allow "used only once" warnings to be fatal

embed.fnc

@@ -1119,6 +1119,9 @@ AOdp	|SV *	|eval_pv	|NN const char *p			\
 				|I32 croak_on_error
 AOdp	|SSize_t|eval_sv	|NN SV *sv				\
 				|I32 flags
+Adfpv	|void	|fatal_warner	|U32 err				\
+				|NN const char *pat			\
+				|...
 Adp	|void	|fbm_compile	|NN SV *sv				\
 				|U32 flags
 ARdp	|char * |fbm_instr	|NN unsigned char *big			\
@@ -3704,6 +3707,9 @@ Adpr	|void	|vcroak 	|NULLOK const char *pat 		\
 				|NULLOK va_list *args
 Adp	|void	|vdeb		|NN const char *pat			\
 				|NULLOK va_list *args
+Adp	|void	|vfatal_warner	|U32 err				\
+				|NN const char *pat			\
+				|NULLOK va_list *args
 Adp	|char * |vform		|NN const char *pat			\
 				|NULLOK va_list *args
 : Used by Data::Alias

embed.h

@@ -793,6 +793,7 @@
 # define vcmp(a,b)                              Perl_vcmp(aTHX_ a,b)
 # define vcroak(a,b)                            Perl_vcroak(aTHX_ a,b)
 # define vdeb(a,b)                              Perl_vdeb(aTHX_ a,b)
+# define vfatal_warner(a,b,c)                   Perl_vfatal_warner(aTHX_ a,b,c)
 # define vform(a,b)                             Perl_vform(aTHX_ a,b)
 # define vload_module(a,b,c,d)                  Perl_vload_module(aTHX_ a,b,c,d)
 # define vmess(a,b)                             Perl_vmess(aTHX_ a,b)
@@ -859,6 +860,7 @@
 #   define deb(...)                             Perl_deb(aTHX_ __VA_ARGS__)
 #   define die(...)                             Perl_die(aTHX_ __VA_ARGS__)
 #   define dump_indent(a,b,...)                 Perl_dump_indent(aTHX_ a,b,__VA_ARGS__)
+#   define fatal_warner(a,...)                  Perl_fatal_warner(aTHX_ a,__VA_ARGS__)
 #   define form(...)                            Perl_form(aTHX_ __VA_ARGS__)
 #   define load_module(a,b,...)                 Perl_load_module(aTHX_ a,b,__VA_ARGS__)
 #   define mess(...)                            Perl_mess(aTHX_ __VA_ARGS__)

gv.c

@@ -2685,10 +2685,14 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8);
 
     if (   full_len != 0
-        && isIDFIRST_lazy_if_safe(name, name + full_len, is_utf8)
-        && !ckWARN(WARN_ONCE) )
-    {
-        GvMULTI_on(gv) ;
+           && isIDFIRST_lazy_if_safe(name, name + full_len, is_utf8)) {
+        if (ckWARN(WARN_ONCE)) {
+            if (ckDEAD(WARN_ONCE))
+                GvONCE_FATAL_on(gv);
+        }
+        else {
+            GvMULTI_on(gv) ;
+        }
     }
 
     /* set up magic where warranted */
@@ -2819,11 +2823,20 @@ Perl_gv_check(pTHX_ HV *stash)
                 CopFILEGV(PL_curcop)
                     = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0);
 #endif
-                Perl_warner(aTHX_ packWARN(WARN_ONCE),
-                        "Name \"%" HEKf "::%" HEKf
-                        "\" used only once: possible typo",
-                            HEKfARG(HvNAME_HEK(stash)),
-                            HEKfARG(GvNAME_HEK(gv)));
+                if (GvONCE_FATAL(gv)) {
+                    fatal_warner(packWARN(WARN_ONCE),
+                                 "Name \"%" HEKf "::%" HEKf
+                                 "\" used only once: possible typo",
+                                 HEKfARG(HvNAME_HEK(stash)),
+                                 HEKfARG(GvNAME_HEK(gv)));
+                }
+                else {
+                    warner(packWARN(WARN_ONCE),
+                           "Name \"%" HEKf "::%" HEKf
+                           "\" used only once: possible typo",
+                           HEKfARG(HvNAME_HEK(stash)),
+                           HEKfARG(GvNAME_HEK(gv)));
+                }
             }
         }
     }

gv.h

