Merge branch 'release-5.21.2' into blead

[perl5.git] / t / test.pl

diff --git a/t/test.pl b/t/test.pl
index 15282ca..13db432 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -53,6 +53,7 @@ sub plan {
        }
     } else {
        my %plan = @_;
+       $plan{skip_all} and skip_all($plan{skip_all});
        $n = $plan{tests};
     }
     _print "1..$n\n" unless $noplan;
@@ -420,6 +421,14 @@ sub unlike ($$@) { like_yn (1,@_) }; # 1 for un-
 
 sub like_yn ($$$@) {
     my ($flip, undef, $expected, $name, @mess) = @_;
+
+    # We just accept like(..., qr/.../), not like(..., '...'), and
+    # definitely not like(..., '/.../') like
+    # Test::Builder::maybe_regex() does.
+    unless (re::is_regexp($expected)) {
+       die "PANIC: The value '$expected' isn't a regexp. The like() function needs a qr// pattern, not a string";
+    }
+
     my $pass;
     $pass = $_[1] =~ /$expected/ if !$flip;
     $pass = $_[1] !~ /$expected/ if $flip;
@@ -1558,8 +1567,14 @@ sub watchdog ($;$)
 
             # Add END block to parent to terminate and
             #   clean up watchdog process
-            eval "END { local \$! = 0; local \$? = 0;
-                        wait() if kill('KILL', $watchdog); };";
+            # Win32 watchdog is launched by cmd.exe shell, so use process group
+            # kill, otherwise the watchdog is never killed and harness waits
+            # every time for the timeout, #121395
+            eval( $is_mswin ?
+            "END { local \$! = 0; local \$? = 0;
+                        wait() if kill('-KILL', $watchdog); };"
+            : "END { local \$! = 0; local \$? = 0;
+                        wait() if kill('KILL', $watchdog); };");
             return;
         }
 
@@ -1646,57 +1661,4 @@ WATCHDOG_VIA_ALARM:
     }
 }
 
-# The following 2 functions allow tests to work on both EBCDIC and
-# ASCII-ish platforms.  They convert string scalars between the native
-# character set and the set of 256 characters which is usually called
-# Latin1.
-
-sub native_to_latin1($) {
-    my $string = shift;
-
-    return $string if ord('^') == 94;   # ASCII, Latin1
-    my $output = "";
-    for my $i (0 .. length($string) - 1) {
-        $output .= chr(ord_native_to_latin1(ord(substr($string, $i, 1))));
-    }
-    # Preserve utf8ness of input onto the output, even if it didn't need to be
-    # utf8
-    utf8::upgrade($output) if utf8::is_utf8($string);
-
-    return $output;
-}
-
-sub latin1_to_native($) {
-    my $string = shift;
-
-    return $string if ord('^') == 94;   # ASCII, Latin1
-    my $output = "";
-    for my $i (0 .. length($string) - 1) {
-        $output .= chr(ord_latin1_to_native(ord(substr($string, $i, 1))));
-    }
-    # Preserve utf8ness of input onto the output, even if it didn't need to be
-    # utf8
-    utf8::upgrade($output) if utf8::is_utf8($string);
-
-    return $output;
-}
-
-sub ord_latin1_to_native {
-    # given an input code point, return the platform's native
-    # equivalent value.  Anything above latin1 is itself.
-
-    my $ord = shift;
-    return $ord if ord('^') == 94;   # ASCII, Latin1
-    return utf8::unicode_to_native($ord);
-}
-
-sub ord_native_to_latin1 {
-    # given an input platform code point, return the latin1 equivalent value.
-    # Anything above latin1 is itself.
-
-    my $ord = shift;
-    return $ord if ord('^') == 94;   # ASCII, Latin1
-    return utf8::native_to_unicode($ord);
-}
-
 1;