--- /dev/null
+/*
+ * Suffix appending for in-place editing under MS-DOS and OS/2.
+ *
+ * Here are the rules:
+ *
+ * Style 0: Append the suffix exactly as standard perl would do it.
+ * If the filesystem groks it, use it. (HPFS will always
+ * grok it. FAT will rarely accept it.)
+ *
+ * Style 1: The suffix begins with a '.'. The extension is replaced.
+ * If the name matches the original name, use the fallback method.
+ *
+ * Style 2: The suffix is a single character, not a '.'. Try to add the
+ * suffix to the following places, using the first one that works.
+ * [1] Append to extension.
+ * [2] Append to filename,
+ * [3] Replace end of extension,
+ * [4] Replace end of filename.
+ * If the name matches the original name, use the fallback method.
+ *
+ * Style 3: Any other case: Ignore the suffix completely and use the
+ * fallback method.
+ *
+ * Fallback method: Change the extension to ".$$$". If that matches the
+ * original name, then change the extension to ".~~~".
+ *
+ * If filename is more than 1000 characters long, we die a horrible
+ * death. Sorry.
+ *
+ * The filename restriction is a cheat so that we can use buf[] to store
+ * assorted temporary goo.
+ *
+ * Examples, assuming style 0 failed.
+ *
+ * suffix = ".bak" (style 1)
+ * foo.bar => foo.bak
+ * foo.bak => foo.$$$ (fallback)
+ * foo.$$$ => foo.~~~ (fallback)
+ * makefile => makefile.bak
+ *
+ * suffix = "~" (style 2)
+ * foo.c => foo.c~
+ * foo.c~ => foo.c~~
+ * foo.c~~ => foo~.c~~
+ * foo~.c~~ => foo~~.c~~
+ * foo~~~~~.c~~ => foo~~~~~.$$$ (fallback)
+ *
+ * foo.pas => foo~.pas
+ * makefile => makefile.~
+ * longname.fil => longname.fi~
+ * longname.fi~ => longnam~.fi~
+ * longnam~.fi~ => longnam~.$$$
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#ifdef OS2
+#define INCL_DOSFILEMGR
+#define INCL_DOSERRORS
+#include <os2.h>
+#endif /* OS2 */
+
+static char suffix1[] = ".$$$";
+static char suffix2[] = ".~~~";
+
+#define ext (&buf[1000])
+
+add_suffix(str,suffix)
+register STR *str;
+register char *suffix;
+{
+ int baselen;
+ int extlen;
+ char *s, *t, *p;
+ STRLEN slen;
+
+ if (!(str->str_pok)) (void)str_2ptr(str);
+ if (str->str_cur > 1000)
+ fatal("Cannot do inplace edit on long filename (%d characters)", str->str_cur);
+
+#ifdef OS2
+ /* Style 0 */
+ slen = str->str_cur;
+ str_cat(str, suffix);
+ if (valid_filename(str->str_ptr)) return;
+
+ /* Fooey, style 0 failed. Fix str before continuing. */
+ str->str_ptr[str->str_cur = slen] = '\0';
+#endif /* OS2 */
+
+ slen = strlen(suffix);
+ t = buf; baselen = 0; s = str->str_ptr;
+ while ( (*t = *s) && *s != '.') {
+ baselen++;
+ if (*s == '\\' || *s == '/') baselen = 0;
+ s++; t++;
+ }
+ p = t;
+
+ t = ext; extlen = 0;
+ while (*t++ = *s++) extlen++;
+ if (extlen == 0) { ext[0] = '.'; ext[1] = 0; extlen++; }
+
+ if (*suffix == '.') { /* Style 1 */
+ if (strEQ(ext, suffix)) goto fallback;
+ strcpy(p, suffix);
+ } else if (suffix[1] == '\0') { /* Style 2 */
+ if (extlen < 4) {
+ ext[extlen] = *suffix;
+ ext[++extlen] = '\0';
+ } else if (baselen < 8) {
+ *p++ = *suffix;
+ } else if (ext[3] != *suffix) {
+ ext[3] = *suffix;
+ } else if (buf[7] != *suffix) {
+ buf[7] = *suffix;
+ } else goto fallback;
+ strcpy(p, ext);
+ } else { /* Style 3: Panic */
+fallback:
+ (void)bcopy(strEQ(ext, suffix1) ? suffix2 : suffix1, p, 4+1);
+ }
+ str_set(str, buf);
+}
+
+#ifdef OS2
+int
+valid_filename(s)
+char *s;
+{
+ HFILE hf;
+ USHORT usAction;
+
+ switch(DosOpen(s, &hf, &usAction, 0L, 0, FILE_OPEN,
+ OPEN_ACCESS_READONLY | OPEN_SHARE_DENYNONE, 0L)) {
+ case NO_ERROR:
+ DosClose(hf);
+ /*FALLTHROUGH*/
+ default:
+ return 1;
+ case ERROR_FILENAME_EXCED_RANGE:
+ return 0;
+ }
+}
+#endif /* OS2 */
-/* $Header: str.c,v 3.0.1.7 90/03/27 16:24:11 lwall Locked $
+/* $Header: str.c,v 3.0.1.8 90/08/09 05:22:18 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.c,v $
+ * 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
+ *
* Revision 3.0.1.7 90/03/27 16:24:11 lwall
* patch16: strings with prefix chopped off sometimes freed wrong
* patch16: taint check blows up on undefined array element
char *
str_grow(str,newlen)
register STR *str;
+#ifndef MSDOS
register int newlen;
+#else
+unsigned long newlen;
+#endif
{
register char *s = str->str_ptr;
+#ifdef MSDOS
+ if (newlen >= 0x10000) {
+ fprintf(stderr, "Allocation too large: %lx\n", newlen);
+ exit(1);
+ }
+#endif /* MSDOS */
if (str->str_state == SS_INCR) { /* data before str_ptr? */
str->str_len += str->str_u.str_useful;
str->str_ptr -= str->str_u.str_useful;
if (str->str_pok) {
str->str_pok = 0; /* invalidate pointer */
if (str->str_state == SS_INCR)
- str_grow(str,0);
+ Str_Grow(str,0);
}
str->str_u.str_nval = num;
str->str_state = SS_NORM;
if (!str)
return "";
if (str->str_nok) {
-/* this is a problem on the sun 4... 24 bytes is not always enough and the
- exponent blows away the malloc stack
- PEJ Wed Jan 31 18:41:34 CST 1990
-*/
-#ifdef sun4
STR_GROW(str, 30);
-#else
- STR_GROW(str, 24);
-#endif /* sun 4 */
s = str->str_ptr;
olderrno = errno; /* some Xenix systems wipe out errno here */
#if defined(scs) && defined(ns32000)
return No;
if (dowarn)
warn("Use of uninitialized variable");
-#ifdef sun4
STR_GROW(str, 30);
-#else
- STR_GROW(str, 24);
-#endif
s = str->str_ptr;
}
*s = '\0';
if (!str)
return 0.0;
if (str->str_state == SS_INCR)
- str_grow(str,0); /* just force copy down */
+ Str_Grow(str,0); /* just force copy down */
str->str_state = SS_NORM;
if (str->str_len && str->str_pok)
str->str_u.str_nval = atof(str->str_ptr);
str_numset(dstr,sstr->str_u.str_nval);
else {
if (dstr->str_state == SS_INCR)
- str_grow(dstr,0); /* just force copy down */
+ Str_Grow(dstr,0); /* just force copy down */
#ifdef STRUCTCOPY
dstr->str_u = sstr->str_u;
str_nset(str,ptr,len)
register STR *str;
register char *ptr;
-register int len;
+register STRLEN len;
{
STR_GROW(str, len + 1);
if (ptr)
register STR *str;
register char *ptr;
{
- register int len;
+ register STRLEN len;
if (!ptr)
ptr = "";
register STR *str;
register char *ptr;
{
- register int delta;
+ register STRLEN delta;
if (!(str->str_pok))
fatal("str_chop: internal inconsistency");
str_ncat(str,ptr,len)
register STR *str;
register char *ptr;
-register int len;
+register STRLEN len;
{
if (!(str->str_pok))
(void)str_2ptr(str);
register STR *str;
register char *ptr;
{
- register int len;
+ register STRLEN len;
if (!ptr)
return;
char *keeplist;
{
register char *to;
- register int len;
+ register STRLEN len;
if (!from)
return Nullch;
#else
str_new(len)
#endif
-int len;
+STRLEN len;
{
register STR *str;
STAB *stab;
int how;
char *name;
-int namlen;
+STRLEN namlen;
{
if (str->str_magic)
return;
void
str_insert(bigstr,offset,len,little,littlelen)
STR *bigstr;
-int offset;
-int len;
+STRLEN offset;
+STRLEN len;
char *little;
-int littlelen;
+STRLEN littlelen;
{
register char *big;
register char *mid;
register STR *nstr;
{
if (str->str_state == SS_INCR)
- str_grow(str,0); /* just force copy down */
+ Str_Grow(str,0); /* just force copy down */
if (nstr->str_state == SS_INCR)
- str_grow(nstr,0);
+ Str_Grow(nstr,0);
if (str->str_ptr)
Safefree(str->str_ptr);
str->str_ptr = nstr->str_ptr;
#endif /* LEAKTEST */
}
+STRLEN
str_len(str)
register STR *str;
{
register STDCHAR *ptr; /* in the innermost loop into registers */
register int newline = record_separator;/* (assuming >= 6 registers) */
int i;
- int bpx;
- int obpx;
+ STRLEN bpx;
+ STRLEN obpx;
register int get_paragraph;
register char *oldbp;
{
register CMD *cmd;
register ARG *arg;
- line_t oldline = line;
+ CMD *oldcurcmd = curcmd;
int retval;
- char *tmps;
str_sset(linestr,str);
in_eval++;
}
#ifdef DEBUGGING
if (debug & 4) {
- tmps = loop_stack[loop_ptr].loop_label;
+ char *tmps = loop_stack[loop_ptr].loop_label;
deb("(Popping label #%d %s)\n",loop_ptr,
tmps ? tmps : "" );
}
#endif
loop_ptr--;
error_count = 0;
+ curcmd = &compiling;
+ curcmd->c_line = oldcurcmd->c_line;
retval = yyparse();
+ curcmd = oldcurcmd;
in_eval--;
if (retval || error_count)
fatal("Invalid component in string or format");
if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
fatal("panic: error in parselist %d %x %d", cmd->c_type,
cmd->c_next, arg ? arg->arg_type : -1);
- line = oldline;
Safefree(cmd);
return arg;
}
register STR *str;
register char *t;
STR *toparse;
- int len;
+ STRLEN len;
register int brackets;
register char *d;
STAB *stab;
STR *
str_make(s,len)
char *s;
-int len;
+STRLEN len;
{
register STR *str = Str_new(79,0);
return Nullstr;
}
if (old->str_state == SS_INCR && !(old->str_pok & 2))
- str_grow(old,0);
+ Str_Grow(old,0);
if (new->str_ptr)
Safefree(new->str_ptr);
Copy(old,new,1,STR);
if (debug & 2048)
fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
#endif
- if (tainted && (!euid || euid != uid)) {
+ if (tainted && (!euid || euid != uid || egid != gid)) {
if (!unsafe)
fatal("%s", s);
else if (dowarn)
-/* $Header: toke.c,v 3.0.1.7 90/03/27 16:32:37 lwall Locked $
+/* $Header: toke.c,v 3.0.1.8 90/08/09 05:39:58 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: toke.c,v $
+ * Revision 3.0.1.8 90/08/09 05:39:58 lwall
+ * patch19: added require operator
+ * patch19: added -x switch to extract script from input trash
+ * patch19: bare @name didn't add array to symbol table
+ * patch19: Added __LINE__ and __FILE__ tokens
+ * patch19: Added __END__ token
+ * patch19: Numeric literals are now stored only in floating point
+ * patch19: some support for FPS compiler misfunction
+ * patch19: "\\$foo" not handled right
+ * patch19: program and data can now both come from STDIN
+ * patch19: "here" strings caused warnings about uninitialized variables
+ *
* Revision 3.0.1.7 90/03/27 16:32:37 lwall
* patch16: MSDOS support
* patch16: formats didn't work inside eval
#ifdef CLINE
#undef CLINE
#endif
-#define CLINE (cmdline = (line < cmdline ? line : cmdline))
+#define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
#define META(c) ((c) | 128)
else
fprintf(stderr,"Tokener at %s\n",s);
#endif
+#ifdef BADSWITCH
+ if (*s & 128) {
+ if ((*s & 127) == '(')
+ *s++ = '(';
+ else
+ warn("Unrecognized character \\%03o ignored", *s++);
+ goto retry;
+ }
+#endif
switch (*s) {
default:
if ((*s & 127) == '(')
else
warn("Unrecognized character \\%03o ignored", *s++);
goto retry;
+ case 4:
+ case 26:
+ goto fake_eof; /* emulate EOF on ^D or ^Z */
case 0:
if (!rsfp)
RETURN(0);
if (minus_n || minus_p || perldb) {
str_set(linestr,"");
if (perldb)
- str_cat(linestr,
-"do 'perldb.pl' || die \"Can't find perldb.pl in @INC\"; print $@;");
+ str_cat(linestr, "require 'perldb.pl';");
if (minus_n || minus_p) {
str_cat(linestr,"line: while (<>) {");
if (minus_a)
in_format = FALSE;
oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
bufend = linestr->str_ptr + linestr->str_cur;
- TERM(FORMLIST);
- }
- line++;
- if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
- if (preprocess)
- (void)mypclose(rsfp);
- else if (rsfp != stdin)
- (void)fclose(rsfp);
- rsfp = Nullfp;
- if (minus_n || minus_p) {
- str_set(linestr,minus_p ? ";}continue{print" : "");
- str_cat(linestr,";}");
+ OPERATOR(FORMLIST);
+ }
+ curcmd->c_line++;
+#ifdef CRYPTSCRIPT
+ cryptswitch();
+#endif /* CRYPTSCRIPT */
+ 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,";}");
+ oldoldbufptr = oldbufptr = s = str_get(linestr);
+ bufend = linestr->str_ptr + linestr->str_cur;
+ minus_n = minus_p = 0;
+ goto retry;
+ }
oldoldbufptr = oldbufptr = s = str_get(linestr);
- bufend = linestr->str_ptr + linestr->str_cur;
- minus_n = minus_p = 0;
- goto retry;
+ str_set(linestr,"");
+ RETURN(';'); /* not infinite loop because rsfp is NULL now */
}
- oldoldbufptr = oldbufptr = s = str_get(linestr);
- str_set(linestr,"");
- RETURN(';'); /* not infinite loop because rsfp is NULL now */
- }
+ if (doextract && *linestr->str_ptr == '#')
+ doextract = FALSE;
+ } while (doextract);
oldoldbufptr = oldbufptr = bufptr = s;
if (perldb) {
STR *str = Str_new(85,0);
str_sset(str,linestr);
- astore(lineary,(int)line,str);
+ astore(lineary,(int)curcmd->c_line,str);
}
#ifdef DEBUG
if (firstline) {
}
#endif
bufend = linestr->str_ptr + linestr->str_cur;
- if (line == 1) {
+ if (curcmd->c_line == 1) {
if (*s == '#' && s[1] == '!') {
if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
char **newargv;
case ' ': case '\t': case '\f':
s++;
goto retry;
- case '\n':
case '#':
if (preprocess && s == str_get(linestr) &&
s[1] == ' ' && isdigit(s[2])) {
- line = atoi(s+2)-1;
+ curcmd->c_line = atoi(s+2)-1;
for (s += 2; isdigit(*s); s++) ;
d = bufend;
while (s < d && isspace(*s)) s++;
- if (filename)
- Safefree(filename);
s[strlen(s)-1] = '\0'; /* wipe out newline */
if (*s == '"') {
s++;
if (*s)
filename = savestr(s);
else
- filename = savestr(origfilename);
+ filename = origfilename;
oldoldbufptr = oldbufptr = s = str_get(linestr);
}
+ /* FALL THROUGH */
+ case '\n':
if (in_eval && !rsfp) {
d = bufend;
while (s < d && *s != '\n')
oldoldbufptr = oldbufptr = s = bufptr + 1;
TERM(FORMLIST);
}
- line++;
+ curcmd->c_line++;
}
else {
*s = '\0';
cmdline = NOLINE; /* invalidate current command line number */
OPERATOR(tmp);
case ';':
- if (line < cmdline)
- cmdline = line;
+ if (curcmd->c_line < cmdline)
+ cmdline = curcmd->c_line;
tmp = *s++;
OPERATOR(tmp);
case ')':
s = scanreg(s,bufend,tokenbuf);
if (reparse)
goto do_reparse;
- yylval.stabval = stabent(tokenbuf,TRUE);
+ yylval.stabval = aadd(stabent(tokenbuf,TRUE));
TERM(ARY);
case '/': /* may either be division or pattern */
/* FALL THROUGH */
case '_':
SNARFWORD;
+ if (d[1] == '_') {
+ if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
+ ARG *arg = op_new(1);
+
+ yylval.arg = arg;
+ arg->arg_type = O_ITEM;
+ 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':
SNARFWORD;
if (strEQ(d,"else"))
OPERATOR(ELSE);
if (strEQ(d,"elsif")) {
- yylval.ival = line;
+ yylval.ival = curcmd->c_line;
OPERATOR(ELSIF);
}
if (strEQ(d,"eq") || strEQ(d,"EQ"))
case 'f': case 'F':
SNARFWORD;
if (strEQ(d,"for") || strEQ(d,"foreach")) {
- yylval.ival = line;
+ yylval.ival = curcmd->c_line;
OPERATOR(FOR);
}
if (strEQ(d,"format")) {
case 'i': case 'I':
SNARFWORD;
if (strEQ(d,"if")) {
- yylval.ival = line;
+ yylval.ival = curcmd->c_line;
OPERATOR(IF);
}
if (strEQ(d,"index"))
SNARFWORD;
if (strEQ(d,"return"))
OLDLOP(O_RETURN);
+ if (strEQ(d,"require")) {
+ allstabs = TRUE; /* must initialize everything since */
+ UNI(O_REQUIRE); /* we don't know what will be used */
+ }
if (strEQ(d,"reset"))
UNI(O_RESET);
if (strEQ(d,"redo"))
break;
case 'e':
if (strEQ(d,"select"))
- OPERATOR(SELECT);
+ OPERATOR(SSELECT);
if (strEQ(d,"seek"))
FOP3(O_SEEK);
if (strEQ(d,"send"))
if (strEQ(d,"socket"))
FOP4(O_SOCKET);
if (strEQ(d,"socketpair"))
- FOP25(O_SOCKETPAIR);
+ FOP25(O_SOCKPAIR);
if (strEQ(d,"sort")) {
checkcomma(s,"subroutine name");
d = bufend;
if (strEQ(d,"substr"))
FUN3(O_SUBSTR);
if (strEQ(d,"sub")) {
- subline = line;
+ subline = curcmd->c_line;
d = bufend;
while (s < d && isspace(*s))
s++;
FUN0(O_TIME);
if (strEQ(d,"times"))
FUN0(O_TMS);
+ if (strEQ(d,"truncate"))
+ FOP2(O_TRUNCATE);
break;
case 'u': case 'U':
SNARFWORD;
if (strEQ(d,"using"))
OPERATOR(USING);
if (strEQ(d,"until")) {
- yylval.ival = line;
+ yylval.ival = curcmd->c_line;
OPERATOR(UNTIL);
}
if (strEQ(d,"unless")) {
- yylval.ival = line;
+ yylval.ival = curcmd->c_line;
OPERATOR(UNLESS);
}
if (strEQ(d,"unlink"))
case 'w': case 'W':
SNARFWORD;
if (strEQ(d,"while")) {
- yylval.ival = line;
+ yylval.ival = curcmd->c_line;
OPERATOR(WHILE);
}
if (strEQ(d,"warn"))
register char *s;
char *what;
{
+ char *word;
+
if (*s == '(')
s++;
while (s < bufend && isascii(*s) && isspace(*s))
s++;
if (isascii(*s) && (isalpha(*s) || *s == '_')) {
- s++;
+ word = s++;
while (isalpha(*s) || isdigit(*s) || *s == '_')
s++;
while (s < bufend && isspace(*s))
s++;
- if (*s == ',')
+ if (*s == ',') {
+ *s = '\0';
+ word = instr(
+ "tell eof times getlogin wait length shift umask getppid \
+ cos exp int log rand sin sqrt ord wantarray",
+ word);
+ *s = ',';
+ if (word)
+ return;
fatal("No comma allowed after %s", what);
+ }
}
}
}
e = tokenbuf + len;
for (d=tokenbuf; d < e; d++) {
- if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') ||
- (*d == '@' && d[-1] != '\\')) {
+ if (*d == '\\')
+ d++;
+ else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
+ (*d == '@')) {
register ARG *arg;
spat->spat_runtime = arg = op_new(1);
d = scanreg(d,bufend,buf);
(void)stabent(buf,TRUE); /* make sure it's created */
for (; d < e; d++) {
- if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
+ if (*d == '\\')
+ d++;
+ else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
d = scanreg(d,bufend,buf);
(void)stabent(buf,TRUE);
}
- else if (*d == '@' && d[-1] != '\\') {
+ else if (*d == '@') {
d = scanreg(d,bufend,buf);
if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
strEQ(buf,"SIG") || strEQ(buf,"INC"))
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,1);
+ 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.
*/
int len;
int *retlen;
{
- char t[512];
+ char t[520];
register char *d = t;
register int i;
register char *send = s + len;
- while (s < send) {
+ while (s < send && d - t <= 256) {
if (s[1] == '-' && s+2 < send) {
for (i = s[0]; i <= s[2]; i++)
*d++ = i;
bool alwaysdollar = FALSE;
bool hereis = FALSE;
STR *herewas;
+ STR *str;
char *leave = "\\$@nrtfb0123456789[{]}"; /* which backslash sequences to keep */
int len;
}
}
out:
- (void)sprintf(tokenbuf,"%ld",i);
- arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
-#ifdef MICROPORT /* Microport 2.4 hack */
- { double zz = str_2num(arg[1].arg_ptr.arg_str); }
-#else
- (void)str_2num(arg[1].arg_ptr.arg_str);
-#endif /* Microport 2.4 hack */
+ str = Str_new(92,0);
+ str_numset(str,(double)i);
+ if (str->str_ptr) {
+ Safefree(str->str_ptr);
+ str->str_ptr = Nullch;
+ str->str_len = str->str_cur = 0;
+ }
+ arg[1].arg_ptr.arg_str = str;
}
break;
case '1': case '2': case '3': case '4': case '5':
*d++ = *s++;
}
*d = '\0';
- arg[1].arg_ptr.arg_str = str_make(tokenbuf, d - tokenbuf);
-#ifdef MICROPORT /* Microport 2.4 hack */
- { double zz = str_2num(arg[1].arg_ptr.arg_str); }
-#else
- (void)str_2num(arg[1].arg_ptr.arg_str);
-#endif /* Microport 2.4 hack */
+ str = Str_new(92,0);
+ str_numset(str,atof(tokenbuf));
+ if (str->str_ptr) {
+ Safefree(str->str_ptr);
+ str->str_ptr = Nullch;
+ str->str_len = str->str_cur = 0;
+ }
+ arg[1].arg_ptr.arg_str = str;
break;
case '<':
if (*++s == '<') {
}
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();
STR *tmpstr;
char *tmps;
- multi_start = line;
+ multi_start = curcmd->c_line;
if (hereis)
multi_open = multi_close = '<';
else {
while (s < bufend &&
(*s != term || bcmp(s,tokenbuf,len) != 0) ) {
if (*s++ == '\n')
- line++;
+ curcmd->c_line++;
}
if (s >= bufend) {
- line = multi_start;
+ curcmd->c_line = multi_start;
fatal("EOF in string");
}
str_nset(tmpstr,d+1,s-d);
bufend = linestr->str_ptr + linestr->str_cur;
hereis = FALSE;
}
+ else
+ str_nset(tmpstr,"",0); /* avoid "uninitialized" warning */
}
else
s = str_append_till(tmpstr,s+1,bufend,term,leave);
while (s >= bufend) { /* multiple line string? */
if (!rsfp ||
!(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
- line = multi_start;
+ curcmd->c_line = multi_start;
fatal("EOF in string");
}
- line++;
+ curcmd->c_line++;
if (perldb) {
STR *str = Str_new(88,0);
str_sset(str,linestr);
- astore(lineary,(int)line,str);
+ astore(lineary,(int)curcmd->c_line,str);
}
bufend = linestr->str_ptr + linestr->str_cur;
if (hereis) {
else
s = str_append_till(tmpstr,s,bufend,term,leave);
}
- multi_end = line;
+ multi_end = curcmd->c_line;
s++;
if (tmpstr->str_cur + 5 < tmpstr->str_len) {
tmpstr->str_len = tmpstr->str_cur + 1;
send = s + tmpstr->str_cur;
while (s < send) { /* see if we can make SINGLE */
if (*s == '\\' && s[1] && isdigit(s[1]) && !isdigit(s[2]) &&
- !alwaysdollar )
+ !alwaysdollar && s[1] != '0')
*s = '$'; /* grandfather \digit in subst */
if ((*s == '$' || *s == '@') && s+1 < send &&
(alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
Zero(&froot, 1, FCMD);
s = bufptr;
while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) {
- line++;
+ curcmd->c_line++;
if (perldb) {
STR *tmpstr = Str_new(89,0);
str_sset(tmpstr,linestr);
- astore(lineary,(int)line,tmpstr);
+ astore(lineary,(int)curcmd->c_line,tmpstr);
}
if (in_eval && !rsfp) {
eol = index(s,'\n');
again:
if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch)
goto badform;
- line++;
+ curcmd->c_line++;
if (perldb) {
STR *tmpstr = Str_new(90,0);
str_sset(tmpstr,linestr);
- astore(lineary,(int)line,tmpstr);
+ astore(lineary,(int)curcmd->c_line,tmpstr);
}
if (in_eval && !rsfp) {
eol = index(s,'\n');
str = flinebeg->f_unparsed = Str_new(91,eol - s);
str->str_u.str_hash = curstash;
str_nset(str,"(",1);
- flinebeg->f_line = line;
+ flinebeg->f_line = curcmd->c_line;
eol[-1] = '\0';
if (!flinebeg->f_next->f_type || index(s, ',')) {
eol[-1] = '\n';
projects / p5sagit/p5-mst-13.2.git / commitdiff