Merge maint-5.004 branch (5.004_04) with mainline.

p4raw-id: //depot/perl@137

diff --cc Configure
Simple merge

diff --cc MANIFEST
index e6b3b41,26a5409..9c8ace9
--- 1/MANIFEST
--- 2/MANIFEST
+++ b/MANIFEST
@@@ -208,10 -206,6 +208,9 @@@ ext/SDBM_File/typemap             SDBM extension i
  ext/Socket/Makefile.PL        Socket extension makefile writer
  ext/Socket/Socket.pm  Socket extension Perl module
  ext/Socket/Socket.xs  Socket extension external subroutines
- ext/util/extliblist   Used by extension Makefile.PL to make lib lists
 +ext/attrs/Makefile.PL attrs extension makefile writer
 +ext/attrs/attrs.pm    attrs extension Perl module
 +ext/attrs/attrs.xs    attrs extension external subroutines
  ext/util/make_ext     Used by Makefile to execute extension Makefiles
  ext/util/mkbootstrap  Turns ext/*/*_BS into bootstrap info
  form.h                        Public declarations for the above

diff --cc Makefile.SH
Simple merge

diff --cc av.c
Simple merge

diff --cc doop.c
Simple merge

diff --cc embed.h
index a824b0a,51e5f40..a34d057
--- 1/embed.h
--- 2/embed.h
+++ b/embed.h
@@@ -338,9 -324,9 +339,10 @@@
  #define magic_gettaint                Perl_magic_gettaint
  #define magic_getuvar         Perl_magic_getuvar
  #define magic_len             Perl_magic_len
 +#define magic_mutexfree               Perl_magic_mutexfree
  #define magic_nextpack                Perl_magic_nextpack
  #define magic_set             Perl_magic_set
+ #define magic_set_all_env     Perl_magic_set_all_env
  #define magic_setamagic               Perl_magic_setamagic
  #define magic_setarylen               Perl_magic_setarylen
  #define magic_setbm           Perl_magic_setbm

diff --cc global.sym
Simple merge

diff --cc gv.c
Simple merge

diff --cc hints/dec_osf.sh
Simple merge

diff --cc hints/linux.sh
Simple merge

diff --cc hv.c
Simple merge

diff --cc malloc.c
Simple merge

diff --cc mg.c
index e02a1d2,ee87d47..dedf381
--- 1/mg.c
--- 2/mg.c
+++ b/mg.c
@@@ -384,6 -391,14 +391,17 @@@ MAGIC *mg
      case '\020':              /* ^P */
        sv_setiv(sv, (IV)perldb);
        break;
 -      if (lex_state != LEX_NOTPARSING)
 -          SvOK_off(sv);
 -      else if (in_eval)
 -          sv_setiv(sv, 1);
 -      else
 -          sv_setiv(sv, 0);
+     case '\023':              /* ^S */
++      {
++          dTHR;
++          if (lex_state != LEX_NOTPARSING)
++              SvOK_off(sv);
++          else if (in_eval)
++              sv_setiv(sv, 1);
++          else
++              sv_setiv(sv, 0);
++      }
+       break;
      case '\024':              /* ^T */
  #ifdef BIG_TIME
        sv_setnv(sv, basetime);
@@@ -658,6 -669,28 +676,29 @@@ MAGIC* mg
  }
  
  int
+ magic_set_all_env(sv,mg)
+ SV* sv;
+ MAGIC* mg;
+ {
+ #if defined(VMS)
+     die("Can't make list assignment to %%ENV on this system");
+ #else
++    dTHR;
+     if (localizing) {
+       HE* entry;
+       magic_clear_all_env(sv,mg);
+       hv_iterinit((HV*)sv);
+       while (entry = hv_iternext((HV*)sv)) {
+           I32 keylen;
+           my_setenv(hv_iterkey(entry, &keylen),
+                     SvPV(hv_iterval((HV*)sv, entry), na));
+       }
+     }
+ #endif
+     return 0;
+ }
+ 
+ int
  magic_clear_all_env(sv,mg)
  SV* sv;
  MAGIC* mg;

diff --cc op.c
index 8a3debc,8e8811d..7c769d1
--- 1/op.c
--- 2/op.c
+++ b/op.c
@@@ -2872,10 -2808,11 +2874,11 @@@ OP *cont
      OP *redo;
      OP *next = 0;
      OP *listop;
 -    OP *op;
 +    OP *o;
      OP *condop;
  
