toke.c - rework "Perl_no_op" warnings so we call Perl_warner() once only

Using multiple calls to Perl_warner() means that fatalized warnings
do not include the full diagnostics. It also means that $SIG{__WARN__}
might get called more than once for a given warning, with parts of the
message in each call. This would affect "missing operator" warnings,
which often come up in the context of barewords and misspelled sub
names.

This patch moves the parenthesized "hint" part of the warning to the
same line as the main warning and ensures the entire message is
dispatched in a single call to Perl_warner(). The result of this is that
the hint is visible even under fatalized warnings and that
$SIG{__WARN__} is called only once for the warning.

At the same time this patch fixes an oversight where we would sometimes
form warning messages with a subject (var name or bareword name) that
was unquoted and sometimes had leading whitespace. This patch changes
this to quote the subject like most of our errors do and to strip the
whitespace when appropriate. (Note this doesn't use the QUOTEDPREFIX
formats, as it didn't seem to be necessary with the type of warnings
this is involved in.) This is not done in a separate patch as it would
mean manually altering all the tests multiple times over multiple
patches.

Note that yywarn() calls Perl_warner(), so even though this patch
does not call it directly it does call it indirectly via yywarn()
via yyerror().

This resolves GH Issue #20425.

3 files changed, 5 insertions, 7 deletions

diff --git a/t/op/heredoc.t b/t/op/heredoc.t
index 6e7e895def..f959bf89fb 100644
--- a/t/op/heredoc.t
+++ b/t/op/heredoc.t
@@ -93,7 +93,7 @@ HEREDOC
     fresh_perl_like(
         qq(0<<<<""0\n\n),
         # valgrind and asan reports an error between these two lines
-        qr/^Number found where operator expected at - line 1, near "<<""0"\s+\(Missing operator/,
+        qr/^Number found where operator expected \(Missing operator before "0"\?\) at - line 1, near "<<""0"/,
         {},
         "don't use an invalid oldoldbufptr"
     );
diff --git a/t/op/hexfp.t b/t/op/hexfp.t
index 5fb80d3d74..8611e0fec3 100644
--- a/t/op/hexfp.t
+++ b/t/op/hexfp.t
@@ -138,10 +138,10 @@ sub get_warn() {
 
 { # Test certain things that are not hexfloats and should stay that way.
     eval '0xp3';
-    like(get_warn(), qr/Missing operator before p3/);
+    like(get_warn(), qr/Missing operator before "p3"/);
 
     eval '5p3';
-    like(get_warn(), qr/Missing operator before p3/);
+    like(get_warn(), qr/Missing operator before "p3"/);
 
     my @a;
     eval '@a = 0x3..5';
diff --git a/t/op/lex.t b/t/op/lex.t
index 08b81d324d..f36f289fdc 100644
--- a/t/op/lex.t
+++ b/t/op/lex.t
@@ -135,8 +135,7 @@ SKIP: {
     skip "Different output on EBCDIC (presumably)", 3 if $::IS_EBCDIC;
     fresh_perl_is(
       qq'"ab}"ax;&\0z\x8Ao}\x82x;', <<gibberish,
-Bareword found where operator expected at - line 1, near ""ab}"ax"
-	(Missing operator before ax?)
+Bareword found where operator expected (Missing operator before "ax"?) at - line 1, near ""ab}"ax"
 syntax error at - line 1, near ""ab}"ax"
 Execution of - aborted due to compilation errors.
 gibberish
@@ -145,8 +144,7 @@ gibberish
     );
     fresh_perl_is(
       qq'"ab}"ax;&{+z}\x8Ao}\x82x;', <<gibberish,
-Bareword found where operator expected at - line 1, near ""ab}"ax"
-	(Missing operator before ax?)
+Bareword found where operator expected (Missing operator before "ax"?) at - line 1, near ""ab}"ax"
 syntax error at - line 1, near ""ab}"ax"
 Execution of - aborted due to compilation errors.
 gibberish