Skip to content
Browse files

[inseparable changes from patch from perl5.003_25 to perl5.003_26]

 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
  • Loading branch information...
1 parent 2752eb9 commit 4fdae80067c447c675a6ac92c7959d2206e207ba Perl 5 Porters committed with Chip Salzenberg Feb 11, 1997
Showing with 363 additions and 94 deletions.
  1. +138 −0 Changes
  2. +2 −2 INSTALL
  3. +10 −0 Porting/Glossary
  4. +2 −2 cop.h
  5. +1 −1 lib/ExtUtils/Liblist.pm
  6. +38 −9 lib/ExtUtils/MM_VMS.pm
  7. +2 −4 lib/ExtUtils/xsubpp
  8. +3 −1 lib/diagnostics.pm
  9. +23 −16 op.c
  10. +1 −1 patchlevel.h
  11. +11 −8 perl.c
  12. +8 −1 pod/perldiag.pod
  13. +3 −2 pod/perlmod.pod
  14. +8 −4 pod/perltoc.pod
  15. +11 −5 pp_ctl.c
  16. +5 −5 scope.h
  17. +2 −6 t/op/recurse.t
  18. +9 −4 toke.c
  19. +8 −1 vms/Makefile
  20. +11 −1 vms/config.vms
  21. +8 −1 vms/descrip.mms
  22. +1 −1 vms/genconfig.pl
  23. +43 −13 vms/perlvms.pod
  24. +3 −3 vms/vms.c
  25. +12 −3 vms/vmsish.h
View
138 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
----------------
View
4 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
View
10 Porting/Glossary
@@ -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.
View
4 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); \
View
2 lib/ExtUtils/Liblist.pm
@@ -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;
}
}
View
47 lib/ExtUtils/MM_VMS.pm
@@ -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 ::
View
6 lib/ExtUtils/xsubpp
@@ -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;
}
View
4 lib/diagnostics.pm
@@ -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;
View
39 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)) {
- AV* curlist = 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]));
}
View
2 patchlevel.h
@@ -1,5 +1,5 @@
#define PATCHLEVEL 3
-#define SUBVERSION 25
+#define SUBVERSION 26
/*
local_patches -- list of locally applied less-than-subversion patches.
View
19 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,15 +2351,15 @@ 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 &&
S_ISDIR(tmpstatbuf.st_mode))
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)
View
9 pod/perldiag.pod
@@ -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
View
5 pod/perlmod.pod
@@ -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>.
View
12 pod/perltoc.pod
@@ -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
View
16 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),"");
View
10 scope.h
@@ -49,11 +49,11 @@
* 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))
View
8 t/op/recurse.t
@@ -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);
View
13 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)
View
9 vms/Makefile
@@ -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
View
12 vms/config.vms
@@ -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:
@@ -1263,7 +1263,17 @@
* 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.
View
9 vms/descrip.mms
@@ -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)
View
2 vms/genconfig.pl
@@ -104,7 +104,7 @@
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) {
View
56 vms/perlvms.pod
@@ -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
View
6 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;
View
15 vms/vmsish.h
@@ -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
@@ -56,14 +56,23 @@
# 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
# define my_getenv Perl_my_getenv
# 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 *));

0 comments on commit 4fdae80

Please sign in to comment.
Something went wrong with that request. Please try again.