-     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
+     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
+                || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
        expr = newUNOP(OP_DEFINED, 0,
            newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
      }
@@@ -3892,20 -3792,20 +3902,20 @@@ OP *o
  }
  
  OP *
 -ck_eof(op)
 -OP *op;
 +ck_eof(o)
 +OP *o;
  {
 -    I32 type = op->op_type;
 +    I32 type = o->op_type;
  
 -    if (op->op_flags & OPf_KIDS) {
 -      if (cLISTOP->op_first->op_type == OP_STUB) {
 -          op_free(op);
 -          op = newUNOP(type, OPf_SPECIAL,
 -               newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV)));
 +    if (o->op_flags & OPf_KIDS) {
 +      if (cLISTOPo->op_first->op_type == OP_STUB) {
 +          op_free(o);
 +          o = newUNOP(type, OPf_SPECIAL,
-               newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
++              newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV)));
        }
 -      return ck_fun(op);
 +      return ck_fun(o);
      }
 -    return op;
 +    return o;
  }
  
  OP *
@@@ -4072,9 -3970,9 +4082,9 @@@ OP *o
        }
      }
      else {
 -      op_free(op);
 +      op_free(o);
        if (type == OP_FTTTY)
-           return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
+            return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
                                SVt_PVIO));
        else
            return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
@@@ -4222,33 -4119,39 +4232,31 @@@ OP *o
  }
  
  OP *
 -ck_glob(op)
 -OP *op;
 +ck_glob(o)
 +OP *o;
  {
-     GV *gv = gv_fetchpv("glob", FALSE, SVt_PVCV);
+     GV *gv;
+ 
+     if ((op->op_flags & OPf_KIDS) && !cLISTOP->op_first->op_sibling)
+       append_elem(OP_GLOB, op, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ 
+     if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
+       gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
  
      if (gv && GvIMPORTED_CV(gv)) {
        static int glob_index;
  
 -      append_elem(OP_GLOB, op,
 +      append_elem(OP_GLOB, o,
                    newSVOP(OP_CONST, 0, newSViv(glob_index++)));
-       o->op_type = OP_LIST;
-       o->op_ppaddr = ppaddr[OP_LIST];
-       cLISTOPo->op_first->op_type = OP_PUSHMARK;
-       cLISTOPo->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
-       o = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                   append_elem(OP_LIST, o, 
-                               scalar(newUNOP(OP_RV2CV, 0,
-                                              newGVOP(OP_GV, 0, gv)))));
-       return ck_subr(o);
-     }
-     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
-       append_elem(OP_GLOB, o, newSVREF(newGVOP(OP_GV, 0, defgv)));
 -      op->op_type = OP_LIST;
 -      op->op_ppaddr = ppaddr[OP_LIST];
 -      ((LISTOP*)op)->op_first->op_type = OP_PUSHMARK;
 -      ((LISTOP*)op)->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
 -      op = newUNOP(OP_ENTERSUB, OPf_STACKED,
 -                   append_elem(OP_LIST, op, 
 -                               scalar(newUNOP(OP_RV2CV, 0,
 -                                              newGVOP(OP_GV, 0, gv)))));
 -      op = newUNOP(OP_NULL, 0, ck_subr(op));
 -      op->op_targ = OP_GLOB;          /* hint at what it used to be */
 -      return op;
++      o = newUNOP(OP_NULL, 0, ck_subr(o));
++      o->op_targ = OP_GLOB;           /* hint at what it used to be */
++      return o;
+     }
      gv = newGVgen("main");
      gv_IOadd(gv);
 -    append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
 -    scalarkids(op);
 -    return ck_fun(op);
 +    append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
 +    scalarkids(o);
 +    return ck_fun(o);
  }
  
  OP *
@@@ -4739,14 -4628,15 +4747,15 @@@ OP *o
            }
        }
        else
 -          list(o);
 -      mod(o, OP_ENTERSUB);
 -      prev = o;
 -      o = o->op_sibling;
 +          list(o2);
 +      mod(o2, OP_ENTERSUB);
 +      prev = o2;
 +      o2 = o2->op_sibling;
      }
