diff options
| -rw-r--r-- | embed.fnc | 10 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | gv.c | 55 | ||||
| -rw-r--r-- | gv.h | 1 | ||||
| -rw-r--r-- | mathoms.c | 12 | ||||
| -rw-r--r-- | proto.h | 26 |
6 files changed, 40 insertions, 66 deletions
@@ -339,10 +339,10 @@ p |char* |getenv_len |NN const char *env_elem|NN unsigned long *len pox |void |get_db_sub |NULLOK SV **svp|NN CV *cv Ap |void |gp_free |NULLOK GV* gv Ap |GP* |gp_ref |NULLOK GP* gp -Ap |GV* |gv_add_by_type |NN GV *gv|svtype type -Apmb |GV* |gv_AVadd |NN GV *gv -Apmb |GV* |gv_HVadd |NN GV *gv -Ap |GV* |gv_IOadd |NULLOK GV* gv +Ap |GV* |gv_add_by_type |NULLOK GV *gv|svtype type +Apmb |GV* |gv_AVadd |NULLOK GV *gv +Apmb |GV* |gv_HVadd |NULLOK GV *gv +Apmb |GV* |gv_IOadd |NULLOK GV* gv ApR |GV* |gv_autoload4 |NULLOK HV* stash|NN const char* name|STRLEN len|I32 method Ap |void |gv_check |NN const HV* stash Ap |void |gv_efullname |NN SV* sv|NN const GV* gv @@ -2082,7 +2082,7 @@ p |void |dump_sv_child |NN SV *sv #endif #ifdef PERL_DONT_CREATE_GVSV -Apbm |GV* |gv_SVadd |NN GV *gv +Apbm |GV* |gv_SVadd |NULLOK GV *gv #endif Apo |bool |ckwarn |U32 w Apo |bool |ckwarn_d |U32 w @@ -269,7 +269,6 @@ #define gp_free Perl_gp_free #define gp_ref Perl_gp_ref #define gv_add_by_type Perl_gv_add_by_type -#define gv_IOadd Perl_gv_IOadd #define gv_autoload4 Perl_gv_autoload4 #define gv_check Perl_gv_check #define gv_efullname Perl_gv_efullname @@ -2597,7 +2596,6 @@ #define gp_free(a) Perl_gp_free(aTHX_ a) #define gp_ref(a) Perl_gp_ref(aTHX_ a) #define gv_add_by_type(a,b) Perl_gv_add_by_type(aTHX_ a,b) -#define gv_IOadd(a) Perl_gv_IOadd(aTHX_ a) #define gv_autoload4(a,b,c,d) Perl_gv_autoload4(aTHX_ a,b,c,d) #define gv_check(a) Perl_gv_check(aTHX_ a) #define gv_efullname(a,b) Perl_gv_efullname(aTHX_ a,b) @@ -45,15 +45,34 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type) { SV **where; - PERL_ARGS_ASSERT_GV_ADD_BY_TYPE; - - if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV) - Perl_croak(aTHX_ "Bad symbol for %s", type == SVt_PVAV ? "array" : type == SVt_PVHV ? "hash" : "scalar"); + if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV) { + const char *what; + if (type == SVt_PVIO) { + /* + * if it walks like a dirhandle, then let's assume that + * this is a dirhandle. + */ + what = PL_op->op_type == OP_READDIR || + PL_op->op_type == OP_TELLDIR || + PL_op->op_type == OP_SEEKDIR || + PL_op->op_type == OP_REWINDDIR || + PL_op->op_type == OP_CLOSEDIR ? + "dirhandle" : "filehandle"; + /* diag_listed_as: Bad symbol for filehandle */ + } else if (type == SVt_PVHV) { + what = "hash"; + } else { + what = type == SVt_PVAV ? "array" : "scalar"; + } + Perl_croak(aTHX_ "Bad symbol for %s", what); + } if (type == SVt_PVHV) { where = (SV **)&GvHV(gv); } else if (type == SVt_PVAV) { where = (SV **)&GvAV(gv); + } else if (type == SVt_PVIO) { + where = (SV **)&GvIOp(gv); } else { where = &GvSV(gv); } @@ -64,34 +83,6 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type) } GV * -Perl_gv_IOadd(pTHX_ register GV *gv) -{ - dVAR; - - if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV) { - - /* - * if it walks like a dirhandle, then let's assume that - * this is a dirhandle. - */ - const char * const fh = - PL_op->op_type == OP_READDIR || - PL_op->op_type == OP_TELLDIR || - PL_op->op_type == OP_SEEKDIR || - PL_op->op_type == OP_REWINDDIR || - PL_op->op_type == OP_CLOSEDIR ? - "dirhandle" : "filehandle"; - /* diag_listed_as: Bad symbol for filehandle */ - Perl_croak(aTHX_ "Bad symbol for %s", fh); - } - - if (!GvIOp(gv)) { - GvIOp(gv) = newIO(); - } - return gv; -} - -GV * Perl_gv_fetchfile(pTHX_ const char *name) { PERL_ARGS_ASSERT_GV_FETCHFILE; @@ -209,6 +209,7 @@ Return the SV from the GV. #define gv_AVadd(gv) gv_add_by_type((gv), SVt_PVAV) #define gv_HVadd(gv) gv_add_by_type((gv), SVt_PVHV) +#define gv_IOadd(gv) gv_add_by_type((gv), SVt_PVIO) #define gv_SVadd(gv) gv_add_by_type((gv), SVt_NULL) /* @@ -1478,8 +1478,6 @@ Perl_save_op(pTHX) GV * Perl_gv_SVadd(pTHX_ GV *gv) { - PERL_ARGS_ASSERT_GV_SVADD; - return gv_SVadd(gv); } #endif @@ -1487,19 +1485,21 @@ Perl_gv_SVadd(pTHX_ GV *gv) GV * Perl_gv_AVadd(pTHX_ GV *gv) { - PERL_ARGS_ASSERT_GV_AVADD; - return gv_AVadd(gv); } GV * Perl_gv_HVadd(pTHX_ register GV *gv) { - PERL_ARGS_ASSERT_GV_HVADD; - return gv_HVadd(gv); } +GV * +Perl_gv_IOadd(pTHX_ register GV *gv) +{ + return gv_IOadd(gv); +} + IO * Perl_newIO(pTHX) { @@ -832,22 +832,10 @@ PERL_CALLCONV void Perl_get_db_sub(pTHX_ SV **svp, CV *cv) PERL_CALLCONV void Perl_gp_free(pTHX_ GV* gv); PERL_CALLCONV GP* Perl_gp_ref(pTHX_ GP* gp); -PERL_CALLCONV GV* Perl_gv_add_by_type(pTHX_ GV *gv, svtype type) - __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_GV_ADD_BY_TYPE \ - assert(gv) - -/* PERL_CALLCONV GV* Perl_gv_AVadd(pTHX_ GV *gv) - __attribute__nonnull__(pTHX_1); */ -#define PERL_ARGS_ASSERT_GV_AVADD \ - assert(gv) - -/* PERL_CALLCONV GV* Perl_gv_HVadd(pTHX_ GV *gv) - __attribute__nonnull__(pTHX_1); */ -#define PERL_ARGS_ASSERT_GV_HVADD \ - assert(gv) - -PERL_CALLCONV GV* Perl_gv_IOadd(pTHX_ GV* gv); +PERL_CALLCONV GV* Perl_gv_add_by_type(pTHX_ GV *gv, svtype type); +/* PERL_CALLCONV GV* Perl_gv_AVadd(pTHX_ GV *gv); */ +/* PERL_CALLCONV GV* Perl_gv_HVadd(pTHX_ GV *gv); */ +/* PERL_CALLCONV GV* Perl_gv_IOadd(pTHX_ GV* gv); */ PERL_CALLCONV GV* Perl_gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN len, I32 method) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_2); @@ -6347,11 +6335,7 @@ PERL_CALLCONV void Perl_dump_sv_child(pTHX_ SV *sv) #endif #ifdef PERL_DONT_CREATE_GVSV -/* PERL_CALLCONV GV* Perl_gv_SVadd(pTHX_ GV *gv) - __attribute__nonnull__(pTHX_1); */ -#define PERL_ARGS_ASSERT_GV_SVADD \ - assert(gv) - +/* PERL_CALLCONV GV* Perl_gv_SVadd(pTHX_ GV *gv); */ #endif PERL_CALLCONV bool Perl_ckwarn(pTHX_ U32 w); PERL_CALLCONV bool Perl_ckwarn_d(pTHX_ U32 w); |