Some Chip patches (some tweaked to match _5x source):

	Subject: [PATCH] local leakage
	Date: Tue, 3 Feb 1998 09:16:50 -0500 (EST)
	Subject: [PATCH] NULs in patterns
	Date: Wed, 4 Feb 1998 01:33:51 -0500 (EST)
	Subject: [PATCH] Configure on PerlIO
	Date: Wed, 4 Feb 1998 01:38:43 -0500 (EST)
	Subject: [PATCH] Avoid core dump on package alias
	Date: Wed, 4 Feb 1998 15:38:42 -0500 (EST)
	Subject: [PATCH] Fix name of $Foo::{'Bar::'}
	Date: Wed, 4 Feb 1998 16:37:51 -0500 (EST)

p4raw-id: //depot/perl@462

diff --git a/Configure b/Configure
index 6dcb640..952a685 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -5464,13 +5464,13 @@ fi
 
 cat <<EOM
 
-Previous version of $package used the standard IO mechanisms as defined in
-<stdio.h>.  Versions 5.003_02 and later of perl allow alternate IO
+Previous version of $package used the standard IO mechanisms as defined
+in <stdio.h>.  Versions 5.003_02 and later of perl allow alternate IO
 mechanisms via a "PerlIO" abstraction, but the stdio mechanism is still
-the default and is the only supported mechanism.  This abstraction
-layer can use AT&T's sfio (if you already have sfio installed) or
-fall back on standard IO.  This PerlIO abstraction layer is
-experimental and may cause problems with some extension modules.
+the default.  This abstraction layer can use AT&T's sfio (if you already
+have sfio installed) or regular stdio.  Using PerlIO with sfio may cause
+problems with some extension modules.  Using PerlIO with stdio is safe,
+but it is slower than plain stdio and therefore is not the default.
 
 If this doesn't make any sense to you, just accept the default 'n'.
 EOM

diff --git a/doio.c b/doio.c
index b25bb9c..d720f99 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -40,12 +40,18 @@
 #    include <utime.h>
 #  endif
 #endif
+
 #ifdef I_FCNTL
 #include <fcntl.h>
 #endif
 #ifdef I_SYS_FILE
 #include <sys/file.h>
 #endif
+#ifdef O_EXCL
+#  define OPEN_EXCL O_EXCL
+#else
+#  define OPEN_EXCL 0
+#endif
 
 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 #include <signal.h>
