See patch #42.
-/* $Header: doio.c,v 3.0.1.13 90/11/10 01:17:37 lwall Locked $
+/* $Header: doio.c,v 3.0.1.14 91/01/11 17:51:04 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: doio.c,v $
+ * Revision 3.0.1.14 91/01/11 17:51:04 lwall
+ * patch42: ANSIfied the stat mode checking
+ * patch42: the -i switch is now much more robust and informative
+ * patch42: close on a pipe didn't return failure correctly
+ * patch42: stat on temp values could wipe them out prematurely, i.e. grep(-d,<*>)
+ * patch42: -l didn't work right with _
+ *
* Revision 3.0.1.13 90/11/10 01:17:37 lwall
* patch38: -e _ was wrong if last stat failed
* patch38: more msdos/os2 upgrades
(void)fclose(fp);
return FALSE;
}
- result = (statbuf.st_mode & S_IFMT);
-#ifdef S_IFSOCK
- if (result == S_IFSOCK || result == 0)
+ if (S_ISSOCK(statbuf.st_mode))
stio->type = 's'; /* in case a socket was passed in to us */
+#ifdef S_IFMT
+ else if (!(statbuf.st_mode & S_IFMT))
+ stio->type = 's'; /* some OS's return 0 on fstat()ed socket */
#endif
}
#if defined(FCNTL) && defined(F_SETFD)
{
register STR *str;
char *oldname;
- int filemode,fileuid,filegid;
+ int filedev;
+ int fileino;
+ int filemode;
+ int fileuid;
+ int filegid;
while (alen(stab_xarray(stab)) >= 0) {
str = ashift(stab_xarray(stab));
#ifdef TAINT
taintproper("Insecure dependency in inplace open");
#endif
+ if (strEQ(oldname,"-")) {
+ str_free(str);
+ defoutstab = stabent("STDOUT",TRUE);
+ return stab_io(stab)->ifp;
+ }
+ filedev = statbuf.st_dev;
+ fileino = statbuf.st_ino;
filemode = statbuf.st_mode;
fileuid = statbuf.st_uid;
filegid = statbuf.st_gid;
+ if (!S_ISREG(filemode)) {
+ warn("Can't do inplace edit: %s is not a regular file",
+ oldname );
+ do_close(stab,FALSE);
+ str_free(str);
+ continue;
+ }
if (*inplace) {
#ifdef SUFFIX
add_suffix(str,inplace);
#else
str_cat(str,inplace);
#endif
+#ifndef FLEXFILENAMES
+ if (stat(str->str_ptr,&statbuf) >= 0
+ && statbuf.st_dev == filedev
+ && statbuf.st_ino == fileino ) {
+ warn("Can't do inplace edit: %s > 14 characters",
+ str->str_ptr );
+ do_close(stab,FALSE);
+ str_free(str);
+ continue;
+ }
+#endif
#ifdef RENAME
#ifndef MSDOS
- (void)rename(oldname,str->str_ptr);
+ if (rename(oldname,str->str_ptr) < 0) {
+ warn("Can't rename %s to %s: %s, skipping file",
+ oldname, str->str_ptr, strerror(errno) );
+ do_close(stab,FALSE);
+ str_free(str);
+ continue;
+ }
#else
do_close(stab,FALSE);
(void)unlink(str->str_ptr);
#endif /* MSDOS */
#else
(void)UNLINK(str->str_ptr);
- (void)link(oldname,str->str_ptr);
+ if (link(oldname,str->str_ptr) < 0) {
+ warn("Can't rename %s to %s: %s, skipping file",
+ oldname, str->str_ptr, strerror(errno) );
+ do_close(stab,FALSE);
+ str_free(str);
+ continue;
+ }
(void)UNLINK(oldname);
#endif
}
str_cat(str,oldname);
errno = 0; /* in case sprintf set errno */
if (!do_open(argvoutstab,str->str_ptr,str->str_cur))
- fatal("Can't do inplace edit");
+ warn("Can't do inplace edit on %s: %s",
+ oldname, strerror(errno) );
defoutstab = argvoutstab;
#ifdef FCHMOD
(void)fchmod(fileno(stab_io(argvoutstab)->ifp),filemode);
return stab_io(stab)->ifp;
}
else
- fprintf(stderr,"Can't open %s\n",str_get(str));
+ fprintf(stderr,"Can't open %s: %s\n",str_get(str), strerror(errno));
str_free(str);
}
if (inplace) {
if (stio->ifp) {
if (stio->type == '|') {
status = mypclose(stio->ifp);
- retval = (status >= 0);
+ retval = (status == 0);
statusvalue = (unsigned short)status & 0xffff;
}
else if (stio->type == '-')
max = 0;
}
else {
- str_sset(statname,ary->ary_array[sp]);
+ str_set(statname,str_get(ary->ary_array[sp]));
statstab = Nullstab;
#ifdef LSTAT
if (arg->arg_type == O_LSTAT)
}
else {
statstab = Nullstab;
- str_sset(statname,str);
+ str_set(statname,str_get(str));
return (laststatval = stat(str_get(str),&statcache));
}
}
+int
+mylstat(arg,str)
+ARG *arg;
+STR *str;
+{
+ if (arg[1].arg_type & A_DONT)
+ fatal("You must supply explicit filename with -l");
+
+ statstab = Nullstab;
+ str_set(statname,str_get(str));
+#ifdef LSTAT
+ return (laststatval = lstat(str_get(str),&statcache));
+#else
+ return (laststatval = stat(str_get(str),&statcache));
+#endif
+}
+
STR *
do_fttext(arg,str)
register ARG *arg;
}
else {
statstab = Nullstab;
- str_sset(statname,str);
+ str_set(statname,str_get(str));
really_filename:
i = open(str_get(str),0);
if (i < 0)
}
else { /* don't let root wipe out directories without -U */
#ifdef LSTAT
- if (lstat(s,&statbuf) < 0 ||
+ if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
#else
- if (stat(s,&statbuf) < 0 ||
+ if (stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
#endif
- (statbuf.st_mode & S_IFMT) == S_IFDIR )
tot--;
else {
if (UNLINK(s))
register struct stat *statbufp;
{
if ((effective ? euid : uid) == 0) { /* root is special */
- if (bit == S_IEXEC) {
- if (statbufp->st_mode & 0111 ||
- (statbufp->st_mode & S_IFMT) == S_IFDIR )
+ if (bit == S_IXUSR) {
+ if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
return TRUE;
}
else
-/* $Header: dolist.c,v 3.0.1.11 90/11/10 01:29:49 lwall Locked $
+/* $Header: dolist.c,v 3.0.1.12 91/01/11 17:54:58 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dolist.c,v $
+ * Revision 3.0.1.12 91/01/11 17:54:58 lwall
+ * patch42: added binary and hex pack/unpack options
+ * patch42: sort subroutines didn't allow copying $a or $b to other variables.
+ * patch42: caller() coredumped when called outside the debugger.
+ *
* Revision 3.0.1.11 90/11/10 01:29:49 lwall
* patch38: temp string values are now copied less often
* patch38: sort parameters are now in the right package
register char *patend = pat + st[sp]->str_cur;
int datumtype;
register int len;
+ register int bits;
+ static char hexchar[] = "0123456789abcdef";
/* These must not be in registers: */
short ashort;
if (gimme != G_ARRAY) { /* arrange to do first one only */
for (patend = pat; !isalpha(*patend); patend++);
- if (*patend == 'a' || *patend == 'A' || *pat == '%') {
+ if (index("aAbBhH", *patend) || *pat == '%') {
patend++;
while (isdigit(*patend) || *patend == '*')
patend++;
datumtype = *pat++;
if (pat >= patend)
len = 1;
- else if (*pat == '*')
+ else if (*pat == '*') {
len = strend - strbeg; /* long enough */
+ pat++;
+ }
else if (isdigit(*pat)) {
len = *pat++ - '0';
while (isdigit(*pat))
}
(void)astore(stack, ++sp, str_2static(str));
break;
+ case 'B':
+ case 'b':
+ if (pat[-1] == '*' || len > (strend - s) * 8)
+ len = (strend - s) * 8;
+ str = Str_new(35, len + 1);
+ str->str_cur = len;
+ str->str_pok = 1;
+ aptr = pat; /* borrow register */
+ pat = str->str_ptr;
+ if (datumtype == 'b') {
+ aint = len;
+ for (len = 0; len < aint; len++) {
+ if (len & 7)
+ bits >>= 1;
+ else
+ bits = *s++;
+ *pat++ = '0' + (bits & 1);
+ }
+ }
+ else {
+ aint = len;
+ for (len = 0; len < aint; len++) {
+ if (len & 7)
+ bits <<= 1;
+ else
+ bits = *s++;
+ *pat++ = '0' + ((bits & 128) != 0);
+ }
+ }
+ *pat = '\0';
+ pat = aptr; /* unborrow register */
+ (void)astore(stack, ++sp, str_2static(str));
+ break;
+ case 'H':
+ case 'h':
+ if (pat[-1] == '*' || len > (strend - s) * 2)
+ len = (strend - s) * 2;
+ str = Str_new(35, len);
+ str->str_cur = len;
+ str->str_pok = 1;
+ aptr = pat; /* borrow register */
+ pat = str->str_ptr;
+ if (datumtype == 'h') {
+ aint = len;
+ for (len = 0; len < aint; len++) {
+ if (len & 1)
+ bits >>= 4;
+ else
+ bits = *s++;
+ *pat++ = hexchar[bits & 15];
+ }
+ }
+ else {
+ aint = len;
+ for (len = 0; len < aint; len++) {
+ if (len & 1)
+ bits <<= 4;
+ else
+ bits = *s++;
+ *pat++ = hexchar[(bits >> 4) & 15];
+ }
+ }
+ *pat = '\0';
+ pat = aptr; /* unborrow register */
+ (void)astore(stack, ++sp, str_2static(str));
+ break;
case 'c':
if (len > strend - s)
len = strend - s;
register int i = sp - arglast[1];
int oldsave = savestack->ary_fill;
SPAT *oldspat = curspat;
+ int oldtmps_base = tmps_base;
savesptr(&stab_val(defstab));
+ tmps_base = tmps_max;
if ((arg[1].arg_type & A_MASK) != A_EXPR) {
arg[1].arg_type &= A_MASK;
dehoist(arg,1);
curspat = oldspat;
}
restorelist(oldsave);
+ tmps_base = oldtmps_base;
if (gimme != G_ARRAY) {
str_numset(str,(double)(dst - arglast[1]));
STABSET(str);
if (*up = st[i]) {
if (!(*up)->str_pok)
(void)str_2ptr(*up);
+ else
+ (*up)->str_pok &= ~SP_TEMP;
up++;
}
}
for (;;) {
if (!csv)
return sp;
- if (csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
+ if (DBsub && csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
count++;
if (!count--)
break;
-/* $Header: eval.c,v 3.0.1.10 90/11/10 01:33:22 lwall Locked $
+/* $Header: eval.c,v 3.0.1.11 91/01/11 17:58:30 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: eval.c,v $
+ * Revision 3.0.1.11 91/01/11 17:58:30 lwall
+ * patch42: ANSIfied the stat mode checking
+ * patch42: perl -D14 crashed on ..
+ * patch42: waitpid() emulation was useless because of #ifdef WAITPID
+ *
* Revision 3.0.1.10 90/11/10 01:33:22 lwall
* patch38: random cleanup
* patch38: couldn't return from sort routine
stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
ary = stab_array(stab);
afill(ary,maxarg - 1);
+ anum = maxarg;
st += arglast[0]+1;
while (maxarg-- > 0)
ary->ary_array[maxarg] = str_smake(st[maxarg]);
+ st -= arglast[0]+1;
goto array_return;
}
arg->arg_type = optype = O_RANGE;
break;
#endif
case O_WAITPID:
-#ifdef WAITPID
+#ifdef WAIT
#ifndef lint
anum = (int)str_gnum(st[1]);
optype = (int)str_gnum(st[2]);
if (same_dirent(tmps2, tmps)) /* can always rename to same name */
anum = 1;
else {
- if (euid || stat(tmps2,&statbuf) < 0 ||
- (statbuf.st_mode & S_IFMT) != S_IFDIR )
+ if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
(void)UNLINK(tmps2);
if (!(anum = link(tmps,tmps2)))
anum = UNLINK(tmps);
case O_FTRREAD:
argtype = 0;
- anum = S_IREAD;
+ anum = S_IRUSR;
goto check_perm;
case O_FTRWRITE:
argtype = 0;
- anum = S_IWRITE;
+ anum = S_IWUSR;
goto check_perm;
case O_FTREXEC:
argtype = 0;
- anum = S_IEXEC;
+ anum = S_IXUSR;
goto check_perm;
case O_FTEREAD:
argtype = 1;
- anum = S_IREAD;
+ anum = S_IRUSR;
goto check_perm;
case O_FTEWRITE:
argtype = 1;
- anum = S_IWRITE;
+ anum = S_IWUSR;
goto check_perm;
case O_FTEEXEC:
argtype = 1;
- anum = S_IEXEC;
+ anum = S_IXUSR;
check_perm:
if (mystat(arg,st[1]) < 0)
goto say_undef;
goto donumset;
case O_FTSOCK:
-#ifdef S_IFSOCK
- anum = S_IFSOCK;
- goto check_file_type;
-#else
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if (S_ISSOCK(statcache.st_mode))
+ goto say_yes;
goto say_no;
-#endif
case O_FTCHR:
- anum = S_IFCHR;
- goto check_file_type;
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if (S_ISCHR(statcache.st_mode))
+ goto say_yes;
+ goto say_no;
case O_FTBLK:
-#ifdef S_IFBLK
- anum = S_IFBLK;
- goto check_file_type;
-#else
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if (S_ISBLK(statcache.st_mode))
+ goto say_yes;
goto say_no;
-#endif
case O_FTFILE:
- anum = S_IFREG;
- goto check_file_type;
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if (S_ISREG(statcache.st_mode))
+ goto say_yes;
+ goto say_no;
case O_FTDIR:
- anum = S_IFDIR;
- check_file_type:
if (mystat(arg,st[1]) < 0)
goto say_undef;
- if ((statcache.st_mode & S_IFMT) == anum )
+ if (S_ISDIR(statcache.st_mode))
goto say_yes;
goto say_no;
case O_FTPIPE:
-#ifdef S_IFIFO
- anum = S_IFIFO;
- goto check_file_type;
-#else
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if (S_ISFIFO(statcache.st_mode))
+ goto say_yes;
goto say_no;
-#endif
case O_FTLINK:
- if (arg[1].arg_type & A_DONT)
- fatal("You must supply explicit filename with -l");
-#ifdef LSTAT
- if (lstat(str_get(st[1]),&statcache) < 0)
+ if (mylstat(arg,st[1]) < 0)
goto say_undef;
- if ((statcache.st_mode & S_IFMT) == S_IFLNK )
+ if (S_ISLNK(statcache.st_mode))
goto say_yes;
-#endif
goto say_no;
case O_SYMLINK:
#ifdef SYMLINK
* kit sizes from getting too big.
*/
-/* $Header: evalargs.xc,v 3.0.1.8 90/11/10 01:35:49 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.9 91/01/11 18:00:18 lwall Locked $
*
* $Log: evalargs.xc,v $
+ * Revision 3.0.1.9 91/01/11 18:00:18 lwall
+ * patch42: <> input to individual array elements was suboptimal
+ *
* Revision 3.0.1.8 90/11/10 01:35:49 lwall
* patch38: array slurps are now faster and take less memory
*
}
if (!fp && dowarn)
warn("Read on closed filehandle <%s>",stab_name(last_in_stab));
+ when = str->str_len; /* remember if already alloced */
+ if (!when)
+ Str_Grow(str,80); /* try short-buffering it */
keepgoing:
if (!fp)
st[sp] = &str_undef;
str = Str_new(58,80);
goto keepgoing;
}
+ else if (!when && str->str_len - str->str_cur > 80) {
+ /* try to reclaim a bit of scalar space on 1st alloc */
+ if (str->str_cur < 60)
+ str->str_len = 80;
+ else
+ str->str_len = str->str_cur+40; /* allow some slop */
+ Renew(str->str_ptr, str->str_len, char);
+ }
}
record_separator = old_record_separator;
#ifdef DEBUGGING
-/* $Header: form.c,v 3.0.1.3 90/10/15 17:26:24 lwall Locked $
+/* $Header: form.c,v 3.0.1.4 91/01/11 18:04:07 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: form.c,v $
+ * Revision 3.0.1.4 91/01/11 18:04:07 lwall
+ * patch42: the @* format counted lines wrong
+ * patch42: the @* format didn't handle lines with nulls or without newline
+ *
* Revision 3.0.1.3 90/10/15 17:26:24 lwall
* patch29: added @###.## fields to format
*
str = stack->ary_array[sp+1];
s = str_get(str);
size = str_len(str);
- CHKLEN(size);
- orec->o_lines += countlines(s);
+ CHKLEN(size+1);
+ orec->o_lines += countlines(s,size) - 1;
(void)bcopy(s,d,size);
d += size;
+ if (size && s[size-1] != '\n') {
+ *d++ = '\n';
+ orec->o_lines++;
+ }
linebeg = fcmd->f_next;
break;
case F_DECIMAL: {
(void)eval(fcmd->f_expr,G_SCALAR,sp);
str = stack->ary_array[sp+1];
+ size = fcmd->f_size;
+ CHKLEN(size);
/* If the field is marked with ^ and the value is undefined,
blank it out. */
if ((fcmd->f_flags & FC_CHOP) && !str->str_pok && !str->str_nok) {
break;
}
value = str_gnum(str);
- size = fcmd->f_size;
- CHKLEN(size);
if (fcmd->f_flags & FC_DP) {
sprintf(d, "%#*.*f", size, fcmd->f_decimals, value);
} else {
*d++ = '\0';
}
-countlines(s)
+countlines(s,size)
register char *s;
+register int size;
{
register int count = 0;
- while (*s) {
+ while (size--) {
if (*s++ == '\n')
count++;
}
--- /dev/null
+#!./perl
+
+while (@ARGV) {
+ $nonono = 1 if $ARGV[0] eq '-n';
+ $versiononly = 1 if $ARGV[0] eq '-v';
+ shift;
+}
+
+@scripts = 'h2ph';
+@manpages = ('perl.man', 'h2ph.man');
+
+# Read in the config file.
+
+open(CONFIG, "config.sh") || die "You haven't run Configure yet!\n";
+while (<CONFIG>) {
+ if (s/^(\w+=)/\$$1/) {
+ $accum =~ s/'undef'/undef/g;
+ eval $accum;
+ $accum = '';
+ }
+ $accum .= $_;
+}
+
+# Do some quick sanity checks.
+
+if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
+
+ $bin || die "No bin directory in config.sh\n";
+-d $bin || die "$bin is not a directory\n";
+-w $bin || die "$bin is not writable by you\n";
+
+-x 'perl' || die "perl isn't executable!\n";
+-x 'taintperl' || die "taintperl isn't executable!\n";
+-x 'suidperl' || die "suidperl isn't executable!\n" if $d_dosuid;
+
+-x 't/TEST' || die "You've never run 'make test'!\n";
+
+# First we install the version-numbered executables.
+
+$ver = sprintf("%5.3f", $]);
+
+&unlink("$bin/perl$ver");
+&cmd("cp perl $bin/perl$ver");
+
+&unlink("$bin/tperl$ver");
+&cmd("cp taintperl $bin/tperl$ver");
+&chmod(0755, "$bin/tperl$ver"); # force non-suid for security
+
+&unlink("$bin/sperl$ver");
+if ($d_dosuid) {
+ &cmd("cp suidperl $bin/sperl$ver");
+ &chmod(04711, "$bin/sperl$ver");
+}
+
+exit 0 if $versiononly;
+
+# Make links to ordinary names if bin directory isn't current directory.
+
+($bdev,$bino) = stat($bin);
+($ddev,$dino) = stat('.');
+
+if ($bdev != $ddev || $bino != $dino) {
+ &unlink("$bin/perl", "$bin/taintperl", "$bin/suidperl");
+ &link("$bin/perl$ver", "$bin/perl");
+ &link("$bin/tperl$ver", "$bin/taintperl");
+ &link("$bin/sperl$ver", "$bin/suidperl") if $d_dosuid;
+}
+
+# Make some enemies in the name of standardization. :-)
+
+($udev,$uino) = stat("/usr/bin");
+
+if (($udev != $ddev || $uino != $dino) && !$nonono) {
+ unlink "/usr/bin/perl";
+ eval 'symlink("$bin/perl", "/usr/bin/perl")' ||
+ eval 'link("$bin/perl", "/usr/bin/perl")' ||
+ &cmd("cp $bin/perl /usr/bin");
+}
+
+# Install scripts.
+
+&makedir($scriptdir);
+
+for (@scripts) {
+ &chmod(0755, $_);
+ &cmd("cp $_ $scriptdir");
+}
+
+# Install library files.
+
+&makedir($privlib);
+
+($pdev,$pino) = stat($privlib);
+
+if ($pdev != $ddev || $pino != $dino) {
+ &cmd("cd lib && cp *.pl $privlib");
+}
+
+# Install man pages.
+
+&makedir($mansrc);
+
+($mdev,$mino) = stat($mansrc);
+if ($mdev != $ddev || $mino != $dino) {
+ for (@manpages) {
+ ($new = $_) =~ s/man$/$manext/;
+ &cmd("cp $_ $mansrc/$new");
+ }
+}
+
+print STDERR " Installation complete\n";
+
+exit 0;
+
+###############################################################################
+
+sub unlink {
+ local(@names) = @_;
+
+ foreach $name (@names) {
+ next unless -e $name;
+ print STDERR " unlink $name\n";
+ unlink($name) || warn "Couldn't unlink $name: $!\n" unless $nonono;
+ }
+}
+
+sub cmd {
+ local($cmd) = @_;
+ print STDERR " $cmd\n";
+ unless ($nonono) {
+ system $cmd;
+ warn "Command failed!!!\n" if $?;
+ }
+}
+
+sub link {
+ local($from,$to) = @_;
+
+ print STDERR " ln $from $to\n";
+ link($from,$to) || warn "Couldn't link $from to $to: $!\n" unless $nonono;
+}
+
+sub chmod {
+ local($mode,$name) = @_;
+
+ printf STDERR " chmod %o %s\n", $mode, $name;
+ chmod($mode,$name) || warn "Couldn't chmod $mode $name: $!\n"
+ unless $nonono;
+}
+
+sub makedir {
+ local($dir) = @_;
+ unless (-d $dir) {
+ local($shortdir) = $dir;
+
+ $shortdir =~ s#(.*)/.*#$1#;
+ &makedir($shortdir);
+
+ print STDERR " mkdir $dir\n";
+ mkdir($dir, 0777) || warn "Couldn't create $dir: $!\n" unless $nonono;
+ }
+}
-/* $Header: malloc.c,v 3.0.1.4 90/11/13 15:23:45 lwall Locked $
+/* $Header: malloc.c,v 3.0.1.5 91/01/11 18:09:52 lwall Locked $
*
* $Log: malloc.c,v $
+ * Revision 3.0.1.5 91/01/11 18:09:52 lwall
+ * patch42: Configure now checks alignment requirements
+ *
* Revision 3.0.1.4 90/11/13 15:23:45 lwall
* patch41: added hp malloc union overhead strut (that sounds very blue collar)
*
*/
union overhead {
union overhead *ov_next; /* when free */
-#if defined(mips) || defined(sparc) || defined(luna88k) || defined(hp9000s800)
- double strut; /* alignment problems */
+#if ALIGNBYTES > 4
+ double strut; /* alignment problems */
#endif
struct {
u_char ovu_magic; /* magic number */
-#define PATCHLEVEL 42
+#define PATCHLEVEL 43
-/* $Header: perl.h,v 3.0.1.10 90/11/10 01:44:13 lwall Locked $
+/* $Header: perl.h,v 3.0.1.11 91/01/11 18:10:57 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.h,v $
+ * Revision 3.0.1.11 91/01/11 18:10:57 lwall
+ * patch42: ANSIfied the stat mode checking
+ *
* Revision 3.0.1.10 90/11/10 01:44:13 lwall
* patch38: more msdos/os2 upgrades
*
# endif
#endif
+/*
+ * The following gobbledygook brought to you on behalf of __STDC__.
+ * (I could just use #ifndef __STDC__, but this is more bulletproof
+ * in the face of half-implementations.)
+ */
+
+#ifndef S_IFMT
+# ifdef _S_IFMT
+# define S_IFMT _S_IFMT
+# else
+# define S_IFMT 0170000
+# endif
+#endif
+
+#ifndef S_ISDIR
+# define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
+#endif
+
+#ifndef S_ISCHR
+# define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
+#endif
+
+#ifndef S_ISBLK
+# define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
+#endif
+
+#ifndef S_ISREG
+# define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
+#endif
+
+#ifndef S_ISFIFO
+# define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
+#endif
+
+#ifndef S_ISLNK
+# ifdef _S_ISLNK
+# define S_ISLNK(m) _S_ISLNK(m)
+# else
+# ifdef _S_IFLNK
+# define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
+# else
+# ifdef S_IFLNK
+# define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
+# else
+# define S_ISLNK(m) (0)
+# endif
+# endif
+# endif
+#endif
+
+#ifndef S_ISSOCK
+# ifdef _S_ISSOCK
+# define S_ISSOCK(m) _S_ISSOCK(m)
+# else
+# ifdef _S_IFSOCK
+# define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
+# else
+# ifdef S_IFSOCK
+# define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
+# else
+# define S_ISSOCK(m) (0)
+# endif
+# endif
+# endif
+#endif
+
+#ifndef S_IRUSR
+# ifdef S_IREAD
+# define S_IRUSR S_IREAD
+# define S_IWUSR S_IWRITE
+# define S_IXUSR S_IEXEC
+# else
+# define S_IRUSR 0400
+# define S_IWUSR 0200
+# define S_IXUSR 0100
+# endif
+# define S_IRGRP (S_IRUSR>>3)
+# define S_IWGRP (S_IWUSR>>3)
+# define S_IXGRP (S_IXUSR>>3)
+# define S_IROTH (S_IRUSR>>6)
+# define S_IWOTH (S_IWUSR>>6)
+# define S_IXOTH (S_IXUSR>>6)
+#endif
+
+#ifndef S_ISUID
+# define S_ISUID 04000
+#endif
+
+#ifndef S_ISGID
+# define S_ISGID 02000
+#endif
+
typedef unsigned int STRLEN;
typedef struct arg ARG;
-/* $Header: perl.y,v 3.0.1.9 90/10/15 18:01:45 lwall Locked $
+/* $Header: perl.y,v 3.0.1.10 91/01/11 18:14:28 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.y,v $
+ * Revision 3.0.1.10 91/01/11 18:14:28 lwall
+ * patch42: package didn't create symbol tables that could be reset
+ * patch42: split with no arguments could wipe out next operator
+ *
* Revision 3.0.1.9 90/10/15 18:01:45 lwall
* patch29: added SysV IPC
* patch29: package behavior is now more consistent
saveitem(curstname);
str_set(curstname,$2);
sprintf(tmpbuf,"'_%s",$2);
- tmpstab = hadd(stabent(tmpbuf,TRUE));
+ tmpstab = stabent(tmpbuf,TRUE);
+ if (!stab_xhash(tmpstab))
+ stab_xhash(tmpstab) = hnew(0);
curstash = stab_xhash(tmpstab);
if (!curstash->tbl_name)
curstash->tbl_name = savestr($2);
aadd(stabent(subline ? "_" : "ARGV", TRUE))),
Nullarg, Nullarg); }
| SPLIT %prec '('
-{static char p[]="/\\s+/";char*o=bufend;bufend=p+5;(void)scanpat(p);bufend=o;
- $$ = make_split(defstab,yylval.arg,Nullarg); }
+ { static char p[]="/\\s+/";
+ char *oldend = bufend;
+ int oldarg = yylval.arg;
+
+ bufend=p+5;
+ (void)scanpat(p);
+ bufend=oldend;
+ $$ = make_split(defstab,yylval.arg,Nullarg);
+ yylval.arg = oldarg; }
| SPLIT '(' sexpr csexpr csexpr ')'
{ $$ = mod_match(O_MATCH, $4,
make_split(defstab,$3,$5));}
#!./perl
-# $Header: op.dbm,v 3.0.1.1 90/03/27 16:25:57 lwall Locked $
+# $Header: op.dbm,v 3.0.1.2 91/01/11 18:29:12 lwall Locked $
if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h') {
print "1..0\n";
print "1..10\n";
-unlink 'Op.dbmx.dir', 'Op.dbmx.pag';
+unlink <Op.dbmx.*>;
umask(0);
print (dbmopen(h,'Op.dbmx',0640) ? "ok 1\n" : "not ok 1\n");
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
#!./perl
-# $Header: op.mkdir,v 3.0.1.3 90/03/12 17:03:57 lwall Locked $
+# $Header: op.mkdir,v 3.0.1.4 91/01/11 18:30:00 lwall Locked $
print "1..7\n";
print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n");
print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n");
-print ($! =~ /exists/ ? "ok 3\n" : "not ok 3\n");
+print ($! =~ /exist/ ? "ok 3\n" : "not ok 3\n");
print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
projects / p5sagit/p5-mst-13.2.git / commitdiff