Dont call Perl_warn manually in core

Leont · mauke · commit 410115a66cf3 · 2025-03-18T04:16:51.000+01:00
Just call warn instead, we've been able to do that for vararg functions since d933027
diff --git a/class.c b/class.c
@@ -141,7 +141,7 @@ XS(injected_constructor)
     struct xpvhv_aux *aux = HvAUX(stash);
 
     if((items - 1) % 2)
-        Perl_warn(aTHX_ "Odd number of arguments passed to %" HvNAMEf_QUOTEDPREFIX " constructor",
+        warn("Odd number of arguments passed to %" HvNAMEf_QUOTEDPREFIX " constructor",
                 HvNAMEfARG(stash));
 
     if (!aux->xhv_class_initfields_cv) {
diff --git a/dump.c b/dump.c
@@ -3496,7 +3496,7 @@ Perl_op_class(pTHX_ const OP *o)
     case OA_UNOP_AUX:
         return OPclass_UNOP_AUX;
     }
-    Perl_warn(aTHX_ "Can't determine class of operator %s, assuming BASEOP\n",
+    warn("Can't determine class of operator %s, assuming BASEOP\n",
          OP_NAME(o));
     return OPclass_BASEOP;
 }
diff --git a/op.c b/op.c
@@ -457,7 +457,7 @@ Perl_Slab_to_ro(pTHX_ OPSLAB *slab)
         /*DEBUG_U(PerlIO_printf(Perl_debug_log,"mprotect ->ro %lu at %p\n",
                               (unsigned long) slab->opslab_size, (void *)slab));*/
         if (mprotect(slab, OpSLABSizeBytes(slab->opslab_size), PROT_READ))
-            Perl_warn(aTHX_ "mprotect for %p %lu failed with %d", (void *)slab,
+            warn("mprotect for %p %lu failed with %d", (void *)slab,
                              (unsigned long)slab->opslab_size, errno);
     }
 }
@@ -476,7 +476,7 @@ Perl_Slab_to_rw(pTHX_ OPSLAB *const slab)
                               (unsigned long) size, (void *)slab2));*/
         if (mprotect((void *)slab2, OpSLABSizeBytes(slab2->opslab_size),
                      PROT_READ|PROT_WRITE)) {
-            Perl_warn(aTHX_ "mprotect RW for %p %lu failed with %d", (void *)slab,
+            warn("mprotect RW for %p %lu failed with %d", (void *)slab,
                              (unsigned long)slab2->opslab_size, errno);
         }
     }
@@ -11712,7 +11712,7 @@ S_process_special_blocks(pTHX_ I32 floor, const char *const fullname,
                          * be BEGIN blocks. Which works out, since the INIT
                          * blocks it creates are eval'ed and so are late.
                          */
-                        Perl_warn(aTHX_ "Treating %s::INIT block as BEGIN block as workaround",
+                        warn("Treating %s::INIT block as BEGIN block as workaround",
                                 MI_INIT_WORKAROUND_PACK);
                         goto module_install_hack;
                     }
diff --git a/pad.c b/pad.c
@@ -358,7 +358,7 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags)
                 LEAVE;
             }
 #ifdef DEBUGGING
-            else Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv);
+            else warn("Slab leaked from cv %p", (void*)cv);
 #endif
         }
     }
@@ -520,7 +520,7 @@ Perl_cv_forget_slab(pTHX_ CV *cv)
     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
 #ifdef DEBUGGING
-    else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv);
+    else if (slabbed)     warn("Slab leaked from cv %p", (void*)cv);
 #endif
 
     if (slab) {
diff --git a/perl.c b/perl.c
@@ -587,7 +587,7 @@ Perl_dump_sv_child(pTHX_ SV *sv)
     }
 
     if (returned_errno || *buffer) {
-        Perl_warn(aTHX_ "Debug leaking scalars child failed%s%.*s with errno"
+        warn("Debug leaking scalars child failed%s%.*s with errno"
                   " %d: %s", (*buffer ? " at " : ""), (int) *buffer, buffer + 1,
                   returned_errno, Strerror(returned_errno));
     }
@@ -5385,7 +5385,7 @@ Perl_my_exit(pTHX_ U32 status)
     }
     if (PL_exit_flags & PERL_EXIT_WARN) {
         PL_exit_flags |= PERL_EXIT_ABORT; /* Protect against reentrant calls */
-        Perl_warn(aTHX_ "Unexpected exit %lu", (unsigned long)status);
+        warn("Unexpected exit %lu", (unsigned long)status);
         PL_exit_flags &= ~PERL_EXIT_ABORT;
     }
     switch (status) {
@@ -5503,7 +5503,7 @@ Perl_my_failure_exit(pTHX)
     }
     if (PL_exit_flags & PERL_EXIT_WARN) {
         PL_exit_flags |= PERL_EXIT_ABORT; /* Protect against reentrant calls */
-        Perl_warn(aTHX_ "Unexpected exit failure %ld", (long)PL_statusvalue);
+        warn("Unexpected exit failure %ld", (long)PL_statusvalue);
         PL_exit_flags &= ~PERL_EXIT_ABORT;
     }
     my_exit_jump();
