This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[inseparable changes from patch from perl5.003_25 to perl5.003_26] perl-5.003_26
authorPerl 5 Porters <perl5-porters@africa.nicoh.com>
Mon, 10 Feb 1997 19:29:00 +0000 (07:29 +1200)
committerChip Salzenberg <chip@atlantic.net>
Mon, 10 Feb 1997 19:29:00 +0000 (07:29 +1200)
 CORE LANGUAGE CHANGES

Subject: Make \r in script an error (per Larry)
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldiag.pod toke.c

 CORE PORTABILITY

Subject: VMS patches post _25
Date: Fri, 07 Feb 1997 01:56:12 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: Porting/Glossary lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp perl.c vms/Makefile vms/config.vms vms/descrip.mms vms/genconfig.pl vms/perlvms.pod vms/vms.c vms/vmsish.h x2p/a2p.c

    private-msgid: <01IF48W3P39W0050BD@hmivax.humgen.upenn.edu>

 LIBRARY AND EXTENSIONS

Subject: Make diagnostics module strip formatting directives
From: Chip Salzenberg <chip@perl.com>
Files: lib/diagnostics.pm pod/perldiag.pod

 OTHER CORE CHANGES

Subject: Fix (yet another) Tk closure problem
From: Chip Salzenberg <chip@perl.com>
Files: op.c perl.c pp_ctl.c

Subject: Fix value of C<foreach>
From: Chip Salzenberg <chip@perl.com>
Files: cop.h pp_ctl.c

Subject: Refine 'runaway string' heuristic
From: Chip Salzenberg <chip@perl.com>
Files: toke.c

Subject: Fix core dump on C<print "a", last> in eval
From: Chip Salzenberg <chip@perl.com>
Files: pp_ctl.c

25 files changed:
Changes
INSTALL
Porting/Glossary
cop.h
lib/ExtUtils/Liblist.pm
lib/ExtUtils/MM_VMS.pm
lib/ExtUtils/xsubpp
lib/diagnostics.pm
op.c
patchlevel.h
perl.c
pod/perldiag.pod
pod/perlmod.pod
pod/perltoc.pod
pp_ctl.c
scope.h
t/op/recurse.t
toke.c
vms/Makefile
vms/config.vms
vms/descrip.mms
vms/genconfig.pl
vms/perlvms.pod
vms/vms.c
vms/vmsish.h

diff --git a/Changes b/Changes
index 6dd2b66..eed5656 100644 (file)
--- a/Changes
+++ b/Changes
@@ -9,6 +9,144 @@ releases.)
 
 
 ----------------
+Version 5.003_26
+----------------
+
+This release is beta candidate #4.  "Once more, dear friends...."
+
+ CORE LANGUAGE CHANGES
+
+  Title:  "Make \r in script an error (per Larry)"
+   From:  Chip Salzenberg
+  Files:  pod/perldiag.pod toke.c
+
+  Title:  "Support '%i' format and 'h' modifier in s?printf"
+   From:  Chip Salzenberg
+  Files:  doop.c pod/perldelta.pod
+
+ CORE PORTABILITY
+
+  Title:  "Fix value of system() and $? for DEC UNIX, VMS, others"
+   From:  Chip Salzenberg
+  Files:  mg.c perl.h pp_sys.c
+
+  Title:  "VMS patches post _25"
+   From:  Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
+ Msg-ID:  <01IF48W3P39W0050BD@hmivax.humgen.upenn.edu>
+   Date:  Fri, 07 Feb 1997 01:56:12 -0500 (EST)
+  Files:  Porting/Glossary lib/ExtUtils/Liblist.pm
+          lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp perl.c
+          vms/Makefile vms/config.vms vms/descrip.mms vms/genconfig.pl
+          vms/perlvms.pod vms/vms.c vms/vmsish.h x2p/a2p.c
+
+  Title:  "Hints for BSDOS"
+   From:  Christopher Davis <ckd@loiosh.kei.com>
+ Msg-ID:  <199702042011.PAA09206@loiosh.kei.com>
+   Date:  Tue, 4 Feb 1997 15:11:13 -0500 (EST)
+  Files:  hints/bsdos.sh
+
+  Title:  "On C<sysopen(..., O_APPEND)>, call C<fopen(..., "a")>"
+   From:  Chip Salzenberg
+  Files:  doio.c
+
+ OTHER CORE CHANGES
+
+  Title:  "Fix (yet another) Tk closure problem"
+   From:  Chip Salzenberg
+  Files:  op.c perl.c pp_ctl.c
+
+  Title:  "Fix value of C<foreach>"
+   From:  Chip Salzenberg
+  Files:  cop.h pp_ctl.c
+
+  Title:  "Regexp optimizations"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199702041102.GAA24805@monk.mps.ohio-state.edu>
+   Date:  Tue, 4 Feb 1997 06:02:10 -0500 (EST)
+  Files:  regcomp.c regexec.c
+
+  Title:  "Re: static buffer in not_a_number() [sv.c] might overflow"
+   From:  Gisle Aas <aas@bergen.sn.no>
+ Msg-ID:  <hbu9uz1si.fsf@bergen.sn.no>
+   Date:  09 Feb 1997 11:55:41 +0100
+  Files:  sv.c
+
+  Title:  "Refine 'runaway string' heuristic"
+   From:  Chip Salzenberg
+  Files:  toke.c
+
+  Title:  "Fix core dump on C<print "a", last> in eval"
+   From:  Chip Salzenberg
+  Files:  pp_ctl.c
+
+  Title:  "Catch C<use integer; $x % 0>"
+   From:  Chip Salzenberg
+  Files:  pp.c
+
+ BUILD PROCESS
+
+  Title:  "Fix usage message in configure.gnu"
+   From:  Jarkko Hietaniemi <jhi@cc.hut.fi>
+  Files:  configure.gnu
+
+ LIBRARY AND EXTENSIONS
+
+  Title:  "DB_File 1.11 patch"
+   From:  pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Msg-ID:  <9702061553.AA18147@claudius.bfsec.bt.co.uk>
+   Date:  Thu, 6 Feb 97 15:53:34 GMT
+  Files:  ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
+
+  Title:  "Faster File::Compare"
+   From:  Gisle Aas <aas@bergen.sn.no>
+ Msg-ID:  <199702051342.OAA02753@bergen.sn.no>
+   Date:  Wed, 5 Feb 1997 14:42:49 +0100
+  Files:  lib/File/Compare.pm
+
+  Title:  "Make diagnostics module strip formatting directives"
+   From:  Chip Salzenberg
+  Files:  lib/diagnostics.pm pod/perldiag.pod
+
+  Title:  "Fix warning from missing POSIX::setvbuf()"
+   From:  Chip Salzenberg
+  Files:  ext/IO/IO.xs
+
+ TESTS
+
+  Title:  "Fix closure.t for AmigaOS (again)"
+   From:  "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de>
+ Msg-ID:  <77724742@Armageddon.meb.uni-bonn.de>
+   Date:  Wed, 05 Feb 1997 18:56:45 +0100
+  Files:  t/op/closure.t
+
+ UTILITIES
+
+  Title:  "perldoc -f <perlfunc>"
+   From:  Gisle Aas <aas@bergen.sn.no>
+ Msg-ID:  <199702051127.MAA02090@bergen.sn.no>
+   Date:  Wed, 5 Feb 1997 12:27:36 +0100
+  Files:  utils/perldoc.PL
+
+  Title:  "Fix pod2man's handling of quotes in =items"
+   From:  Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID:  <199702042023.WAA13143@alpha.hut.fi>
+   Date:  Tue, 4 Feb 1997 22:23:34 +0200 (EET)
+  Files:  pod/pod2man.PL
+
+ DOCUMENTATION
+
+  Title:  "return *FH pod patch"
+   From:  allen@gateway.grumman.com (John L. Allen)
+ Msg-ID:  <9702061507.AA04474@gateway.grumman.com>
+   Date:  Thu, 6 Feb 1997 10:07:28 -0500
+  Files:  pod/perldata.pod pod/perlsub.pod
+
+  Title:  "Describe interation of untie and DESTROY"
+   From:  Paul Marquess and Chip Salzenberg
+  Files:  pod/perltie.pod
+
+
+----------------
 Version 5.003_25
 ----------------
 
