From: Robin Houston <robin@cpan.org>
Date: Tue, 27 Mar 2001 20:57:11 +0000 (+0100)
Subject: Autoloading Errno.pm when %! is encountered
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d2c93421f4371f0b56a9693b1b3c1113b425f5ae;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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};