@@ -158,6 +158,15 @@ Return the CV from the GV.
 /* GVf_INTRO is one-shot flag which indicates that the next assignment
    of a reference to the glob is to be localised; it distinguishes
    'local *g = $ref' from '*g = $ref'.
+
+   GVf_MULTI is used to implement the "used only once" warning.  It is
+   always set on a glob when an existing name is referenced, and when
+   a name is created when the warning is disabled.  A post parse scan
+   in gv_check() then reports any names where this isn't set.
+
+   GVf_ONCE_FATAL is set on a glob when it is created and fatal "used
+   only once" warnings are enabled, since PL_curcop no longer has the
+   fatal flag set at the point where the warnings are reported.
 */
 #define GVf_INTRO	0x01
 #define GVf_MULTI	0x02
@@ -168,6 +177,7 @@ Return the CV from the GV.
 #define GVf_IMPORTED_AV	  0x20
 #define GVf_IMPORTED_HV	  0x40
 #define GVf_IMPORTED_CV	  0x80
+#define GVf_ONCE_FATAL	0x100
 
 #define GvINTRO(gv)		(GvFLAGS(gv) & GVf_INTRO)
 #define GvINTRO_on(gv)		(GvFLAGS(gv) |= GVf_INTRO)
@@ -201,6 +211,10 @@ Return the CV from the GV.
 #define GvIMPORTED_CV_on(gv)	(GvFLAGS(gv) |= GVf_IMPORTED_CV)
 #define GvIMPORTED_CV_off(gv)	(GvFLAGS(gv) &= ~GVf_IMPORTED_CV)
 
+#define GvONCE_FATAL(gv)	(GvFLAGS(gv) & GVf_ONCE_FATAL)
+#define GvONCE_FATAL_on(gv)	(GvFLAGS(gv) |= GVf_ONCE_FATAL)
+#define GvONCE_FATAL_off(gv)	(GvFLAGS(gv) &= ~GVf_ONCE_FATAL)
+
 #ifndef PERL_CORE
 #  define GvIN_PAD(gv)		0
 #  define GvIN_PAD_on(gv)	NOOP

t/lib/warnings/gv

@@ -299,3 +299,11 @@ no strict;
 my $x = $i;
 EXPECT
 Name "main::i" used only once: possible typo at - line 4.
+########
+# https://github.com/Perl/perl5/issues/13814
+use warnings FATAL => qw(once);
+print @Foo::bar, "\n";
+print "still alive\n";
+EXPECT
+OPTION fatal
+Name "Foo::bar" used only once: possible typo at - line 3.

util.c

@@ -2135,6 +2135,27 @@ any of the categories are by default enabled.
 =for apidoc vwarner
 This is like C<L</warner>>, but C<args> are an encapsulated argument list.
 
+=for apidoc fatal_warner
+
+Like L</warner> except that it acts as if fatal warnings are enabled
+for the warning.
+
+If called when there are pending compilation errors this function may
+return.
+
+This is currently used to generate "used only once" fatal warnings
+since the COP where the name being reported is no longer the current
+COP when the warning is generated and may be useful for similar cases.
+
+C<err> must be one of the C<L</packWARN>>, C<packWARN2>, C<packWARN3>,
+C<packWARN4> macros populated with the appropriate number of warning
+categories.
+
+=for apidoc vfatal_warner
+
+This is like C<L</fatal_warner>> but C<args> are an encapsulated
+argument list.
+
 =cut
 */
 
@@ -2195,21 +2216,42 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
         (PL_warnhook == PERL_WARNHOOK_FATAL || ckDEAD(err)) &&
         !(PL_in_eval & EVAL_KEEPERR)
     ) {
-        SV * const msv = vmess(pat, args);
-
-        if (PL_parser && PL_parser->error_count) {
-            qerror(msv);
-        }
-        else {
-            invoke_exception_hook(msv, FALSE);
-            die_unwind(msv);
-        }
+        vfatal_warner(err, pat, args);
     }
     else {
         Perl_vwarn(aTHX_ pat, args);
     }
 }
 
+void
+Perl_fatal_warner(pTHX_ U32 err, const char *pat, ...)
+{
+    PERL_ARGS_ASSERT_FATAL_WARNER;
+
+    va_list args;
+    va_start(args, pat);
+    vfatal_warner(err, pat, &args);
+    va_end(args);
+}
+
+void
+Perl_vfatal_warner(pTHX_ U32 err, const char *pat, va_list *args)
+{
+    PERL_ARGS_ASSERT_VFATAL_WARNER;
+
+    PERL_UNUSED_ARG(err);
+
+    SV * const msv = vmess(pat, args);
+
+    if (PL_parser && PL_parser->error_count) {
+        qerror(msv);
+    }
+    else {
+        invoke_exception_hook(msv, FALSE);
+        die_unwind(msv);
+    }
+}
+
 /* implements the ckWARN? macros */
 
 bool