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;
unlink($u);
if (open(A, $a)) {
if (open(U, ">$u")) {
- print U pack("$f", 0xFEFF);
+ print U pack("$f", 0xFEFF) if $b;
while (<A>) {
print U pack("$f*", unpack("C*", $_));
}
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"};
}