This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge maint-5.004 branch (5.004_03) with mainline.
authorMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Wed, 8 Oct 1997 10:19:27 +0000 (10:19 +0000)
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Wed, 8 Oct 1997 10:19:27 +0000 (10:19 +0000)
MANIFEST is out of sync.

p4raw-id: //depot/perl@114

30 files changed:
1  2 
Configure
MANIFEST
Makefile.SH
XSUB.h
av.c
doio.c
embed.h
ext/DB_File/DB_File.pm
ext/DB_File/DB_File.xs
global.sym
gv.c
hints/linux.sh
malloc.c
mg.c
op.c
opcode.pl
perl.c
perl.h
pp.c
pp_ctl.c
pp_hot.c
pp_sys.c
proto.h
regcomp.c
regexec.c
scope.c
sv.c
toke.c
util.c
vms/vms.c

diff --cc Configure
Simple merge
diff --cc MANIFEST
Simple merge
diff --cc Makefile.SH
Simple merge
diff --cc XSUB.h
Simple merge
diff --cc av.c
Simple merge
diff --cc doio.c
Simple merge
diff --cc embed.h
Simple merge
@@@ -1,8 -1,8 +1,8 @@@
  # DB_File.pm -- Perl 5 interface to Berkeley DB 
  #
  # written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
- # last modified 31st May 1997
 -# last modified 29th Jun 1997
--# version 1.15
++# last modified 8th Oct 1997
++# version 1.16
  #
  #     Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved.
  #     This program is free software; you can redistribute it and/or
@@@ -1668,8 -1663,19 +1663,23 @@@ ordinary array to a HASH or BTREE datab
  
  =item 1.15
  
+ Patch from Gisle Aas <gisle@aas.no> to suppress "use of undefined
+ value" warning with db_get and db_seq.
+ Patch from Gisle Aas <gisle@aas.no> to make DB_File export only the O_*
+ constants from Fcntl.
+ Removed the DESTROY method from the DB_File::HASHINFO module.
+ Previously DB_File hard-wired the class name of any object that it
+ created to "DB_File". This makes sub-classing difficult. Now DB_File
+ creats objects in the namespace of the package it has been inherited
+ into.
++=item 1.16
++
 +Minor changes to DB_File.xs to support multithreaded perl.
 +
  =back
  
  =head1 BUGS
@@@ -3,8 -3,8 +3,8 @@@
   DB_File.xs -- Perl 5 interface to Berkeley DB 
  
   written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
-  last modified 31st May 1997
 - last modified 29th Jun 1997
-- version 1.15
++ last modified 8th Oct 1997
++ version 1.16
  
   All comments/suggestions/problems are welcome
  
@@@ -42,7 -42,9 +42,9 @@@
        1.13 -  Tidied up a few casts.
        1.14 -  Made it illegal to tie an associative array to a RECNO
                database and an ordinary array to a HASH or BTREE database.
-       1.15 -  Minor additions to DB_File.xs to support multithreaded perl.
+       1.15 -  Patch from Gisle Aas <gisle@aas.no> to suppress "use of 
+               undefined value" warning with db_get and db_seq.
 -
++      1.16 -  Minor additions to DB_File.xs to support multithreaded perl.
  
  */
  
diff --cc global.sym
Simple merge
diff --cc gv.c
--- 1/gv.c
--- 2/gv.c
+++ b/gv.c
@@@ -1348,12 -1339,12 +1350,12 @@@ int flags
      myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
  
      ENTER;
 -    SAVESPTR(op);
 +    SAVEOP();
      op = (OP *) &myop;
-     if (perldb && curstash != debstash)
+     if (PERLDB_SUB && curstash != debstash)
        op->op_private |= OPpENTERSUB_DB;
      PUTBACK;
 -    pp_pushmark();
 +    pp_pushmark(ARGS);
  
      EXTEND(sp, notfound + 5);
      PUSHs(lr>0? right: left);
diff --cc hints/linux.sh
@@@ -183,14 -183,14 +183,25 @@@ els
      echo 'Your csh is really tcsh.  Good.'
  fi
  
+ # Shimpei Yamashita <shimpei@socrates.patnet.caltech.edu>
+ # Message-Id: <33EF1634.B36B6500@pobox.com>
+ # 
+ # MkLinux (osname=linux,archname=ppc-linux), which differs slightly from other
+ # linuces, needs special flags passed in order for dynamic loading to work.
+ # instead of the recommended:
+ # ccdlflags='-rdynamic'
+ # 
+ # it should be:
+ # ccdlflags='-Wl,-E'
 +if [ "X$usethreads" != "X" ]; then
 +    ccflags="-D_REENTRANT -DUSE_THREADS $ccflags"
 +    cppflags="-D_REENTRANT -DUSE_THREADS $cppflags"
 +    # -lpthread needs to come before -lc but after other libraries such
 +    # as -lgdbm and such like. We assume here that -lc is present in
 +    # libswanted. If that fails to be true in future, then this can be
 +    # changed to add pthread to the very end of libswanted.
 +    set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
 +    shift
 +    libswanted="$*"
 +fi
