Add new field 'printconv' to basic PDL Type hash.

The printconv field is meant to be used in C (s)printf statements, and lets one write cleaner-compling code on strict compilers (clang). The idea is to eliminate multiple warnings like "parameter has type double (%g) but you passed in PDL_Short (aka 'short')." when writing a generic print statement in C/XS. The line at the end of pdlcore.c.PL demonstrates usage. This still needs 1) a little documentation in PDL::Types; 2) vetting on other platforms with different IV sizes and/or C compilers to make sure what I wrote is general (it probably isn't). 3) ideas about a different way to do this (using the packtype field that is already in there??). Suggestions welcome.
PDLPorters · May 16, 2016 · a969508 · a969508
1 parent 45f72f1
commit a969508
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 3 deletions.
diff --git a/Basic/Core/Types.pm.PL b/Basic/Core/Types.pm.PL
@@ -25,7 +25,19 @@ sub packtypeof_PDL_Indx {
 
 sub typeof_PDL_Indx {
    warn "Types.pm.PL: using typedef $Config{'ivtype'} PDL_Indx\n";
-   return $Config{'ivtype'} 
+   return $Config{'ivtype'};
+}
+
+sub printconvof_PDL_Indx {
+    if ($Config{'ivsize'} == 8) {
+	return 'ld';
+    }
+    elsif ($Config{'ivsize'} == 4 ) {
+	return 'd';
+    }
+    else {
+	die "Types.pm.PL: printconv for ivsize==$Config{'ivsize'} not handled\n";
+    }
 }
 
 sub typeof_PDL_Long {
@@ -58,6 +70,7 @@ my @types = (
 	      ppforcetype => 'byte', # for some types different from ctype
 	      usenan => 0,           # do we need NaN handling for this type?
 	      packtype => 'C*',      # the perl pack type
+	      printconv => 'hhu',
 	      defaultbadval => 'UCHAR_MAX',
 	     },
 	     {
@@ -67,6 +80,7 @@ my @types = (
 	      ppforcetype => 'short',
 	      usenan => 0,
 	      packtype => 's*',
+	      printconv => 'hd',
 	      defaultbadval => 'SHRT_MIN',
 	     },
 	     {
@@ -77,6 +91,7 @@ my @types = (
 	      ppforcetype => 'ushort',
 	      usenan => 0,
 	      packtype => 'S*',
+	      printconv => 'hu',
 	      defaultbadval => 'USHRT_MAX',
 	     },
 	     {
@@ -86,6 +101,7 @@ my @types = (
 	      ppforcetype => 'int',
 	      usenan => 0,
 	      packtype => 'l*',
+	      printconv => 'd',
 	      defaultbadval => 'INT_MIN',
 	     },
 
@@ -102,6 +118,7 @@ my @types = (
         ppforcetype => 'indx',
         usenan => 0,
         packtype => &packtypeof_PDL_Indx,
+	printconv => &printconvof_PDL_Indx,
         defaultbadval => 'LONG_MIN',
        },
 #
@@ -117,6 +134,7 @@ my @types = (
 	ppforcetype => 'longlong',
 	usenan => 0,
 	packtype => 'q*',
+	printconv => (!defined($Config{longlongsize})||$Config{longlongsize}==8)?'ld':'lld', #this is suboptimal
 	defaultbadval => 'LONG_MIN', # this is far from optimal
 		                     # but LLONG_MIN/LLONG_MAX are probably
 		                     # nonportable
@@ -137,6 +155,7 @@ my @types = (
 		  ppforcetype => 'float',
 		  usenan => 1,
 		  packtype => 'f*',
+		  printconv => 'f',
 	          defaultbadval => '-FLT_MAX',
 	      },
 	      {
@@ -146,6 +165,7 @@ my @types = (
 		  ppforcetype => 'double',
 		  usenan => 1,
 		  packtype => 'd*',
+		  printconv => 'g',
 	          defaultbadval => '-DBL_MAX',
 	      },
 	      );
@@ -210,6 +230,7 @@ sub gentypehashentry ($$) {
 		 ioname => &convertfunc($type), # same as the name of the
 		                                # convertfunc
 		 defbval => $type->{defaultbadval},
+		 printconv => $type->{printconv}
 		};
   return $newhash;
 }

diff --git a/Basic/Core/pdlcore.c.PL b/Basic/Core/pdlcore.c.PL
@@ -7,7 +7,7 @@ use Config;
 use File::Basename qw(&basename &dirname);
 
 require 'Dev.pm'; PDL::Core::Dev->import;
-use vars qw( %PDL_DATATYPES );
+our %PDL_DATATYPES ;
 
 # check for bad value support
 require './Config.pm'; # to load the PDL not the Perl one
@@ -1280,7 +1280,7 @@ PDL_Indx pdl_setav_$type(PDL_$type* pdata, AV* av,
 
     if(debug_flag) {
       fflush(stdout);
-      fprintf(stderr,"Warning: pdl_setav_$type converted undef to $PDL::undefval (%g) %ld time%s\\n",undefval,undef_count,undef_count==1?"":"s");
+      fprintf(stderr,"Warning: pdl_setav_$type converted undef to $PDL::undefval (%$PDL::Types::typehash{$in}->{printconv}) %ld time%s\\n",undefval,undef_count,undef_count==1?"":"s");
       fflush(stderr);
     }
   }