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.

pod/perldelta.pod

@@ -218,6 +218,23 @@ XXX Changes (i.e. rewording) of diagnostic messages go here
 
 =item *
 
+Various warnings that used to produce parenthesized hints underneath the
+main warning message and after its "location data" were chanaged to put
+the hint inline with the main message. For instance:
+
+ Bareword found where operator expected at -e line 1, near "foo bar"
+     (Do you need to predeclare foo?)
+
+will now look like this but as one line:
+
+ Bareword found where operator expected (Do you need to predeclare
+ foo?) at -e line 1, near "foo bar"
+
+as a result such warnings will no longer trigger C<$SIG{__WARN__}>
+twice, and the hint will be visible when fatal warnings is in effect.
+
+=item *
+
 XXX Describe change here
 
 =back

t/lib/croak/toke

@@ -2,8 +2,7 @@ __END__
 # NAME foo found where operator expected
 myfunc 1,2,3
 EXPECT
-Number found where operator expected at - line 1, near "myfunc 1"
-	(Do you need to predeclare myfunc?)
+Number found where operator expected (Do you need to predeclare "myfunc"?) at - line 1, near "myfunc 1"
 syntax error at - line 1, near "myfunc 1"
 Execution of - aborted due to compilation errors.
 ########
@@ -14,41 +13,36 @@ $foo;
 myfunc 1,2,3
 EXPECT
 Global symbol "$foo" requires explicit package name (did you forget to declare "my $foo"?) at - line 3.
-Number found where operator expected at - line 4, near "myfunc 1"
-	(Do you need to predeclare myfunc?)
+Number found where operator expected (Do you need to predeclare "myfunc"?) at - line 4, near "myfunc 1"
 syntax error at - line 4, near "myfunc 1"
 Execution of - aborted due to compilation errors.
 ########
