$#a>>=1 relies on malloc wrap to avoid the segfault, so need to

[p5sagit/p5-mst-13.2.git] / t / TEST

diff --git a/t/TEST b/t/TEST
index 357f230..38afe6f 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -1,7 +1,9 @@
 #!./perl
 
 # This is written in a peculiar style, since we're trying to avoid
-# most of the constructs we'll be testing for.
+# most of the constructs we'll be testing for.  (This comment is
+# probably obsolete on the avoidance side, though still currrent
+# on the peculiarity side.)
 
 $| = 1;
 
@@ -20,7 +22,8 @@ if ($#ARGV >= 0) {
        $core    = 1 if $1 eq 'core';
        $verbose = 1 if $1 eq 'v';
        $torture = 1 if $1 eq 'torture';
-       $with_utf= 1 if $1 eq 'utf8';
+       $with_utf8 = 1 if $1 eq 'utf8';
+       $with_utf16 = 1 if $1 eq 'utf16';
        $bytecompile = 1 if $1 eq 'bytecompile';
        $compile = 1 if $1 eq 'compile';
        $taintwarn = 1 if $1 eq 'taintwarn';
@@ -92,18 +95,58 @@ sub _quote_args {
     return $argstring;
 }
 
+sub _populate_hash {
+    return map {$_, 1} split /\s+/, $_[0];
+}
+
 unless (@ARGV) {
     foreach my $dir (qw(base comp cmd run io op uni)) {
         _find_tests($dir);
     }
     _find_tests("lib") unless $core;
+    # Config.pm may be broken for make minitest. And this is only a refinement
+    # for skipping tests on non-default builds, so it is allowed to fail.
+    # What we want to to is make a list of extensions which we did not build.
+    my $configsh = File::Spec->catfile($updir, "config.sh");
+    my %skip;
+    if (-f $configsh) {
+       my (%extensions, %known_extensions);
+       open FH, $configsh or die "Can't open $configsh: $!";
+       while (<FH>) {
+           if (/^extensions=['"](.*)['"]$/) {
+               # Deliberate string interpolation to avoid triggering possible
+               # $1 resetting bugs.
+               %extensions = _populate_hash ("$1");
+           }
+           elsif (/^known_extensions=['"](.*)['"]$/) {
+               %known_extensions = _populate_hash ($1);
+           }
+       }
+       if (%extensions) {
+           if (%known_extensions) {
+               foreach (keys %known_extensions) {
+                   $skip{$_}++ unless $extensions{$_};
+               }
+           } else {
+               warn "No known_extensions line found in $configsh";
+           }
+       } else {
+           warn "No extensions line found in $configsh";
+       }
+    }
     my $mani = File::Spec->catfile($updir, "MANIFEST");
     if (open(MANI, $mani)) {
         while (<MANI>) { # similar code in t/harness
-           if (m!^(ext/\S+/?(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) {
+           if (m!^(ext/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) {
                $t = $1;
+               $extension = $2;
                if (!$core || $t =~ m!^lib/[a-z]!)
                {
+                   if (defined $extension) {
+                       $extension =~ s!/t$!!;
+                       # XXX Do I want to warn that I'm skipping these?
+                       next if $skip{$extension};
+                   }
                    $path = File::Spec->catfile($updir, $t);
                    push @ARGV, $path;
                    $name{$path} = $t;
@@ -134,6 +177,32 @@ elsif( $compile ) {
 elsif( $bytecompile ) {
     _testprogs('bytecompile', '', @ARGV);
 }
+elsif ($with_utf16) {
+    for my $e (0, 1) {
+       for my $b (0, 1) {
+           print STDERR "# ENDIAN $e BOM $b\n";
+           my @UARGV;
+           for my $a (@ARGV) {
+               my $u = $a . "." . ($e ? "l" : "b") . "e" . ($b ? "b" : "");
+               my $f = $e ? "v" : "n";
+               push @UARGV, $u;
+               unlink($u);
+               if (open(A, $a)) {
+                   if (open(U, ">$u")) {
+                       print U pack("$f", 0xFEFF) if $b;
+                       while (<A>) {
+                           print U pack("$f*", unpack("C*", $_));
+                       }
+                       close(A);
+                   }
+                   close(B);
+               }
+           }
+           _testprogs('perl', '', @UARGV);
+           unlink(@UARGV);
+       }
+    }
+}
 else {
     _testprogs('compile', '',   @ARGV) if -e "../testcompile";
     _testprogs('perl',    '',   @ARGV);
@@ -219,6 +288,9 @@ EOT
        open(SCRIPT,"<$test") or die "Can't run $test.\n";
        $_ = <SCRIPT>;
        close(SCRIPT) unless ($type eq 'deparse');
+       if ($with_utf16) {
+           $_ =~ tr/\0//d;
+       }
        if (/#!.*\bperl.*\s-\w*([tT])/) {
            $switch = qq{"-$1"};
        }
@@ -243,7 +315,7 @@ EOT
            close(SCRIPT);
        }
 
-       my $utf = $with_utf ? '-I../lib -Mutf8' : '';
+       my $utf8 = $with_utf8 ? '-I../lib -Mutf8' : '';
        my $testswitch = '-I. -MTestInit'; # -T will strict . from @INC
        if ($type eq 'deparse') {
            my $deparse =
@@ -275,7 +347,7 @@ EOT
            my $bytecompile =
                "$perl $testswitch $switch -I../lib $bswitch". 
                "-o$test.plc $test 2>$null &&".
-               "$perl $testswitch $switch -I../lib $utf $test.plc |";
+               "$perl $testswitch $switch -I../lib $utf8 $test.plc |";
            open(RESULTS,$bytecompile)
                or print "can't byte-compile '$bytecompile': $!.\n";
        }
@@ -288,7 +360,7 @@ EOT
                                . "--num-callers=50 --logfile-fd=3 $perl";
                $redir = "3>$valgrind_log";
            }
-           my $run = "$perl" . _quote_args("$testswitch $switch $utf") . " $test $redir|";
+           my $run = "$perl" . _quote_args("$testswitch $switch $utf8") . " $test $redir|";
            open(RESULTS,$run) or print "can't run '$run': $!.\n";
        }
        else {
@@ -296,7 +368,7 @@ EOT
             my $pl2c = "$testswitch -I../lib ../utils/perlcc --testsuite " .
               # -O9 for good measure, -fcog is broken ATM
                        "$switch -Wb=-O9,-fno-cog -L .. " .
-                       "-I \".. ../lib/CORE\" $args $utf $test -o ";
+                       "-I \".. ../lib/CORE\" $args $utf8 $test -o ";
 
             if( $^O eq 'MSWin32' ) {
                 $test_executable = "$test.exe";