-     if (proto && !optional && *proto == '$')
+     if (proto && !optional &&
+         (*proto && *proto != '@' && *proto != '%' && *proto != ';'))
 -      return too_few_arguments(op, gv_ename(namegv));
 -    return op;
 +      return too_few_arguments(o, gv_ename(namegv));
 +    return o;
  }
  
  OP *

diff --cc opcode.h
Simple merge

diff --cc perl.c
Simple merge

diff --cc perl.h
Simple merge

diff --cc perly.c
Simple merge

diff --cc perly.y
Simple merge

diff --cc pp.c
Simple merge

diff --cc pp_ctl.c
index 15b975d,516e41e..d14fa4b
--- 1/pp_ctl.c
--- 2/pp_ctl.c
+++ b/pp_ctl.c
@@@ -2272,14 -2224,9 +2272,15 @@@ int gimme
      /* compiled okay, so do it */
  
      CvDEPTH(compcv) = 1;
 -
      SP = stack_base + POPMARK;                /* pop original mark */
+     op = saveop;                                      /* The caller may need it. */
 +#ifdef USE_THREADS
 +    MUTEX_LOCK(&eval_mutex);
 +    eval_owner = 0;
 +    COND_SIGNAL(&eval_cond);
 +    MUTEX_UNLOCK(&eval_mutex);
 +#endif /* USE_THREADS */
 +
      RETURNOP(eval_start);
  }
  

diff --cc pp_hot.c
Simple merge

diff --cc pp_sys.c
Simple merge

diff --cc proto.h
Simple merge

diff --cc regcomp.c
Simple merge

diff --cc regexec.c
index 0ed2bc7,c640d67..e5d9e4d
--- 1/regexec.c
--- 2/regexec.c
+++ b/regexec.c
@@@ -145,9 -143,9 +145,10 @@@ regcppop(
   *    0 > length [ "foobar" =~ / ( (foo) | (bar) )* /x ]->[1]
   */
  static void
- regcppartblow()
+ regcppartblow(base)
+ I32 base;
  {
 +    dTHR;
      I32 i = SSPOPINT;
      U32 paren;
      char *startp;

diff --cc scope.c
index 7628196,3006f1a..3fc1a0e
--- 1/scope.c
--- 2/scope.c
+++ b/scope.c
@@@ -177,8 -165,12 +177,13 @@@ save_gp(gv, empty
  GV *gv;
  I32 empty;
  {
-     SSCHECK(3);
 +    dTHR;
+     SSCHECK(6);
+     SSPUSHIV((IV)SvLEN(gv));
+     SvLEN(gv) = 0; /* forget that anything was allocated here */
+     SSPUSHIV((IV)SvCUR(gv));
+     SSPUSHPTR(SvPVX(gv));
+     SvPOK_off(gv);
      SSPUSHPTR(SvREFCNT_inc(gv));
      SSPUSHPTR(GvGP(gv));
      SSPUSHINT(SAVEt_GP);
@@@ -201,10 -193,11 +206,12 @@@ AV 
  save_ary(gv)
  GV *gv;
  {
 +    dTHR;
+     AV *oav, *av;
+ 
      SSCHECK(3);
      SSPUSHPTR(gv);
-     SSPUSHPTR(GvAVn(gv));
+     SSPUSHPTR(oav = GvAVn(gv));
      SSPUSHINT(SAVEt_AV);
  
      GvAV(gv) = Null(AV*);
@@@ -215,10 -218,11 +232,12 @@@ HV 
  save_hash(gv)
  GV *gv;
  {
 +    dTHR;
+     HV *ohv, *hv;
+ 
      SSCHECK(3);
      SSPUSHPTR(gv);
-     SSPUSHPTR(GvHVn(gv));
+     SSPUSHPTR(ohv = GvHVn(gv));
      SSPUSHINT(SAVEt_HV);
  
      GvHV(gv) = Null(HV*);
@@@ -661,8 -674,7 +720,8 @@@ voi
  cx_dump(cx)
  CONTEXT* cx;
  {
-     PerlIO_printf(Perl_debug_log, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]);
 +    dTHR;
+     PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]);
      if (cx->cx_type != CXt_SUBST) {
        PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
        PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);

diff --cc sv.c
Simple merge

diff --cc toke.c
Simple merge

diff --cc util.c
Simple merge

diff --cc vms/perly_c.vms
Simple merge

diff --cc vms/vms.c
Simple merge

diff --cc x2p/Makefile.SH
Simple merge