fix bug in perldl calling perldlpp - fix #497

Basic/AutoLoader.pm

@@ -224,10 +224,10 @@ sub PDL::AutoLoader::autoloader_do {
   my ($file) = shift;
   if(defined($PDL::NiceSlice::VERSION)) {
     print "AutoLoader: NiceSlice enabled...\n" if($PDL::debug);
-    if(open(AUTOLOAD_FILE,"<$file")) {
-      my($script) = PDL::NiceSlice::perldlpp("PDL::NiceSlice", join("",<AUTOLOAD_FILE>));
-      eval $script;
-    }
+    return if !open my $fh ,"<", $file;
+    my $text = join "", <$fh>;
+    my $script = PDL::NiceSlice::perldlpp("PDL::NiceSlice", $text);
+    eval $script;
   } else {
     print "AutoLoader: no NiceSlice...\n" if($PDL::debug);
     do $file;

Basic/SourceFilter/NiceSlice.pm

@@ -365,24 +365,17 @@ sub reinstator_regexp{
 sub perldlpp {
  my ($class, $txt) = @_;
  local($_);
- ##############################
- # Backwards compatibility to before the two-parameter form. The only
- # call should be around line 206 of PDL::AutoLoader, but one never
- # knows....
- #    -- CED 5-Nov-2007
- if(!defined($txt)) { 
+ if (!defined($txt)) { 
      print "PDL::NiceSlice::perldlpp -- got deprecated one-argument form, from ".(join("; ",caller))."...\n";
      $txt = $class; 
      $class = "PDL::NiceSlice";
  }
 
- ## Debugging to track exactly what is going on -- left in, in case it's needed again
- if($PDL::NiceSlice::debug > 1) {
+ if ($PDL::NiceSlice::debug > 1) {
      print "PDL::NiceSlice::perldlpp - got:\n$txt\n";
-     my $i;
-     for $i(0..5){
-	 my($package,$filename,$line,$subroutine, $hasargs) = caller($i);
-	 printf("layer %d: %20s, %40s, line %5d, sub %20s, args: %d\n",$i,$package,$filename,$line,$subroutine,$hasargs);
+     for my $i (0..5){
+	 my ($package,$filename,$line,$subroutine, $hasargs) = caller($i);
+	 printf "layer %d: %20s, %40s, line %5s, sub %20s, args: %s\n",$i,$package//'',$filename//'',$line//'',$subroutine//'',$hasargs//'';
      }
  }
 
@@ -438,7 +431,7 @@ sub perldlpp {
 	     $new .= "$_\n";
 
 	 }
-     } while(@lines && !$end);
+     } while @lines && !$end;
  };
 
  if ($@) {

perldl

@@ -199,7 +199,7 @@ unless ($@) {
     return $ret;
   }
   my $preproc = sub { my ($txt) = @_;
-	  my $new = PDL::NiceSlice::perldlpp('main',$txt);
+	  my $new = PDL::NiceSlice::perldlpp('PDL::NiceSlice',$txt);
 	  print STDERR "processed $new\n" if report && $new ne $txt;
 	  return $new;
   };

t/autoload.t

@@ -3,6 +3,7 @@ use strict;
 use warnings;
 use Test::More;
 use PDL::LiteF;
+use PDL::NiceSlice;
 
 plan skip_all => 'This test must be run from t/..' if !-f 't/func.pdl';
 
@@ -17,6 +18,9 @@ my $x = long(2 + ones(2,2));
 my $y = func($x);
 
 ok approx(sum($y), 4*29), 'Check autoload of func.pdl' or diag "got=$y";
+{ no warnings 'once';
+is $::GLOBAL_VAR, '$'.'COMP(max_it)', "NiceSlice didn't mangle text";
+}
 
 #check that tilde expansion works (not applicable on MS Windows)
 SKIP: {

t/func.pdl

@@ -1,13 +1,10 @@
-
 # Test file for autoloader.t
 
+no PDL::NiceSlice;
 sub func {
-
    my $x = shift;
-
+   $::GLOBAL_VAR = '$COMP(max_it)';
    return ($x**3 + 2);
-
 };
 
 1; # OK status
-