lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (10/17/90)
System: perl version 3.0 Patch #: 35 Priority: HIGH Subject: patch #29, continued Description: See patch #29. Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle". If you don't have the patch program, apply the following by hand, or get patch (version 2.0, latest patchlevel). After patching: *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #36 FIRST *** If patch indicates that patchlevel is the wrong version, you may need to apply one or more previous patches, or the patch may already have been applied. See the patchlevel.h file to find out what has or has not been applied. In any event, don't continue with the patch. If you are missing previous patches they can be obtained from me: Larry Wall lwall@jpl-devvax.jpl.nasa.gov If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 3.0 LIST ^ note the c where PATH is a return path FROM ME TO YOU either in Internet notation, or in bang notation from some well-known host, and LIST is the number of one or more patches you need, separated by spaces, commas, and/or hyphens. Saying 35- says everything from 35 to the end. You can also get the patches via anonymous FTP from jpl-devvax.jpl.nasa.gov (128.149.1.143). Index: patchlevel.h Prereq: 34 1c1 < #define PATCHLEVEL 34 --- > #define PATCHLEVEL 35 Index: str.c Prereq: 3.0.1.8 *** str.c.old Tue Oct 16 12:03:28 1990 --- str.c Tue Oct 16 12:03:34 1990 *************** *** 1,4 **** ! /* $Header: str.c,v 3.0.1.8 90/08/09 05:22:18 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.c,v 3.0.1.9 90/10/16 10:41:21 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.c,v $ + * Revision 3.0.1.9 90/10/16 10:41:21 lwall + * patch29: the undefined value could get defined by devious means + * patch29: undefined values compared inconsistently + * patch29: taintperl now checks for world writable PATH components + * * Revision 3.0.1.8 90/08/09 05:22:18 lwall * patch19: the number to string converter wasn't allocating enough space * patch19: tainting didn't work on setgid scripts *************** *** 235,241 **** if (sstr) tainted |= sstr->str_tainted; #endif ! if (sstr == dstr) return; if (!sstr) dstr->str_pok = dstr->str_nok = 0; --- 240,246 ---- if (sstr) tainted |= sstr->str_tainted; #endif ! if (sstr == dstr || dstr == &str_undef) return; if (!sstr) dstr->str_pok = dstr->str_nok = 0; *************** *** 250,257 **** char *tmps = sstr->str_ptr; if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) { ! dstr->str_magic = str_smake(sstr->str_magic); ! dstr->str_magic->str_rare = 'X'; } } } --- 255,264 ---- char *tmps = sstr->str_ptr; if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) { ! if (!dstr->str_magic) { ! dstr->str_magic = str_smake(sstr->str_magic); ! dstr->str_magic->str_rare = 'X'; ! } } } } *************** *** 275,280 **** --- 282,289 ---- register char *ptr; register STRLEN len; { + if (str == &str_undef) + return; STR_GROW(str, len + 1); if (ptr) (void)bcopy(ptr,str->str_ptr,len); *************** *** 293,298 **** --- 302,309 ---- { register STRLEN len; + if (str == &str_undef) + return; if (!ptr) ptr = ""; len = strlen(ptr); *************** *** 333,338 **** --- 344,351 ---- register char *ptr; register STRLEN len; { + if (str == &str_undef) + return; if (!(str->str_pok)) (void)str_2ptr(str); STR_GROW(str, str->str_cur + len + 1); *************** *** 367,372 **** --- 380,387 ---- { register STRLEN len; + if (str == &str_undef) + return; if (!ptr) return; if (!(str->str_pok)) *************** *** 393,398 **** --- 408,415 ---- register char *to; register STRLEN len; + if (str == &str_undef) + return Nullch; if (!from) return Nullch; len = fromend - from; *************** *** 455,461 **** char *name; STRLEN namlen; { ! if (str->str_magic) return; str->str_magic = Str_new(75,namlen); str = str->str_magic; --- 472,478 ---- char *name; STRLEN namlen; { ! if (str == &str_undef || str->str_magic) return; str->str_magic = Str_new(75,namlen); str = str->str_magic; *************** *** 479,484 **** --- 496,503 ---- register char *bigend; register int i; + if (bigstr == &str_undef) + return; bigstr->str_nok = 0; bigstr->str_pok = SP_VALID; /* disable possible screamer */ *************** *** 550,555 **** --- 569,576 ---- register STR *str; register STR *nstr; { + if (str == &str_undef) + return; if (str->str_state == SS_INCR) Str_Grow(str,0); /* just force copy down */ if (nstr->str_state == SS_INCR) *************** *** 576,582 **** str_free(str) register STR *str; { ! if (!str) return; if (str->str_state) { if (str->str_state == SS_FREE) /* already freed */ --- 597,603 ---- str_free(str) register STR *str; { ! if (!str || str == &str_undef) return; if (str->str_state) { if (str->str_state == SS_FREE) /* already freed */ *************** *** 636,645 **** register STR *str1; register STR *str2; { ! if (!str1) ! return str2 == Nullstr; ! if (!str2) ! return 0; if (!str1->str_pok) (void)str_2ptr(str1); --- 657,666 ---- register STR *str1; register STR *str2; { ! if (!str1 || str1 == &str_undef) ! return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur); ! if (!str2 || str2 == &str_undef) ! return !str1->str_cur; if (!str1->str_pok) (void)str_2ptr(str1); *************** *** 658,667 **** { int retval; ! if (!str1) ! return str2 == Nullstr; ! if (!str2) ! return 0; if (!str1->str_pok) (void)str_2ptr(str1); --- 679,688 ---- { int retval; ! if (!str1 || str1 == &str_undef) ! return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur)?0:-1; ! if (!str2 || str2 == &str_undef) ! return str1->str_cur != 0; if (!str1->str_pok) (void)str_2ptr(str1); *************** *** 698,709 **** register int get_paragraph; register char *oldbp; if (get_paragraph = !rslen) { /* yes, that's an assignment */ newline = '\n'; oldbp = Nullch; /* remember last \n position (none) */ } #ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */ - cnt = fp->_cnt; /* get count into register */ str->str_nok = 0; /* invalidate number */ str->str_pok = 1; /* validate pointer */ --- 719,731 ---- register int get_paragraph; register char *oldbp; + if (str == &str_undef) + return Nullch; if (get_paragraph = !rslen) { /* yes, that's an assignment */ newline = '\n'; oldbp = Nullch; /* remember last \n position (none) */ } #ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */ cnt = fp->_cnt; /* get count into register */ str->str_nok = 0; /* invalidate number */ str->str_pok = 1; /* validate pointer */ *************** *** 790,797 **** --- 812,821 ---- register CMD *cmd; register ARG *arg; CMD *oldcurcmd = curcmd; + int oldperldb = perldb; int retval; + perldb = 0; str_sset(linestr,str); in_eval++; oldoldbufptr = oldbufptr = bufptr = str_get(linestr); *************** *** 810,815 **** --- 834,840 ---- if (setjmp(loop_stack[loop_ptr].loop_env)) { in_eval--; loop_ptr--; + perldb = oldperldb; fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr); } #ifdef DEBUGGING *************** *** 825,830 **** --- 850,856 ---- curcmd->c_line = oldcurcmd->c_line; retval = yyparse(); curcmd = oldcurcmd; + perldb = oldperldb; in_eval--; if (retval || error_count) fatal("Invalid component in string or format"); *************** *** 994,1000 **** weight += 100; break; case '-': ! if (last_un_char < d[1] || d[1] == '\\') { if (index("aA01! ",last_un_char)) weight += 30; if (index("zZ79~",d[1])) --- 1020,1027 ---- weight += 100; break; case '-': ! if (last_un_char < (unsigned char) d[1] ! || d[1] == '\\') { if (index("aA01! ",last_un_char)) weight += 30; if (index("zZ79~",d[1])) *************** *** 1068,1078 **** register char *send; register STR **elem; if (!(src->str_pok & SP_INTRP)) { int oldsave = savestack->ary_fill; (void)savehptr(&curstash); ! curstash = src->str_u.str_hash; /* so stabent knows right package */ intrpcompile(src); restorelist(oldsave); } --- 1095,1107 ---- register char *send; register STR **elem; + if (str == &str_undef) + return Nullstr; if (!(src->str_pok & SP_INTRP)) { int oldsave = savestack->ary_fill; (void)savehptr(&curstash); ! curstash = curcmd->c_stash; /* so stabent knows right package */ intrpcompile(src); restorelist(oldsave); } *************** *** 1113,1119 **** { register char *d; ! if (!str) return; if (str->str_nok) { str->str_u.str_nval += 1.0; --- 1142,1148 ---- { register char *d; ! if (!str || str == &str_undef) return; if (str->str_nok) { str->str_u.str_nval += 1.0; *************** *** 1162,1168 **** str_dec(str) register STR *str; { ! if (!str) return; if (str->str_nok) { str->str_u.str_nval -= 1.0; --- 1191,1197 ---- str_dec(str) register STR *str; { ! if (!str || str == &str_undef) return; if (str->str_nok) { str->str_u.str_nval -= 1.0; *************** *** 1210,1215 **** --- 1239,1246 ---- str_2static(str) register STR *str; { + if (str == &str_undef) + return str; if (++tmps_max > tmps_size) { tmps_size = tmps_max; if (!(tmps_size & 127)) { *************** *** 1292,1297 **** --- 1323,1330 ---- /* reset variables */ + if (!stash->tbl_array) + return; while (*s) { i = *s; if (s[1] == '-') { *************** *** 1315,1321 **** aclear(stab_xarray(stab)); } if (stab_xhash(stab)) { ! hclear(stab_xhash(stab)); if (stab == envstab) environ[0] = Nullch; } --- 1348,1354 ---- aclear(stab_xarray(stab)); } if (stab_xhash(stab)) { ! hclear(stab_xhash(stab), FALSE); if (stab == envstab) environ[0] = Nullch; } *************** *** 1345,1356 **** register STR *envstr; envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE); ! if (!envstr || envstr->str_tainted) { tainted = 1; ! taintproper("Insecure PATH"); } envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE); ! if (envstr && envstr->str_tainted) { tainted = 1; taintproper("Insecure IFS"); } --- 1378,1392 ---- register STR *envstr; envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE); ! if (envstr == &str_undef || envstr->str_tainted) { tainted = 1; ! if (envstr->str_tainted == 2) ! taintproper("Insecure directory in PATH"); ! else ! taintproper("Insecure PATH"); } envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE); ! if (envstr != &str_undef && envstr->str_tainted) { tainted = 1; taintproper("Insecure IFS"); } Index: str.h Prereq: 3.0.1.2 *** str.h.old Tue Oct 16 12:03:45 1990 --- str.h Tue Oct 16 12:03:49 1990 *************** *** 1,4 **** ! /* $Header: str.h,v 3.0.1.2 90/08/09 05:23:24 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.h,v 3.0.1.3 90/10/16 10:44:04 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.h,v $ + * Revision 3.0.1.3 90/10/16 10:44:04 lwall + * patch29: added caller + * patch29: scripts now run at almost full speed under the debugger + * * Revision 3.0.1.2 90/08/09 05:23:24 lwall * patch19: various MSDOS and OS/2 patches folded in * *************** *** 27,32 **** --- 31,37 ---- ARG *str_args; /* list of args for interpreted string */ HASH *str_hash; /* string represents an assoc array (stab?) */ ARRAY *str_array; /* string represents an array */ + CMD *str_cmd; /* command for this source line */ } str_u; STRLEN str_cur; /* length of str_ptr as a C string */ STR *str_magic; /* while free, link to next free str */ *************** *** 51,56 **** --- 56,62 ---- ARG *str_args; /* list of args for interpreted string */ HASH *str_hash; /* string represents an assoc array (stab?) */ ARRAY *str_array; /* string represents an array */ + CMD *str_cmd; /* command for this source line */ } str_u; STRLEN str_cur; /* length of str_ptr as a C string */ STR *str_magic; /* while free, link to next free str */ *************** *** 94,99 **** --- 100,106 ---- #define SS_SSTRP 6 /* STR* on save stack */ #define SS_SHPTR 7 /* HASH* on save stack */ #define SS_SNSTAB 8 /* non-stab on save stack */ + #define SS_SCSV 9 /* callsave structure on save stack */ #define SS_HASH 253 /* carrying an hash */ #define SS_ARY 254 /* carrying an array */ #define SS_FREE 255 /* in free list */ Index: lib/syslog.pl *** lib/syslog.pl.old Tue Oct 16 11:53:46 1990 --- lib/syslog.pl Tue Oct 16 11:53:48 1990 *************** *** 1,6 **** --- 1,31 ---- # # syslog.pl # + # $Log: syslog.pl,v $ + Revision 3.0.1.3 90/10/15 17:42:18 lwall + patch29: various portability fixes + + # Revision 3.0.1.1 90/08/09 03:57:17 lwall + # patch19: Initial revision + # + # Revision 1.2 90/06/11 18:45:30 18:45:30 root () + # - Changed 'warn' to 'mail|warning' in test call (to give example of + # facility specification, and because 'warn' didn't work on HP-UX). + # - Fixed typo in &openlog ("ncons" should be "cons"). + # - Added (package-global) $maskpri, and &setlogmask. + # - In &syslog: + # - put argument test ahead of &connect (why waste cycles?), + # - allowed facility to be specified in &syslog's first arg (temporarily + # overrides any $facility set in &openlog), just as in syslog(3C), + # - do a return 0 when bit for $numpri not set in log mask (see syslog(3C)), + # - changed $whoami code to use getlogin, getpwuid($<) and 'syslog' + # (in that order) when $ident is null, + # - made PID logging consistent with syslog(3C) and subject to $lo_pid only, + # - fixed typo in "print CONS" statement ($<facility should be <$facility). + # - changed \n to \r in print CONS (\r is useful, $message already has a \n). + # - Changed &xlate to return -1 for an unknown name, instead of croaking. + # + # # tom christiansen <tchrist@convex.com> # modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov> # NOTE: openlog now takes three arguments, just like openlog(3) *************** *** 15,21 **** # # do openlog($program,'cons,pid','user'); # do syslog('info','this is another test'); ! # do syslog('warn','this is a better test: %d', time); # do closelog(); # # do syslog('debug','this is the last test'); --- 40,46 ---- # # do openlog($program,'cons,pid','user'); # do syslog('info','this is another test'); ! # do syslog('mail|warning','this is a better test: %d', time); # do closelog(); # # do syslog('debug','this is the last test'); *************** *** 29,41 **** $host = 'localhost' unless $host; # set $syslog'host to change ! require 'syslog.ph'; sub main'openlog { ($ident, $logopt, $facility) = @_; # package vars $lo_pid = $logopt =~ /\bpid\b/; $lo_ndelay = $logopt =~ /\bndelay\b/; ! $lo_cons = $logopt =~ /\bncons\b/; $lo_nowait = $logopt =~ /\bnowait\b/; &connect if $lo_ndelay; } --- 54,68 ---- $host = 'localhost' unless $host; # set $syslog'host to change ! require '/usr/local/lib/perl/syslog.ph'; + $maskpri = &LOG_UPTO(&LOG_DEBUG); + sub main'openlog { ($ident, $logopt, $facility) = @_; # package vars $lo_pid = $logopt =~ /\bpid\b/; $lo_ndelay = $logopt =~ /\bndelay\b/; ! $lo_cons = $logopt =~ /\bcons\b/; $lo_nowait = $logopt =~ /\bnowait\b/; &connect if $lo_ndelay; } *************** *** 44,76 **** $facility = $ident = ''; &disconnect; } sub main'syslog { local($priority) = shift; local($mask) = shift; local($message, $whoami); ! &connect unless $connected; ! $whoami = $ident; ! die "syslog: expected both priority and mask" unless $mask && $priority; ! $facility = "user" unless $facility; if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) { $whoami = $1; $mask = $2; } - $whoami .= " [$$]" if $lo_pid; $mask =~ s/%m/$!/g; $mask .= "\n" unless $mask =~ /\n$/; $message = sprintf ($mask, @_); ! $whoami = sprintf ("%s %d",$ENV{'USER'}||$ENV{'LOGNAME'},$$) unless $whoami; ! ! $sum = &xlate($priority) + &xlate($facility); unless (send(SYSLOG,"<$sum>$whoami: $message",0)) { if ($lo_cons) { if ($pid = fork) { --- 71,141 ---- $facility = $ident = ''; &disconnect; } + + sub main'setlogmask { + local($oldmask) = $maskpri; + $maskpri = shift; + $oldmask; + } sub main'syslog { local($priority) = shift; local($mask) = shift; local($message, $whoami); + local(@words, $num, $numpri, $numfac, $sum); + local($facility) = $facility; # may need to change temporarily. ! die "syslog: expected both priority and mask" unless $mask && $priority; ! @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility". ! undef $numpri; ! undef $numfac; ! foreach (@words) { ! $num = &xlate($_); # Translate word to number. ! if (/^kern$/ || $num < 0) { ! die "syslog: invalid level/facility: $_\n"; ! } ! elsif ($num <= &LOG_PRIMASK) { ! die "syslog: too many levels given: $_\n" if defined($numpri); ! $numpri = $num; ! return 0 unless &LOG_MASK($numpri) & $maskpri; ! } ! else { ! die "syslog: too many facilities given: $_\n" if defined($numfac); ! $facility = $_; ! $numfac = $num; ! } ! } ! die "syslog: level must be given\n" unless defined($numpri); ! if (!defined($numfac)) { # Facility not specified in this call. ! $facility = 'user' unless $facility; ! $numfac = &xlate($facility); ! } + &connect unless $connected; + + $whoami = $ident; + if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) { $whoami = $1; $mask = $2; } + unless ($whoami) { + ($whoami = getlogin) || + ($whoami = getpwuid($<)) || + ($whoami = 'syslog'); + } + + $whoami .= "[$$]" if $lo_pid; + $mask =~ s/%m/$!/g; $mask .= "\n" unless $mask =~ /\n$/; $message = sprintf ($mask, @_); ! $sum = $numpri + $numfac; unless (send(SYSLOG,"<$sum>$whoami: $message",0)) { if ($lo_cons) { if ($pid = fork) { *************** *** 80,86 **** } else { open(CONS,">/dev/console"); ! print CONS "$<facility.$priority>$whoami: $message\n"; exit if defined $pid; # if fork failed, we're parent close CONS; } --- 145,151 ---- } else { open(CONS,">/dev/console"); ! print CONS "<$facility.$priority>$whoami: $message\r"; exit if defined $pid; # if fork failed, we're parent close CONS; } *************** *** 93,99 **** $name =~ y/a-z/A-Z/; $name = "LOG_$name" unless $name =~ /^LOG_/; $name = "syslog'$name"; ! &$name; } sub connect { --- 158,164 ---- $name =~ y/a-z/A-Z/; $name = "LOG_$name" unless $name =~ /^LOG_/; $name = "syslog'$name"; ! eval &$name || -1; } sub connect { Index: toke.c Prereq: 3.0.1.9 *** toke.c.old Tue Oct 16 12:05:09 1990 --- toke.c Tue Oct 16 12:05:15 1990 *************** *** 1,4 **** ! /* $Header: toke.c,v 3.0.1.9 90/08/13 22:37:25 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: toke.c,v 3.0.1.10 90/10/16 11:20:46 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,26 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: toke.c,v $ + * Revision 3.0.1.10 90/10/16 11:20:46 lwall + * patch29: the length of a search pattern was limited + * patch29: added DATA filehandle to read stuff after __END__ + * patch29: added -M, -A and -C + * patch29: added cmp and <=> + * patch29: added caller + * patch29: added scalar + * patch29: added sysread and syswrite + * patch29: added SysV IPC + * patch29: added waitpid + * patch29: tr/// now understands c, d and s options, and handles nulls right + * patch29: 0x80000000 now makes unsigned value + * patch29: Null could not be used as a delimiter + * patch29: added @###.## fields to format + * * Revision 3.0.1.9 90/08/13 22:37:25 lwall * patch28: defined(@array) and defined(%array) didn't work right * *************** *** 62,67 **** --- 77,90 ---- #include "perl.h" #include "perly.h" + #ifdef I_FCNTL + #include <fcntl.h> + #endif + + /* which backslash sequences to keep in m// or s// */ + + static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtf0123456789[{]}"; + char *reparse; /* if non-null, scanreg found ${foo[$bar]} */ #ifdef CLINE *************** *** 79,91 **** #define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0) #define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1) #define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2) #define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3) #define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST) #define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2) #define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN) #define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3) #define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN) - #define LFUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)LFUNC4) #define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP) #define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP) #define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP) --- 102,116 ---- #define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0) #define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1) #define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2) + #define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x) #define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3) + #define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4) + #define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5) #define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST) #define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2) #define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN) #define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3) #define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN) #define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP) #define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP) #define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP) *************** *** 215,222 **** firstline = FALSE; if (minus_n || minus_p || perldb) { str_set(linestr,""); ! if (perldb) ! str_cat(linestr, "require 'perldb.pl';"); if (minus_n || minus_p) { str_cat(linestr,"line: while (<>) {"); if (minus_a) --- 240,252 ---- firstline = FALSE; if (minus_n || minus_p || perldb) { str_set(linestr,""); ! if (perldb) { ! char *getenv(); ! char *pdb = getenv("PERLDB"); ! ! str_cat(linestr, pdb ? pdb : "require 'perldb.pl'"); ! str_cat(linestr, ";"); ! } if (minus_n || minus_p) { str_cat(linestr,"line: while (<>) {"); if (minus_a) *************** *** 242,254 **** do { if ((s = str_gets(linestr, rsfp, 0)) == Nullch) { fake_eof: ! if (preprocess) ! (void)mypclose(rsfp); ! else if (rsfp == stdin) ! clearerr(stdin); ! else ! (void)fclose(rsfp); ! rsfp = Nullfp; if (minus_n || minus_p) { str_set(linestr,minus_p ? ";}continue{print" : ""); str_cat(linestr,";}"); --- 272,286 ---- do { if ((s = str_gets(linestr, rsfp, 0)) == Nullch) { fake_eof: ! if (rsfp) { ! if (preprocess) ! (void)mypclose(rsfp); ! else if (rsfp == stdin) ! clearerr(stdin); ! else ! (void)fclose(rsfp); ! rsfp = Nullfp; ! } if (minus_n || minus_p) { str_set(linestr,minus_p ? ";}continue{print" : ""); str_cat(linestr,";}"); *************** *** 269,275 **** STR *str = Str_new(85,0); str_sset(str,linestr); ! astore(lineary,(int)curcmd->c_line,str); } #ifdef DEBUG if (firstline) { --- 301,307 ---- STR *str = Str_new(85,0); str_sset(str,linestr); ! astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str); } #ifdef DEBUG if (firstline) { *************** *** 332,340 **** s[strlen(s)-1] = '\0'; /* wipe out trailing quote */ } if (*s) ! filename = savestr(s); else ! filename = origfilename; oldoldbufptr = oldbufptr = s = str_get(linestr); } /* FALL THROUGH */ --- 364,372 ---- s[strlen(s)-1] = '\0'; /* wipe out trailing quote */ } if (*s) ! curcmd->c_filestab = fstab(s); else ! curcmd->c_filestab = fstab(origfilename); oldoldbufptr = oldbufptr = s = str_get(linestr); } /* FALL THROUGH */ *************** *** 345,350 **** --- 377,389 ---- s++; if (s < d) s++; + if (perldb) { + STR *str = Str_new(85,0); + + str_nset(str,linestr->str_ptr, s - linestr->str_ptr); + astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str); + str_chop(linestr, s); + } if (in_format) { bufptr = s; yylval.formval = load_format(); *************** *** 387,392 **** --- 426,434 ---- case 't': FTST(O_FTTTY); case 'T': FTST(O_FTTEXT); case 'B': FTST(O_FTBINARY); + case 'M': stabent("\024",TRUE); FTST(O_FTMTIME); + case 'A': stabent("\024",TRUE); FTST(O_FTATIME); + case 'C': stabent("\024",TRUE); FTST(O_FTCTIME); default: s -= 2; break; *************** *** 507,514 **** tmp = *s++; if (tmp == '<') OPERATOR(LS); ! if (tmp == '=') ROP(O_LE); s--; ROP(O_LT); case '>': --- 549,561 ---- tmp = *s++; if (tmp == '<') OPERATOR(LS); ! if (tmp == '=') { ! tmp = *s++; ! if (tmp == '>') ! EOP(O_NCMP); ! s--; ROP(O_LE); + } s--; ROP(O_LT); case '>': *************** *** 600,612 **** if (d[2] == 'L') (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line); else ! strcpy(tokenbuf, filename); arg[1].arg_type = A_SINGLE; arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf)); TERM(RSTRING); } ! else if (strEQ(d,"__END__")) goto fake_eof; } break; case 'a': case 'A': --- 647,681 ---- if (d[2] == 'L') (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line); else ! strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr); arg[1].arg_type = A_SINGLE; arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf)); TERM(RSTRING); } ! else if (strEQ(d,"__END__")) { ! #ifndef TAINT ! STAB *stab; ! int fd; ! ! if (stab = stabent("DATA",FALSE)) { ! stab->str_pok |= SP_MULTI; ! stab_io(stab) = stio_new(); ! stab_io(stab)->ifp = rsfp; ! #if defined(FCNTL) && defined(F_SETFD) ! fd = fileno(rsfp); ! fcntl(fd,F_SETFD,fd >= 3); ! #endif ! if (preprocess) ! stab_io(stab)->type = '|'; ! else if (rsfp == stdin) ! stab_io(stab)->type = '-'; ! else ! stab_io(stab)->type = '<'; ! rsfp = Nullfp; ! } ! #endif goto fake_eof; + } } break; case 'a': case 'A': *************** *** 637,642 **** --- 706,715 ---- FOP(O_CLOSE); if (strEQ(d,"closedir")) FOP(O_CLOSEDIR); + if (strEQ(d,"cmp")) + EOP(O_SCMP); + if (strEQ(d,"caller")) + UNI(O_CALLER); if (strEQ(d,"crypt")) { #ifdef FCRYPT init_des(); *************** *** 701,707 **** HFUN(O_EACH); if (strEQ(d,"exec")) { set_csh(); ! LOP(O_EXEC); } if (strEQ(d,"endhostent")) FUN0(O_EHOSTENT); --- 774,780 ---- HFUN(O_EACH); if (strEQ(d,"exec")) { set_csh(); ! LOP(O_EXEC_OP); } if (strEQ(d,"endhostent")) FUN0(O_EHOSTENT); *************** *** 834,840 **** OPERATOR(IF); } if (strEQ(d,"index")) ! FUN2(O_INDEX); if (strEQ(d,"int")) UNI(O_INT); if (strEQ(d,"ioctl")) --- 907,913 ---- OPERATOR(IF); } if (strEQ(d,"index")) ! FUN2x(O_INDEX); if (strEQ(d,"int")) UNI(O_INT); if (strEQ(d,"ioctl")) *************** *** 890,897 **** else RETURN(1); /* force error */ } ! if (strEQ(d,"mkdir")) ! FUN2(O_MKDIR); break; case 'n': case 'N': SNARFWORD; --- 963,984 ---- else RETURN(1); /* force error */ } ! switch (d[1]) { ! case 'k': ! if (strEQ(d,"mkdir")) ! FUN2(O_MKDIR); ! break; ! case 's': ! if (strEQ(d,"msgctl")) ! FUN3(O_MSGCTL); ! if (strEQ(d,"msgget")) ! FUN2(O_MSGGET); ! if (strEQ(d,"msgrcv")) ! FUN5(O_MSGRCV); ! if (strEQ(d,"msgsnd")) ! FUN3(O_MSGSND); ! break; ! } break; case 'n': case 'N': SNARFWORD; *************** *** 964,970 **** if (strEQ(d,"rmdir")) UNI(O_RMDIR); if (strEQ(d,"rindex")) ! FUN2(O_RINDEX); if (strEQ(d,"read")) FOP3(O_READ); if (strEQ(d,"readdir")) --- 1051,1057 ---- if (strEQ(d,"rmdir")) UNI(O_RMDIR); if (strEQ(d,"rindex")) ! FUN2x(O_RINDEX); if (strEQ(d,"read")) FOP3(O_READ); if (strEQ(d,"readdir")) *************** *** 996,1002 **** --- 1083,1093 ---- switch (d[1]) { case 'a': case 'b': + break; case 'c': + if (strEQ(d,"scalar")) + UNI(O_SCALAR); + break; case 'd': break; case 'e': *************** *** 1004,1009 **** --- 1095,1106 ---- OPERATOR(SSELECT); if (strEQ(d,"seek")) FOP3(O_SEEK); + if (strEQ(d,"semctl")) + FUN4(O_SEMCTL); + if (strEQ(d,"semget")) + FUN3(O_SEMGET); + if (strEQ(d,"semop")) + FUN2(O_SEMOP); if (strEQ(d,"send")) FOP3(O_SEND); if (strEQ(d,"setpgrp")) *************** *** 1033,1038 **** --- 1130,1143 ---- case 'h': if (strEQ(d,"shift")) TERM(SHIFT); + if (strEQ(d,"shmctl")) + FUN3(O_SHMCTL); + if (strEQ(d,"shmget")) + FUN3(O_SHMGET); + if (strEQ(d,"shmread")) + FUN4(O_SHMREAD); + if (strEQ(d,"shmwrite")) + FUN4(O_SHMWRITE); if (strEQ(d,"shutdown")) FOP2(O_SHUTDOWN); break; *************** *** 1107,1113 **** break; case 'u': if (strEQ(d,"substr")) ! FUN3(O_SUBSTR); if (strEQ(d,"sub")) { subline = curcmd->c_line; d = bufend; --- 1212,1218 ---- break; case 'u': if (strEQ(d,"substr")) ! FUN2x(O_SUBSTR); if (strEQ(d,"sub")) { subline = curcmd->c_line; d = bufend; *************** *** 1144,1149 **** --- 1249,1258 ---- FUN2(O_SYMLINK); if (strEQ(d,"syscall")) LOP(O_SYSCALL); + if (strEQ(d,"sysread")) + FOP3(O_SYSREAD); + if (strEQ(d,"syswrite")) + FOP3(O_SYSWRITE); break; case 'z': break; *************** *** 1215,1220 **** --- 1324,1331 ---- LOP(O_WARN); if (strEQ(d,"wait")) FUN0(O_WAIT); + if (strEQ(d,"waitpid")) + FUN2(O_WAITPID); if (strEQ(d,"wantarray")) { yylval.arg = op_new(1); yylval.arg->arg_type = O_ITEM; *************** *** 1428,1433 **** --- 1539,1545 ---- register char *e; int len; SPAT savespat; + STR *str = Str_new(93,0); Newz(801,spat,1,SPAT); spat->spat_next = curstash->tbl_spatroot; /* link into spat list */ *************** *** 1445,1452 **** default: fatal("panic: scanpat"); } ! s = cpytill(tokenbuf,s,bufend,s[-1],&len); if (s >= bufend) { yyerror("Search pattern not terminated"); yylval.arg = Nullarg; return s; --- 1557,1565 ---- default: fatal("panic: scanpat"); } ! s = str_append_till(str,s,bufend,s[-1],patleave); if (s >= bufend) { + str_free(str); yyerror("Search pattern not terminated"); yylval.arg = Nullarg; return s; *************** *** 1463,1470 **** spat->spat_flags |= SPAT_KEEP; } } ! e = tokenbuf + len; ! for (d=tokenbuf; d < e; d++) { if (*d == '\\') d++; else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') || --- 1576,1584 ---- spat->spat_flags |= SPAT_KEEP; } } ! len = str->str_cur; ! e = str->str_ptr + len; ! for (d = str->str_ptr; d < e; d++) { if (*d == '\\') d++; else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') || *************** *** 1474,1481 **** spat->spat_runtime = arg = op_new(1); arg->arg_type = O_ITEM; arg[1].arg_type = A_DOUBLE; ! arg[1].arg_ptr.arg_str = str_make(tokenbuf,len); ! arg[1].arg_ptr.arg_str->str_u.str_hash = curstash; d = scanreg(d,bufend,buf); (void)stabent(buf,TRUE); /* make sure it's created */ for (; d < e; d++) { --- 1588,1594 ---- spat->spat_runtime = arg = op_new(1); arg->arg_type = O_ITEM; arg[1].arg_type = A_DOUBLE; ! arg[1].arg_ptr.arg_str = str_smake(str); d = scanreg(d,bufend,buf); (void)stabent(buf,TRUE); /* make sure it's created */ for (; d < e; d++) { *************** *** 1501,1508 **** #else (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT)); #endif ! if (*tokenbuf == '^') { ! spat->spat_short = scanconst(tokenbuf+1,len-1); if (spat->spat_short) { spat->spat_slen = spat->spat_short->str_cur; if (spat->spat_slen == len - 1) --- 1614,1621 ---- #else (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT)); #endif ! if (*str->str_ptr == '^') { ! spat->spat_short = scanconst(str->str_ptr+1,len-1); if (spat->spat_short) { spat->spat_slen = spat->spat_short->str_cur; if (spat->spat_slen == len - 1) *************** *** 1511,1517 **** } else { spat->spat_flags |= SPAT_SCANFIRST; ! spat->spat_short = scanconst(tokenbuf,len); if (spat->spat_short) { spat->spat_slen = spat->spat_short->str_cur; if (spat->spat_slen == len) --- 1624,1630 ---- } else { spat->spat_flags |= SPAT_SCANFIRST; ! spat->spat_short = scanconst(str->str_ptr,len); if (spat->spat_short) { spat->spat_slen = spat->spat_short->str_cur; if (spat->spat_slen == len) *************** *** 1520,1526 **** } if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) { fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD); ! spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len, spat->spat_flags & SPAT_FOLD); /* Note that this regexp can still be used if someone says * something like /a/ && s//b/; so we can't delete it. --- 1633,1639 ---- } if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) { fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD); ! spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len, spat->spat_flags & SPAT_FOLD); /* Note that this regexp can still be used if someone says * something like /a/ && s//b/; so we can't delete it. *************** *** 1535,1545 **** #endif if (spat->spat_short) fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD); ! spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len, spat->spat_flags & SPAT_FOLD,1); hoistmust(spat); } got_pat: yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat); return s; } --- 1648,1659 ---- #endif if (spat->spat_short) fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD); ! spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len, spat->spat_flags & SPAT_FOLD,1); hoistmust(spat); } got_pat: + str_free(str); yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat); return s; } *************** *** 1552,1579 **** register char *d; register char *e; int len; Newz(802,spat,1,SPAT); spat->spat_next = curstash->tbl_spatroot; /* link into spat list */ curstash->tbl_spatroot = spat; ! s = cpytill(tokenbuf,s+1,bufend,*s,&len); if (s >= bufend) { yyerror("Substitution pattern not terminated"); yylval.arg = Nullarg; return s; } ! e = tokenbuf + len; ! for (d=tokenbuf; d < e; d++) { ! if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') || ! (*d == '@' && d[-1] != '\\')) { register ARG *arg; spat->spat_runtime = arg = op_new(1); arg->arg_type = O_ITEM; arg[1].arg_type = A_DOUBLE; ! arg[1].arg_ptr.arg_str = str_make(tokenbuf,len); ! arg[1].arg_ptr.arg_str->str_u.str_hash = curstash; d = scanreg(d,bufend,buf); (void)stabent(buf,TRUE); /* make sure it's created */ for (; *d; d++) { --- 1666,1697 ---- register char *d; register char *e; int len; + STR *str = Str_new(93,0); Newz(802,spat,1,SPAT); spat->spat_next = curstash->tbl_spatroot; /* link into spat list */ curstash->tbl_spatroot = spat; ! s = str_append_till(str,s+1,bufend,*s,patleave); if (s >= bufend) { + str_free(str); yyerror("Substitution pattern not terminated"); yylval.arg = Nullarg; return s; } ! len = str->str_cur; ! e = str->str_ptr + len; ! for (d = str->str_ptr; d < e; d++) { ! if (*d == '\\') ! d++; ! else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') || ! *d == '@' ) { register ARG *arg; spat->spat_runtime = arg = op_new(1); arg->arg_type = O_ITEM; arg[1].arg_type = A_DOUBLE; ! arg[1].arg_ptr.arg_str = str_smake(str); d = scanreg(d,bufend,buf); (void)stabent(buf,TRUE); /* make sure it's created */ for (; *d; d++) { *************** *** 1591,1611 **** goto get_repl; /* skip compiling for now */ } } ! if (*tokenbuf == '^') { ! spat->spat_short = scanconst(tokenbuf+1,len-1); if (spat->spat_short) spat->spat_slen = spat->spat_short->str_cur; } else { spat->spat_flags |= SPAT_SCANFIRST; ! spat->spat_short = scanconst(tokenbuf,len); if (spat->spat_short) spat->spat_slen = spat->spat_short->str_cur; } - d = nsavestr(tokenbuf,len); get_repl: s = scanstr(s); if (s >= bufend) { yyerror("Substitution replacement not terminated"); yylval.arg = Nullarg; return s; --- 1709,1729 ---- goto get_repl; /* skip compiling for now */ } } ! if (*str->str_ptr == '^') { ! spat->spat_short = scanconst(str->str_ptr+1,len-1); if (spat->spat_short) spat->spat_slen = spat->spat_short->str_cur; } else { spat->spat_flags |= SPAT_SCANFIRST; ! spat->spat_short = scanconst(str->str_ptr,len); if (spat->spat_short) spat->spat_slen = spat->spat_short->str_cur; } get_repl: s = scanstr(s); if (s >= bufend) { + str_free(str); yyerror("Substitution replacement not terminated"); yylval.arg = Nullarg; return s; *************** *** 1632,1641 **** s++; if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) spat->spat_repl[1].arg_type = A_SINGLE; ! spat->spat_repl = fixeval(make_op(O_EVAL,2, spat->spat_repl, Nullarg, ! Nullarg)); spat->spat_flags &= ~SPAT_CONST; } if (*s == 'g') { --- 1750,1759 ---- s++; if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) spat->spat_repl[1].arg_type = A_SINGLE; ! spat->spat_repl = make_op(O_EVAL,2, spat->spat_repl, Nullarg, ! Nullarg); spat->spat_flags &= ~SPAT_CONST; } if (*s == 'g') { *************** *** 1660,1670 **** if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST)) fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD); if (!spat->spat_runtime) { ! spat->spat_regexp = regcomp(d,d+len,spat->spat_flags & SPAT_FOLD,1); hoistmust(spat); - Safefree(d); } yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat); return s; } --- 1778,1789 ---- if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST)) fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD); if (!spat->spat_runtime) { ! spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len, ! spat->spat_flags & SPAT_FOLD,1); hoistmust(spat); } yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat); + str_free(str); return s; } *************** *** 1729,1742 **** l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg)); register char *t; register char *r; ! register char *tbl; register int i; register int j; int tlen, rlen; ! Newz(803,tbl,256,char); arg[2].arg_type = A_NULL; ! arg[2].arg_ptr.arg_cval = tbl; s = scanstr(s); if (s >= bufend) { yyerror("Translation pattern not terminated"); --- 1848,1864 ---- l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg)); register char *t; register char *r; ! register short *tbl; register int i; register int j; int tlen, rlen; + int squash; + int delete; + int complement; ! New(803,tbl,256,short); arg[2].arg_type = A_NULL; ! arg[2].arg_ptr.arg_cval = (char*) tbl; s = scanstr(s); if (s >= bufend) { yyerror("Translation pattern not terminated"); *************** *** 1752,1770 **** yylval.arg = Nullarg; return s; } r = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr, yylval.arg[1].arg_ptr.arg_str->str_cur,&rlen); free_arg(yylval.arg); yylval.arg = arg; ! if (!*r) { Safefree(r); r = t; rlen = tlen; } ! for (i = 0, j = 0; i < tlen; i++,j++) { ! if (j >= rlen) ! --j; ! tbl[t[i] & 0377] = r[j]; } if (r != t) Safefree(r); Safefree(t); --- 1874,1931 ---- yylval.arg = Nullarg; return s; } + complement = delete = squash = 0; + while (*s == 'c' || *s == 'd' || *s == 's') { + if (*s == 'c') + complement = 1; + else if (*s == 'd') + delete = 2; + else + squash = 1; + s++; + } r = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr, yylval.arg[1].arg_ptr.arg_str->str_cur,&rlen); free_arg(yylval.arg); + arg[2].arg_len = delete|squash; yylval.arg = arg; ! if (!rlen && !delete) { Safefree(r); r = t; rlen = tlen; } ! if (complement) { ! Zero(tbl, 256, short); ! for (i = 0; i < tlen; i++) ! tbl[t[i] & 0377] = -1; ! for (i = 0, j = 0; i < 256; i++,j++) { ! if (!tbl[i]) { ! if (j >= rlen) { ! if (delete) { ! tbl[i] = -2; ! continue; ! } ! --j; ! } ! tbl[i] = r[j]; ! } ! } } + else { + for (i = 0; i < 256; i++) + tbl[i] = -1; + for (i = 0, j = 0; i < tlen; i++,j++) { + if (j >= rlen) { + if (delete) { + if (tbl[t[i] & 0377] == -1) + tbl[t[i] & 0377] = -2; + continue; + } + --j; + } + if (tbl[t[i] & 0377] == -1) + tbl[t[i] & 0377] = r[j]; + } + } if (r != t) Safefree(r); Safefree(t); *************** *** 1802,1808 **** goto snarf_it; case '0': { ! long i; int shift; arg[1].arg_type = A_SINGLE; --- 1963,1969 ---- goto snarf_it; case '0': { ! unsigned long i; int shift; arg[1].arg_type = A_SINGLE; *************** *** 1936,1942 **** arg[1].arg_ptr.arg_stab = stab = genstab(); stab_io(stab) = stio_new(); stab_val(stab) = str_make(d,len); - stab_val(stab)->str_u.str_hash = curstash; Safefree(d); set_csh(); } --- 2097,2102 ---- *************** *** 1950,1959 **** } else { arg[1].arg_type = A_READ; - #ifdef NOTDEF - if (rsfp == stdin && (strEQ(d,"stdin") || strEQ(d,"STDIN"))) - yyerror("Can't get both program and data from <STDIN>"); - #endif arg[1].arg_ptr.arg_stab = stabent(d,TRUE); if (!stab_io(arg[1].arg_ptr.arg_stab)) stab_io(arg[1].arg_ptr.arg_stab) = stio_new(); --- 2110,2115 ---- *************** *** 2003,2009 **** multi_open = multi_close = '<'; else { multi_open = term; ! if (tmps = index("([{< )]}> )]}>",term)) term = tmps[5]; multi_close = term; } --- 2159,2165 ---- multi_open = multi_close = '<'; else { multi_open = term; ! if (term && (tmps = index("([{< )]}> )]}>",term))) term = tmps[5]; multi_close = term; } *************** *** 2045,2051 **** STR *str = Str_new(88,0); str_sset(str,linestr); ! astore(lineary,(int)curcmd->c_line,str); } bufend = linestr->str_ptr + linestr->str_cur; if (hereis) { --- 2201,2208 ---- STR *str = Str_new(88,0); str_sset(str,linestr); ! astore(stab_xarray(curcmd->c_filestab), ! (int)curcmd->c_line,str); } bufend = linestr->str_ptr + linestr->str_cur; if (hereis) { *************** *** 2151,2158 **** if ((arg[1].arg_type & A_MASK) == A_DOUBLE && makesingle) arg[1].arg_type = A_SINGLE; /* now we can optimize on it */ - tmpstr->str_u.str_hash = curstash; /* so interp knows package */ - tmpstr->str_cur = d - tmpstr->str_ptr; arg[1].arg_ptr.arg_str = tmpstr; s = tmps; --- 2308,2313 ---- *************** *** 2182,2193 **** s = bufptr; while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) { curcmd->c_line++; - if (perldb) { - STR *tmpstr = Str_new(89,0); - - str_sset(tmpstr,linestr); - astore(lineary,(int)curcmd->c_line,tmpstr); - } if (in_eval && !rsfp) { eol = index(s,'\n'); if (!eol++) --- 2337,2342 ---- *************** *** 2195,2200 **** --- 2344,2355 ---- } else eol = bufend = linestr->str_ptr + linestr->str_cur; + if (perldb) { + STR *tmpstr = Str_new(89,0); + + str_nset(tmpstr, s, eol-s); + astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr); + } if (strnEQ(s,".\n",2)) { bufptr = s; return froot.f_next; *************** *** 2254,2260 **** --- 2409,2443 ---- while (*s == '|') s++; break; + case '#': + case '.': + /* Catch the special case @... and handle it as a string + field. */ + if (*s == '.' && s[1] == '.') { + goto default_format; + } + fcmd->f_type = F_DECIMAL; + { + char *p; + + /* Read a format in the form @####.####, where either group + of ### may be empty, or the final .### may be missing. */ + while (*s == '#') + s++; + if (*s == '.') { + s++; + p = s; + while (*s == '#') + s++; + fcmd->f_decimals = s-p; + fcmd->f_flags |= FC_DP; + } else { + fcmd->f_decimals = 0; + } + } + break; default: + default_format: fcmd->f_type = F_LEFT; break; } *************** *** 2270,2281 **** if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch) goto badform; curcmd->c_line++; - if (perldb) { - STR *tmpstr = Str_new(90,0); - - str_sset(tmpstr,linestr); - astore(lineary,(int)curcmd->c_line,tmpstr); - } if (in_eval && !rsfp) { eol = index(s,'\n'); if (!eol++) --- 2453,2458 ---- *************** *** 2283,2288 **** --- 2460,2472 ---- } else eol = bufend = linestr->str_ptr + linestr->str_cur; + if (perldb) { + STR *tmpstr = Str_new(90,0); + + str_nset(tmpstr, s, eol-s); + astore(stab_xarray(curcmd->c_filestab), + (int)curcmd->c_line,tmpstr); + } if (strnEQ(s,".\n",2)) { bufptr = s; yyerror("Missing values line"); *** End of Patch 35 ***