Subject: v20i108: Perl, a language with features of C/sed/awk/shell/etc, Patch1 Newsgroups: comp.sources.unix,comp.sources.bugs Sender: sources Approved: rsalz@uunet.UU.NET Followup-To: comp.sources.d Submitted-by: Larry Wall Posting-number: Volume 20, Issue 108 Archive-name: perl3.0/patch1 [ IMPORTANT! PLEASE READ THIS NOTE: This is the first patch for PERL3.0. There might be others. If you are retrieving this from a comp.sources.unix archive site, that site MIGHT NOT have all the latest patches: patches don't always get posted to c.s.u, for a variety of reasons. (If you questions or problems with this, please mail to rsalz@uunet.uu.net.) This patch, as with all of Larry Wall's patches, contains information on how to get all the later patches. If you cannot subscribe to comp.sources.bugs, SAVE THIS and use the instructions below to get the new patches. Thank you for your cooperation. If you follow these guidelines, you will reduce needless net and email bandwith, and make it easier on the moderator, and the archive sites. /r$ ] System: perl version 3.0 Patch #: 1 Priority: MEDIUM-HIGH Subject: Configure now includes user's PATH Subject: Configure decides whether to include Subject: Configure checks Sun shared library in preference to /lib/libc.a Subject: Fixed Configure typo of -fpcc-struct-return Subject: Configure figures out if BSD shadow passwords are installed Subject: Clarified prompts regarding gid and uid types Subject: Makefile.SH needed some more .h dependecies Subject: Documented that "make test" is needed before "cd t; TEST" Subject: reverse didn't work Subject: heuristically disabled optimization could cause core dump Subject: unless was broken when run under the debugger Subject: Configure vfork test was backwards Subject: numeric switch optimization was broken Subject: Configure now checks for BSD shadow passwords Subject: split in a subroutine wrongly freed referenced arguments Subject: glob didn't free a temporary string Subject: RCS expanded an unintended $Header in lib/perldb.pl Subject: some declarations were missing from malloc.c Subject: sparc machines had alignment problems in malloc.c Subject: vfork now conditionally defined based on VFORK Subject: DEC risc machines have a buggy memcmp Subject: perl.h now includes if it exists Subject: documented the desirability of unnecessary parentheses Subject: grandfathered "format stdout" Subject: operator(); is now normally equivalent to operator; Subject: string ordering tests were wrong Subject: $/ now works even when STDSTDIO undefined Subject: rearranged some structures to align doubles better on Gould Subject: added regression tests for reverse Subject: disambiguated word after "sort" better Subject: declared bcopy if necessary Subject: in x2p/Makefile.SH, added dependency on ../config.sh Description: Configure had difficulties if the user's path had weird components. Now Configure appends the user's path to its own. Some machines need included in order to define certain macros for packing or unpacking network order data. On Suns, the shared library is used by default. If it doesn't contain something contained in /lib/libc.a, then Configure was getting things wrong (such as gethostent()). Now Configure uses the shared library if it's there in preference to libc.a. When gcc was selected as the compiler, the cc flags defaulted to -fpcc_struct_return. Unfortunately, the underlines should be hyphens. Configure figures out if BSD shadow passwords are installed and the getpw* routines now return slightly different data in the affected fields. Some of the prompts in Configure with regard to gid and uid types were unclear as to their intended use. They are now a little clearer. Sometimes you could change a .h file and taintperl and suidperl didn't get remade correctly because of missing dependencies in the Makefile. The README file was misleading about the fact that you have to say "make test" before you can "cd t; TEST" The reverse operator was busted in two different ways. Should work better now. There are now regression tests for it. Some of the optimizations that perl does are disabled after period of time if perl decides they aren't doing any good. One of these caused a string to be freed that was later referenced via another pointer, causing core dumps. The free turned out to be unnecessary, so it was removed. The unless modifier was broken when run under the debugger, due to the invert() routine in perl.y inverting the logic on the DB subroutine call instead of the command the unless was modifying. Configure vfork test was backwards. It now works like other defines. The numeric switch optimization was broken, and caused code to be bypassed. This has been fixed. A split in a subroutine that has no target splits into @_. Unfortunately, this wrongly freed any referenced arguments passed in through @_, causing confusing behavior later in the program. File globbing () left one orphaned string each time it called the shell to do the glob. RCS expanded an unintended $Header in lib/perldb.pl. This has been fixed simply by replacing the $ with a . Some forward declarations of static functions were missing from malloc.c. There's a strut in malloc for mips machines to extend the overhead union to the size of a double. This was also enabled for sparc machines. DEC risc machines are reported to have a buggy memcmp. I've put some conditional code into perl.h which I think will undef MEMCMP appropriately. In perl.man.4, I documented the desirability of using parens even where they aren't strictly necessary. I've grandfathered "format stdout" to be the same as "format STDOUT". Unary operators can be called with no argument. The corresponding function call form using empty parens () didn't work right, though it did for certain functions in 2.0. It now works in 3.0. The string ordering tests were wrong for pairs of strings in which one string was a prefix of the other. This affected lt, le, gt, ge, and the sort operator when used with no subroutine. $/ didn't work with the stupid code used when STDSTDIO was undefined. The stupid code has been replaced with smarter code that can do it right. Special thanks to Piet van Oostrum for the code. Goulds work better if the union in STR is at an 8 byte boundary. The fields were rearranged somewhat to provide this. "sort keys %a" should now work right (though parens are still desirable for readability). bcopy() needed a forward declaration on some machines. In x2p/Makefile.SH, added dependency on ../config.sh so that it gets linked down from above if it got removed for some reason. 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 1 Index: Configure Prereq: 3.0 *** Configure.old Thu Oct 26 23:29:20 1989 --- Configure Thu Oct 26 23:29:22 1989 *************** *** 8,14 **** # and edit it to reflect your system. Some packages may include samples # of config.h for certain machines, so you might look for one of those.) # ! # $Header: Configure,v 3.0 89/10/18 15:04:55 lwall Locked $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than --- 8,14 ---- # and edit it to reflect your system. Some packages may include samples # of config.h for certain machines, so you might look for one of those.) # ! # $Header: Configure,v 3.0.1.1 89/10/26 22:58:02 lwall Locked $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than *************** *** 15,21 **** # working with this copy of Configure, you may wish to get metaconfig.) : sanity checks ! PATH='.:/bin:/usr/bin:/usr/local/bin:/usr/ucb:/usr/local:/usr/lbin:/etc:/usr/new:/usr/new/bin:/usr/nbin' export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh $0; kill $$) if test ! -t 0; then --- 15,21 ---- # working with this copy of Configure, you may wish to get metaconfig.) : sanity checks ! PATH=".:/bin:/usr/bin:/usr/local/bin:/usr/ucb:/usr/local:/usr/lbin:/etc:/usr/new:/usr/new/bin:/usr/nbin:$PATH" export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh $0; kill $$) if test ! -t 0; then *************** *** 157,162 **** --- 157,163 ---- d_dirnamlen='' i_fcntl='' i_grp='' + i_niin='' i_pwd='' d_pwquota='' d_pwage='' *************** *** 424,430 **** cpp egrep test - uname " for file in $loclist; do xxx=`loc $file $file $pth` --- 425,430 ---- *************** *** 513,533 **** rmlist="$rmlist loc" : get list of predefined functions in a handy place - if $test -n "$uname"; then - os=`$uname -s` - else - os=unknown - fi echo " " ! if test -f /lib/libc.a; then echo "Your C library is in /lib/libc.a. You're normal." libc=/lib/libc.a else ! if test "$os" = DomainOS ; then ! ans=`loc libc blurfl/dyick $libpth` ! else ! ans=`loc libc.a blurfl/dyick $libpth` ! fi if test ! -f "$ans"; then ans=`loc clib blurfl/dyick $libpth` fi --- 513,529 ---- rmlist="$rmlist loc" : get list of predefined functions in a handy place echo " " ! set /usr/lib/libc.so.[0-9]* ! eval set \$$# ! if test -f "$1"; then ! echo "Your shared C library is in $1." ! libc="$1" ! elif test -f /lib/libc.a; then echo "Your C library is in /lib/libc.a. You're normal." libc=/lib/libc.a else ! ans=`loc libc.a blurfl/dyick $libpth` if test ! -f "$ans"; then ans=`loc clib blurfl/dyick $libpth` fi *************** *** 573,583 **** if $contains '^printf$' libc.list >/dev/null 2>&1; then echo "done" else ! if test "$os" = DomainOS ; then ! $sed -n -e 's/^__*//' -e 's/^\([a-zA-Z_0-9$]*\).*xtern.*/\1/p' libc.list ! else $sed -n -e 's/^.* D __*//p' -e 's/^.* D //p' libc.list - fi $contains '^printf$' libc.list >/dev/null 2>&1 || \ $sed -n -e 's/^_//' \ -e 's/^\([a-zA-Z_0-9]*\).*xtern.*text.*/\1/p' libc.list --- 569,577 ---- if $contains '^printf$' libc.list >/dev/null 2>&1; then echo "done" else ! $sed -n -e 's/^__*//' -e 's/^\([a-zA-Z_0-9$]*\).*xtern.*/\1/p' libc.list ! $contains '^printf$' libc.list >/dev/null 2>&1 || \ $sed -n -e 's/^.* D __*//p' -e 's/^.* D //p' libc.list $contains '^printf$' libc.list >/dev/null 2>&1 || \ $sed -n -e 's/^_//' \ -e 's/^\([a-zA-Z_0-9]*\).*xtern.*text.*/\1/p' libc.list *************** *** 1102,1108 **** case "$ccflags" in '') case "$cc" in ! gcc) dflt='-fpcc_struct_return';; *) dflt='none';; esac ;; --- 1096,1102 ---- case "$ccflags" in '') case "$cc" in ! gcc) dflt='-fpcc-struct-return';; *) dflt='none';; esac ;; *************** *** 1553,1559 **** echo "dbm.h not found." fi ! : see if this is an pwd system echo " " if $test -r /usr/include/pwd.h ; then i_pwd="$define" --- 1547,1553 ---- echo "dbm.h not found." fi ! : see if this is a pwd system echo " " if $test -r /usr/include/pwd.h ; then i_pwd="$define" *************** *** 1568,1577 **** --- 1562,1589 ---- else d_pwage="$undef" fi + if $contains 'pw_change' /usr/include/pwd.h >/dev/null 2>&1; then + d_pwchange="$define" + else + d_pwchange="$undef" + fi + if $contains 'pw_class' /usr/include/pwd.h >/dev/null 2>&1; then + d_pwclass="$define" + else + d_pwclass="$undef" + fi + if $contains 'pw_expire' /usr/include/pwd.h >/dev/null 2>&1; then + d_pwexpire="$define" + else + d_pwexpire="$undef" + fi else i_pwd="$undef" d_pwquota="$undef" d_pwage="$undef" + d_pwchange="$undef" + d_pwclass="$undef" + d_pwexpire="$undef" echo "No pwd.h found." fi *************** *** 1868,1874 **** esac cont=true echo " " ! rp="What type are group ids on this system declared as? [$dflt]" $echo $n "$rp $c" . myread gidtype="$ans" --- 1880,1886 ---- esac cont=true echo " " ! rp="What type are the group ids are returned by getgroups()? [$dflt]" $echo $n "$rp $c" . myread gidtype="$ans" *************** *** 1893,1898 **** --- 1905,1920 ---- echo "No grp.h found." fi + : see if this is a netinet/in.h system + echo " " + if $test -r /usr/include/netinet/in.h ; then + i_niin="$define" + echo "netinet/in.h found." + else + i_niin="$undef" + echo "No netinet/in.h found." + fi + : see if this is a sys/dir.h system echo " " if $test -r /usr/include/sys/dir.h ; then *************** *** 2070,2076 **** esac cont=true echo " " ! rp="What type are user ids on this system declared as? [$dflt]" $echo $n "$rp $c" . myread uidtype="$ans" --- 2092,2098 ---- esac cont=true echo " " ! rp="What type are user ids returned by getuid(), etc.? [$dflt]" $echo $n "$rp $c" . myread uidtype="$ans" *************** *** 2307,2312 **** --- 2329,2335 ---- d_dirnamlen='$d_dirnamlen' i_fcntl='$i_fcntl' i_grp='$i_grp' + i_niin='$i_niin' i_pwd='$i_pwd' d_pwquota='$d_pwquota' d_pwage='$d_pwage' Index: Makefile.SH Prereq: 3.0 *** Makefile.SH.old Thu Oct 26 23:29:29 1989 --- Makefile.SH Thu Oct 26 23:29:31 1989 *************** *** 25,33 **** echo "Extracting Makefile (with variable substitutions)" cat >Makefile <Makefile <Makefile <Makefile <.shlist + + config.sh: ../config.sh + rm -f config.sh + ln ../config.sh . # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE $(obj): Index: README *** README.old Thu Oct 26 23:29:35 1989 --- README Thu Oct 26 23:29:36 1989 *************** *** 65,72 **** This will run the regression tests on the perl you just made. If it doesn't say "All tests successful" then something went wrong. See the README in the t subdirectory. Note that you can't run it ! in background if this disables opening of /dev/tty. If in doubt, just ! cd to the t directory and run TEST by hand. 6) make install --- 65,73 ---- This will run the regression tests on the perl you just made. If it doesn't say "All tests successful" then something went wrong. See the README in the t subdirectory. Note that you can't run it ! in background if this disables opening of /dev/tty. If "make test" ! bombs out, just cd to the t directory and run TEST by hand to see if ! it makes any difference. 6) make install Index: arg.h Prereq: 3.0 *** arg.h.old Thu Oct 26 23:29:41 1989 --- arg.h Thu Oct 26 23:29:43 1989 *************** *** 1,4 **** ! /* $Header: arg.h,v 3.0 89/10/18 15:08:27 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: arg.h,v 3.0.1.1 89/10/26 23:02:35 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: arg.h,v $ + * Revision 3.0.1.1 89/10/26 23:02:35 lwall + * patch1: reverse didn't work + * * Revision 3.0 89/10/18 15:08:27 lwall * 3.0 baseline * *************** *** 805,811 **** A(3,3,0), /* AASSIGN */ A(0,0,0), /* SASSIGN */ A(0,0,0), /* DUMP */ ! A(0,0,0), /* REVERSE */ A(1,0,0), /* ADDROF */ A(1,1,1), /* SOCKET */ A(1,1,0), /* BIND */ --- 808,814 ---- A(3,3,0), /* AASSIGN */ A(0,0,0), /* SASSIGN */ A(0,0,0), /* DUMP */ ! A(0,3,0), /* REVERSE */ A(1,0,0), /* ADDROF */ A(1,1,1), /* SOCKET */ A(1,1,0), /* BIND */ Index: cmd.c Prereq: 3.0 *** cmd.c.old Thu Oct 26 23:29:50 1989 --- cmd.c Thu Oct 26 23:29:52 1989 *************** *** 1,4 **** ! /* $Header: cmd.c,v 3.0 89/10/18 15:09:02 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cmd.c,v 3.0.1.1 89/10/26 23:04:21 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cmd.c,v $ + * Revision 3.0.1.1 89/10/26 23:04:21 lwall + * patch1: heuristically disabled optimization could cause core dump + * * Revision 3.0 89/10/18 15:09:02 lwall * 3.0 baseline * *************** *** 416,423 **** } } if (--cmd->c_short->str_u.str_useful < 0) { - str_free(cmd->c_short); - cmd->c_short = Nullstr; cmdflags &= ~CF_OPTIMIZE; cmdflags |= CFT_EVAL; /* never try this optimization again */ cmd->c_flags = cmdflags; --- 419,424 ---- Index: cmd.h Prereq: 3.0 *** cmd.h.old Thu Oct 26 23:29:55 1989 --- cmd.h Thu Oct 26 23:29:56 1989 *************** *** 1,4 **** ! /* $Header: cmd.h,v 3.0 89/10/18 15:09:15 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cmd.h,v 3.0.1.1 89/10/26 23:05:43 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cmd.h,v $ + * Revision 3.0.1.1 89/10/26 23:05:43 lwall + * patch1: unless was broken when run under the debugger + * * Revision 3.0 89/10/18 15:09:15 lwall * 3.0 baseline * *************** *** 53,58 **** --- 56,62 ---- #define CF_ONCE 010000 /* we've already pushed the label on the stack */ #define CF_FLIP 020000 /* on a match do flipflop */ #define CF_TERM 040000 /* value of this cmd might be returned */ + #define CF_DBSUB 0100000 /* this is an inserted cmd for debugging */ #define CFT_FALSE 0 /* c_expr is always false */ #define CFT_TRUE 1 /* c_expr is always true */ Index: config.h.SH *** config.h.SH.old Thu Oct 26 23:29:59 1989 --- config.h.SH Thu Oct 26 23:30:01 1989 *************** *** 385,395 **** */ #$d_varargs VARARGS /**/ ! /* vfork: ! * This symbol, if defined, remaps the vfork routine to fork if the ! * vfork() routine isn't supported here. */ ! #$d_vfork vfork fork /**/ /* VOIDSIG: * This symbol is defined if this system declares "void (*signal())()" in --- 385,394 ---- */ #$d_varargs VARARGS /**/ ! /* VFORK: ! * This symbol, if defined, indicates that vfork() exists. */ ! #$d_vfork VFORK /**/ /* VOIDSIG: * This symbol is defined if this system declares "void (*signal())()" in *************** *** 443,448 **** --- 442,453 ---- */ #$i_grp I_GRP /**/ + /* I_NETINET_IN: + * This symbol, if defined, indicates to the C program that it should + * include netinet/in.h. + */ + #$i_niin I_NETINET_IN /**/ + /* I_PWD: * This symbol, if defined, indicates to the C program that it should * include pwd.h. *************** *** 455,463 **** --- 460,483 ---- * This symbol, if defined, indicates to the C program that struct passwd * contains pw_age. */ + /* PWCHANGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_change. + */ + /* PWCLASS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_class. + */ + /* PWEXPIRE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_expire. + */ #$i_pwd I_PWD /**/ #$d_pwquota PWQUOTA /**/ #$d_pwage PWAGE /**/ + #$d_pwage PWCHANGE /**/ + #$d_pwage PWCLASS /**/ + #$d_pwage PWEXPIRE /**/ /* I_SYSDIR: * This symbol, if defined, indicates to the C program that it should Index: cons.c Prereq: 3.0 *** cons.c.old Thu Oct 26 23:30:06 1989 --- cons.c Thu Oct 26 23:30:08 1989 *************** *** 1,4 **** ! /* $Header: cons.c,v 3.0 89/10/18 15:10:23 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cons.c,v 3.0.1.1 89/10/26 23:09:01 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: cons.c,v $ + * Revision 3.0.1.1 89/10/26 23:09:01 lwall + * patch1: numeric switch optimization was broken + * patch1: unless was broken when run under the debugger + * * Revision 3.0 89/10/18 15:10:23 lwall * 3.0 baseline * *************** *** 285,295 **** Newz(105,loc, max - min + 3, CMD*); loc++; while (count--) { i = (int)str_gnum(cur->c_short); i -= min; - max -= min; - max++; switch(cur->c_slen) { case O_LE: i++; --- 289,299 ---- Newz(105,loc, max - min + 3, CMD*); loc++; + max -= min; + max++; while (count--) { i = (int)str_gnum(cur->c_short); i -= min; switch(cur->c_slen) { case O_LE: i++; *************** *** 314,319 **** --- 318,324 ---- } loc--; min--; + max++; for (i = 0; i <= max; i++) if (!loc[i]) loc[i] = cur; *************** *** 378,384 **** stab2arg(A_WORD,DBstab), make_list(arg), Nullarg); ! cmd->c_flags |= CF_COND; cmd->c_line = head->c_line; cmd->c_label = head->c_label; cmd->c_file = filename; --- 383,389 ---- stab2arg(A_WORD,DBstab), make_list(arg), Nullarg); ! cmd->c_flags |= CF_COND|CF_DBSUB; cmd->c_line = head->c_line; cmd->c_label = head->c_label; cmd->c_file = filename; *************** *** 797,808 **** CMD * invert(cmd) ! register CMD *cmd; { ! if (cmd->c_head) ! cmd->c_head->c_flags ^= CF_INVERT; ! else ! cmd->c_flags ^= CF_INVERT; return cmd; } --- 802,815 ---- CMD * invert(cmd) ! CMD *cmd; { ! register CMD *targ = cmd; ! if (targ->c_head) ! targ = targ->c_head; ! if (targ->c_flags & CF_DBSUB) ! targ = targ->c_next; ! targ->c_flags ^= CF_INVERT; return cmd; } Index: doio.c Prereq: 3.0 *** doio.c.old Thu Oct 26 23:30:14 1989 --- doio.c Thu Oct 26 23:30:16 1989 *************** *** 1,4 **** ! /* $Header: doio.c,v 3.0 89/10/18 15:10:54 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doio.c,v 3.0.1.1 89/10/26 23:10:05 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doio.c,v $ + * Revision 3.0.1.1 89/10/26 23:10:05 lwall + * patch1: Configure now checks for BSD shadow passwords + * * Revision 3.0 89/10/18 15:10:54 lwall * 3.0 baseline * *************** *** 1580,1585 **** --- 1583,1591 ---- (void)astore(ary, ++sp, str = str_static(&str_no)); str_numset(str, (double)pwent->pw_gid); (void)astore(ary, ++sp, str = str_static(&str_no)); + #ifdef PWCHANGE + str_numset(str, (double)pwent->pw_change); + #else #ifdef PWQUOTA str_numset(str, (double)pwent->pw_quota); #else *************** *** 1587,1594 **** --- 1593,1605 ---- str_set(str, pwent->pw_age); #endif #endif + #endif (void)astore(ary, ++sp, str = str_static(&str_no)); + #ifdef PWCLASS + str_set(str,pwent->pw_class); + #else str_set(str, pwent->pw_comment); + #endif (void)astore(ary, ++sp, str = str_static(&str_no)); str_set(str, pwent->pw_gecos); (void)astore(ary, ++sp, str = str_static(&str_no)); *************** *** 1595,1600 **** --- 1606,1615 ---- str_set(str, pwent->pw_dir); (void)astore(ary, ++sp, str = str_static(&str_no)); str_set(str, pwent->pw_shell); + #ifdef PWEXPIRE + (void)astore(ary, ++sp, str = str_static(&str_no)); + str_numset(str, (double)pwent->pw_expire); + #endif } return sp; Index: dolist.c Prereq: 3.0 *** dolist.c.old Thu Oct 26 23:30:24 1989 --- dolist.c Thu Oct 26 23:30:26 1989 *************** *** 1,4 **** ! /* $Header: dolist.c,v 3.0 89/10/18 15:11:02 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: dolist.c,v 3.0.1.1 89/10/26 23:11:51 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: dolist.c,v $ + * Revision 3.0.1.1 89/10/26 23:11:51 lwall + * patch1: split in a subroutine wrongly freed referenced arguments + * patch1: reverse didn't work + * * Revision 3.0 89/10/18 15:11:02 lwall * 3.0 baseline * *************** *** 285,292 **** #endif ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab); if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) { - ary->ary_flags |= ARF_REAL; realarray = 1; ary->ary_fill = -1; sp = -1; /* temporarily switch stacks */ } --- 289,300 ---- #endif ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab); if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) { realarray = 1; + if (!(ary->ary_flags & ARF_REAL)) { + ary->ary_flags |= ARF_REAL; + for (i = ary->ary_fill; i >= 0; i--) + ary->ary_array[i] = Nullstr; /* don't free mere refs */ + } ary->ary_fill = -1; sp = -1; /* temporarily switch stacks */ } *************** *** 754,761 **** } while (i-- > 0) { *up++ = *down; ! *down-- = *up; } return arglast[2] - 1; } --- 762,772 ---- } while (i-- > 0) { *up++ = *down; ! if (i-- > 0) ! *down-- = *up; } + i = arglast[2] - arglast[1]; + Copy(down+1,up,i/2,STR*); return arglast[2] - 1; } Index: evalargs.xc Prereq: 3.0 *** evalargs.xc.old Thu Oct 26 23:30:31 1989 --- evalargs.xc Thu Oct 26 23:30:32 1989 *************** *** 2,10 **** * kit sizes from getting too big. */ ! /* $Header: evalargs.xc,v 3.0 89/10/18 15:17:16 lwall Locked $ * * $Log: evalargs.xc,v $ * Revision 3.0 89/10/18 15:17:16 lwall * 3.0 baseline * --- 2,13 ---- * kit sizes from getting too big. */ ! /* $Header: evalargs.xc,v 3.0.1.1 89/10/26 23:12:55 lwall Locked $ * * $Log: evalargs.xc,v $ + * Revision 3.0.1.1 89/10/26 23:12:55 lwall + * patch1: glob didn't free a temporary string + * * Revision 3.0 89/10/18 15:17:16 lwall * 3.0 baseline * *************** *** 275,280 **** --- 278,284 ---- } (void)do_open(last_in_stab,tmpstr->str_ptr); fp = stab_io(last_in_stab)->ifp; + str_free(tmpstr); } } } Index: malloc.c Prereq: 3.0 *** malloc.c.old Thu Oct 26 23:30:42 1989 --- malloc.c Thu Oct 26 23:30:43 1989 *************** *** 1,6 **** ! /* $Header: malloc.c,v 3.0 89/10/18 15:20:39 lwall Locked $ * * $Log: malloc.c,v $ * Revision 3.0 89/10/18 15:20:39 lwall * 3.0 baseline * --- 1,10 ---- ! /* $Header: malloc.c,v 3.0.1.1 89/10/26 23:15:05 lwall Locked $ * * $Log: malloc.c,v $ + * Revision 3.0.1.1 89/10/26 23:15:05 lwall + * patch1: some declarations were missing from malloc.c + * patch1: sparc machines had alignment problems in malloc.c + * * Revision 3.0 89/10/18 15:20:39 lwall * 3.0 baseline * *************** *** 27,32 **** --- 31,38 ---- #include "EXTERN.h" #include "perl.h" + static findbucket(), morecore(); + /* I don't much care whether these are defined in sys/types.h--LAW */ #define u_char unsigned char *************** *** 44,50 **** */ union overhead { union overhead *ov_next; /* when free */ ! #ifdef mips double strut; /* alignment problems */ #endif struct { --- 50,56 ---- */ union overhead { union overhead *ov_next; /* when free */ ! #if defined (mips) || defined (sparc) double strut; /* alignment problems */ #endif struct { Index: t/op.sort Prereq: 3.0 *** t/op.sort.old Thu Oct 26 23:31:20 1989 --- t/op.sort Thu Oct 26 23:31:21 1989 *************** *** 1,8 **** #!./perl ! # $Header: op.sort,v 3.0 89/10/18 15:31:19 lwall Locked $ ! print "1..3\n"; sub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; } --- 1,8 ---- #!./perl ! # $Header: op.sort,v 3.0.1.1 89/10/26 23:25:37 lwall Locked $ ! print "1..8\n"; sub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; } *************** *** 17,19 **** --- 17,39 ---- $x = join('', sort @george, 'to', @harry); print ($x eq 'AbelAxedCainPunishedcatchaseddoggonetoxyz'?"ok 3\n":"not ok 3\n"); + + @a = (); + @b = reverse @a; + print ("@b" eq "" ? "ok 4\n" : "not ok 4 (@b)\n"); + + @a = (1); + @b = reverse @a; + print ("@b" eq "1" ? "ok 5\n" : "not ok 5 (@b)\n"); + + @a = (1,2); + @b = reverse @a; + print ("@b" eq "2 1" ? "ok 6\n" : "not ok 6 (@b)\n"); + + @a = (1,2,3); + @b = reverse @a; + print ("@b" eq "3 2 1" ? "ok 7\n" : "not ok 7 (@b)\n"); + + @a = (1,2,3,4); + @b = reverse @a; + print ("@b" eq "4 3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n"); Index: perl.h Prereq: 3.0 *** perl.h.old Thu Oct 26 23:30:47 1989 --- perl.h Thu Oct 26 23:30:48 1989 *************** *** 1,4 **** ! /* $Header: perl.h,v 3.0 89/10/18 15:21:21 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: perl.h,v 3.0.1.1 89/10/26 23:17:08 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: perl.h,v $ + * Revision 3.0.1.1 89/10/26 23:17:08 lwall + * patch1: vfork now conditionally defined based on VFORK + * patch1: DEC risc machines have a buggy memcmp + * patch1: perl.h now includes if it exists + * * Revision 3.0 89/10/18 15:21:21 lwall * 3.0 baseline * *************** *** 24,29 **** --- 29,42 ---- # endif #endif + #ifndef VFORK + # define vfork fork + #endif + + #if defined(MEMCMP) && defined(mips) && BYTEORDER == 01234 + #undef MEMCMP + #endif + #ifdef MEMCPY extern char *memcpy(), *memset(); #define bcopy(s1,s2,l) memcpy(s2,s1,l) *************** *** 37,42 **** --- 50,59 ---- #include #include #include /* if this needs types.h we're still wrong */ + + #ifdef I_NETINET_IN + #include + #endif #ifndef _TYPES_ /* If types.h defines this it's easy. */ #ifndef major /* Does everyone's types.h define this? */ Index: perl.man.4 Prereq: 3.0 *** perl.man.4.old Thu Oct 26 23:30:54 1989 --- perl.man.4 Thu Oct 26 23:30:56 1989 *************** *** 1,7 **** ''' Beginning of part 4 ! ''' $Header: perl.man.4,v 3.0 89/10/18 15:21:55 lwall Locked $ ''' ''' $Log: perl.man.4,v $ ''' Revision 3.0 89/10/18 15:21:55 lwall ''' 3.0 baseline ''' --- 1,10 ---- ''' Beginning of part 4 ! ''' $Header: perl.man.4,v 3.0.1.1 89/10/26 23:18:43 lwall Locked $ ''' ''' $Log: perl.man.4,v $ + ''' Revision 3.0.1.1 89/10/26 23:18:43 lwall + ''' patch1: documented the desirability of unnecessary parentheses + ''' ''' Revision 3.0 89/10/18 15:21:55 lwall ''' 3.0 baseline ''' *************** *** 992,997 **** --- 995,1012 ---- The defaults are there for lazy systems programmers writing one-shot programs. If you want your program to be readable, consider supplying the argument. + .Sp + Along the same lines, just because you + .I can + omit parentheses in many places doesn't mean that you ought to: + .nf + + return print reverse sort num values array; + return print(reverse(sort num (values(%array)))); + + .fi + When in doubt, parenthesize. + At the very least it will let some poor schmuck bounce on the % key in vi. .Ip 2. 4 4 Don't go through silly contortions to exit a loop at the top or the bottom, when *************** *** 1017,1022 **** --- 1032,1039 ---- .Ip 6. 4 4 For portability, when using features that may not be implemented on every machine, test the construct in an eval to see if it fails. + If you know what version or patchlevel a particular feature was implemented, + you can test $] to see if it will be there. .Ip 4. 4 4 Choose mnemonic indentifiers. .Ip 5. 4 4 Index: perl.y Prereq: 3.0 *** perl.y.old Thu Oct 26 23:31:02 1989 --- perl.y Thu Oct 26 23:31:03 1989 *************** *** 1,4 **** ! /* $Header: perl.y,v 3.0 89/10/18 15:22:04 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: perl.y,v 3.0.1.1 89/10/26 23:20:41 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: perl.y,v $ + * Revision 3.0.1.1 89/10/26 23:20:41 lwall + * patch1: grandfathered "format stdout" + * patch1: operator(); is now normally equivalent to operator; + * * Revision 3.0 89/10/18 15:22:04 lwall * 3.0 baseline * *************** *** 276,282 **** ; format : FORMAT WORD '=' FORMLIST ! { stab_form(stabent($2,TRUE)) = $4; Safefree($2);} | FORMAT '=' FORMLIST { stab_form(stabent("STDOUT",TRUE)) = $3; } ; --- 280,292 ---- ; format : FORMAT WORD '=' FORMLIST ! { if (strEQ($2,"stdout")) ! stab_form(stabent("STDOUT",TRUE)) = $4; ! else if (strEQ($2,"stderr")) ! stab_form(stabent("STDERR",TRUE)) = $4; ! else ! stab_form(stabent($2,TRUE)) = $4; ! Safefree($2);} | FORMAT '=' FORMLIST { stab_form(stabent("STDOUT",TRUE)) = $3; } ; *************** *** 632,637 **** --- 642,651 ---- Nullarg, Nullarg)); } | FUNC0 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); } + | FUNC1 '(' ')' + { $$ = make_op($1, 1, Nullarg, Nullarg, Nullarg); + if ($1 == O_EVAL || $1 == O_RESET) + $$ = fixeval($$); } | FUNC1 '(' expr ')' { $$ = make_op($1, 1, $3, Nullarg, Nullarg); if ($1 == O_EVAL || $1 == O_RESET) Index: lib/perldb.pl Prereq: 3.0 *** lib/perldb.pl.old Thu Oct 26 23:30:36 1989 --- lib/perldb.pl Thu Oct 26 23:30:37 1989 *************** *** 1,6 **** package DB; ! $header = '$Header: perldb.pl,v 3.0 89/10/18 15:19:46 lwall Locked $'; # # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. --- 1,6 ---- package DB; ! $header = '$Header: perldb.pl,v 3.0.1.1 89/10/26 23:14:02 lwall Locked $'; # # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. *************** *** 10,15 **** --- 10,18 ---- # have a breakpoint. It also inserts a do 'perldb.pl' before the first line. # # $Log: perldb.pl,v $ + # Revision 3.0.1.1 89/10/26 23:14:02 lwall + # patch1: RCS expanded an unintended $Header in lib/perldb.pl + # # Revision 3.0 89/10/18 15:19:46 lwall # 3.0 baseline # *************** *** 25,31 **** select(STDOUT); $| = 1; # for real STDOUT ! $header =~ s/\$Header: perldb.pl,v 3.0 89/10/18 15:19:46 lwall Locked $/$1$2/; print OUT "\nLoading DB from $header\n\n"; sub DB { --- 28,34 ---- select(STDOUT); $| = 1; # for real STDOUT ! $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/; print OUT "\nLoading DB from $header\n\n"; sub DB { Index: str.c Prereq: 3.0 *** str.c.old Thu Oct 26 23:31:09 1989 --- str.c Thu Oct 26 23:31:10 1989 *************** *** 1,4 **** ! /* $Header: str.c,v 3.0 89/10/18 15:23:38 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.c,v 3.0.1.1 89/10/26 23:23:41 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.c,v $ + * Revision 3.0.1.1 89/10/26 23:23:41 lwall + * patch1: string ordering tests were wrong + * patch1: $/ now works even when STDSTDIO undefined + * * Revision 3.0 89/10/18 15:23:38 lwall * 3.0 baseline * *************** *** 604,610 **** if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur)) return retval; else ! return 1; } else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur)) return retval; --- 608,614 ---- if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur)) return retval; else ! return -1; } else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur)) return retval; *************** *** 611,617 **** else if (str1->str_cur == str2->str_cur) return 0; else ! return -1; } char * --- 615,621 ---- else if (str1->str_cur == str2->str_cur) return 0; else ! return 1; } char * *************** *** 620,627 **** register FILE *fp; int append; { - #ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */ - register char *bp; /* we're going to steal some values */ register int cnt; /* from the stdio struct and put EVERYTHING */ register STDCHAR *ptr; /* in the innermost loop into registers */ --- 624,629 ---- *************** *** 636,641 **** --- 638,645 ---- 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 */ *************** *** 686,701 **** #else /* !STDSTDIO */ /* The big, slow, and stupid way */ ! static char buf[8192]; ! if (fgets(buf, sizeof buf, fp) != Nullch) { if (append) str_cat(str, buf); else str_set(str, buf); } - else - str_set(str, No); #endif /* STDSTDIO */ --- 690,717 ---- #else /* !STDSTDIO */ /* The big, slow, and stupid way */ ! { ! static char buf[8192]; ! char * bpe = buf + sizeof(buf) - 3; ! screamer: ! bp = buf; ! filler: ! while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe); ! if (i == newline && get_paragraph && ! (i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ! goto filler; ! ! *bp = '\0'; if (append) str_cat(str, buf); else str_set(str, buf); + if (i != newline && i != EOF) { + append = -1; + goto screamer; + } } #endif /* STDSTDIO */ Index: str.h Prereq: 3.0 *** str.h.old Thu Oct 26 23:31:15 1989 --- str.h Thu Oct 26 23:31:16 1989 *************** *** 1,4 **** ! /* $Header: str.h,v 3.0 89/10/18 15:23:49 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.h,v 3.0.1.1 89/10/26 23:24:42 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.h,v $ + * Revision 3.0.1.1 89/10/26 23:24:42 lwall + * patch1: rearranged some structures to align doubles better on Gould + * * Revision 3.0 89/10/18 15:23:49 lwall * 3.0 baseline * *************** *** 13,18 **** --- 16,22 ---- struct string { char * str_ptr; /* pointer to malloced string */ + int str_len; /* allocated size */ union { double str_nval; /* numeric value, if any */ STAB *str_stab; /* magic stab for magic "key" string */ *************** *** 21,27 **** HASH *str_hash; /* string represents an assoc array (stab?) */ ARRAY *str_array; /* string represents an array */ } str_u; - int str_len; /* allocated size */ int str_cur; /* length of str_ptr as a C string */ STR *str_magic; /* while free, link to next free str */ /* while in use, ptr to "key" for magic items */ --- 25,30 ---- *************** *** 37,42 **** --- 40,46 ---- struct stab { /* should be identical, except for str_ptr */ STBP * str_ptr; /* pointer to malloced string */ + int str_len; /* allocated size */ union { double str_nval; /* numeric value, if any */ STAB *str_stab; /* magic stab for magic "key" string */ *************** *** 45,51 **** HASH *str_hash; /* string represents an assoc array (stab?) */ ARRAY *str_array; /* string represents an array */ } str_u; - int str_len; /* allocated size */ int str_cur; /* length of str_ptr as a C string */ STR *str_magic; /* while free, link to next free str */ /* while in use, ptr to "key" for magic items */ --- 49,54 ---- Index: toke.c Prereq: 3.0 *** toke.c.old Thu Oct 26 23:31:26 1989 --- toke.c Thu Oct 26 23:31:28 1989 *************** *** 1,4 **** ! /* $Header: toke.c,v 3.0 89/10/18 15:32:33 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: toke.c,v 3.0.1.1 89/10/26 23:26:21 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: toke.c,v $ + * Revision 3.0.1.1 89/10/26 23:26:21 lwall + * patch1: disambiguated word after "sort" better + * * Revision 3.0 89/10/18 15:32:33 lwall * 3.0 baseline * *************** *** 865,871 **** fatal("sort is now a reserved word"); if (isascii(*s) && (isalpha(*s) || *s == '_')) { for (d = s; isalpha(*d) || isdigit(*d) || *d == '_'; d++) ; ! if (d >= bufend || isspace(*d)) *(--s) = '\\'; /* force next ident to WORD */ } LOP(O_SORT); --- 868,882 ---- fatal("sort is now a reserved word"); if (isascii(*s) && (isalpha(*s) || *s == '_')) { for (d = s; isalpha(*d) || isdigit(*d) || *d == '_'; d++) ; ! strncpy(tokenbuf,s,d-s); ! if (strNE(tokenbuf,"keys") && ! strNE(tokenbuf,"values") && ! strNE(tokenbuf,"split") && ! strNE(tokenbuf,"grep") && ! strNE(tokenbuf,"readdir") && ! strNE(tokenbuf,"unpack") && ! strNE(tokenbuf,"do") && ! (d >= bufend || isspace(*d)) ) *(--s) = '\\'; /* force next ident to WORD */ } LOP(O_SORT); Index: util.h Prereq: 3.0 *** util.h.old Thu Oct 26 23:31:34 1989 --- util.h Thu Oct 26 23:31:35 1989 *************** *** 1,4 **** ! /* $Header: util.h,v 3.0 89/10/18 15:33:18 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: util.h,v 3.0.1.1 89/10/26 23:28:25 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.h,v $ + * Revision 3.0.1.1 89/10/26 23:28:25 lwall + * patch1: declared bcopy if necessary + * * Revision 3.0 89/10/18 15:33:18 lwall * 3.0 baseline * *************** *** 30,32 **** --- 33,40 ---- char *nsavestr(); FILE *mypopen(); int mypclose(); + #ifndef BCOPY + #ifndef MEMCPY + char *bcopy(); + #endif + #endif