diff --git a/perlio.c b/perlio.c
@@ -760,7 +760,7 @@ perlio_mg_set(pTHX_ SV *sv, MAGIC *mg)
         IO * const io = GvIOn(GV_FROM_REF(sv));
         PerlIO * const ifp = IoIFP(io);
         PerlIO * const ofp = IoOFP(io);
-        Perl_warn(aTHX_ "set %" SVf " %p %p %p",
+        warn("set %" SVf " %p %p %p",
                   SVfARG(sv), (void*)io, (void*)ifp, (void*)ofp);
     }
     return 0;
@@ -773,7 +773,7 @@ perlio_mg_get(pTHX_ SV *sv, MAGIC *mg)
         IO * const io = GvIOn(GV_FROM_REF(sv));
         PerlIO * const ifp = IoIFP(io);
         PerlIO * const ofp = IoOFP(io);
-        Perl_warn(aTHX_ "get %" SVf " %p %p %p",
+        warn("get %" SVf " %p %p %p",
                   SVfARG(sv), (void*)io, (void*)ifp, (void*)ofp);
     }
     return 0;
@@ -782,14 +782,14 @@ perlio_mg_get(pTHX_ SV *sv, MAGIC *mg)
 static int
 perlio_mg_clear(pTHX_ SV *sv, MAGIC *mg)
 {
-    Perl_warn(aTHX_ "clear %" SVf, SVfARG(sv));
+    warn("clear %" SVf, SVfARG(sv));
     return 0;
 }
 
 static int
 perlio_mg_free(pTHX_ SV *sv, MAGIC *mg)
 {
-    Perl_warn(aTHX_ "free %" SVf, SVfARG(sv));
+    warn("free %" SVf, SVfARG(sv));
     return 0;
 }
 
@@ -815,7 +815,7 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
     mg = mg_find(sv, PERL_MAGIC_ext);
     mg->mg_virtual = &perlio_vtab;
     mg_magical(sv);
-    Perl_warn(aTHX_ "attrib %" SVf, SVfARG(sv));
+    warn("attrib %" SVf, SVfARG(sv));
     for (i = 2; i < items; i++) {
         STRLEN len;
         const char * const name = SvPV_const(ST(i), len);
diff --git a/pp_ctl.c b/pp_ctl.c
@@ -1946,7 +1946,7 @@ Perl_qerror(pTHX_ SV *err)
         else if (PL_errors)
             sv_catsv(PL_errors, err);
         else
-            Perl_warn(aTHX_ "%" SVf, SVfARG(err));
+            warn("%" SVf, SVfARG(err));
 
         if (PL_parser) {
             ++PL_parser->error_count;
diff --git a/pp_sys.c b/pp_sys.c
@@ -576,7 +576,7 @@ PP_wrapped(pp_warn, 0, 1)
       }
     }
     if (SvROK(exsv) && !PL_warnhook)
-         Perl_warn(aTHX_ "%" SVf, SVfARG(exsv));
+         warn("%" SVf, SVfARG(exsv));
     else warn_sv(exsv);
     RETSETYES;
 }