diff --git a/INSTALL b/INSTALL
index 837c726..156fdd9 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -117,7 +117,7 @@ e.g.
 If your prefix contains the string "perl", then the directories
 are simplified.  For example, if you use prefix=/opt/perl,
 then Configure will suggest /opt/perl/lib instead of
-/usr/local/lib/perl5/.
+/opt/perl/lib/perl5/.
 
 By default, Configure will compile perl to use dynamic loading, if
 your system supports it.  If you want to force perl to be compiled
@@ -1102,4 +1102,4 @@ from the original README by Larry Wall.
 
 =head1 LAST MODIFIED
 
-22 January 1997
+8 February 1997
index 58f2cac..c71c199 100644 (file)
@@ -1113,6 +1113,11 @@ lns (lns.U):
        symbolic links (if they are supported).  It can be used
        in the Makefile. It is either 'ln -s' or 'ln'
 
+longsize (intsize.U):
+       This variable contains the value of the LONGSIZE symbol,
+       which indicates to the C program how many bytes there are
+       in a long integer.
+
 lseektype (lseektype.U):
        This variable defines lseektype to be something like off_t, long, 
        or whatever type is used to declare lseek offset's type in the
@@ -1288,6 +1293,11 @@ shmattype (d_shmat.U):
        This symbol contains the type of pointer returned by shmat().
        It can be 'void *' or 'char *'.
 
+shortsize (intsize.U):
+       This variable contains the value of the SHORTSIZE symbol,
+       which indicates to the C program how many bytes there are
+       in a short integer.
+
 shrpenv (libperl.U):
        If the user builds a shared libperl.so, then we need to tell the
        'perl' executable where it will be able to find the installed libperl.so. 
diff --git a/cop.h b/cop.h
index 501faac..00501fd 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -125,10 +125,10 @@ struct block_loop {
          POPLOOP2(); }
 
 #define POPLOOP1(cx)                                                   \
-       cxloop = cx->blk_loop;  /* because DESTROY may clobber *cx */
+       cxloop = cx->blk_loop;  /* because DESTROY may clobber *cx */   \
+       newsp = stack_base + cxloop.resetsp;
 
 #define POPLOOP2()                                                     \
