From 9bb85c7e3f7e6fc1097cd3f0352c5577cf52c598 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 4 Dec 2023 08:44:15 +1100 Subject: [PATCH] allow "used only once" warnings to be fatal "used only once" warnings are special, instead of being emitted at the code where the name in question is used, they are emitted during a scan of the symbol table done after parsing has finished. This meant that any FATAL flags set in the COP for the parse point of the name is no longer in scope, so the warnings we emit can't be treated as fatal. To make them behave as FATAL set a new flag on the name if fatal WARN_ONCE warnings are enabled and use that to dispatch the warnings as normal or fatally when we do the symbol table scan. I originally approached the dispatch as fatal or non-fatal by messing around with cop_warnings, but that was dumb, and I went for a much simpler change. Fixes #13814 --- embed.fnc | 6 +++++ embed.h | 2 ++ gv.c | 31 +++++++++++++++++------- gv.h | 14 +++++++++++ proto.h | 11 +++++++++ t/lib/warnings/gv | 8 +++++++ util.c | 60 ++++++++++++++++++++++++++++++++++++++++------- 7 files changed, 114 insertions(+), 18 deletions(-) diff --git a/embed.fnc b/embed.fnc index 6b15455aba78..ee57637bc0f6 100644 --- a/embed.fnc +++ b/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 diff --git a/embed.h b/embed.h index e42004da21b9..ce3050ae28d3 100644 --- a/embed.h +++ b/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__) diff --git a/gv.c b/gv.c index 93fc37da63a5..aacc1ad0c61f 100644 --- a/gv.c +++ b/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))); + } } } } diff --git a/gv.h b/gv.h index 68865b99916d..2de17674c09f 100644 --- a/gv.h +++ b/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 diff --git a/proto.h b/proto.h index 3ebd419b487a..13847e0023d8 100644 --- a/proto.h +++ b/proto.h @@ -1097,6 +1097,12 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags); #define PERL_ARGS_ASSERT_EVAL_SV \ assert(sv) +PERL_CALLCONV void +Perl_fatal_warner(pTHX_ U32 err, const char *pat, ...) + __attribute__format__(__printf__,pTHX_2,pTHX_3); +#define PERL_ARGS_ASSERT_FATAL_WARNER \ + assert(pat) + PERL_CALLCONV void Perl_fbm_compile(pTHX_ SV *sv, U32 flags); #define PERL_ARGS_ASSERT_FBM_COMPILE \ @@ -5180,6 +5186,11 @@ Perl_vdeb(pTHX_ const char *pat, va_list *args); #define PERL_ARGS_ASSERT_VDEB \ assert(pat) +PERL_CALLCONV void +Perl_vfatal_warner(pTHX_ U32 err, const char *pat, va_list *args); +#define PERL_ARGS_ASSERT_VFATAL_WARNER \ + assert(pat) + PERL_CALLCONV char * Perl_vform(pTHX_ const char *pat, va_list *args); #define PERL_ARGS_ASSERT_VFORM \ diff --git a/t/lib/warnings/gv b/t/lib/warnings/gv index 4a8c9aabd82e..d0a8e0cb1963 100644 --- a/t/lib/warnings/gv +++ b/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. diff --git a/util.c b/util.c index 3830f472665c..b6cc08fcf1cf 100644 --- a/util.c +++ b/util.c @@ -2135,6 +2135,27 @@ any of the categories are by default enabled. =for apidoc vwarner This is like C>, but C are an encapsulated argument list. +=for apidoc fatal_warner + +Like L 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 must be one of the C>, C, C, +C macros populated with the appropriate number of warning +categories. + +=for apidoc vfatal_warner + +This is like C> but C 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