diff --git a/scope.c b/scope.c
@@ -1960,7 +1960,7 @@ Perl_magic_freedestruct(pTHX_ SV* sv, MAGIC* mg) {
 
     IV nargs = 0;
     if (PL_phase == PERL_PHASE_DESTRUCT) {
-        Perl_warn(aTHX_ "Can't call destructor for 0x%p in global destruction\n", sv);
+        warn("Can't call destructor for 0x%p in global destruction\n", sv);
         return 1;
     }
 
diff --git a/sv.c b/sv.c
@@ -4163,7 +4163,7 @@ Perl_sv_buf_to_ro(pTHX_ SV *sv)
     if (!header->readonly) header->readonly = 1;
 # endif
     if (mprotect(header, len, PROT_READ))
-        Perl_warn(aTHX_ "mprotect RW for COW string %p %lu failed with %d",
+        warn("mprotect RW for COW string %p %lu failed with %d",
                          header, len, errno);
 }
 
@@ -4175,7 +4175,7 @@ S_sv_buf_to_rw(pTHX_ SV *sv)
     const MEM_SIZE len = header->size;
     PERL_ARGS_ASSERT_SV_BUF_TO_RW;
     if (mprotect(header, len, PROT_READ|PROT_WRITE))
-        Perl_warn(aTHX_ "mprotect for COW string %p %lu failed with %d",
+        warn("mprotect for COW string %p %lu failed with %d",
                          header, len, errno);
 # ifdef PERL_TRACK_MEMPOOL
     header->readonly = 0;
diff --git a/util.c b/util.c
@@ -93,7 +93,7 @@ S_maybe_protect_rw(pTHX_ struct perl_memory_debug_header *header)
 {
     if (header->readonly
      && mprotect(header, header->size, PROT_READ|PROT_WRITE))
-        Perl_warn(aTHX_ "mprotect for COW string %p %lu failed with %d",
+        warn("mprotect for COW string %p %lu failed with %d",
                          header, header->size, errno);
 }
 
@@ -102,7 +102,7 @@ S_maybe_protect_ro(pTHX_ struct perl_memory_debug_header *header)
 {
     if (header->readonly
      && mprotect(header, header->size, PROT_READ))
-        Perl_warn(aTHX_ "mprotect RW for COW string %p %lu failed with %d",
+        warn("mprotect RW for COW string %p %lu failed with %d",
                          header, header->size, errno);
 }
 # define maybe_protect_rw(foo) S_maybe_protect_rw(aTHX_ foo)
@@ -4799,7 +4799,7 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer)
             env_pv++;
 
         if (*env_pv && !isXDIGIT(*env_pv)) {
-            Perl_warn(aTHX_ "perl: warning: Non hex character in '$ENV{PERL_HASH_SEED}', seed only partially set\n");
+            warn("perl: warning: Non hex character in '$ENV{PERL_HASH_SEED}', seed only partially set\n");
         }
         /* should we check for unparsed crap? */
         /* should we warn about unused hex? */
@@ -4826,7 +4826,7 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer)
         } else if (strEQ(env_pv,"2") || strEQ(env_pv,"DETERMINISTIC")) {
             PL_hash_rand_bits_enabled= 2;
         } else {
-            Perl_warn(aTHX_ "perl: warning: strange setting in '$ENV{PERL_PERTURB_KEYS}': '%s'\n", env_pv);
+            warn("perl: warning: strange setting in '$ENV{PERL_PERTURB_KEYS}': '%s'\n", env_pv);
         }
     }
 #  endif
diff --git a/vms/vms.c b/vms/vms.c
@@ -931,7 +931,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
                     "Can't read CRTL environ\n");
             } else
 #endif
-                Perl_warn(aTHX_ "Can't read CRTL environ\n");
+                warn("Can't read CRTL environ\n");
             continue;
           }
           retsts = SS$_NOLOGNAM;
@@ -10921,7 +10921,7 @@ Perl_vms_do_aexec(pTHX_ SV *really,SV **mark,SV **sp)
   if (vfork_called) {           /* this follows a vfork - act Unixish */
     vfork_called--;
     if (vfork_called < 0) {
-      Perl_warn(aTHX_ "Internal inconsistency in tracking vforks");
+      warn("Internal inconsistency in tracking vforks");
       vfork_called = 0;
     }
     else return do_aexec(really,mark,sp);
@@ -10949,7 +10949,7 @@ Perl_vms_do_exec(pTHX_ const char *cmd)
   if (vfork_called) {             /* this follows a vfork - act Unixish */
     vfork_called--;
     if (vfork_called < 0) {
-      Perl_warn(aTHX_ "Internal inconsistency in tracking vforks");
+      warn("Internal inconsistency in tracking vforks");
       vfork_called = 0;
     }
     else return do_exec(cmd);
@@ -11382,7 +11382,7 @@ fillpasswd (pTHX_ const char *name, struct passwd *pwd)
         pwd->pw_gid= uic.uic$v_group;
     }
     else
-      Perl_warn(aTHX_ "getpwnam returned invalid UIC %#o for user \"%s\"");
+      warn("getpwnam returned invalid UIC %#o for user \"%s\"");
     pwd->pw_passwd=  pw_passwd;
     pwd->pw_gecos=   owner.pw_gecos;
     pwd->pw_dir=     defdev.pw_dir;
@@ -11595,7 +11595,7 @@ Perl_my_time(pTHX_ time_t *timep)
       if (!vmstrnenv("SYS$TIMEZONE_DIFFERENTIAL",off,0,fildev,0)) {
         gmtime_emulation_type++;
         utc_offset_secs = 0;
-        Perl_warn(aTHX_ "no UTC offset information; assuming local time is UTC");
+        warn("no UTC offset information; assuming local time is UTC");
       }
       else { utc_offset_secs = atol(off); }
     }
