Autoloading Errno.pm when %! is encountered

Message-ID: <20010327205710.A24053@puffinry.freeserve.co.uk>

p4raw-id: //depot/perl@9390

diff --git a/embed.h b/embed.h
index 4dc1773..c8015c5 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -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

diff --git a/embed.pl b/embed.pl
index 7867892..552c0a5 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -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)

diff --git a/gv.c b/gv.c
index 0d34366..72fcf82 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -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;

diff --git a/proto.h b/proto.h
index 5a6ef0b..9be4cd7 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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 c2a8211..d71d6b2 100755 (executable)
--- 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};