Minor tweaks for the test.utf16 target, by Jarkko

[perl5.git] / t / TEST

diff --git a/t/TEST b/t/TEST
index 5885060..fb3adb9 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,9 +22,12 @@ 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';
-        $bytecompile = 1 if $1 eq 'bytecompile';
-        $compile = 1 if $1 eq 'compile';
+       $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';
+       $ENV{PERL_CORE_MINITEST} = 1 if $1 eq 'minitest';
        if ($1 =~ /^deparse(,.+)?$/) {
            $deparse = 1;
            $deparse_opts = $1;
@@ -66,7 +71,8 @@ sub _find_tests {
     my($dir) = @_;
     opendir DIR, $dir or die "Trouble opening $dir: $!";
     foreach my $f (sort { $a cmp $b } readdir DIR) {
-        next if $f eq $curdir or $f eq $updir;
+        next if $f eq $curdir or $f eq $updir or
+           $f =~ /^(?:CVS|RCS|SCCS|\.svn)$/;
 
         my $fullpath = File::Spec->catfile($dir, $f);
 
@@ -131,6 +137,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);
@@ -216,11 +248,20 @@ 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"};
        }
        else {
-           $switch = '';
+           if ($taintwarn) {
+               # not all tests are expected to pass with this option
+               $switch = '"-t"';
+           }
+           else {
+               $switch = '';
+           }
        }
 
         my $test_executable; # for 'compile' tests
@@ -234,7 +275,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 =
@@ -266,7 +307,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";
        }
@@ -279,7 +320,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 {
@@ -287,7 +328,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";
@@ -346,7 +387,7 @@ EOT
                        $seen_ok = 1;
                        if ($2 == $next) {
                            my($not, $num, $extra) = ($1, $2, $3);
-                           my($istodo) = $extra =~ /^\s*#\s*TODO/ if $extra;
+                           my($istodo) = $extra =~ /#\s*TODO/ if $extra;
                            $istodo = 1 if $todo{$num};
 
                            if( $not && !$istodo ) {
@@ -439,7 +480,12 @@ EOT
        }
        else {
            $next += 1;
-           print "${te}FAILED at test $next\n";
+           if ($next > $max) {
+               print "${te}FAILED at test $next\tpossibly due to extra output\n";
+           }
+           else {
+               print "${te}FAILED at test $next\n";
+           }
            $bad = $bad + 1;
            $_ = $test;
            if (/^base/) {