diff options
| -rw-r--r-- | embed.h | 4 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | gv.c | 50 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rwxr-xr-x | t/op/magic.t | 23 |
5 files changed, 65 insertions, 14 deletions
@@ -883,6 +883,7 @@ #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define gv_init_sv S_gv_init_sv +#define require_errno S_require_errno #endif #if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) #define hsplit S_hsplit @@ -2366,6 +2367,7 @@ #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define gv_init_sv(a,b) S_gv_init_sv(aTHX_ a,b) +#define require_errno(a) S_require_errno(aTHX_ a) #endif #if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) #define hsplit(a) S_hsplit(aTHX_ a) @@ -4633,6 +4635,8 @@ #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define S_gv_init_sv CPerlObj::S_gv_init_sv #define gv_init_sv S_gv_init_sv +#define S_require_errno CPerlObj::S_require_errno +#define require_errno S_require_errno #endif #if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) #define S_hsplit CPerlObj::S_hsplit @@ -2262,6 +2262,7 @@ s |I32 |do_trans_complex_utf8 |SV *sv #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) s |void |gv_init_sv |GV *gv|I32 sv_type +s |void |require_errno |GV *gv #endif #if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) @@ -471,6 +471,28 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) return gv; } +/* The "gv" parameter should be the glob known to Perl code as *! + * The scalar must already have been magicalized. + */ +STATIC void +S_require_errno(pTHX_ GV *gv) +{ + HV* stash = gv_stashpvn("Errno",5,FALSE); + + if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) { + dSP; + PUTBACK; + ENTER; + save_scalar(gv); /* keep the value of $! */ + require_pv("Errno.pm"); + LEAVE; + SPAGAIN; + stash = gv_stashpvn("Errno",5,FALSE); + if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) + Perl_croak(aTHX_ "Can't use %%! because Errno.pm is not available"); + } +} + /* =for apidoc gv_stashpv @@ -694,6 +716,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (add) { GvMULTI_on(gv); gv_init_sv(gv, sv_type); + if (*name=='!' && sv_type == SVt_PVHV && len==1) + require_errno(gv); } return gv; } else if (add & GV_NOINIT) { @@ -814,19 +838,19 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) case '!': if (len > 1) break; - if (sv_type > SVt_PV && PL_curcop != &PL_compiling) { - HV* stash = gv_stashpvn("Errno",5,FALSE); - if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) { - dSP; - PUTBACK; - require_pv("Errno.pm"); - SPAGAIN; - stash = gv_stashpvn("Errno",5,FALSE); - if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) - Perl_croak(aTHX_ "Can't use %%! because Errno.pm is not available"); - } - } - goto magicalize; + + /* If %! has been used, automatically load Errno.pm. + The require will itself set errno, so in order to + preserve its value we have to set up the magic + now (rather than going to magicalize) + */ + + sv_magic(GvSV(gv), (SV*)gv, 0, name, len); + + if (sv_type == SVt_PVHV) + require_errno(gv); + + break; case '-': if (len > 1) break; @@ -994,6 +994,7 @@ STATIC I32 S_do_trans_complex_utf8(pTHX_ SV *sv); #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) STATIC void S_gv_init_sv(pTHX_ GV *gv, I32 sv_type); +STATIC void S_require_errno(pTHX_ GV *gv); #endif #if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) diff --git a/t/op/magic.t b/t/op/magic.t index c2a82115b4..d71d6b299c 100755 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -27,7 +27,7 @@ $Is_os2 = $^O eq 'os2'; $Is_Cygwin = $^O eq 'cygwin'; $PERL = ($Is_MSWin32 ? '.\perl' : './perl'); -print "1..35\n"; +print "1..38\n"; eval '$ENV{"FOO"} = "hi there";'; # check that ENV is inited inside eval if ($Is_MSWin32) { ok 1, `cmd /x /c set FOO` eq "FOO=hi there\n"; } @@ -226,3 +226,24 @@ else { ok "34 # skipped: no caseless %ENV support",1; ok "35 # skipped: no caseless %ENV support",1; } + +# Make sure Errno hasn't been prematurely autoloaded + +ok 36, !defined %Errno::; + +# Test auto-loading of Errno when %! is used + +ok 37, scalar eval q{ + my $errs = %!; + defined %Errno::; +}, $@; + + +# Make sure that Errno loading doesn't clobber $! + +undef %Errno::; +delete $INC{"Errno.pm"}; + +open(FOO, "nonesuch"); # Generate ENOENT +my %errs = %{"!"}; # Cause Errno.pm to be loaded at run-time +ok 38, ${"!"}{ENOENT}; |