assert() that every NN argument is not NULL. Otherwise we have the

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index 8b045e0..78fb2e3 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -194,6 +194,9 @@ void
 Perl_sys_init(int* argc, char*** argv)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_SYS_INIT;
+
     PERL_UNUSED_ARG(argc); /* may not be used depending on _BODY macro */
     PERL_UNUSED_ARG(argv);
     PERL_SYS_INIT_BODY(argc, argv);
@@ -203,6 +206,9 @@ void
 Perl_sys_init3(int* argc, char*** argv, char*** env)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_SYS_INIT3;
+
     PERL_UNUSED_ARG(argc); /* may not be used depending on _BODY macro */
     PERL_UNUSED_ARG(argv);
     PERL_UNUSED_ARG(env);
@@ -228,6 +234,9 @@ perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
                 struct IPerlProc* ipP)
 {
     PerlInterpreter *my_perl;
+
+    PERL_ARGS_ASSERT_PERL_ALLOC_USING;
+
     /* Newx() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
     S_init_tls_and_interp(my_perl);
@@ -288,11 +297,14 @@ void
 perl_construct(pTHXx)
 {
     dVAR;
-    PERL_UNUSED_ARG(my_perl);
+
+    PERL_ARGS_ASSERT_PERL_CONSTRUCT;
+
 #ifdef MULTIPLICITY
     init_interp();
     PL_perl_destruct_level = 1;
 #else
+    PERL_UNUSED_ARG(my_perl);
    if (PL_perl_destruct_level > 0)
        init_interp();
 #endif
@@ -478,6 +490,8 @@ Perl_dump_sv_child(pTHX_ SV *sv)
     int returned_errno;
     unsigned char buffer[256];
 
+    PERL_ARGS_ASSERT_DUMP_SV_CHILD;
+
     if(sock == -1 || debug_fd == -1)
        return;
 
@@ -580,7 +594,10 @@ perl_destruct(pTHXx)
     pid_t child;
 #endif
 
+    PERL_ARGS_ASSERT_PERL_DESTRUCT;
+#ifndef MULTIPLICITY
     PERL_UNUSED_ARG(my_perl);
+#endif
 
     /* wait for all pseudo-forked children to finish */
     PERL_WAIT_FOR_CHILDREN;
@@ -1346,6 +1363,8 @@ perl_free(pTHXx)
 {
     dVAR;
 
+    PERL_ARGS_ASSERT_PERL_FREE;
+
     if (PL_veto_cleanup)
        return;
 
@@ -1490,7 +1509,10 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
     int ret;
     dJMPENV;
 
+    PERL_ARGS_ASSERT_PERL_PARSE;
+#ifndef MULTIPLICITY
     PERL_UNUSED_ARG(my_perl);
+#endif
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW_AND_IAMSUID
     Perl_croak(aTHX_ "suidperl is no longer needed since the kernel can now "
@@ -2271,7 +2293,10 @@ perl_run(pTHXx)
     int ret = 0;
     dJMPENV;
 
+    PERL_ARGS_ASSERT_PERL_RUN;
+#ifndef MULTIPLICITY
     PERL_UNUSED_ARG(my_perl);
+#endif
 
     oldscope = PL_scopestack_ix;
 #ifdef VMS
@@ -2389,6 +2414,9 @@ SV*
 Perl_get_sv(pTHX_ const char *name, I32 create)
 {
     GV *gv;
+
+    PERL_ARGS_ASSERT_GET_SV;
+
     gv = gv_fetchpv(name, create, SVt_PV);
     if (gv)
        return GvSV(gv);
@@ -2411,6 +2439,9 @@ AV*
 Perl_get_av(pTHX_ const char *name, I32 create)
 {
     GV* const gv = gv_fetchpv(name, create, SVt_PVAV);
+
+    PERL_ARGS_ASSERT_GET_AV;
+
     if (create)
        return GvAVn(gv);
     if (gv)
@@ -2434,6 +2465,9 @@ HV*
 Perl_get_hv(pTHX_ const char *name, I32 create)
 {
     GV* const gv = gv_fetchpv(name, create, SVt_PVHV);
+
+    PERL_ARGS_ASSERT_GET_HV;
+
     if (create)
        return GvHVn(gv);
     if (gv)
@@ -2466,6 +2500,9 @@ Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
     /* XXX this is probably not what they think they're getting.
      * It has the same effect as "sub name;", i.e. just a forward
      * declaration! */
+
+    PERL_ARGS_ASSERT_GET_CVN_FLAGS;
+
     if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) {
        SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8);
        return newSUB(start_subparse(FALSE, 0),
@@ -2480,6 +2517,8 @@ Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
 CV*
 Perl_get_cv(pTHX_ const char *name, I32 flags)
 {
+    PERL_ARGS_ASSERT_GET_CV;
+
     return get_cvn_flags(name, strlen(name), flags);
 }
 
@@ -2505,6 +2544,8 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
     dVAR;
     dSP;
 
+    PERL_ARGS_ASSERT_CALL_ARGV;
+
     PUSHMARK(SP);
     if (argv) {
        while (*argv) {
@@ -2529,6 +2570,8 @@ Perl_call_pv(pTHX_ const char *sub_name, I32 flags)
                        /* name of the subroutine */
                        /* See G_* flags in cop.h */
 {
+    PERL_ARGS_ASSERT_CALL_PV;
+
     return call_sv((SV*)get_cv(sub_name, TRUE), flags);
 }
 
@@ -2546,6 +2589,8 @@ Perl_call_method(pTHX_ const char *methname, I32 flags)
                                /* name of the subroutine */
                        /* See G_* flags in cop.h */
 {
+    PERL_ARGS_ASSERT_CALL_METHOD;
+
     return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD);
 }
 
@@ -2560,7 +2605,7 @@ L<perlcall>.
 */
 
 I32
-Perl_call_sv(pTHX_ SV *sv, I32 flags)
+Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
                        /* See G_* flags in cop.h */
 {
     dVAR; dSP;
@@ -2574,6 +2619,8 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
     OP* const oldop = PL_op;
     dJMPENV;
 
+    PERL_ARGS_ASSERT_CALL_SV;
+
     if (flags & G_DISCARD) {
        ENTER;
        SAVETMPS;
@@ -2705,6 +2752,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     OP* const oldop = PL_op;
     dJMPENV;
 
+    PERL_ARGS_ASSERT_EVAL_SV;
+
     if (flags & G_DISCARD) {
        ENTER;
        SAVETMPS;
@@ -2791,6 +2840,8 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
     dSP;
     SV* sv = newSVpv(p, 0);
 
+    PERL_ARGS_ASSERT_EVAL_PV;
+
     eval_sv(sv, G_SCALAR);
     SvREFCNT_dec(sv);
 
@@ -2824,6 +2875,9 @@ Perl_require_pv(pTHX_ const char *pv)
     dVAR;
     dSP;
     SV* sv;
+
+    PERL_ARGS_ASSERT_REQUIRE_PV;
+
     PUSHSTACKi(PERLSI_REQUIRE);
     PUTBACK;
     sv = Perl_newSVpvf(aTHX_ "require q%c%s%c", 0, pv, 0);
@@ -2837,6 +2891,8 @@ Perl_magicname(pTHX_ const char *sym, const char *name, I32 namlen)
 {
     register GV * const gv = gv_fetchpv(sym, GV_ADD, SVt_PV);
 
+    PERL_ARGS_ASSERT_MAGICNAME;
+
     if (gv)
        sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, namlen);
 }
@@ -2881,6 +2937,8 @@ NULL
 };
     const char * const *p = usage_msg;
 
+    PERL_ARGS_ASSERT_USAGE;
+
     PerlIO_printf(PerlIO_stdout(),
                  "\nUsage: %s [switches] [--] [programfile] [arguments]",
                  name);
@@ -2923,6 +2981,9 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
       NULL
     };
     int i = 0;
+
+    PERL_ARGS_ASSERT_GET_DEBUG_OPTS;
+
     if (isALPHA(**s)) {
        /* if adding extra options, remember to update DEBUG_MASK */
        static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAq";
@@ -2961,6 +3022,8 @@ Perl_moreswitches(pTHX_ const char *s)
     dVAR;
     UV rschar;
 
+    PERL_ARGS_ASSERT_MORESWITCHES;
+
     switch (*s) {
     case '0':
     {
@@ -3504,6 +3567,8 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch,
     int fdscript = -1;
     dVAR;
 
+    PERL_ARGS_ASSERT_OPEN_SCRIPT;
+
     if (PL_e_script) {
        PL_origfilename = savepvs("-e");
     }
@@ -3786,6 +3851,8 @@ S_validate_suid(pTHX_ const char *validarg,
     dVAR;
     const char *s, *s2;
 
+    PERL_ARGS_ASSERT_VALIDATE_SUID;
+
     /* do we need to emulate setuid on scripts? */
 
     /* This code is for those BSD systems that have setuid #! scripts disabled
@@ -4164,6 +4231,8 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 STATIC void
 S_validate_suid(pTHX_ PerlIO *rsfp)
 {
+    PERL_ARGS_ASSERT_VALIDATE_SUID;
+
     if (PL_euid != PL_uid || PL_egid != PL_gid) {      /* (suidperl doesn't exist, in fact) */
 #  ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
        PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */
@@ -4191,6 +4260,8 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
     int maclines = 0;
 #endif
 
+    PERL_ARGS_ASSERT_FIND_BEGINNING;
+
     /* skip forward in input to the real script? */
 
 #ifdef MACOS_TRADITIONAL
@@ -4496,6 +4567,9 @@ void
 Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_INIT_ARGV_SYMBOLS;
+
     argc--,argv++;     /* skip name of script */
     if (PL_doswitches) {
        for (; argc > 0 && **argv == '-'; argc--,argv++) {
@@ -4538,6 +4612,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     dVAR;
     GV* tmpgv;
 
+    PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS;
+
     PL_toptarget = newSV_type(SVt_PVFM);
     sv_setpvn(PL_toptarget, "", 0);
     PL_bodytarget = newSV_type(SVt_PVFM);
@@ -4768,6 +4844,9 @@ S_incpush_if_exists(pTHX_ SV *dir)
 {
     dVAR;
     Stat_t tmpstatbuf;
+
+    PERL_ARGS_ASSERT_INCPUSH_IF_EXISTS;
+
     if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
        S_ISDIR(tmpstatbuf.st_mode)) {
        av_push(GvAVn(PL_incgv), dir);
@@ -5011,6 +5090,8 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
     int ret;
     dJMPENV;
 
+    PERL_ARGS_ASSERT_CALL_LIST;
+
     while (av_len(paramList) >= 0) {
        cv = (CV*)av_shift(paramList);
        if (PL_savebegin) {