Escape double-quotes in generated #line directives

[perl5.git] / lib / diagnostics.t

diff --git a/lib/diagnostics.t b/lib/diagnostics.t
index 1dc8ec3..c983ac6 100644 (file)
--- a/lib/diagnostics.t
+++ b/lib/diagnostics.t
@@ -1,13 +1,18 @@
-#!./perl
+#!./perl -w
 
 BEGIN {
     chdir '..' if -d '../pod' && -d '../t';
     @INC = 'lib';
+    require './t/test.pl';
+    plan(18);
 }
 
-use Test::More tests => 7;
-
-BEGIN { use_ok('diagnostics') }
+BEGIN {
+    my $w;
+    $SIG{__WARN__} = sub { $w = shift };
+    use_ok('diagnostics');
+    is $w, undef, 'no warnings when loading diagnostics.pm';
+}
 
 require base;
 
@@ -17,10 +22,12 @@ eval {
 
 like( $@, qr/^Base class package "I::do::not::exist" is empty/);
 
-# Test for %.0f patterns in perldiag, added in 5.11.0
-close STDERR;
-open STDERR, ">", \my $warning
+open *whatever, ">", \my $warning
     or die "Couldn't redirect STDERR to var: $!";
+my $old_stderr = *STDERR{IO};
+*STDERR = *whatever{IO};
+
+# Test for %.0f patterns in perldiag, added in 5.11.0
 warn('gmtime(nan) too large');
 like $warning, qr/\(W overflow\) You called/, '%0.f patterns';
 
@@ -40,7 +47,7 @@ like $warning, qr/using lex_stuff_pvn or similar/, 'L<foo|bar/baz>';
 # Multiple messages with the same description
 seek STDERR, 0,0;
 $warning = '';
-warn 'Code point 0x%X is not Unicode, may not be portable';
+warn 'Code point 0xBEE5 is not Unicode, may not be portable';
 like $warning, qr/W utf8/,
    'Message sharing its description with the following message';
 
@@ -49,3 +56,92 @@ seek STDERR, 0,0;
 $warning = '';
 warn "Execution of -e aborted due to compilation errors.\n";
 like $warning, qr/The final summary message/, 'Periods at end of line';
+
+# Test for %d/%u
+seek STDERR, 0,0;
+$warning = '';
+warn "Bad arg length for us, is 4, should be 42";
+like $warning, qr/In C parlance/, '%u works';
+
+# Test for %X
+seek STDERR, 0,0;
+$warning = '';
+warn "Unicode surrogate U+C0FFEE is illegal in UTF-8";
+like $warning, qr/You had a UTF-16 surrogate/, '%X';
+
+# Strip S<>
+seek STDERR, 0,0;
+$warning = '';
+warn "syntax error";
+like $warning, qr/cybernetic version of 20 questions/s, 'strip S<>';
+
+# Errors ending with dots
+seek STDERR, 0,0;
+$warning = '';
+warn "I had compilation errors.\n";
+like $warning, qr/final summary message/, 'dotty errors';
+
+# Multiline errors
+seek STDERR, 0,0;
+$warning = '';
+warn "Attempt to reload weapon aborted.\nCompilation failed in require";
+like $warning,
+     qr/You tried to load a file.*Perl could not compile/s,
+    'multiline errors';
+
+*STDERR = $old_stderr;
+
+# These tests use a panic under the hope that the description is not likely
+# to change.
+@runperl_args = (
+        switches => [ '-Ilib', '-Mdiagnostics' ],
+        stderr => 1,
+        nolib => 1, # -I../lib would go outside the build dir
+);
+$subs =
+ "sub foo{bar()}sub bar{baz()}sub baz{die q _panic: gremlins_}foo()";
+is runperl(@runperl_args, prog => $subs),
+   << 'EOT', 'internal error with backtrace';
+panic: gremlins at -e line 1 (#1)
+    (P) An internal error.
+    
+Uncaught exception from user code:
+       panic: gremlins at -e line 1.
+       main::baz() called at -e line 1
+       main::bar() called at -e line 1
+       main::foo() called at -e line 1
+EOT
+is runperl(@runperl_args, prog => $subs =~ s/panic\K/k/r),
+   << 'EOU', 'user error with backtrace';
+Uncaught exception from user code:
+       panick: gremlins at -e line 1.
+       main::baz() called at -e line 1
+       main::bar() called at -e line 1
+       main::foo() called at -e line 1
+EOU
+is runperl(@runperl_args, prog => 'die q _panic: gremlins_'),
+   << 'EOV', 'no backtrace from top-level internal error';
+panic: gremlins at -e line 1 (#1)
+    (P) An internal error.
+    
+Uncaught exception from user code:
+       panic: gremlins at -e line 1.
+EOV
+is runperl(@runperl_args, prog => 'die q _panick: gremlins_'),
+   << 'EOW', 'no backtrace from top-level user error';
+Uncaught exception from user code:
+       panick: gremlins at -e line 1.
+EOW
+like runperl(
+      @runperl_args,
+      prog => $subs =~
+         s[panic: gremlins]
+          [Attempt to reload foo aborted.\nCompilation failed in require]r,
+     ),
+     qr/Uncaught exception from user code:
+       Attempt to reload foo aborted\.
+       Compilation failed in require at -e line \d+\.
+       main::baz\(\) called at -e line \d+
+       main::bar\(\) called at -e line \d+
+       main::foo\(\) called at -e line \d+
+/,  'backtrace from multiline error';