Xref: utzoo comp.sources.bugs:2608 comp.lang.perl:2599 Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!hellgate.utah.edu!caen!sdd.hp.com!elroy.jpl.nasa.gov!jpl-devvax!lwall From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) Newsgroups: comp.sources.bugs,comp.lang.perl Subject: perl 3.0 patch #35 Summary: This is an official patch for perl 3.0. Please apply it. Message-ID: <10006@jpl-devvax.JPL.NASA.GOV> Date: 17 Oct 90 16:55:50 GMT Organization: Jet Propulsion Laboratory, Pasadena, CA Lines: 1842 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 #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 ($ # modified to use sockets by Larry Wall # 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 "$$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 + #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 "); - #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 ***