Travis-CI (ignore)

Basic/Bad/bad.pd

@@ -492,7 +492,7 @@ foreach my $i ( 0 .. $ntypes ) {
 
 EOC
 
-    my $set_code = "if ( items > 0 ) { $storage = ($realctype) val; }";
+    my $set_code = "if ( val.type != -1 ) { ANYVAL_TO_CTYPE($storage, $ctype, val); }";
 
     # if UseNaN is true, then we can not change the value used to
     # represent bad elements since it's a NaN. At least, not for
@@ -505,8 +505,8 @@ EOC
     $str .=
 "
 pdl *
-_badvalue_int${i}(val=0)
-    double val
+_badvalue_int${i}(val)
+    PDL_Anyval val
   CODE:
    {
     $init_code
@@ -518,13 +518,13 @@ _badvalue_int${i}(val=0)
     RETVAL
 
 pdl *
-_badvalue_per_pdl_int${i}(pdl_val, val=0)
+_badvalue_per_pdl_int${i}(pdl_val, val)
     pdl* pdl_val
-    double val
+    PDL_Anyval val
   CODE:
    {
     $init_code
-    if ( items > 1 ) {
+    if ( val.type != -1) {
        pdl_val->badvalue = val;
        pdl_val->has_badvalue = 1;
        PDL->propagate_badvalue( pdl_val );
@@ -533,7 +533,7 @@ _badvalue_per_pdl_int${i}(pdl_val, val=0)
     if (pdl_val->has_badvalue == 0) {
        *data = ($ctype) $storage;
     } else {
-       *data = ($ctype) pdl_val->badvalue;
+       ANYVAL_TO_CTYPE(*data, $ctype, pdl_val->badvalue);
     }
 
     RETVAL = p;
@@ -577,7 +577,7 @@ sub PDL::badvalue {
     my $num;
     if ( UNIVERSAL::isa($self,"PDL") ) {
 	$num = $self->get_datatype;
-	if ( $num < 4 and defined($val) and $self->badflag ) {
+	if ( $num < $PDL_F && defined($val) && $self->badflag ) {
 	    $self->inplace->setbadtoval( $val );
 	    $self->badflag(1);
 	}
@@ -587,7 +587,7 @@ sub PDL::badvalue {
 	    if ( defined $val ) {
 		return &{$name}($self, $val )->sclr;
 	    } else {
-		return &{$name}($self)->sclr;
+		return &{$name}($self, undef)->sclr;
 	    }
 	}
 
@@ -602,7 +602,7 @@ sub PDL::badvalue {
     if ( defined $val ) {
 	return &{$name}( $val )->sclr;
     } else {
-	return &{$name}()->sclr;
+	return &{$name}( undef )->sclr;
     }
 
 } # sub: badvalue()

Basic/Core/Core.pm

@@ -55,14 +55,16 @@ $PDL::toolongtoprint = 10000;  # maximum pdl size to stringify for printing
 *at		= \&PDL::at;	  *flows	= \&PDL::flows;
 *sclr           = \&PDL::sclr;    *shape        = \&PDL::shape;
 
+# XXX-PDLANYVAL alltopdl changes need a check */
+
 for (map {
   [ PDL::Types::typefld($_,'convertfunc'), PDL::Types::typefld($_,'numval') ]
 } PDL::Types::typesrtkeys()) {
   my ($conv, $val) = @$_;
   no strict 'refs';
   *$conv = *{"PDL::$conv"} = sub {
     return bless [$val], "PDL::Type" unless @_;
-    convert(alltopdl('PDL', (scalar(@_)>1 ? [@_] : shift)), $val);
+    alltopdl('PDL', (scalar(@_)>1 ? [@_] : shift), PDL::Type->new($val));
   };
 }
 
@@ -2198,6 +2200,10 @@ sub PDL::topdl {
 # Convert everything to PDL if not blessed
 
 sub alltopdl {
+    if (ref $_[2] eq 'PDL::Type') {
+      return convert($_[1], $_[2]) if blessed($_[1]);
+      return $_[0]->new($_[2], $_[1]) if $_[0] eq 'PDL';
+    }
     return $_[1] if blessed($_[1]); # Fall through
     return $_[0]->new($_[1]);
 0;}

Basic/Core/Core.xs

@@ -28,8 +28,6 @@
 
 #define setflag(reg,flagval,val) (val?(reg |= flagval):(reg &= ~flagval))
 
-#define SET_RETVAL_NV(x) x->datatype<PDL_F ? (RETVAL=newSViv( (IV)result )) : (RETVAL=newSVnv( result ))
-
 Core PDL; /* Struct holding pointers to shared C routines */
 
 #ifdef FOO
@@ -248,7 +246,7 @@ void propagate_badvalue( pdl *it ) {
 
 /* this is horrible - the routines from bad should perhaps be here instead ? */
 PDL_Anyval pdl_get_badvalue( int datatype ) {
-    PDL_Anyval retval;
+    PDL_Anyval retval = { -1, 0 };
     switch ( datatype ) {
 
 #include "pdldataswitch.c"
@@ -261,7 +259,7 @@ PDL_Anyval pdl_get_badvalue( int datatype ) {
 
 
 PDL_Anyval pdl_get_pdl_badvalue( pdl *it ) {
-    PDL_Anyval retval;
+    PDL_Anyval retval = { -1, 0 };
     int datatype;
 
 #if BADVAL_PER_PDL
@@ -620,10 +618,10 @@ sclr_c(it)
 	PDL_Indx nullp = 0;
 	PDL_Indx dummyd = 1;
 	PDL_Indx dummyi = 1;
-	PDL_Anyval result;
+	PDL_Anyval result = { -1, 0 };
    CODE:
         /* get the first element of a piddle and return as
-         * Perl double scalar (NV)
+         * Perl scalar (autodetect suitable type IV or NV)
          */
         pdl_make_physvaffine( it );
 	if (it->nvals < 1)
@@ -632,7 +630,7 @@ sclr_c(it)
         /* result = pdl_get_offs(PDL_REPRP(it),offs); */
         result=pdl_at(PDL_REPRP(it), it->datatype, &nullp, &dummyd,
         &dummyi, PDL_REPROFFS(it),1);
-        SET_RETVAL_NV(it) ;
+        ANYVAL_TO_SV(RETVAL, result);
 
     OUTPUT:
         RETVAL
@@ -646,7 +644,7 @@ at_c(x,position)
     PDL_Indx * pos;
     int npos;
     int ipos;
-    PDL_Anyval result;
+    PDL_Anyval result = { -1, 0 };
    CODE:
     pdl_make_physvaffine( x );
 
@@ -668,7 +666,7 @@ at_c(x,position)
         (PDL_VAFFOK(x) ? x->vafftrans->incs : x->dimincs), PDL_REPROFFS(x),
 	x->ndims);
 
-    SET_RETVAL_NV(x) ;
+    ANYVAL_TO_SV(RETVAL, result);
 
     OUTPUT:
      RETVAL
@@ -682,7 +680,7 @@ at_bad_c(x,position)
     int npos;
     int ipos;
     int badflag;
-    PDL_Anyval result;
+    PDL_Anyval result = { -1, 0 };
    CODE:
     pdl_make_physvaffine( x );
 
@@ -708,22 +706,23 @@ at_bad_c(x,position)
 #  if BADVAL_USENAN
    /* do we have to bother about NaN's? */
    if ( badflag &&
-        ( ( x->datatype < 4 && ( result == pdl_get_badvalue( x->datatype ) ) ) ||
-          ( x->datatype >= 4 && ( finite(result) == 0 ) )
+        ( ( x->datatype < PDL_F && ANYVAL_EQ_ANYVAL(result, pdl_get_badvalue(x->datatype)) ) ||
+          ( x->datatype == PDL_F && finite(pdl_val.value.F) == 0 ) ||
+          ( x->datatype == PDL_D && finite(pdl_val.value.D) == 0 ) )
         )
       ) {
 	 RETVAL = newSVpvn( "BAD", 3 );
    } else
 #  else
    if ( badflag &&
-        ( pdl_get_badvalue( x->datatype ) == result )
+        ANYVAL_EQ_ANYVAL( result, pdl_get_badvalue( x->datatype ) )
       ) {
 	 RETVAL = newSVpvn( "BAD", 3 );
    } else
 #  endif
 #endif
 
-    SET_RETVAL_NV(x) ;
+    ANYVAL_TO_SV(RETVAL, result);
 
     OUTPUT:
      RETVAL
@@ -739,6 +738,7 @@ list_c(x)
 	void *data;
 	int ind;
 	int stop = 0;
+	SV *sv;
 	PPCODE:
       pdl_make_physvaffine( x );
 	inds = pdl_malloc(sizeof(PDL_Indx) * x->ndims); /* GCC -> on stack :( */
@@ -749,8 +749,10 @@ list_c(x)
 	EXTEND(sp,x->nvals);
 	for(ind=0; ind < x->ndims; ind++) inds[ind] = 0;
 	while(!stop) {
-		PUSHs(sv_2mortal(newSVnv(pdl_at( data, x->datatype,
-			inds, x->dims, incs, offs, x->ndims))));
+		PDL_Anyval pdl_val = { -1, 0 };
+		pdl_val = pdl_at( data, x->datatype, inds, x->dims, incs, offs, x->ndims);
+		ANYVAL_TO_SV(sv,pdl_val);
+		PUSHs(sv_2mortal(sv));
 		stop = 1;
 		for(ind = 0; ind < x->ndims; ind++)
 			if(++(inds[ind]) >= x->dims[ind])
@@ -774,6 +776,9 @@ listref_c(x)
    int lind;
    int stop = 0;
    AV *av;
+   SV *sv;
+   PDL_Anyval pdl_val =    { -1, 0 };
+   PDL_Anyval pdl_badval = { -1, 0 };
   CODE:
 #if BADVAL
     /*
@@ -782,12 +787,10 @@ listref_c(x)
     #  returns
     */
 
-   SV *sv;
-   PDL_Anyval pdl_val, pdl_badval;
    int badflag = (x->state & PDL_BADVAL) > 0;
 #  if BADVAL_USENAN
     /* do we have to bother about NaN's? */
-   if ( badflag && x->datatype < 4 ) {
+   if ( badflag && x->datatype < PDL_F ) {
       pdl_badval = pdl_get_pdl_badvalue( x );
    }
 #  else
@@ -811,23 +814,22 @@ listref_c(x)
       pdl_val = pdl_at( data, x->datatype, inds, x->dims, incs, offs, x->ndims );
       if ( badflag && 
 #  if BADVAL_USENAN
-	/* NOTE: dangerous use of hardwired datatype value 4! */
-	( (x->datatype < 4 && pdl_val == pdl_badval) ||
-			(x->datatype >= 4 && finite(pdl_val) == 0) )
+        ( (x->datatype < PDL_F && ANYVAL_EQ_ANYVAL(pdl_val, pdl_badval)) ||
+          (x->datatype == PDL_F && finite(pdl_val.value.F) == 0) ||
+          (x->datatype == PDL_D && finite(pdl_val.value.D) == 0) )
 #  else
-        pdl_val == pdl_badval
+        ANYVAL_EQ_ANYVAL(pdl_val, pdl_badval)
 #  endif
       ) {
 	 sv = newSVpvn( "BAD", 3 );
       } else {
-	 sv = newSVnv( pdl_val );
+	 ANYVAL_TO_SV(sv, pdl_val);
       }
       av_store( av, lind, sv );
 #else
-      av_store(av,lind,
-               newSVnv( pdl_at( data, x->datatype,
-	       inds, x->dims, incs, offs, x->ndims ) )
-               );
+      pdl_val = pdl_at( data, x->datatype, inds, x->dims, incs, offs, x->ndims );
+      ANYVAL_TO_SV(sv, pdl_val);
+      av_store(av, lind, sv);
 #endif
 
       lind++;
@@ -1315,6 +1317,7 @@ void
 threadover_n(...)
    PREINIT:
    int npdls;
+   SV *sv;
    CODE:
    {
     npdls = items - 1;
@@ -1342,8 +1345,10 @@ threadover_n(...)
 		EXTEND(sp,items);
 		PUSHs(sv_2mortal(newSViv((sd-1))));
 		for(i=0; i<npdls; i++) {
-			PUSHs(sv_2mortal(newSVnv(
-				pdl_get_offs(pdls[i],pdl_thr.offs[i]))));
+			PDL_Anyval pdl_val = { -1, 0 };
+			pdl_val = pdl_get_offs(pdls[i],pdl_thr.offs[i]);
+			ANYVAL_TO_SV(sv, pdl_val);
+			PUSHs(sv_2mortal(sv));
 		}
 	    	PUTBACK;
 		perl_call_sv(code,G_DISCARD);

Basic/Core/Dev.pm

@@ -315,6 +315,7 @@ sub flushgeneric {  # Construct the generic code switch
 
      $type = $PDL_DATATYPES{$case};
 
+     my $ppsym = $PDL::Types::typehash{$case}->{ppsym};
      print $indent,"case $case:\n"; # Start of this case
      print $indent,"   {";
 
@@ -324,6 +325,7 @@ sub flushgeneric {  # Construct the generic code switch
         $line = $_;
 
         $line =~ s/\bgeneric\b/$type/g;
+        $line =~ s/\bgeneric_ppsym\b/$ppsym/g;
 
         print "   ",$line;
      }
@@ -724,9 +726,10 @@ sub datatypes_switch {
   foreach my $i ( 0 .. $ntypes ) {
     my $type = PDL::Type->new( $i );
     my $typesym = $type->symbol;
+    my $typeppsym = $type->ppsym;
     my $cname = $type->ctype;
     $cname =~ s/^PDL_//;
-    push @m, "\tcase $typesym: retval = PDL.bvals.$cname; break;";
+    push @m, "\tcase $typesym: retval.type = $typesym; retval.value.$typeppsym = PDL.bvals.$cname; break;";
   }
   print map "$_\n", @m;
 }

Basic/Core/Types.pm.PL

@@ -143,15 +143,6 @@ my @types = (
 		  packtype => 'd*',
 	          defaultbadval => '-DBL_MAX',
 	      },
-	      {
-		  identifier => 'A',
-		  pdlctype => 'PDL_Anyval',
-		  realctype => 'double',
-		  ppforcetype => 'anyval',
-		  usenan => 0,
-		  packtype => '(a8)*',
-	          defaultbadval => '-DBL_MAX',
-	      },
 	      );
 
 sub checktypehas {
@@ -453,15 +444,21 @@ sub datatypes_header {
     $PDL_Indx_type = $Config::Config{'ivtype'};
     warn "Using new 64bit index support\n" if $Config::Config{'ivsize'}==8;
 
+    my $anyval_union = '';
     my $enum = '';
     my $typedefs = '';
     for (sort { $typehash{$a}{'numval'}<=>$typehash{$b}{'numval'} }  keys %typehash) {
      $enum .= $typehash{$_}{'sym'}.", ";
+     $anyval_union .= "        $typehash{$_}{'ctype'} $typehash{$_}{'ppsym'};\n";
      $typedefs .= "typedef $typehash{$_}{'realctype'}              $typehash{$_}{'ctype'};\n";
     }
     chop $enum;
     chop $enum;
 
+    $typedefs .= "typedef struct {\n    pdl_datatypes type;\n    union {\n";
+    $typedefs .= $anyval_union;
+    $typedefs .= "    } value;\n} PDL_Anyval;\n";
+
     my $indx_type = typefld('PDL_IND','realctype');
     $typedefs .= '#define IND_FLAG ';
     if ($indx_type eq 'long'){
@@ -481,7 +478,7 @@ sub datatypes_header {
 
 /* Data types/sizes [must be in order of complexity] */
 
-enum pdl_datatypes { $enum };
+typedef enum { $enum } pdl_datatypes;
 
 /* Define the pdl data types */
 
@@ -668,7 +665,7 @@ sub badvalue {
   my ( $self, $val ) = @_;
   my $name = "PDL::_badvalue_int" . $self->enum();
   if ( defined $val ) { return &{$name}( $val )->sclr; }
-  else                { return &{$name}()->sclr; }
+  else                { return &{$name}( undef )->sclr; }
 }
 
 sub orig_badvalue {