Flush PL_stashcache on glob-to-glob assignment

[perl5.git] / t / test.pl

diff --git a/t/test.pl b/t/test.pl
index aee1d24..e141b91 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -463,7 +463,7 @@ sub skip_without_dynamic_extension {
     my ($extension) = @_;
     skip("no dynamic loading on miniperl, no $extension") if is_miniperl();
     return if &_have_dynamic_extension;
-    skip_all("$extension was not built");
+    skip("$extension was not built");
 }
 
 sub todo_skip {
@@ -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;
@@ -762,6 +765,44 @@ sub unlink_all {
     $count;
 }
 
+# _num_to_alpha - Returns a string of letters representing a positive integer.
+# Arguments :
+#   number to convert
+#   maximum number of letters
+
+# returns undef if the number is negative
+# returns undef if the number of letters is greater than the maximum wanted
+
+# _num_to_alpha( 0) eq 'A';
+# _num_to_alpha( 1) eq 'B';
+# _num_to_alpha(25) eq 'Z';
+# _num_to_alpha(26) eq 'AA';
+# _num_to_alpha(27) eq 'AB';
+
+my @letters = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z);
+
+# Avoid ++ -- ranges split negative numbers
+sub _num_to_alpha{
+    my($num,$max_char) = @_;
+    return unless $num >= 0;
+    my $alpha = '';
+    my $char_count = 0;
+    $max_char = 0 if $max_char < 0;
+
+    while( 1 ){
+        $alpha = $letters[ $num % 26 ] . $alpha;
+        $num = int( $num / 26 );
+        last if $num == 0;
+        $num = $num - 1;
+
+        # char limit
+        next unless $max_char;
+        $char_count = $char_count + 1;
+        return if $char_count == $max_char;
+    }
+    return $alpha;
+}
+
 my %tmpfiles;
 END { unlink_all keys %tmpfiles }
 
@@ -769,25 +810,23 @@ END { unlink_all keys %tmpfiles }
 $::tempfile_regexp = 'tmp\d+[A-Z][A-Z]?';
 
 # Avoid ++, avoid ranges, avoid split //
-my @letters = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z);
+my $tempfile_count = 0;
 sub tempfile {
-    my $count = 0;
-    do {
-       my $temp = $count;
+    while(1){
        my $try = "tmp$$";
-       do {
-           $try = $try . $letters[$temp % 26];
-           $temp = int ($temp / 26);
-       } while $temp;
+        my $alpha = _num_to_alpha($tempfile_count,2);
+        last unless defined $alpha;
+        $try = $try . $alpha;
+        $tempfile_count = $tempfile_count + 1;
+
        # Need to note all the file names we allocated, as a second request may
        # come before the first is created.
-       if (!-e $try && !$tmpfiles{$try}) {
+       if (!$tmpfiles{$try} && !-e $try) {
            # We have a winner
            $tmpfiles{$try} = 1;
            return $try;
        }
-       $count = $count + 1;
-    } while $count < 26 * 26;
+    }
     die "Can't find temporary file name starting 'tmp$$'";
 }
 
@@ -905,7 +944,8 @@ sub fresh_perl_like {
 # Each program is source code to run followed by an "EXPECT" line, followed
 # by the expected output.
 #
-# The code to run may contain (note the '# ' on each):
+# The code to run may begin with a command line switch such as -w or -0777
+# (alphanumerics only), and may contain (note the '# ' on each):
 #   # TODO reason for todo
 #   # SKIP reason for skip
 #   # SKIP ?code to test if this should be skipped
@@ -914,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
@@ -926,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.
 
@@ -945,6 +985,7 @@ sub run_multiple_progs {
 
     my $tmpfile = tempfile();
 
+  PROGRAM:
     for (@prgs){
        unless (/\n/) {
            print "# From $_\n";
@@ -971,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"