----------------
+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
----------------
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
=head1 LAST MODIFIED
-22 January 1997
+8 February 1997
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
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.
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); \
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;
}
}
# 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;
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;
}
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
';
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);
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";
$(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()"
$(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 ::
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;
}
}
next;
}
- $header = $1;
+
+ # strip formatting directives in =item line
+ ($header = $1) =~ s/[A-Z]<(.*?)>/$1/g;
if ($header =~ /%[sd]/) {
$rhs = $lhs = $header;
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;
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);
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);
{
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",
: 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]));
}
#define PATCHLEVEL 3
-#define SUBVERSION 25
+#define SUBVERSION 26
/*
local_patches -- list of locally applied less-than-subversion patches.
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);
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);
runops();
}
else if (main_start) {
+ CvDEPTH(main_cv) = 1;
op = main_start;
runops();
}
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 &&
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 &&
{
#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)
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
(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
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
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>.
=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
TIEHANDLE classname, LIST, PRINT this, LIST, READLINE this, DESTROY this
+=item The C<untie> Gotcha
+
=back
=item SEE ALSO
=item Sharing databases with C applications
+=item The untie gotcha
+
=back
=item COMMON QUESTIONS
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)
;
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 */
switch (pop2) {
case CXt_LOOP:
POPLOOP2(); /* release loop vars ... */
+ LEAVE;
break;
case CXt_SUB:
POPSUB2(); /* release CV and @_ ... */
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);
/* compiled okay, so do it */
+ CvDEPTH(compcv) = 1;
+
SP = stack_base + POPMARK; /* pop original mark */
RETURNOP(eval_start);
}
}
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;
lex_end();
LEAVE;
+
if (!(save_flags & OPf_SPECIAL))
sv_setpv(GvSV(errgv),"");
* 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))
# 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);
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 '#':
{
register char *s;
register PMOP *pm;
+ I32 first_start;
I32 es = 0;
yylval.ival = OP_NULL;
if (s[-1] == multi_open)
s--;
+ first_start = multi_start;
s = scan_str(s);
if (!s) {
if (lex_stuff)
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)) {
(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)
OBJVAL = $@
# Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00325#
+PERL_VERSION = 5_00326#
ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)]
@ 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
* 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.
.endif
# Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00325#
+PERL_VERSION = 5_00326#
ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)]
@ 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)
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) {
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*,
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,
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
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
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
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
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
} /* 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;
#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
# 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
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 *));
projects / p5sagit/p5-mst-13.2.git / commitdiff