diff options
-rw-r--r-- | embed.fnc | 3 | ||||
-rw-r--r-- | embed.h | 2 | ||||
-rw-r--r-- | gv.c | 2 | ||||
-rw-r--r-- | op.c | 12 | ||||
-rw-r--r-- | pp.c | 9 | ||||
-rw-r--r-- | proto.h | 2 |
6 files changed, 12 insertions, 18 deletions
@@ -265,8 +265,7 @@ Afnp |int |printf_nocontext|NN const char *format|... #endif : Used in pp.c p |SV * |core_prototype |NULLOK SV *sv|NN const char *name \ - |const int code|NULLOK int * const opnum\ - |const bool croak + |const int code|NULLOK int * const opnum : Used in sv.c p |void |cv_ckproto_len |NN const CV* cv|NULLOK const GV* gv\ |NULLOK const char* p|const STRLEN len @@ -1008,7 +1008,7 @@ #define ck_trunc(a) Perl_ck_trunc(aTHX_ a) #define ck_unpack(a) Perl_ck_unpack(aTHX_ a) #define convert(a,b,c) Perl_convert(aTHX_ a,b,c) -#define core_prototype(a,b,c,d,e) Perl_core_prototype(aTHX_ a,b,c,d,e) +#define core_prototype(a,b,c,d) Perl_core_prototype(aTHX_ a,b,c,d) #define create_eval_scope(a) Perl_create_eval_scope(aTHX_ a) #define cv_ckproto_len(a,b,c,d) Perl_cv_ckproto_len(aTHX_ a,b,c,d) #define cvgv_set(a,b) Perl_cvgv_set(aTHX_ a,b) @@ -1361,7 +1361,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, CvFILE(cv) = (char *)file; CvISXSUB_on(cv); CvXSUB(cv) = core_xsub; - (void)core_prototype((SV *)cv, name, code, &opnum, 0); + (void)core_prototype((SV *)cv, name, code, &opnum); opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL; cv_set_call_checker( cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv @@ -10343,7 +10343,7 @@ returns NULL if C<croak> is false. SV * Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, - int * const opnum, const bool croak) + int * const opnum) { int i = 0, n = 0, seen_question = 0, defgv = 0; I32 oa; @@ -10353,15 +10353,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, PERL_ARGS_ASSERT_CORE_PROTOTYPE; - if (!code || code == -KEY_CORE) { - if (croak) - return (SV *)Perl_die(aTHX_ - "Can't find an opnumber for \"%s\"", name - ); - return NULL; - } - - if (code > 0) return NULL; /* Not overridable */ + assert (code < 0 && code != -KEY_CORE); if (!sv) sv = sv_newmortal(); @@ -439,9 +439,12 @@ PP(pp_prototype) const char * s = SvPVX_const(TOPs); if (strnEQ(s, "CORE::", 6)) { const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1); - SV *const sv = - core_prototype(NULL, s + 6, code, NULL, 1); - if (sv) ret = sv; + if (!code || code == -KEY_CORE) + DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6); + if (code < 0) { /* Overridable. */ + SV * const sv = core_prototype(NULL, s + 6, code, NULL); + if (sv) ret = sv; + } goto set; } } @@ -578,7 +578,7 @@ PERL_CALLCONV void Perl_cop_store_label(pTHX_ COP *const cop, const char *label, #define PERL_ARGS_ASSERT_COP_STORE_LABEL \ assert(cop); assert(label) -PERL_CALLCONV SV * Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, int * const opnum, const bool croak) +PERL_CALLCONV SV * Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, int * const opnum) __attribute__nonnull__(pTHX_2); #define PERL_ARGS_ASSERT_CORE_PROTOTYPE \ assert(name) |