-# NAME (Missing operator before ${?) [perl #123737]
+# NAME (Missing operator before "${"?) [perl #123737]
 0${
 EXPECT
-Scalar found where operator expected at - line 1, near "0${"
-	(Missing operator before ${?)
+Scalar found where operator expected (Missing operator before "${"?) at - line 1, near "0${"
 syntax error at - line 1, near "0$"
 Execution of - aborted due to compilation errors.
 ########
-# NAME (Missing operator before $#{?) [perl #123737]
+# NAME (Missing operator before "$#{"?) [perl #123737]
 0$#{
 EXPECT
-Array length found where operator expected at - line 1, near "0$#{"
-	(Missing operator before $#{?)
+Array length found where operator expected (Missing operator before "$#{"?) at - line 1, near "0$#{"
 syntax error at - line 1, near "0$#"
 Execution of - aborted due to compilation errors.
 ########
-# NAME (Missing operator before @foo) [perl #123737]
+# NAME (Missing operator before "@foo") [perl #123737]
 0@foo
 EXPECT
-Array found where operator expected at - line 1, near "0@foo"
-	(Missing operator before @foo?)
+Array found where operator expected (Missing operator before "@foo"?) at - line 1, near "0@foo"
 syntax error at - line 1, near "0@foo
 "
 Execution of - aborted due to compilation errors.
 ########
-# NAME (Missing operator before @{) [perl #123737]
+# NAME (Missing operator before "@{") [perl #123737]
 0@{
 EXPECT
-Array found where operator expected at - line 1, near "0@{"
-	(Missing operator before @{?)
+Array found where operator expected (Missing operator before "@{"?) at - line 1, near "0@{"
 syntax error at - line 1, near "0@"
 Execution of - aborted due to compilation errors.
 ########
@@ -339,9 +333,8 @@ has cxxc => (
     default => sub { 1 }
 );
 EXPECT
-Bareword found where operator expected at - line 9, near "isa => 'Int"
+Bareword found where operator expected (Do you need to predeclare "isa"?) at - line 9, near "isa => 'Int"
   (Might be a runaway multi-line '' string starting on line 4)
-	(Do you need to predeclare isa?)
 Bad name after Int' at - line 9.
 ########
 # NAME Bad name after :: (with other helpful messages)
@@ -358,9 +351,8 @@ has cxxc => (
     default => sub { 1 }
 );
 EXPECT
-Bareword found where operator expected at - line 9, near "isa => "Foo"
+Bareword found where operator expected (Do you need to predeclare "isa"?) at - line 9, near "isa => "Foo"
   (Might be a runaway multi-line "" string starting on line 4)
-	(Do you need to predeclare isa?)
 Bad name after Foo:: at - line 9.
 ########
 # NAME Unterminated delimiter for here document
@@ -478,8 +470,7 @@ Use of bare << to mean <<"" is forbidden at - line 1.
 # NAME incomplete floating point decimal exponent (#131725)
 1e--5
 EXPECT
-Bareword found where operator expected at - line 1, near "1e"
-	(Missing operator before e?)
+Bareword found where operator expected (Missing operator before "e"?) at - line 1, near "1e"
 syntax error at - line 1, near "1e"
 Execution of - aborted due to compilation errors.
 ########
@@ -501,17 +492,15 @@ Execution of - aborted due to compilation errors.
 01.1234567p0;
 07.8p0;
 EXPECT
-Bareword found where operator expected at - line 2, near "8p0"
-	(Missing operator before p0?)
+Bareword found where operator expected (Missing operator before "p0"?) at - line 2, near "8p0"
 syntax error at - line 2, near "8p0"
 Execution of - aborted due to compilation errors.
 ########
 # NAME binary fp with non-binary digits after the decimal point
 0b1.10p0;
 0b1.2p0;
 EXPECT
-Bareword found where operator expected at - line 2, near "2p0"
-	(Missing operator before p0?)
+Bareword found where operator expected (Missing operator before "p0"?) at - line 2, near "2p0"
 syntax error at - line 2, near "2p0"
 Execution of - aborted due to compilation errors.
 ########
@@ -566,8 +555,7 @@ Execution of - aborted due to compilation errors.
 # NAME [perl #134310] don't confuse S_no_op() with PL_bufptr after s
 0 0x@
 EXPECT
-Number found where operator expected at - line 1, near "0 0x"
-	(Missing operator before  0x?)
+Number found where operator expected (Missing operator before "0x"?) at - line 1, near "0 0x"
 No digits found for hexadecimal literal at - line 1, near "0 0x@"
 syntax error at - line 1, near "0 0x"
 Execution of - aborted due to compilation errors.

t/lib/feature/bareword_filehandles

@@ -127,8 +127,7 @@ my $x = atan2(FOO 1, 2);
 # atan2() above) could end up calling newGVREF(), producing an unexpected error message.
 EXPECT
 OPTIONS fatal
-Number found where operator expected at - line 2, near "FOO 1"
-	(Do you need to predeclare FOO?)
+Number found where operator expected (Do you need to predeclare "FOO"?) at - line 2, near "FOO 1"
 Missing comma after first argument to atan2 function at - line 2, near "2)"
 Execution of - aborted due to compilation errors.
 ########

t/lib/feature/bits

@@ -6,8 +6,7 @@ use feature 'say';
 BEGIN { %^H = () }
 say "Fail";
 EXPECT
-String found where operator expected at - line 3, near "say "Fail""
-	(Do you need to predeclare say?)
+String found where operator expected (Do you need to predeclare "say"?) at - line 3, near "say "Fail""
 syntax error at - line 3, near "say "Fail""
 Execution of - aborted due to compilation errors.
 ########
@@ -28,8 +27,7 @@ say "Hello";
 no feature 'say';
 say "Goodbye";
 EXPECT
-String found where operator expected at - line 4, near "say "Goodbye""
-	(Do you need to predeclare say?)
+String found where operator expected (Do you need to predeclare "say"?) at - line 4, near "say "Goodbye""
 syntax error at - line 4, near "say "Goodbye""
 Execution of - aborted due to compilation errors.
 ########
@@ -39,7 +37,6 @@ say "Hello";
 BEGIN { delete $^H{feature_say}; }
 say "Goodbye";
 EXPECT
-String found where operator expected at - line 4, near "say "Goodbye""
-	(Do you need to predeclare say?)
+String found where operator expected (Do you need to predeclare "say"?) at - line 4, near "say "Goodbye""
 syntax error at - line 4, near "say "Goodbye""
 Execution of - aborted due to compilation errors.

t/lib/feature/bundle

@@ -107,6 +107,5 @@ Assigning non-zero to $[ is no longer possible at - line 3.
 eval 'BEGIN { $^H |= 0x3c020000 } $_ = evalbytes 12345';
 print $_||$@;
 EXPECT
-Number found where operator expected at (eval 1) line 1, near "evalbytes 12345"
-	(Do you need to predeclare evalbytes?)
+Number found where operator expected (Do you need to predeclare "evalbytes"?) at (eval 1) line 1, near "evalbytes 12345"
 syntax error at (eval 1) line 1, near "evalbytes 12345"

t/lib/feature/indirect

@@ -23,8 +23,7 @@ system $foox "foo", "bar";
 my $y = new Foo;
 EXPECT
 OPTIONS fatal
-Bareword found where operator expected at - line 19, near "new Foo"
-	(Do you need to predeclare new?)
+Bareword found where operator expected (Do you need to predeclare "new"?) at - line 19, near "new Foo"
 syntax error at - line 19, near "new Foo"
 Execution of - aborted due to compilation errors.
 ########
@@ -97,8 +96,7 @@ my $z = new $class;
 
 EXPECT
 OPTIONS fatal
-Scalar found where operator expected at - line 29, near "new $class"
-	(Do you need to predeclare new?)
+Scalar found where operator expected (Do you need to predeclare "new"?) at - line 29, near "new $class"
 syntax error at - line 29, near "new $class"
 Execution of - aborted due to compilation errors.
 ########
@@ -135,7 +133,6 @@ my $z = new $class ();
 
 EXPECT
 OPTIONS fatal
-Scalar found where operator expected at - line 29, near "new $class"
-	(Do you need to predeclare new?)
+Scalar found where operator expected (Do you need to predeclare "new"?) at - line 29, near "new $class"
 syntax error at - line 29, near "new $class "
 Execution of - aborted due to compilation errors.

t/lib/feature/say

@@ -7,8 +7,7 @@ use warnings;
 say "Hello", "world";
 EXPECT
 Unquoted string "say" may clash with future reserved word at - line 3.
-String found where operator expected at - line 3, near "say "Hello""
-	(Do you need to predeclare say?)
+String found where operator expected (Do you need to predeclare "say"?) at - line 3, near "say "Hello""
 syntax error at - line 3, near "say "Hello""
 Execution of - aborted due to compilation errors.
 ########
@@ -32,8 +31,7 @@ use warnings;
 say "Hello", "world";
 EXPECT
 Unquoted string "say" may clash with future reserved word at - line 4.
-String found where operator expected at - line 4, near "say "Hello""
-	(Do you need to predeclare say?)
+String found where operator expected (Do you need to predeclare "say"?) at - line 4, near "say "Hello""
 syntax error at - line 4, near "say "Hello""
 Execution of - aborted due to compilation errors.
 ########
@@ -45,8 +43,7 @@ no feature;
 say "Hello", "world";
 EXPECT
 Unquoted string "say" may clash with future reserved word at - line 6.
-String found where operator expected at - line 6, near "say "Hello""
-	(Do you need to predeclare say?)
+String found where operator expected (Do you need to predeclare "say"?) at - line 6, near "say "Hello""
 syntax error at - line 6, near "say "Hello""
 Execution of - aborted due to compilation errors.
 ########
@@ -58,7 +55,6 @@ no feature 'say';
 say "Hello", "world";
 EXPECT
 Unquoted string "say" may clash with future reserved word at - line 6.
-String found where operator expected at - line 6, near "say "Hello""
-	(Do you need to predeclare say?)
+String found where operator expected (Do you need to predeclare "say"?) at - line 6, near "say "Hello""
 syntax error at - line 6, near "say "Hello""
 Execution of - aborted due to compilation errors.

t/lib/subs/subs

@@ -4,8 +4,7 @@ __END__
 Fred 1,2 ;
 sub Fred {}
 EXPECT
-Number found where operator expected at - line 3, near "Fred 1"
-	(Do you need to predeclare Fred?)
+Number found where operator expected (Do you need to predeclare "Fred"?) at - line 3, near "Fred 1"
 syntax error at - line 3, near "Fred 1"
 Execution of - aborted due to compilation errors.
 ########
@@ -15,8 +14,7 @@ Fred 1,2 ;
 use subs qw( Fred ) ;
 sub Fred {}
 EXPECT
-Number found where operator expected at - line 3, near "Fred 1"
-	(Do you need to predeclare Fred?)
+Number found where operator expected (Do you need to predeclare "Fred"?) at - line 3, near "Fred 1"
 syntax error at - line 3, near "Fred 1"
 Execution of - aborted due to compilation errors.
 ########
@@ -88,8 +86,7 @@ use open qw( :utf8 :std );
 Frèd 1,2 ;
 sub Frèd {}
 EXPECT
-Number found where operator expected at - line 5, near "Frèd 1"
-	(Do you need to predeclare Frèd?)
+Number found where operator expected (Do you need to predeclare "Frèd"?) at - line 5, near "Frèd 1"
 syntax error at - line 5, near "Frèd 1"
 Execution of - aborted due to compilation errors.
 ########
@@ -101,7 +98,6 @@ use open qw( :utf8 :std );
 use subs qw( ふれど ) ;
 sub ふれど {}
 EXPECT
-Number found where operator expected at - line 5, near "ふれど 1"
-	(Do you need to predeclare ふれど?)
+Number found where operator expected (Do you need to predeclare "ふれど"?) at - line 5, near "ふれど 1"
 syntax error at - line 5, near "ふれど 1"
 Execution of - aborted due to compilation errors.

t/lib/warnings/toke

@@ -1040,10 +1040,8 @@ Operator or semicolon missing before %foo at - line 8.
 Ambiguous use of % resolved as operator % at - line 8.
 Operator or semicolon missing before %foo at - line 10.
 Ambiguous use of % resolved as operator % at - line 10.
-Bareword found where operator expected at - line 12, near "$%foo"
-	(Missing operator before foo?)
-Bareword found where operator expected at - line 13, near "$ %foo"
-	(Missing operator before foo?)
+Bareword found where operator expected (Missing operator before "foo"?) at - line 12, near "$%foo"
+Bareword found where operator expected (Missing operator before "foo"?) at - line 13, near "$ %foo"
 Illegal modulus zero at - line 3.
 ########
 # toke.c
@@ -1067,10 +1065,8 @@ Operator or semicolon missing before &foo at - line 8.
 Ambiguous use of & resolved as operator & at - line 8.
 Operator or semicolon missing before &foo at - line 10.
 Ambiguous use of & resolved as operator & at - line 10.
-Bareword found where operator expected at - line 13, near "$&foo"
-	(Missing operator before foo?)
-Bareword found where operator expected at - line 14, near "$ &foo"
-	(Missing operator before foo?)
+Bareword found where operator expected (Missing operator before "foo"?) at - line 13, near "$&foo"
+Bareword found where operator expected (Missing operator before "foo"?) at - line 14, near "$ &foo"
 Undefined subroutine &main::foo called at - line 3.
 ########
 # toke.c
@@ -1269,8 +1265,7 @@ eval q/5 6/;
 no warnings "syntax";
 eval q/5 6/;
 EXPECT
-Number found where operator expected at (eval 1) line 1, near "5 6"
-	(Missing operator before  6?)
+Number found where operator expected (Missing operator before "6"?) at (eval 1) line 1, near "5 6"
 ########
 # toke.c
 use warnings "syntax"; no warnings "deprecated";
@@ -1777,3 +1772,11 @@ Use of '》' is deprecated as a string delimiter at - line 12.
 Use of '‹' is deprecated as a string delimiter at - line 13.
 Use of '›' is deprecated as a string delimiter at - line 14.
 ########
+# NAME check bareword warning is a single error message
+BEGIN { $SIG{__WARN__}= sub { print STDERR "warn: $_[0]" }; }
+sub bar {}
+foo bar;
+EXPECT
+warn: Bareword found where operator expected (Do you need to predeclare "foo"?) at - line 3, near "foo bar"
+syntax error at - line 3, near "foo bar"
+Execution of - aborted due to compilation errors.

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"
     );

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';

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