diff --cc malloc.c
Simple merge
diff --cc mg.c
Simple merge
diff --cc op.c
--- 1/op.c
--- 2/op.c
+++ b/op.c
@@@ -1110,9 -1059,11 +1110,11 @@@ I32 type
  
      case OP_RV2AV:
      case OP_RV2HV:
 -      if (!type && cUNOP->op_first->op_type != OP_GV)
++      if (!type && cUNOPo->op_first->op_type != OP_GV)
+           croak("Can't localize through a reference");
 -      if (type == OP_REFGEN && op->op_flags & OPf_PARENS) {
 +      if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
            modcount = 10000;
 -          return op;          /* Treat \(@foo) like ordinary list. */
 +          return o          /* Treat \(@foo) like ordinary list. */
        }
        /* FALL THROUGH */
      case OP_RV2GV:
        modcount = 10000;
        break;
      case OP_RV2SV:
 -      if (!type && cUNOP->op_first->op_type != OP_GV)
 +      if (!type && cUNOPo->op_first->op_type != OP_GV)
-           croak("Can't localize a reference");
+           croak("Can't localize through a reference");
 -      ref(cUNOP->op_first, op->op_type); 
 +      ref(cUNOPo->op_first, o->op_type); 
        /* FALL THROUGH */
      case OP_GV:
      case OP_AV2ARYLEN:
@@@ -4641,10 -4526,10 +4653,10 @@@ OP *o
            }
        }
      }
 -    op->op_private |= (hints & HINT_STRICT_REFS);
 +    o->op_private |= (hints & HINT_STRICT_REFS);
