X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2FTEST;h=38afe6f6910fe05d6d30fcd9b184b8a9e7c54076;hb=25988e07f3c5c5717930b897625a3e6119c92879;hp=ecd5122f35ef2017eb06788928e18dfa98fcb75d;hpb=21c74f43bb8a4eac1af459c973ca694bf54dde7b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/TEST b/t/TEST index ecd5122..38afe6f 100755 --- 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; @@ -64,9 +69,10 @@ my $updir = File::Spec->updir; sub _find_tests { my($dir) = @_; - opendir DIR, $dir || die "Trouble opening $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); @@ -89,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 () { + 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 () { # 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; @@ -112,7 +158,7 @@ unless (@ARGV) { warn "$0: cannot open $mani: $!\n"; } unless ($core) { - _find_tests('pod'); + _find_tests('pod'); _find_tests('x2p'); _find_tests('japh') if $torture; } @@ -131,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 () { + 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); @@ -183,6 +255,8 @@ EOT } # + 3 : we want three dots between the test name and the "ok" $dotdotdot = $maxlen + 3 ; + my $valgrind = 0; + my $valgrind_log = 'current.valgrind'; while ($test = shift @tests) { if ( $infinite{$test} && $type eq 'compile' ) { @@ -197,7 +271,7 @@ EOT # Redefinition happens at compile time next; } - elsif ($test eq "lib/switch.t") { + elsif ($test =~ m{lib/Switch/t/}) { # B::Deparse doesn't support source filtering next; } @@ -214,11 +288,20 @@ EOT open(SCRIPT,"<$test") or die "Can't run $test.\n"; $_ =