← Back to branch summary

~ubuntu-branches/ubuntu/lucid/pdl/lucid

« back to all changes in this revision

Viewing changes to t/subclass4.t

  • Committer: Bazaar Package Importer
  • Author(s): Ben Gertzfield
  • Date: 2002-04-08 18:47:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020408184716-0hf64dc96kin3htp
Tags: upstream-2.3.2
Import upstream version 2.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/subclass4.t
 
1
 
 
2
use PDL::LiteF;
 
3
 
 
4
 
 
5
 
 
6
########### Test of Subclassed-object copying for simple function cases ###########
 
7
 
 
8
 
 
9
##  First define a PDL-derived object:
 
10
package PDL::Derived;
 
11
@PDL::Derived::ISA = qw/PDL/;
 
12
 
 
13
 
 
14
sub new {
 
15
   my $class = shift;
 
16
 
 
17
   my $data = $_[0];
 
18
 
 
19
   my $self;
 
20
   if(ref($data) eq 'PDL' ){ # if $data is an object (a pdl)
 
21
           $self = $class->initialize;
 
22
           $self->{PDL} = $data;
 
23
   }
 
24
   else{        # if $data not an object call inherited constructor
 
25
           $self = $class->SUPER::new($data);
 
26
   }
 
27
 
 
28
   return $self;
 
29
}
 
30
 
 
31
####### Initialize function. This over-ridden function is called by the PDL constructors
 
32
sub initialize {
 
33
        my $class = shift;
 
34
        my $self = {
 
35
                PDL => PDL->null,       # used to store PDL object
 
36
                someThingElse => 42,
 
37
        };
 
38
        $class = (ref $class ? ref $class : $class );
 
39
        bless $self, $class;
 
40
}
 
41
 
 
42
###### Derived Object Needs to supply its own copy #####
 
43
sub copy {
 
44
        my $self = shift;
 
45
        
 
46
        # setup the object
 
47
        my $new = $self->initialize;
 
48
        
 
49
        # copy the PDL
 
50
        $new->{PDL} = $self->{PDL}->SUPER::copy;
 
51
 
 
52
        # copy the other stuff:
 
53
        $new->{someThingElse} = $self->{someThingElse};
 
54
 
 
55
        return $new;
 
56
 
 
57
}
 
58
 
 
59
 
 
60
#######################################################
 
61
package main;
 
62
 
 
63
###### Testing Begins #########
 
64
print "1..8\n";   
 
65
 
 
66
my $testNo = 1;
 
67
 
 
68
# Create New PDL::Derived Object
 
69
#   (Initialize sets 'someThingElse' data member
 
70
#     to 42)
 
71
$im = new PDL::Derived [
 
72
  [ 1, 2,  3,  3 , 5],
 
73
  [ 2,  3,  4,  5,  6],
 
74
  [13, 13, 13, 13, 13],
 
75
  [ 1,  3,  1,  3,  1],
 
76
  [10, 10,  2,  2,  2,]
 
77
 ];
 
78
 
 
79
#  Set 'someThingElse' Data Member to 24. (from 42)
 
80
$im->{someThingElse} = 24;
 
81
 
 
82
# Test to see if simple functions (a functions
 
83
#    with signature sqrt a(), [o]b() ) copies subclassed object correctly.
 
84
my @simpleFuncs = (qw/ 
 
85
bitnot sqrt abs sin cos not exp log10 /);
 
86
 
 
87
foreach my $op( @simpleFuncs){
 
88
        
 
89
        $w = $im->$op(); 
 
90
 
 
91
        ok($testNo++, $w->{someThingElse} == 24 ); 
 
92
}
 
93
 
 
94
 
 
95
 
 
96
sub ok {
 
97
        my $no = shift ;
 
98
        my $result = shift ;
 
99
        print "not " unless $result ;
 
100
        print "ok $no\n" ;
 
101
}