@@ -381,16 +387,16 @@ nextargv(register GV *gv)
     filemode = 0;
     while (av_len(GvAV(gv)) >= 0) {
        dTHR;
-       STRLEN len;
+       STRLEN oldlen;
        sv = av_shift(GvAV(gv));
        SAVEFREESV(sv);
        sv_setsv(GvSV(gv),sv);
        SvSETMAGIC(GvSV(gv));
-       oldname = SvPVx(GvSV(gv), len);
-       if (do_open(gv,oldname,len,FALSE,0,0,Nullfp)) {
+       oldname = SvPVx(GvSV(gv), oldlen);
+       if (do_open(gv,oldname,oldlen,inplace!=0,0,0,Nullfp)) {
            if (inplace) {
                TAINT_PROPER("inplace open");
-               if (strEQ(oldname,"-")) {
+               if (oldlen == 1 && *oldname == '-') {
                    setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
                    return IoIFP(GvIOp(gv));
                }
@@ -439,7 +445,7 @@ nextargv(register GV *gv)
                    do_close(gv,FALSE);
                    (void)PerlLIO_unlink(SvPVX(sv));
                    (void)PerlLIO_rename(oldname,SvPVX(sv));
-                   do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp);
+                   do_open(gv,SvPVX(sv),SvCUR(sv),inplace!=0,0,0,Nullfp);
 #endif /* DOSISH */
 #else
                    (void)UNLINK(SvPVX(sv));
@@ -456,8 +462,8 @@ nextargv(register GV *gv)
 #if !defined(DOSISH) && !defined(AMIGAOS)
 #  ifndef VMS  /* Don't delete; use automatic file versioning */
                    if (UNLINK(oldname) < 0) {
-                       warn("Can't rename %s to %s: %s, skipping file",
-                         oldname, SvPVX(sv), Strerror(errno) );
+                       warn("Can't remove %s: %s, skipping file",
+                         oldname, Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -467,10 +473,11 @@ nextargv(register GV *gv)
 #endif
                }
 
-               sv_setpvn(sv,">",1);
-               sv_catpv(sv,oldname);
+               sv_setpvn(sv,">",!inplace);
+               sv_catpvn(sv,oldname,oldlen);
                SETERRNO(0,0);          /* in case sprintf set errno */
-               if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp)) {
+               if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),inplace!=0,
+                            O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) {
                    warn("Can't do inplace edit on %s: %s",
                      oldname, Strerror(errno) );
                    do_close(gv,FALSE);

diff --git a/gv.c b/gv.c
index 251e453..80090c9 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -97,7 +97,7 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi)
     GvFILEGV(gv) = curcop->cop_filegv;
     GvEGV(gv) = gv;
     sv_magic((SV*)gv, (SV*)gv, '*', name, len);
-    GvSTASH(gv) = stash;
+    GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
     GvNAME(gv) = savepvn(name, len);
     GvNAMELEN(gv) = len;
     if (multi)
@@ -421,14 +421,15 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
                tmpbuf[len++] = ':';
                tmpbuf[len] = '\0';
                gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
+               gv = gvp ? *gvp : Nullgv;
+               if (gv && gv != (GV*)&sv_undef) {
+                   if (SvTYPE(gv) != SVt_PVGV)
+                       gv_init(gv, stash, tmpbuf, len, (add & 2));
+                   else
+                       GvMULTI_on(gv);
+               }
                Safefree(tmpbuf);
-               if (!gvp || *gvp == (GV*)&sv_undef)
-                   return Nullgv;
-               gv = *gvp;
-
-               if (SvTYPE(gv) == SVt_PVGV)
-                   GvMULTI_on(gv);
-               else if (!add)
+               if (!gv || gv == (GV*)&sv_undef)
                    return Nullgv;
                else
                    gv_init(gv, stash, nambeg, namend - nambeg, (add & 2));

diff --git a/op.c b/op.c
index 88d6475..3cff0b2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1162,6 +1162,7 @@ mod(OP *o, I32 type)
        /* FALL THROUGH */
     case OP_GV:
     case OP_AV2ARYLEN:
+       hints |= HINT_BLOCK_SCOPE;
     case OP_SASSIGN:
     case OP_AELEMFAST:
        modcount++;

diff --git a/pp_ctl.c b/pp_ctl.c
index d0033bf..acf6f01 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -86,10 +86,12 @@ PP(pp_regcomp) {
     else {
        t = SvPV(tmpstr, len);
 
-       /* JMR: Check against the last compiled regexp */
-       if ( ! pm->op_pmregexp  || ! pm->op_pmregexp->precomp
-           || strnNE(pm->op_pmregexp->precomp, t, len) 
-           || pm->op_pmregexp->precomp[len]) {
+       /* JMR: Check against the last compiled regexp
+          To know for sure, we'd need the length of precomp.
+          But we don't have it, so we must ... take a guess. */
+       if (!pm->op_pmregexp || !pm->op_pmregexp->precomp ||
+           memNE(pm->op_pmregexp->precomp, t, len + 1))
+       {
            if (pm->op_pmregexp) {
                ReREFCNT_dec(pm->op_pmregexp);
                pm->op_pmregexp = Null(REGEXP*);        /* crucial if regcomp aborts */

diff --git a/sv.c b/sv.c
index 5b37d72..38c0411 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1916,7 +1916,7 @@ sv_setsv(SV *dstr, register SV *sstr)
                STRLEN len = GvNAMELEN(sstr);
                sv_upgrade(dstr, SVt_PVGV);
                sv_magic(dstr, dstr, '*', name, len);
-               GvSTASH(dstr) = GvSTASH(sstr);
+               GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr));
                GvNAME(dstr) = savepvn(name, len);
                GvNAMELEN(dstr) = len;
                SvFAKE_on(dstr);        /* can coerce to non-glob */
@@ -2699,6 +2699,7 @@ sv_clear(register SV *sv)
     case SVt_PVGV:
        gp_free((GV*)sv);
        Safefree(GvNAME(sv));
+       SvREFCNT_dec(GvSTASH(sv));
        /* FALL THROUGH */
     case SVt_PVLV:
     case SVt_PVMG:

diff --git a/t/op/gv.t b/t/op/gv.t
index ece32d9..55e7429 100755 (executable)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -4,7 +4,7 @@
 # various typeglob tests
 #
 
-print "1..11\n";
+print "1..13\n";
 
 # type coersion on assignment
 $foo = 'foo';
@@ -57,3 +57,11 @@ if (defined $baa) {
   print ref(\$baa) eq 'GLOB' ? "ok 11\n" : "not ok 11\n";
 }
 
+# nested package globs
+# NOTE:  It's probably OK if these semantics change, because the
+#        fact that %X::Y:: is stored in %X:: isn't documented.
+#        (I hope.)
+
+{ package Foo::Bar }
+print exists $Foo::{'Bar::'} ? "ok 12\n" : "not ok 12\n";
+print $Foo::{'Bar::'} eq '*Foo::Bar::' ? "ok 13\n" : "not ok 13\n";

diff --git a/t/op/local.t b/t/op/local.t
index f527c9c..3e30306 100755 (executable)
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $
 
-print "1..23\n";
+print "1..24\n";
 
 sub foo {
     local($a, $b) = @_;
@@ -52,3 +52,9 @@ print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n";
 
 eval 'local(%$e)';
 print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n";
+
+# check for scope leakage
+$a = 'outer';
+if (1) { local $a = 'inner' }
+print +($a eq 'outer') ? "" : "not ", "ok 24\n";
+