Use fnc to force out malformed warnings

[perl5.git] / t / uni / parser.t

diff --git a/t/uni/parser.t b/t/uni/parser.t
index 7b958af..624fdd0 100644 (file)
--- a/t/uni/parser.t
+++ b/t/uni/parser.t
@@ -4,16 +4,17 @@
 # (including weird syntax errors)
 
 BEGIN {
+    chdir 't' if -d 't';
     require './test.pl';
     skip_all_without_unicode_tables();
 }
 
-plan (tests => 52);
+plan (tests => 55);
 
 use utf8;
 use open qw( :utf8 :std );
 
-ok *tèst, "*main::tèst", "sanity check.";
+is *tèst, "*main::tèst", "sanity check.";
 ok $::{"tèst"}, "gets the right glob in the stash.";
 
 my $glob_by_sub = sub { *ｍａｉｎ::method }->();
@@ -82,8 +83,7 @@ closedir FÒÒ;
 sub участники { 1 }
 
 ok $::{"участники"}, "non-const sub declarations generate the right glob";
-ok *{$::{"участники"}}{CODE};
-is *{$::{"участники"}}{CODE}->(), 1;
+is $::{"участники"}->(), 1;
 
 sub 原 () { 1 }
 
@@ -191,7 +191,74 @@ like( $@, qr/Bad name after Ｆｏｏ'/, 'Bad name after Ｆｏｏ\'' );
 
 {
     no warnings 'utf8';
-    my $malformed_to_be = "\x{c0}\x{a0}";   # Overlong sequence
+    local $SIG{__WARN__} = sub { }; # The eval will also output a warning,
+                                    # which we ignore
+    my $malformed_to_be = ($::IS_EBCDIC)   # Overlong sequence
+                           ? "\x{74}\x{41}"
+                           : "\x{c0}\x{a0}";
     CORE::evalbytes "use charnames ':full'; use utf8; my \$x = \"\\N{abc$malformed_to_be}\"";
     like( $@, qr/Malformed UTF-8 character immediately after '\\N\{abc' at .* within string/, 'Malformed UTF-8 input to \N{}');
 }
+
+# RT# 124216: Perl_sv_clear: Assertion
+# If a parsing error occurred during a forced token within an interpolated
+# context, the stack unwinding failed to restore PL_lex_defer and so after
+# error recovery the state restored after the forced token was processed
+# was the wrong one, resulting in the lexer thinking we're still inside a
+# quoted string and things getting freed multiple times.
+#
+# The \x{3030} char isn't a legal var name, and this triggers the error.
+#
+# NB: this only failed if the closing quote of the interpolated string is
+# the last char of the file (i.e. no trailing \n).
+
+{
+    my $bad = "\x{3030}";
+    # Write out the individual utf8 bytes making up \x{3030}. This
+    # avoids 'Wide char in print' warnings from test.pl. (We may still
+    # get that warning when compiling the prog itself, since the
+    # error it prints to stderr contains a wide char.)
+    utf8::encode($bad);
+
+    fresh_perl_like(qq{use utf8; "\$$bad"},
+        qr/
+            \A
+            ( \QWide character in print at - line 1.\E\n )?
+            \Qsyntax error at - line 1, near \E"\$.*"\n
+            \QExecution of - aborted due to compilation errors.\E\z
+        /xm,
+
+        {stderr => 1}, "RT# 124216");
+}
+
+SKIP: {   # [perl #128738]
+    use Config;
+    if ($Config{uvsize} < 8) {
+        skip("test is only valid on 64-bit ints", 2);
+    }
+    else {
+        no warnings 'deprecated';
+        my $a;
+        eval "\$a = q \x{ffffffff}Hello, \\\\whirled!\x{ffffffff}";
+        is $@, "",
+               "No errors in eval'ing a string with large code point delimiter";
+        is $a, 'Hello, \whirled!',
+               "Got expected result in eval'ing a string with a large code point"
+            . " delimiter";
+    }
+}
+
+
+# New tests go here ^^^^^
+
+# Keep this test last, as it will mess up line number reporting for any
+# subsequent tests.
+
+<<END;
+${
+#line 57
+qq ϟϟ }
+END
+is __LINE__, 59, '#line directive and qq with uni delims inside heredoc';
+
+# Put new tests above the line number tests.