-     if (perldb && curstash != debstash)
+     if (PERLDB_SUB && curstash != debstash)
 -      op->op_private |= OPpENTERSUB_DB;
 -    while (o != cvop) {
 +      o->op_private |= OPpENTERSUB_DB;
 +    while (o2 != cvop) {
        if (proto) {
            switch (*proto) {
            case '\0':
diff --cc opcode.pl
Simple merge
diff --cc perl.c
--- 1/perl.c
--- 2/perl.c
+++ b/perl.c
@@@ -1004,10 -895,8 +1016,10 @@@ PerlInterpreter *sv_interp
            PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", origfilename);
            my_exit(0);
        }
-       if (perldb && DBsingle)
-           sv_setiv(DBsingle, 1); 
+       if (PERLDB_SINGLE && DBsingle)
+          sv_setiv(DBsingle, 1); 
 +      if (initav)
 +          call_list(oldscope, initav);
      }
  
      /* do it */
diff --cc perl.h
--- 1/perl.h
--- 2/perl.h
+++ b/perl.h
@@@ -1310,26 -1283,9 +1316,21 @@@ typedef Sighandler_t Sigsave_t
  # ifndef register
  #  define register
  # endif
- # ifdef MYMALLOC
- #  ifndef DEBUGGING_MSTATS
- #   define DEBUGGING_MSTATS
- #  endif
- # endif
  # define PAD_SV(po) pad_sv(po)
 +# define RUNOPS_DEFAULT runops_debug
  #else
  # define PAD_SV(po) curpad[po]
 +# define RUNOPS_DEFAULT runops_standard
 +#endif
 +
 +/*
 + * These need prototyping here because <proto.h> isn't
 + * included until after runops is initialised.
 + */
 +
 +int runops_standard _((void));
 +#ifdef DEBUGGING
 +int runops_debug _((void));
  #endif
  
  /****************/
diff --cc pp.c
Simple merge
diff --cc pp_ctl.c
+++ b/pp_ctl.c
@@@ -1969,7 -1940,12 +1969,12 @@@ PP(pp_goto
            OP *oldop = op;
            for (ix = 1; enterops[ix]; ix++) {
                op = enterops[ix];
 -              (*op->op_ppaddr)();
+               /* Eventually we may want to stack the needed arguments
+                * for each op.  For now, we punt on the hard ones. */
+               if (op->op_type == OP_ENTERITER)
+                   DIE("Can't \"goto\" into the middle of a foreach loop",
+                       label);
 +              (*op->op_ppaddr)(ARGS);
            }
            op = oldop;
        }
@@@ -2466,19 -2412,12 +2474,20 @@@ PP(pp_entereval
  
      /* prepare to compile string */
  
-     if (perldb && curstash != debstash)
+     if (PERLDB_LINE && curstash != debstash)
        save_lines(GvAV(compiling.cop_filegv), linestr);
      PUTBACK;
 +#ifdef USE_THREADS
 +    MUTEX_LOCK(&eval_mutex);
 +    if (eval_owner && eval_owner != thr)
 +      while (eval_owner)
 +          COND_WAIT(&eval_cond, &eval_mutex);
 +    eval_owner = thr;
 +    MUTEX_UNLOCK(&eval_mutex);
 +#endif /* USE_THREADS */
      ret = doeval(gimme);
-     if (perldb && was != sub_generation) { /* Some subs defined here. */
+     if (PERLDB_INTER && was != sub_generation /* Some subs defined here. */
+       && ret != op->op_next) {        /* Successive compilation. */
        strcpy(safestr, "_<(eval )");   /* Anything fake and short. */
      }
      return DOCATCH(ret);
diff --cc pp_hot.c
+++ b/pp_hot.c
@@@ -524,10 -499,8 +522,8 @@@ PP(pp_rv2hv
      if (SvROK(sv)) {
        wasref:
        hv = (HV*)SvRV(sv);
 -      if (SvTYPE(hv) != SVt_PVHV)
 +      if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV)
            DIE("Not a HASH reference");
-       if (op->op_private & OPpLVAL_INTRO)
-           hv = (HV*)save_svref((SV**)sv);
        if (op->op_flags & OPf_REF) {
            SETs((SV*)hv);
            RETURN;
diff --cc pp_sys.c
+++ b/pp_sys.c
@@@ -534,9 -533,9 +534,9 @@@ PP(pp_tie
      CATCH_SET(TRUE);
  
      ENTER;
 -    SAVESPTR(op);
 +    SAVEOP();
      op = (OP *) &myop;
-     if (perldb && curstash != debstash)
+     if (PERLDB_SUB && curstash != debstash)
        op->op_private |= OPpENTERSUB_DB;
  
      XPUSHs((SV*)GvCV(gv));
@@@ -645,12 -644,12 +645,12 @@@ PP(pp_dbmopen
      CATCH_SET(TRUE);
  
      ENTER;
 -    SAVESPTR(op);
 +    SAVEOP();
      op = (OP *) &myop;
-     if (perldb && curstash != debstash)
+     if (PERLDB_SUB && curstash != debstash)
        op->op_private |= OPpENTERSUB_DB;
      PUTBACK;
 -    pp_pushmark();
 +    pp_pushmark(ARGS);
  
      EXTEND(sp, 5);
      PUSHs(sv);
diff --cc proto.h
Simple merge
diff --cc regcomp.c
Simple merge
diff --cc regexec.c
+++ b/regexec.c
@@@ -136,6 -134,34 +136,35 @@@ regcppop(
      return input;
  }
  
+ /* After a successful match in WHILEM, we want to restore paren matches
+  * that have been overwritten by a failed match attempt in the process
+  * of reaching this success. We do this by restoring regstartp[i]
+  * wherever regendp[i] has not changed; if OPEN is changed to modify
+  * regendp[], the '== endp' test below should be changed to match.
+  * This corrects the error of:
+  *    0 > length [ "foobar" =~ / ( (foo) | (bar) )* /x ]->[1]
+  */
+ static void
+ regcppartblow()
+ {
++    dTHR;
+     I32 i = SSPOPINT;
+     U32 paren;
+     char *startp;
+     char *endp;
+     assert(i == SAVEt_REGCONTEXT);
+     i = SSPOPINT;
+     /* input, lastparen, size */
+     SSPOPPTR; SSPOPINT; SSPOPINT;
+     for (i -= 3; i > 0; i -= 3) {
+       paren = (U32)SSPOPINT;
+       startp = (char *) SSPOPPTR;
+       endp = (char *) SSPOPPTR;
+       if (paren <= *reglastparen && regendp[paren] == endp)
+           regstartp[paren] = startp;
+     }
+ }
  #define regcpblow(cp) leave_scope(cp)
  
  /*
diff --cc scope.c
Simple merge
diff --cc sv.c
--- 1/sv.c
--- 2/sv.c
+++ b/sv.c
@@@ -1731,12 -1716,15 +1734,16 @@@ STRLEN *lp
        if (SvTYPE(sv) < SVt_PVIV)
            sv_upgrade(sv, SVt_PVIV);
        olderrno = errno;       /* some Xenix systems wipe out errno here */
-       sv_setpvf(sv, "%Vd", SvIVX(sv));
+       sv_setpviv(sv, SvIVX(sv));
        errno = olderrno;
        s = SvEND(sv);
+       if (oldIOK)
+           SvIOK_on(sv);
+       else
+           SvIOKp_on(sv);
      }
      else {
 +      dTHR;
        if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
            warn(warn_uninit);
        *lp = 0;
diff --cc toke.c
Simple merge
diff --cc util.c
Simple merge
diff --cc vms/vms.c
Simple merge