diff --git a/win32/win32.c b/win32/win32.c
@@ -2745,7 +2745,7 @@ do_raise(pTHX_ int sig)
 void
 sig_terminate(pTHX_ int sig)
 {
-    Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig);
+    warn("Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig);
     /* exit() seems to be safe, my_exit() or die() is a problem in ^C 
        thread 
      */
@@ -5669,7 +5669,7 @@ win32_csighandler(int sig)
 {
 #if 0
     dTHXa(PERL_GET_SIG_CONTEXT);
-    Perl_warn(aTHX_ "Got signal %d",sig);
+    warn("Got signal %d",sig);
 #endif
     PERL_UNUSED_ARG(sig);
     /* Does nothing */

Original file line number	Diff line number	Diff line change
`@@ -3496,7 +3496,7 @@ Perl_op_class(pTHX_ const OP *o)`
`3496`	`3496`	`case OA_UNOP_AUX:`
`3497`	`3497`	`return OPclass_UNOP_AUX;`
`3498`	`3498`	`}`
`3499`		`- Perl_warn(aTHX_ "Can't determine class of operator %s, assuming BASEOP\n",`
	`3499`	`+ warn("Can't determine class of operator %s, assuming BASEOP\n",`
`3500`	`3500`	`OP_NAME(o));`
`3501`	`3501`	`return OPclass_BASEOP;`
`3502`	`3502`	`}`
Original file line number	Diff line number	Diff line change
`@@ -457,7 +457,7 @@ Perl_Slab_to_ro(pTHX_ OPSLAB *slab)`
`457`	`457`	`/*DEBUG_U(PerlIO_printf(Perl_debug_log,"mprotect ->ro %lu at %p\n",`
`458`	`458`	`(unsigned long) slab->opslab_size, (void )slab));/`
`459`	`459`	`if (mprotect(slab, OpSLABSizeBytes(slab->opslab_size), PROT_READ))`
`460`		`- Perl_warn(aTHX_ "mprotect for %p %lu failed with %d", (void *)slab,`
	`460`	`+ warn("mprotect for %p %lu failed with %d", (void *)slab,`
`461`	`461`	`(unsigned long)slab->opslab_size, errno);`
`462`	`462`	`}`
`463`	`463`	`}`
`@@ -476,7 +476,7 @@ Perl_Slab_to_rw(pTHX_ OPSLAB *const slab)`
`476`	`476`	`(unsigned long) size, (void )slab2));/`
`477`	`477`	`if (mprotect((void *)slab2, OpSLABSizeBytes(slab2->opslab_size),`
`478`	`478`	`PROT_READ\|PROT_WRITE)) {`
`479`		`- Perl_warn(aTHX_ "mprotect RW for %p %lu failed with %d", (void *)slab,`
	`479`	`+ warn("mprotect RW for %p %lu failed with %d", (void *)slab,`
`480`	`480`	`(unsigned long)slab2->opslab_size, errno);`
`481`	`481`	`}`
`482`	`482`	`}`
`@@ -11712,7 +11712,7 @@ S_process_special_blocks(pTHX_ I32 floor, const char *const fullname,`
`11712`	`11712`	`* be BEGIN blocks. Which works out, since the INIT`
`11713`	`11713`	`* blocks it creates are eval'ed and so are late.`
`11714`	`11714`	`*/`
`11715`		`- Perl_warn(aTHX_ "Treating %s::INIT block as BEGIN block as workaround",`
	`11715`	`+ warn("Treating %s::INIT block as BEGIN block as workaround",`
`11716`	`11716`	`MI_INIT_WORKAROUND_PACK);`
`11717`	`11717`	`goto module_install_hack;`
`11718`	`11718`	`}`
Original file line number	Diff line number	Diff line change
`@@ -358,7 +358,7 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags)`
`358`	`358`	`LEAVE;`
`359`	`359`	`}`
`360`	`360`	`#ifdef DEBUGGING`
`361`		`- else Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv);`
	`361`	`+ else warn("Slab leaked from cv %p", (void*)cv);`
`362`	`362`	`#endif`
`363`	`363`	`}`
`364`	`364`	`}`
`@@ -520,7 +520,7 @@ Perl_cv_forget_slab(pTHX_ CV *cv)`
`520`	`520`	`if (CvROOT(cv)) slab = OpSLAB(CvROOT(cv));`
`521`	`521`	`else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);`
`522`	`522`	`#ifdef DEBUGGING`
`523`		`- else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv);`
	`523`	`+ else if (slabbed) warn("Slab leaked from cv %p", (void*)cv);`
`524`	`524`	`#endif`
`525`	`525`
`526`	`526`	`if (slab) {`
Original file line number	Diff line number	Diff line change
`@@ -587,7 +587,7 @@ Perl_dump_sv_child(pTHX_ SV *sv)`
`587`	`587`	`}`
`588`	`588`
`589`	`589`	`if (returned_errno \|\| *buffer) {`
`590`		`- Perl_warn(aTHX_ "Debug leaking scalars child failed%s%.*s with errno"`
	`590`	`+ warn("Debug leaking scalars child failed%s%.*s with errno"`
`591`	`591`	`" %d: %s", (buffer ? " at " : ""), (int) buffer, buffer + 1,`
`592`	`592`	`returned_errno, Strerror(returned_errno));`
`593`	`593`	`}`
`@@ -5385,7 +5385,7 @@ Perl_my_exit(pTHX_ U32 status)`
`5385`	`5385`	`}`
`5386`	`5386`	`if (PL_exit_flags & PERL_EXIT_WARN) {`
`5387`	`5387`	`PL_exit_flags \|= PERL_EXIT_ABORT; /* Protect against reentrant calls */`
`5388`		`- Perl_warn(aTHX_ "Unexpected exit %lu", (unsigned long)status);`
	`5388`	`+ warn("Unexpected exit %lu", (unsigned long)status);`
`5389`	`5389`	`PL_exit_flags &= ~PERL_EXIT_ABORT;`
`5390`	`5390`	`}`
`5391`	`5391`	`switch (status) {`
`@@ -5503,7 +5503,7 @@ Perl_my_failure_exit(pTHX)`
`5503`	`5503`	`}`
`5504`	`5504`	`if (PL_exit_flags & PERL_EXIT_WARN) {`
`5505`	`5505`	`PL_exit_flags \|= PERL_EXIT_ABORT; /* Protect against reentrant calls */`
`5506`		`- Perl_warn(aTHX_ "Unexpected exit failure %ld", (long)PL_statusvalue);`
	`5506`	`+ warn("Unexpected exit failure %ld", (long)PL_statusvalue);`
`5507`	`5507`	`PL_exit_flags &= ~PERL_EXIT_ABORT;`
`5508`	`5508`	`}`
`5509`	`5509`	`my_exit_jump();`
Original file line number	Diff line number	Diff line change
`@@ -576,7 +576,7 @@ PP_wrapped(pp_warn, 0, 1)`
`576`	`576`	`}`
`577`	`577`	`}`
`578`	`578`	`if (SvROK(exsv) && !PL_warnhook)`
`579`		`- Perl_warn(aTHX_ "%" SVf, SVfARG(exsv));`
	`579`	`+ warn("%" SVf, SVfARG(exsv));`
`580`	`580`	`else warn_sv(exsv);`
`581`	`581`	`RETSETYES;`
`582`	`582`	`}`
Original file line number	Diff line number	Diff line change
`@@ -1960,7 +1960,7 @@ Perl_magic_freedestruct(pTHX_ SV* sv, MAGIC* mg) {`
`1960`	`1960`
`1961`	`1961`	`IV nargs = 0;`
`1962`	`1962`	`if (PL_phase == PERL_PHASE_DESTRUCT) {`
`1963`		`- Perl_warn(aTHX_ "Can't call destructor for 0x%p in global destruction\n", sv);`
	`1963`	`+ warn("Can't call destructor for 0x%p in global destruction\n", sv);`
`1964`	`1964`	`return 1;`
`1965`	`1965`	`}`
`1966`	`1966`