-       newsp = stack_base + cxloop.resetsp;                            \
        SvREFCNT_dec(cxloop.iterlval);                                  \
        if (cxloop.itervar) {                                           \
            SvREFCNT_dec(*cxloop.itervar);                              \
index 59b2efa..cb482e1 100644 (file)
@@ -290,7 +290,7 @@ sub _vms_ext {
       if ($ctype) { 
         eval '$' . $ctype . "{'$cand'}++";
         die "Error recording library: $@" if $@;
-        print STDOUT "\tFound as $name (really $test), type $type\n" if $verbose > 1;
+        print STDOUT "\tFound as $cand (really $ctest), type $ctype\n" if $verbose > 1;
         next LIB;
       }
     }
index f609cc8..b56b1b8 100644 (file)
@@ -6,9 +6,10 @@
 #   Author:  Charles Bailey  bailey@genetics.upenn.edu
 
 package ExtUtils::MM_VMS;
-$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.39 (16-Jan-1997)';
+$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.39 (31-Jan-1997)';
 unshift @MM::ISA, 'ExtUtils::MM_VMS';
 
+use Carp qw( &carp );
 use Config;
 require Exporter;
 use VMS::Filespec;
@@ -47,16 +48,23 @@ sub eliminate_macros {
        return '';
     }
     my($npath) = unixify($path);
+    my($complex) = 0;
     my($head,$macro,$tail);
 
     # perform m##g in scalar context so it acts as an iterator
     while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#g) { 
         if ($self->{$2}) {
             ($head,$macro,$tail) = ($1,$2,$3);
-            ($macro = unixify($self->{$macro})) =~ s#/$##;
+            if (ref $self->{$macro}) {
+              carp "Can't expand macro containing " . ref $self->{$macro};
+              $npath = "$head\cB$macro\cB$tail";
+              $complex = 1;
+            }
+            else { ($macro = unixify($self->{$macro})) =~ s#/$##; }
             $npath = "$head$macro$tail";
         }
     }
+    if ($complex) { $npath =~ s#\cB(.*?)\cB#\$($1)#g; }
     print "eliminate_macros($path) = |$npath|\n" if $Verbose >= 3;
     $npath;
 }
@@ -590,8 +598,8 @@ sub constants {
        foreach $def (@defs) {
            next unless $def;
            if ($def =~ s/^-D//) {       # If it was a Unix-style definition
-               $def =~ /='(.*)'$/=$1/;  # then remove shell-protection ''
-               $def =~ /^'(.*)'$/$1/;   # from entire term or argument
+               $def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
+               $def =~ s/^'(.*)'$/$1/;   # from entire term or argument
            }
            if ($def =~ /=/) {
                $def =~ s/"/""/g;  # Protect existing " from DCL
@@ -1590,7 +1598,19 @@ clean ::
 ';
 
     my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
-    push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
+    # Unlink realclean, $attribs{FILES} is a string here; it may contain
+    # a list or a macro that expands to a list.
+    if ($attribs{FILES}) {
+       my($word,$key,@filist);
+       if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
+       else { @filist = split /\s+/, $attribs{FILES}; }
+       foreach $word (@filist) {
+           if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
+               push(@otherfiles, @{$self->{$key}});
+           }
+           else { push(@otherfiles, $attribs{FILES}); }
+       }
+    }
     push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
     push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
     my($file,$line);
@@ -1649,9 +1669,18 @@ realclean :: clean
        else { $line .= " $file"; }
     }
     push @m, "\t\$(RM_F) $line\n" if $line;
-    if ($attribs{FILES} && ref $attribs{FILES} eq 'ARRAY') {
+    if ($attribs{FILES}) {
+       my($word,$key,@filist,@allfiles);
+       if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
+       else { @filist = split /\s+/, $attribs{FILES}; }
+       foreach $word (@filist) {
+           if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
+               push(@allfiles, @{$self->{$key}});
+           }
+           else { push(@allfiles, $attribs{FILES}); }
+       }
        $line = '';
-       foreach $file (@{$attribs{'FILES'}}) {
+       foreach $file (@allfiles) {
            $file = $self->fixpath($file);
            if (length($line) + length($file) > 80) {
                push @m, "\t\$(RM_RF) $line\n";
@@ -1681,7 +1710,7 @@ distcheck :
        $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; fullcheck()"
 
 skipcheck :
-       $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; skipcheck()"
+       $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&skipcheck\'; skipcheck()"
 
 manifest :
        $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&mkmanifest\'; mkmanifest()"
@@ -1810,7 +1839,7 @@ pure__install : pure_site_install
        $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
 
 doc__install : doc_site_install
-       $(NOECHO} $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+       $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
 
 # This hack brought to you by DCL's 255-character command line limit
 pure_perl_install ::
index d655a26..5f6feb8 100755 (executable)
@@ -1295,8 +1295,6 @@ sub map_type {
 
 
 sub Exit {
-# If this is VMS, the exit status has meaning to the shell, so we
-# use a predictable value (SS$_Normal or SS$_Abort) rather than an
-# arbitrary number.
-    exit ($Is_VMS ? ($errors ? 44 : 1) : $errors) ;
+    # VMS error exit: SS$_ABORT.
+    exit $errors ? ($Is_VMS ? 44 : 1) : 0;
 }
index 89d7467..bbae58e 100644 (file)
@@ -313,7 +313,9 @@ EOFUNC
            }
            next;
        }
-       $header = $1;
+
+       # strip formatting directives in =item line
+       ($header = $1) =~ s/[A-Z]<(.*?)>/$1/g;
 
        if ($header =~ /%[sd]/) {
            $rhs = $lhs = $header;
diff --git a/op.c b/op.c
index 9409378..664802a 100644 (file)
--- a/op.c
+++ b/op.c
@@ -177,9 +177,10 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
     int saweval;
 
     for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
-       AVcurlist = CvPADLIST(cv);
-       SV** svp = av_fetch(curlist, 0, FALSE);
+       AV *curlist = CvPADLIST(cv);
+       SV **svp = av_fetch(curlist, 0, FALSE);
        AV *curname;
+
        if (!svp || *svp == &sv_undef)
            continue;
        curname = (AV*)*svp;
@@ -198,8 +199,8 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
 
                depth = CvDEPTH(cv);
                if (!depth) {
-                   if (newoff && !CvUNIQUE(cv))
-                       return 0; /* don't clone inactive sub's stack frame */
+                   if (newoff)
+                       return 0; /* don't clone from inactive stack frame */
                    depth = 1;
                }
                oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
@@ -1369,22 +1370,18 @@ OP *op;
        peep(eval_start);
     }
     else {
-       if (!op) {
-           main_start = 0;
+       if (!op)
            return;
-       }
        main_root = scope(sawparens(scalarvoid(op)));
        curcop = &compiling;
        main_start = LINKLIST(main_root);
        main_root->op_next = 0;
        peep(main_start);
-       main_cv = compcv;
        compcv = 0;
-       /* Register with debugger: */
 
+       /* Register with debugger */
        if (perldb) {
            CV *cv = perl_get_cv("DB::postponed", FALSE);
-       
            if (cv) {
                dSP;
                PUSHMARK(sp);
@@ -2858,10 +2855,10 @@ CV* cv;
 {
     CV *outside = CvOUTSIDE(cv);
     AV* padlist = CvPADLIST(cv);
-    AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
-    AV* pad = (AV*)*av_fetch(padlist, 1, FALSE);
-    SV** pname = AvARRAY(pad_name);
-    SV** ppad = AvARRAY(pad);
+    AV* pad_name;
+    AV* pad;
+    SV** pname;
+    SV** ppad;
     I32 ix;
 
     PerlIO_printf(Perl_debug_log, "\tCV=0x%p (%s), OUTSIDE=0x%p (%s)\n",
@@ -2877,10 +2874,20 @@ CV* cv;
                   : CvUNIQUE(outside) ? "UNIQUE"
                   : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
 
+    if (!padlist)
+       return;
+
+    pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
+    pad = (AV*)*av_fetch(padlist, 1, FALSE);
+    pname = AvARRAY(pad_name);
+    ppad = AvARRAY(pad);
+
     for (ix = 1; ix <= AvFILL(pad); ix++) {
        if (SvPOK(pname[ix]))
-           PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (\"%s\" %ld-%ld)\n",
-                         ix, ppad[ix], SvPVX(pname[ix]),
+           PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (%s\"%s\" %ld-%ld)\n",
+                         ix, ppad[ix],
+                         SvFAKE(pname[ix]) ? "FAKE " : "",
+                         SvPVX(pname[ix]),
                          (long)I_32(SvNVX(pname[ix])),
                          (long)SvIVX(pname[ix]));
     }
index 7db0e20..4051843 100644 (file)
@@ -1,5 +1,5 @@
 #define PATCHLEVEL 3
-#define SUBVERSION 25
+#define SUBVERSION 26
 
 /*
        local_patches -- list of locally applied less-than-subversion patches.
diff --git a/perl.c b/perl.c
index 77bcb4d..1e3c6fd 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -476,9 +476,11 @@ setuid perl scripts securely.\n");
        return 0;
     }
 
+    SvREFCNT_dec(main_cv);
     if (main_root)
        op_free(main_root);
-    main_root = 0;
+    main_cv = 0;
+    main_start = main_root = 0;
 
     time(&basetime);
 
@@ -687,7 +689,7 @@ setuid perl scripts securely.\n");
     if (doextract)
        find_beginning();
 
-    compcv = (CV*)NEWSV(1104,0);
+    main_cv = compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)compcv, SVt_PVCV);
     CvUNIQUE_on(compcv);
 
@@ -819,6 +821,7 @@ PerlInterpreter *sv_interp;
        runops();
     }
     else if (main_start) {
+       CvDEPTH(main_cv) = 1;
        op = main_start;
        runops();
     }
@@ -2348,7 +2351,7 @@ int addsubdirs;
        if (addsubdirs) {
            struct stat tmpstatbuf;
 
-           /* .../archname/version if -d .../archname/auto */
+           /* .../archname/version if -d .../archname/version/auto */
            sv_setsv(subdir, libdir);
            sv_catpv(subdir, archpat_auto);
            if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
@@ -2356,7 +2359,7 @@ int addsubdirs;
                av_push(GvAVn(incgv),
                        newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
 
-           /* .../archname/version if -d .../archname/version/auto */
+           /* .../archname if -d .../archname/auto */
            sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME),
                      strlen(patchlevel) + 1, "", 0);
            if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
@@ -2464,14 +2467,14 @@ my_failure_exit()
 {
 #ifdef VMS
     if (vaxc$errno & 1) {
-       if (GETSTATUS_NATIVE & 1)       /* fortuitiously includes "-1" */
-           SETSTATUS_NATIVE(44);
+       if (STATUS_NATIVE & 1)          /* fortuitiously includes "-1" */
+           STATUS_NATIVE_SET(44);
     }
     else {
        if (!vaxc$errno && errno)       /* someone must have set $^E = 0 */
-           SETSTATUS_NATIVE(44);
+           STATUS_NATIVE_SET(44);
        else
-           SETSTATUS_NATIVE(vaxc$errno);
+           STATUS_NATIVE_SET(vaxc$errno);
     }
 #else
     if (errno & 255)
index 32f55be..e29d135 100644 (file)
@@ -1078,6 +1078,13 @@ appear in %ENV.  This may be a benign occurrence, as some software packages
 might directly modify logical name tables and introduce non-standard names,
 or it may indicate that a logical name table has been corrupted.
 
+=item Illegal character %s (carriage return)
+
+(F) A carriage return character was found in the input.  This is an
+error, and not a warning, because carriage return characters can break
+here documents (e.g. C<print E<LT>E<LT>EOF;>).  Note that Perl always
+opens scripts in text mode, so this error should only occur in C<eval>.
+
 =item Illegal division by zero
 
 (F) You tried to divide a number by 0.  Either something was wrong in your
@@ -2185,7 +2192,7 @@ you're not running on Unix.
 (F) There has to be at least one argument to syscall() to specify the
 system call to call, silly dilly.
 
-=item Too late for "-T" option (try putting it first)
+=item Too late for "B<-T>" option (try putting it first)
 
 (X) The #! line in a Perl script contains the "-T" option, but Perl
 was not invoked with "-T" in its argument list.  Due to the way Perl
index c2b1f6c..da5c62a 100644 (file)
@@ -332,7 +332,8 @@ F<.pl> files will all eventually be converted into standard modules, and
 the F<.ph> files made by B<h2ph> will probably end up as extension modules
 made by B<h2xs>.  (Some F<.ph> values may already be available through the
 POSIX module.)  The B<pl2pm> file in the distribution may help in your
-conversion, but it's just a mechanical process, so is far from bulletproof.
+conversion, but it's just a mechanical process and therefore far from 
+bulletproof.
 
 =head2 Pragmatic Modules
 
@@ -349,7 +350,7 @@ which lasts until the end of that BLOCK.
 Unlike the pragmas that effect the C<$^H> hints variable, the C<use
 vars> and C<use subs> declarations are not BLOCK-scoped.  They allow
 you to pre-declare a variables or subroutines within a particular
-<I>file</I> rather than just a block.  Such declarations are effective
+I<file> rather than just a block.  Such declarations are effective
 for the entire file for which they were declared.  You cannot rescind
 them with C<no vars> or C<no subs>.
 
index 02d3dd3..1e088c1 100644 (file)
@@ -64,10 +64,10 @@ $^E, $^H, $^M, $^S
 
 =item New and Changed Built-in Functions
 
-delete on slices, flock, keys as an lvalue, my() in Control Structures,
-unpack() and pack(), use VERSION, use Module VERSION LIST,
-prototype(FUNCTION), $_ as Default, C<m//g> does not trigger a pos() reset
-on failure, nested C<sub{}> closures work now, formats work right on
+delete on slices, flock, printf and sprintf, keys as an lvalue, my() in
+Control Structures, unpack() and pack(), use VERSION, use Module VERSION
+LIST, prototype(FUNCTION), $_ as Default, C<m//g> does not trigger a pos()
+reset on failure, nested C<sub{}> closures work now, formats work right on
 changing lexicals
 
 =item New Built-in Methods
@@ -952,6 +952,8 @@ this, NEXTKEY this, lastkey, DESTROY this
 
 TIEHANDLE classname, LIST, PRINT this, LIST, READLINE this, DESTROY this
 
+=item The C<untie> Gotcha
+
 =back
 
 =item SEE ALSO
@@ -2058,6 +2060,8 @@ $value, $flags) ;>, B<$status = $X-E<gt>sync([$flags]) ;>
 
 =item Sharing databases with C applications
 
+=item The untie gotcha
+
 =back
 
 =item COMMON QUESTIONS
index 2955b16..6baf002 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1287,9 +1287,9 @@ PP(pp_leaveloop)
     SV **mark;
 
     POPBLOCK(cx,newpm);
+    mark = newsp;
     POPLOOP1(cx);      /* Delay POPLOOP2 until stack values are safe */
 
-    mark = newsp;
     if (gimme == G_SCALAR) {
        if (op->op_private & OPpLEAVE_VOID)
            ;
@@ -1422,8 +1422,7 @@ PP(pp_last)
     case CXt_LOOP:
        POPLOOP1(cx);   /* Delay POPLOOP2 until stack values are safe */
        pop2 = CXt_LOOP;
-       nextop = cx->blk_loop.last_op->op_next;
-       LEAVE;
+       nextop = cxloop.last_op->op_next;
        break;
     case CXt_SUB:
        POPSUB1(cx);    /* Delay POPSUB2 until stack values are safe */
@@ -1458,6 +1457,7 @@ PP(pp_last)
     switch (pop2) {
     case CXt_LOOP:
        POPLOOP2();     /* release loop vars ... */
+       LEAVE;
        break;
     case CXt_SUB:
        POPSUB2();      /* release CV and @_ ... */
@@ -2035,10 +2035,8 @@ int gimme;
     DEBUG_x(dump_eval());
 
     /* Register with debugger: */
-
     if (perldb && saveop->op_type == OP_REQUIRE) {
        CV *cv = perl_get_cv("DB::postponed", FALSE);
-       
        if (cv) {
            dSP;
            PUSHMARK(sp);
@@ -2050,6 +2048,8 @@ int gimme;
 
     /* compiled okay, so do it */
 
+    CvDEPTH(compcv) = 1;
+
     SP = stack_base + POPMARK;         /* pop original mark */
     RETURNOP(eval_start);
 }
@@ -2271,6 +2271,11 @@ PP(pp_leaveeval)
     }
     curpm = newpm;     /* Don't pop $1 et al till now */
 
+#ifdef DEBUGGING
+    assert(CvDEPTH(compcv) == 1);
+#endif
+    CvDEPTH(compcv) = 0;
+
     if (optype == OP_REQUIRE &&
        !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) {
        char *name = cx->blk_eval.old_name;
@@ -2282,6 +2287,7 @@ PP(pp_leaveeval)
 
     lex_end();
     LEAVE;
+
     if (!(save_flags & OPf_SPECIAL))
        sv_setpv(GvSV(errgv),"");
 
diff --git a/scope.h b/scope.h
index 53081a3..d0931b1 100644 (file)
--- a/scope.h
+++ b/scope.h
  * Not using SOFT_CAST on SAVEFREESV and SAVEFREESV
  * because these are used for several kinds of pointer values
  */
-#define SAVEI16(i)     save_I16(SOFT_CAST(I16*)&(i));
-#define SAVEI32(i)     save_I32(SOFT_CAST(I32*)&(i));
-#define SAVEINT(i)     save_int(SOFT_CAST(int*)&(i));
-#define SAVEIV(i)      save_iv(SOFT_CAST(IV*)&(i));
-#define SAVELONG(l)    save_long(SOFT_CAST(long*)&(l));
+#define SAVEI16(i)     save_I16(SOFT_CAST(I16*)&(i))
+#define SAVEI32(i)     save_I32(SOFT_CAST(I32*)&(i))
+#define SAVEINT(i)     save_int(SOFT_CAST(int*)&(i))
+#define SAVEIV(i)      save_iv(SOFT_CAST(IV*)&(i))
+#define SAVELONG(l)    save_long(SOFT_CAST(long*)&(l))
 #define SAVESPTR(s)    save_sptr((SV**)&(s))
 #define SAVEPPTR(s)    save_pptr(SOFT_CAST(char**)&(s))
 #define SAVEFREESV(s)  save_freesv((SV*)(s))
index 6b21c66..6594940 100755 (executable)
@@ -22,13 +22,9 @@ sub fibonacci ($) {
 
 # Highly recursive, highly aggressive.
 # Kids, don't try this at home.
-# For example ackermann(4,0) will take quite a long time.
 #
-# In fact, the current Perl, 5.004, will complain loudly:
-# "Deep recursion on subroutine." (see perldiag) when
-# computing the ackermann(4,0) because the recursion will
-# become so deep (>100 levels) that Perl suspects the script
-# has been lost in an infinite recursion.
+# For example ackermann(4,1) will take quite a long time.
+# It will simply eat away your memory. Trust me.
 
 sub ackermann ($$) {
     return $_[1] + 1               if ($_[0] == 0);
diff --git a/toke.c b/toke.c
index c8ff0a0..c57b888 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1696,7 +1696,9 @@ yylex()
            return yylex();
        }
        goto retry;
-    case ' ': case '\t': case '\f': case '\r': case 013:
+    case '\r':
+       croak("Illegal character \\%03o (carriage return)");
+    case ' ': case '\t': case '\f': case 013:
        s++;
        goto retry;
     case '#':
@@ -4445,6 +4447,7 @@ char *start;
 {
     register char *s;
     register PMOP *pm;
+    I32 first_start;
     I32 es = 0;
 
     yylval.ival = OP_NULL;
@@ -4461,6 +4464,7 @@ char *start;
     if (s[-1] == multi_open)
        s--;
 
+    first_start = multi_start;
     s = scan_str(s);
     if (!s) {
        if (lex_stuff)
@@ -4471,6 +4475,7 @@ char *start;
        lex_repl = Nullsv;
        croak("Substitution replacement not terminated");
     }
+    multi_start = first_start; /* so whole substitution is taken together */
 
     pm = (PMOP*)newPMOP(OP_SUBST, 0);
     while (*s && strchr("iogmsex", *s)) {
@@ -5162,10 +5167,10 @@ char *s;
        (void)sprintf(tname,"next char %c",yychar);
     (void)sprintf(buf, "%s at %s line %d, %s\n",
       s,SvPVX(GvSV(curcop->cop_filegv)),curcop->cop_line,tname);
-    if (curcop->cop_line == multi_end && multi_start < multi_end) {
+    if (multi_start < multi_end && (U32)(curcop->cop_line - multi_end) <= 1) {
        sprintf(buf+strlen(buf),
-         "  (Might be a runaway multi-line %c%c string starting on line %ld)\n",
-         multi_open,multi_close,(long)multi_start);
+       "  (Might be a runaway multi-line %c%c string starting on line %ld)\n",
+               multi_open,multi_close,(long)multi_start);
         multi_end = 0;
     }
     if (in_eval & 2)
index d5194b4..d5e6553 100644 (file)
@@ -32,7 +32,7 @@ ARCH = VMS_VAX
 OBJVAL = $@
 
 # Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00325#
+PERL_VERSION = 5_00326#
 
 
 ARCHDIR =  [.lib.$(ARCH).$(PERL_VERSION)]
@@ -418,6 +418,13 @@ IO : [.lib]IO.pm [.lib.IO]File.pm [.lib.IO]Handle.pm [.lib.IO]Pipe.pm [.lib.IO]S
        @ If f$$Search("a2p$(O)").nes."" Then Rename/NoLog a2p$(O),hash$(O),str$(O),util$(O),walk$(O) [.x2p]
        Link $(LINKFLAGS) /Exe=$@ $(MMS$SOURCE_LIST) $(CRTLOPTS)
 
+# Accomodate buggy cpp in some version of DECC, which chokes on illegal
+# filespec "y.tab.c"
+[.x2p]a2p$(O) : [.x2p]a2p.c $(MINIPERL_EXE)
+       $(MINIPERL) -pe "s/^#line\s+(\d+)\s+\Q""y.tab.c""/#line $1 ""y_tab.c""/;" [.x2p]a2p.c >$*_vms.c
+       $(CC) $(CFLAGS) /Object=$@ $*_vms.c
+       Delete/Log/NoConfirm $*_vms.c;
+
 [.lib.pod]pod2html.com : [.pod]pod2html.PL $(ARCHDIR)Config.pm
        @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
        $(MINIPERL) [.pod]pod2html.PL
index 97d5c96..41f0fa5 100644 (file)
@@ -76,7 +76,7 @@
  * when Perl is built.  Please do not change it by hand; make
  * any changes to FndVers.Com instead.
  */
-#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00325"  /**/
+#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00326"  /**/
 #define ARCHLIB ARCHLIB_EXP    /*config-skip*/
 
 /* ARCHNAME:
  *     This symbol contains the size of an int, so that the C preprocessor
  *     can make decisions based on it.
  */
+/* LONGSIZE:
+ *     This symbol contains the value of sizeof(long) so that the C
+ *     preprocessor can make decisions based on it.
+ */
+/* SHORTSIZE:
+ *     This symbol contains the value of sizeof(short) so that the C
+ *     preprocessor can make decisions based on it.
+ */
 #define INTSIZE 4              /**/
+#define LONGSIZE 4             /**/
+#define SHORTSIZE 2            /**/
 
 /* Off_t:
  *     This symbol holds the type used to declare offsets in the kernel.
index 36386ef..c15db04 100644 (file)
@@ -65,7 +65,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O)
 .endif
 
 # Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00325#
+PERL_VERSION = 5_00326#
 
 
 ARCHDIR =  [.lib.$(ARCH).$(PERL_VERSION)]
@@ -539,6 +539,13 @@ IO : [.lib]IO.pm [.lib.IO]File.pm [.lib.IO]Handle.pm [.lib.IO]Pipe.pm [.lib.IO]S
        @ If F$Search("a2p$(O)").nes."" Then Rename/NoLog a2p$(O),hash$(O),str$(O),util$(O),walk$(O) [.x2p]
        Link $(LINKFLAGS) /Exe=$(MMS$TARGET) $(MMS$SOURCE_LIST) $(CRTLOPTS)
 
+# Accomodate buggy cpp in some version of DECC, which chokes on illegal
+# filespec "y.tab.c"
+[.x2p]a2p$(O) : [.x2p]a2p.c $(MINIPERL_EXE)
+       $(MINIPERL) -pe "s/^#line\s+(\d+)\s+\Q""y.tab.c""/#line $1 ""y_tab.c""/;" $(MMS$SOURCE) >$(MMS$TARGET_NAME)_vms.c
+       $(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$TARGET_NAME)_vms.c
+       Delete/Log/NoConfirm $(MMS$TARGET_NAME)_vms.c;
+
 [.lib.pod]pod2html.com : [.pod]pod2html.PL $(ARCHDIR)Config.pm
        @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
        $(MINIPERL) $(MMS$SOURCE)
index 3680147..22bf016 100644 (file)
@@ -104,7 +104,7 @@ installsitelib='$installsitelib'
 installsitearch='$installsitearch'
 path_sep='|'
 startperl='\$ perl 'f\$env("procedure")' 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8' !
-$ exit++ + ++$status != 0 and $exit = $status = undef;
+\$ exit++ + ++\$status != 0 and \$exit = \$status = undef;'
 EndOfIntro
 
 foreach (@ARGV) {
index e065b08..830ff61 100644 (file)
@@ -300,7 +300,7 @@ As of the time this document was last revised, the following
 Perl functions were implemented in the VMS port of Perl 
 (functions marked with * are discussed in more detail below):
 
-    file tests*, abs, alarm, atan, binmode*, bless,
+    file tests*, abs, alarm, atan, backticks*, binmode*, bless,
     caller, chdir, chmod, chown, chomp, chop, chr,
     close, closedir, cos, crypt*, defined, delete,
     die, do, dump*, each, endpwent, eof, eval, exec*,
@@ -310,7 +310,7 @@ Perl functions were implemented in the VMS port of Perl
     last, lc, lcfirst, length, local, localtime, log, m//,
     map, mkdir, my, next, no, oct, open, opendir, ord, pack,
     pipe, pop, pos, print, printf, push, q//, qq//, qw//,
-    qx//, quotemeta, rand, read, readdir, redo, ref, rename,
+    qx//*, quotemeta, rand, read, readdir, redo, ref, rename,
     require, reset, return, reverse, rewinddir, rindex,
     rmdir, s///, scalar, seek, seekdir, select(internal),
     select (system call)*, setpwent, shift, sin, sleep,
@@ -375,6 +375,13 @@ only, and then manually check the appropriate bits, as defined by
 your C compiler's F<stat.h>, in the mode value it returns, if you
 need an approximation of the file's protections.
 
+=item backticks
+
+Backticks create a subprocess, and pass the enclosed string
+to it for execution as a DCL command.  Since the subprocess is
+created directly via C<lib$spawn()>, any valid DCL command string
+may be specified.
+
 =item binmode FILEHANDLE
 
 The C<binmode> operator will attempt to insure that no translation
@@ -509,6 +516,10 @@ supervisor-mode images like DCL.)
 Also, negative signal values don't do anything special under
 VMS; they're just converted to the corresponding positive value.
 
+=item qx//
+
+See the entry on C<backticks> above.
+
 =item select (system call)
 
 If Perl was not built with socket support, the system call
@@ -537,7 +548,12 @@ valid DCL command string may be specified.  If LIST consists
 of the empty string, C<system> spawns an interactive DCL subprocess,
 in the same fashion as typiing B<SPAWN> at the DCL prompt.
 Perl waits for the subprocess to complete before continuing
-execution in the current process.
+execution in the current process.  As described in L<perlfunc>,
+the return value of C<system> is a fake "status" which follows
+POSIX semantics; see the description of C<$?> in this document
+for more detail.  The actual VMS exit status of the subprocess
+is available in C<$^S> (as long as you haven't used another Perl
+function that resets C<$?> and C<$^S> in the meantime).
 
 =item time
 
@@ -679,16 +695,6 @@ In all operations on %ENV, the key string is treated as if it
 were entirely uppercase, regardless of the case actually 
 specified in the Perl expression.
 
-=item $?
-
-Since VMS status values are 32 bits wide, the value of C<$?>
-is simply the final status value of the last subprocess to
-complete.  This differs from the behavior of C<$?> under Unix,
-and under VMS' POSIX environment, in that the low-order 8 bits
-of C<$?> do not specify whether the process terminated normally
-or due to a signal, and you do not need to shift C<$?> 8 bits
-to the right in order to find the process' exit status.
-
 =item $!
 
 The string value of C<$!> is that returned by the CRTL's
@@ -710,6 +716,30 @@ is the value of vaxc$errno, and its string value is the
 corresponding VMS message string, as retrieved by sys$getmsg().
 Setting C<$^E> sets vaxc$errno to the value specified.
 
+=item $?
+
+The "status value" returned in C<$?> is synthesized from the
+actual exit status of the subprocess in a way that approximates
+POSIX wait(5) semantics, in order to allow Perl programs to
+portably test for successful completion of subprocesses.  The
+low order 8 bits of C<$?> are always 0 under VMS, since the
+termination status of a process may or may not have been
+generated by an exception.  The next 8 bits are derived from
+severity portion of the subprocess' exit status: if the
+severity was success or informational, these bits are all 0;
+otherwise, they contain the severity value shifted left one bit.
+As a result, C<$?> will always be zero if the subprocess' exit
+status indicated successful completion, and non-zero if a
+warning or error occurred.  The actual VMS exit status may
+be found in C<$^S> (q.v.).
+
+=item $^S
+
+Under VMS, this is the 32-bit VMS status value returned by the
+last subprocess to complete.  Unlink C<$?>, no manipulation
+is done to make this look like a POSIX wait(5) value, so it
+may be treated as a normal VMS status value.
+
 =item $|
 
 Setting C<$|> for an I/O stream causes data to be flushed
index a9060b4..08570f0 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -801,9 +801,9 @@ I32 my_pclose(FILE *fp)
 }  /* end of my_pclose() */
 
 /* sort-of waitpid; use only with popen() */
-/*{{{unsigned long int waitpid(unsigned long int pid, int *statusp, int flags)*/
-unsigned long int
-waitpid(unsigned long int pid, int *statusp, int flags)
+/*{{{Pid_t my_waitpid(Pid_t pid, int *statusp, int flags)*/
+Pid_t
+my_waitpid(Pid_t pid, int *statusp, int flags)
 {
     struct pipe_details *info;
     
index 10cdc08..ad3f1e1 100644 (file)
@@ -13,7 +13,7 @@
 #include <libdef.h>  /* status codes for various places */
 #include <rmsdef.h>  /* at which errno and vaxc$errno are */
 #include <ssdef.h>   /* explicitly set in the perl source code */
-#include <stsdef.h>
+#include <stsdef.h>  /* bitmasks for exit status testing */
 
 /* Suppress compiler warnings from DECC for VMS-specific extensions:
  * GLOBALEXT, NOSHAREEXT, READONLYEXT: global[dr]ef declarations
 #  include <unistd.h> /* DECC has this; VAXC and gcc don't */
 #endif
 
+/* DECC introduces this routine in the RTL as of VMS 7.0; for now,
+ * we'll use ours, since it gives us the full VMS exit status. */
+#ifdef __PID_T
+#  define Pid_t pid_t
+#else
+#  define Pid_t unsigned int
+#endif
+#define waitpid my_waitpid
+
 /* Our own contribution to PerlShr's global symbols . . . */
 #ifdef EMBED
 #  define my_trnlnm            Perl_my_trnlnm
@@ -63,7 +72,7 @@
 #  define prime_env_iter       Perl_prime_env_iter
 #  define my_setenv            Perl_my_setenv
 #  define my_crypt             Perl_my_crypt
-#  define waitpid              Perl_waitpid
+#  define my_waitpid           Perl_my_waitpid
 #  define my_gconvert          Perl_my_gconvert
 #  define do_rmdir             Perl_do_rmdir
 #  define kill_file            Perl_kill_file
@@ -454,7 +463,7 @@ typedef char  __VMS_PROTOTYPES__;
 int    my_trnlnm _((char *, char *, unsigned long int));
 char * my_getenv _((char *));
 char * my_crypt _((const char *, const char *));
-unsigned long int      waitpid _((unsigned long int, int *, int));
+Pid_t  my_waitpid _((Pid_t, int *, int));
 char * my_gconvert _((double, int, int, char *));
 int    do_rmdir _((char *));
 int    kill_file _((char *));