From: Gurusamy Sarathy <gsar@cpan.org>
Date: Wed, 8 Oct 1997 02:18:23 +0000 (-0400)
Subject: Merge a patch in preparation for "weak keywords":
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=49dc05e34e370524b8b4de5368e27314830b2308;p=p5sagit%2Fp5-mst-13.2.git

Merge a patch in preparation for "weak keywords":
    Message-Id: <199710080618.CAA23899@aatma.engin.umich.edu>
    Subject: [PATCH] global overrides for keywords

p4raw-id: //depot/win32/perl@224
---

diff --git a/interp.sym b/interp.sym
index a12ea99..9235ff2 100644
--- a/interp.sym
+++ b/interp.sym
@@ -58,6 +58,7 @@ forkprocess
 formfeed
 formtarget
 gensym
+globalstash
 in_eval
 incgv
 initav
diff --git a/perl.c b/perl.c
index f83e09f..56ef5fa 100644
--- a/perl.c
+++ b/perl.c
@@ -1816,6 +1816,7 @@ init_main_stash()
     curstash = defstash;
     compiling.cop_stash = defstash;
     debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
+    globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
     /* We must init $/ before switches are processed. */
     sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
 }
diff --git a/perl.h b/perl.h
index 0523187..d8e69b6 100644
--- a/perl.h
+++ b/perl.h
@@ -1887,6 +1887,7 @@ IEXT AV *	Idbargs;	/* args to call listed by caller function */
 IEXT HV *	Idefstash;	/* main symbol table */
 IEXT HV *	Icurstash;	/* symbol table for current package */
 IEXT HV *	Idebstash;	/* symbol table for perldb package */
+IEXT HV *	Iglobalstash;	/* global keyword overrides imported here */
 IEXT SV *	Icurstname;	/* name of current package */
 IEXT AV *	Ibeginav;	/* names of BEGIN subroutines */
 IEXT AV *	Iendav;		/* names of END subroutines */
diff --git a/toke.c b/toke.c
index 6c53b99..df5e0eb 100644
--- a/toke.c
+++ b/toke.c
@@ -2551,7 +2551,10 @@ yylex()
     case 'y': case 'Y':
     case 'z': case 'Z':
 
-      keylookup:
+      keylookup: {
+	GV *gv = Nullgv;
+	GV **gvp = 0;
+
 	bufptr = s;
 	s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
 
@@ -2593,16 +2596,18 @@ yylex()
 	}
 
 	if (tmp < 0) {			/* second-class keyword? */
-	    GV* gv;
-	    if (expect != XOPERATOR &&
-		(*s != ':' || s[1] != ':') &&
-		(gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) &&
-		GvIMPORTED_CV(gv))
+	    if (expect != XOPERATOR && (*s != ':' || s[1] != ':') &&
+		(((gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) &&
+		  GvCVu(gv) && GvIMPORTED_CV(gv)) ||
+		 ((gvp = (GV**)hv_fetch(globalstash,tokenbuf,len,FALSE)) &&
+		  (gv = *gvp) != (GV*)&sv_undef &&
+		  GvCVu(gv) && GvIMPORTED_CV(gv))))
 	    {
 		tmp = 0;
 	    }
-	    else
-		tmp = -tmp;
+	    else {
+		tmp = -tmp; gv = Nullgv; gvp = 0;
+	    }
 	}
 
       reserved_word:
@@ -2610,7 +2615,6 @@ yylex()
 
 	default:			/* not a keyword */
 	  just_a_word: {
-		GV *gv;
 		SV *sv;
 		char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]);
 
@@ -2635,12 +2639,19 @@ yylex()
 
 		/* Look for a subroutine with this name in current package. */
 
-		gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV);
+		if (gvp) {
+		    sv = newSVpv("CORE::GLOBAL::",14);
+		    sv_catpv(sv,tokenbuf);
+		}
+		else
+		    sv = newSVpv(tokenbuf,0);
+		if (!gv)
+		    gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV);
 
 		/* Presume this is going to be a bareword of some sort. */
 
 		CLINE;
-		yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
+		yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
 		yylval.opval->op_private = OPpCONST_BARE;
 
 		/* See if it's the indirect object for a list operator. */
@@ -3776,7 +3787,7 @@ yylex()
 	    s = scan_trans(s);
 	    TERM(sublex_start());
 	}
-    }
+    }}
 }
 
 I32