The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
use PDL::LiteF;
use Test::More tests => 8;


########### Test of Subclassed-object copying for simple function cases ###########


##  First define a PDL-derived object:
package PDL::Derived;
@PDL::Derived::ISA = qw/PDL/;

sub new {
   my $class = shift;

   my $data = $_[0];

   my $self;
   if(ref($data) eq 'PDL' ){ # if $data is an object (a pdl)
	   $self = $class->initialize;
	   $self->{PDL} = $data;
   }
   else{	# if $data not an object call inherited constructor
	   $self = $class->SUPER::new($data);
   }

   return $self;
}

####### Initialize function. This over-ridden function is called by the PDL constructors
sub initialize {
	my $class = shift;
        my $self = {
                PDL => PDL->null, 	# used to store PDL object
		someThingElse => 42,
        };
	$class = (ref $class ? ref $class : $class );
        bless $self, $class;
}

###### Derived Object Needs to supply its own copy #####
sub copy {
	my $self = shift;
	
	# setup the object
	my $new = $self->initialize;
	
	# copy the PDL
	$new->{PDL} = $self->{PDL}->SUPER::copy;

	# copy the other stuff:
	$new->{someThingElse} = $self->{someThingElse};

	return $new;

}


#######################################################
package main;

###### Testing Begins #########

# Create New PDL::Derived Object
#   (Initialize sets 'someThingElse' data member
#     to 42)
$im = new PDL::Derived [
  [ 1, 2,  3,  3 , 5],
  [ 2,  3,  4,  5,  6],
  [13, 13, 13, 13, 13],
  [ 1,  3,  1,  3,  1],
  [10, 10,  2,  2,  2,]
 ];

#  Set 'someThingElse' Data Member to 24. (from 42)
$im->{someThingElse} = 24;

# Test to see if simple functions (a functions
#    with signature sqrt a(), [o]b() ) copies subclassed object correctly.
my @simpleFuncs = (qw/ 
bitnot sqrt abs sin cos not exp log10 /);

foreach my $op( @simpleFuncs){
	
	$w = $im->$op(); 

	ok($w->{someThingElse} == 24, "$op subclassed object correctly"); 
}