This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Flush PL_stashcache on glob-to-glob assignment
[perl5.git] / t / test.pl
index bf9269b..e141b91 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -497,7 +497,10 @@ sub eq_hash {
     # Force a hash recompute if this perl's internals can cache the hash key.
     $key = "" . $key;
     if (exists $orig->{$key}) {
-      if ($orig->{$key} ne $value) {
+      if (
+        defined $orig->{$key} != defined $value
+        || (defined $value && $orig->{$key} ne $value)
+      ) {
         _print "# key ", _qq($key), " was ", _qq($orig->{$key}),
                      " now ", _qq($value), "\n";
         $fail = 1;
@@ -951,9 +954,6 @@ sub fresh_perl_like {
 # The expected output may contain:
 #   OPTION list of options
 #   OPTIONS list of options
-#   PREFIX
-#     indicates that the supplied output is only a prefix to the
-#     expected output
 #
 # The possible options for OPTION may be:
 #   regex - the expected output is a regular expression
@@ -963,6 +963,9 @@ sub fresh_perl_like {
 # If the actual output contains a line "SKIPPED" the test will be
 # skipped.
 #
+# If the actual output contains a line "PREFIX", any output starting with that
+# line will be ignored when comparing with the expected output
+#
 # If the global variable $FATAL is true then OPTION fatal is the
 # default.
 
@@ -982,6 +985,7 @@ sub run_multiple_progs {
 
     my $tmpfile = tempfile();
 
+  PROGRAM:
     for (@prgs){
        unless (/\n/) {
            print "# From $_\n";
@@ -1008,13 +1012,22 @@ sub run_multiple_progs {
                $reason{$what} = $temp;
            }
        }
+
        my $name = '';
        if ($prog =~ s/^#\s*NAME\s+(.+)\n//m) {
            $name = $1;
        }
 
+       if ($reason{skip}) {
+       SKIP:
+         {
+           skip($name ? "$name - $reason{skip}" : $reason{skip}, 1);
+         }
+         next PROGRAM;
+       }
+
        if ($prog =~ /--FILE--/) {
-           my @files = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
+           my @files = split(/\n?--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
            shift @files ;
            die "Internal error: test $_ didn't split into pairs, got " .
                scalar(@files) . "[" . join("%%%%", @files) ."]\n"