From 6ee623d521a149edc6574c512fa951a192cd086a Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Thu, 14 May 1998 22:24:26 +0000 Subject: [PATCH] [win32] integrate mainline p4raw-id: //depot/win32/perl@973 --- Configure | 476 +++++++------ INSTALL | 47 +- MANIFEST | 10 + Makefile.SH | 76 ++- Policy_sh.SH | 13 +- Porting/Contract | 103 +++ Porting/Glossary | 20 +- Porting/config.sh | 16 +- Porting/config_H | 151 +++-- Porting/pumpkin.pod | 115 +++- README.beos | 75 +++ Todo | 2 +- beos/nm.c | 53 ++ cflags.SH | 1 + config_h.SH | 145 ++-- djgpp/djgppsed.sh | 2 +- doop.c | 2 +- emacs/ptags | 3 + ext/B/B/CC.pm | 4 +- ext/B/byteperl.c | 8 + ext/POSIX/hints/bsdos.pl | 3 + ext/POSIX/hints/freebsd.pl | 3 + ext/POSIX/hints/netbsd.pl | 3 + ext/POSIX/hints/openbsd.pl | 3 + ext/Thread/Thread.pm | 127 +++- handy.h | 7 +- hints/beos.sh | 45 ++ hints/dos_djgpp.sh | 15 +- hints/irix_5.sh | 2 +- hints/irix_6.sh | 2 +- hints/machten.sh | 26 +- hints/netbsd.sh | 5 + hints/solaris_2.sh | 20 +- hints/svr4.sh | 106 ++- hints/unicos.sh | 9 +- hints/unicosmk.sh | 9 +- hv.h | 3 +- installperl | 64 +- lib/Benchmark.pm | 156 ++++- lib/ExtUtils/Install.pm | 11 +- lib/ExtUtils/MM_OS2.pm | 3 +- lib/ExtUtils/MM_Unix.pm | 17 +- lib/ExtUtils/MM_VMS.pm | 69 +- lib/ExtUtils/Mksymlists.pm | 5 +- lib/Getopt/Long.pm | 6 + lib/Getopt/Std.pm | 6 + lib/Term/ReadLine.pm | 2 +- lib/Test.pm | 134 ++-- lib/Test/Harness.pm | 4 +- lib/chat2.pl | 4 +- lib/perl5db.pl | 12 +- lib/strict.pm | 13 + op.c | 3 +- os2/Changes | 4 + os2/Makefile.SHs | 24 +- os2/os2.c | 15 +- os2/os2thread.h | 16 +- patchlevel.h | 2 +- perl.c | 4 +- perl.h | 13 +- plan9/config.plan9 | 5 + pod/Makefile | 6 +- pod/perldebug.pod | 12 + pod/perldelta.pod | 1573 +------------------------------------------ pod/perldelta4.pod | 1609 ++++++++++++++++++++++++++++++++++++++++++++ pod/perlfunc.pod | 18 +- pod/perlsub.pod | 39 ++ pod/perlsyn.pod | 12 + pp.c | 2 +- pp_hot.c | 5 +- pp_sys.c | 28 +- proto.h | 4 - sv.c | 4 - sv.h | 1 + t/TEST | 61 +- t/harness | 13 + t/io/pipe.t | 3 +- t/lib/anydbm.t | 6 +- thrdvar.h | 12 +- thread.h | 8 +- utils/Makefile | 15 +- utils/h2ph.PL | 2 +- utils/perlcc.PL | 935 +++++++++++++++++++++++++ vms/config.vms | 51 +- vms/descrip.mms | 70 +- vms/ext/DCLsym/Makefile.PL | 3 +- vms/ext/Stdio/Makefile.PL | 4 +- vms/ext/Stdio/Stdio.xs | 1 + vms/genconfig.pl | 4 + vms/perlvms.pod | 35 +- win32/config.bc | 1 + win32/config.vc | 1 + win32/config_H.bc | 5 + win32/config_H.vc | 5 + x2p/Makefile.SH | 8 +- 95 files changed, 4584 insertions(+), 2274 deletions(-) create mode 100644 Porting/Contract create mode 100644 README.beos create mode 100644 beos/nm.c create mode 100644 ext/POSIX/hints/bsdos.pl create mode 100644 ext/POSIX/hints/freebsd.pl create mode 100644 ext/POSIX/hints/netbsd.pl create mode 100644 ext/POSIX/hints/openbsd.pl create mode 100644 hints/beos.sh create mode 100644 pod/perldelta4.pod create mode 100644 utils/perlcc.PL diff --git a/Configure b/Configure index 4430ece..65b1872 100755 --- a/Configure +++ b/Configure @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Thu Apr 2 09:30:50 EST 1998 [metaconfig 3.0 PL70] +# Generated on Wed May 13 13:35:54 EDT 1998 [metaconfig 3.0 PL70] cat >/tmp/c1$$ <&4 +cat <<'EOT' >testcpp.c +#define ABC abc +#define XYZ xyz +ABC.XYZ +EOT +cd .. +echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin +chmod 755 cppstdin +wrapper=`pwd`/cppstdin +ok='false' +cd UU + +if $test "X$cppstdin" != "X" && \ + $cppstdin $cppminus testcpp.out 2>&1 && \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 +then + echo "You used to use $cppstdin $cppminus so we'll use that again." + case "$cpprun" in + '') echo "But let's see if we can live without a wrapper..." ;; + *) + if $cpprun $cpplast testcpp.out 2>&1 && \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 + then + echo "(And we'll use $cpprun $cpplast to preprocess directly.)" + ok='true' + else + echo "(However, $cpprun $cpplast does not work, let's see...)" + fi + ;; + esac +else + case "$cppstdin" in + '') ;; + *) + echo "Good old $cppstdin $cppminus does not seem to be of any help..." + ;; + esac +fi + +if $ok; then + : nothing +elif echo 'Maybe "'"$cc"' -E" will work...'; \ + $cc -E testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Yup, it does." + x_cpp="$cc -E" + x_minus=''; +elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \ + $cc -E - testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Yup, it does." + x_cpp="$cc -E" + x_minus='-'; +elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \ + $cc -P testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Yipee, that works!" + x_cpp="$cc -P" + x_minus=''; +elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \ + $cc -P - testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "At long last!" + x_cpp="$cc -P" + x_minus='-'; +elif echo 'No such luck, maybe "'$cpp'" will work...'; \ + $cpp testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "It works!" + x_cpp="$cpp" + x_minus=''; +elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \ + $cpp - testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Hooray, it works! I was beginning to wonder." + x_cpp="$cpp" + x_minus='-'; +elif echo 'Uh-uh. Time to get fancy. Trying a wrapper...'; \ + $wrapper testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + x_cpp="$wrapper" + x_minus='' + echo "Eureka!" +else + dflt='' + rp="No dice. I can't find a C preprocessor. Name one:" + . ./myread + x_cpp="$ans" + x_minus='' + $x_cpp testcpp.out 2>&1 + if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "OK, that will do." >&4 + else +echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4 + exit 1 + fi +fi + +case "$ok" in +false) + cppstdin="$x_cpp" + cppminus="$x_minus" + cpprun="$x_cpp" + cpplast="$x_minus" + set X $x_cpp + shift + case "$1" in + "$cpp") + echo "Perhaps can we force $cc -E using a wrapper..." + if $wrapper testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 + then + echo "Yup, we can." + cppstdin="$wrapper" + cppminus=''; + else + echo "Nope, we'll have to live without it..." + fi + ;; + esac + case "$cpprun" in + "$wrapper") + cpprun='' + cpplast='' + ;; + esac + ;; +esac + +case "$cppstdin" in +"$wrapper") ;; +*) $rm -f $wrapper;; +esac +$rm -f testcpp.c testcpp.out + : Set private lib path case "$plibpth" in '') if ./mips; then @@ -3536,144 +3650,6 @@ none) libs=' ';; *) libs="$ans";; esac -: see how we invoke the C preprocessor -echo " " -echo "Now, how can we feed standard input to your C preprocessor..." >&4 -cat <<'EOT' >testcpp.c -#define ABC abc -#define XYZ xyz -ABC.XYZ -EOT -cd .. -echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin -chmod 755 cppstdin -wrapper=`pwd`/cppstdin -ok='false' -cd UU - -if $test "X$cppstdin" != "X" && \ - $cppstdin $cppminus testcpp.out 2>&1 && \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 -then - echo "You used to use $cppstdin $cppminus so we'll use that again." - case "$cpprun" in - '') echo "But let's see if we can live without a wrapper..." ;; - *) - if $cpprun $cpplast testcpp.out 2>&1 && \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 - then - echo "(And we'll use $cpprun $cpplast to preprocess directly.)" - ok='true' - else - echo "(However, $cpprun $cpplast does not work, let's see...)" - fi - ;; - esac -else - case "$cppstdin" in - '') ;; - *) - echo "Good old $cppstdin $cppminus does not seem to be of any help..." - ;; - esac -fi - -if $ok; then - : nothing -elif echo 'Maybe "'"$cc"' -E" will work...'; \ - $cc -E testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Yup, it does." - x_cpp="$cc -E" - x_minus=''; -elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \ - $cc -E - testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Yup, it does." - x_cpp="$cc -E" - x_minus='-'; -elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \ - $cc -P testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Yipee, that works!" - x_cpp="$cc -P" - x_minus=''; -elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \ - $cc -P - testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "At long last!" - x_cpp="$cc -P" - x_minus='-'; -elif echo 'No such luck, maybe "'$cpp'" will work...'; \ - $cpp testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "It works!" - x_cpp="$cpp" - x_minus=''; -elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \ - $cpp - testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Hooray, it works! I was beginning to wonder." - x_cpp="$cpp" - x_minus='-'; -elif echo 'Uh-uh. Time to get fancy. Trying a wrapper...'; \ - $wrapper testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - x_cpp="$wrapper" - x_minus='' - echo "Eureka!" -else - dflt='' - rp="No dice. I can't find a C preprocessor. Name one:" - . ./myread - x_cpp="$ans" - x_minus='' - $x_cpp testcpp.out 2>&1 - if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "OK, that will do." >&4 - else -echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4 - exit 1 - fi -fi - -case "$ok" in -false) - cppstdin="$x_cpp" - cppminus="$x_minus" - cpprun="$x_cpp" - cpplast="$x_minus" - set X $x_cpp - shift - case "$1" in - "$cpp") - echo "Perhaps can we force $cc -E using a wrapper..." - if $wrapper testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 - then - echo "Yup, we can." - cppstdin="$wrapper" - cppminus=''; - else - echo "Nope, we'll have to live without it..." - fi - ;; - esac - case "$cpprun" in - "$wrapper") - cpprun='' - cpplast='' - ;; - esac - ;; -esac - -case "$cppstdin" in -"$wrapper") ;; -*) $rm -f $wrapper;; -esac -$rm -f testcpp.c testcpp.out - : determine optimize, if desired, or use for debug flag also case "$optimize" in ' '|$undef) dflt='none';; @@ -3957,16 +3933,89 @@ n) echo "OK, that should do.";; esac $rm -f try try.* core +: Cruising for prototypes +echo " " +echo "Checking out function prototypes..." >&4 +$cat >prototype.c <<'EOCP' +main(int argc, char *argv[]) { + exit(0);} +EOCP +if $cc $ccflags -c prototype.c >prototype.out 2>&1 ; then + echo "Your C compiler appears to support function prototypes." + val="$define" +else + echo "Your C compiler doesn't seem to understand function prototypes." + val="$undef" +fi +set prototype +eval $setvar +$rm -f prototype* + +case "$prototype" in +"$define") ;; +*) ansi2knr='ansi2knr' + echo " " + cat <&4 + +$me: FATAL ERROR: +This version of $package can only be compiled by a compiler that +understands function prototypes. Unfortunately, your C compiler + $cc $ccflags +doesn't seem to understand them. Sorry about that. + +If GNU cc is avaiable for your system, perhaps you could try that instead. + +Eventually, we hope to support building Perl with pre-ANSI compilers. +If you would like to help in that effort, please contact . + +Aborting Configure now. +EOM + exit 2 + ;; +esac + +: determine where public executables go +echo " " +set dflt bin bin +eval $prefixit +fn=d~ +rp='Pathname where the public executables will reside?' +. ./getfile +if $test "X$ansexp" != "X$binexp"; then + installbin='' +fi +bin="$ans" +binexp="$ansexp" +if $afs; then + $cat < /dev/null 2>&1;' : define a shorthand compile call for compilations that should be ok. compile_ok=' mc_file=$1; shift; -$cc $optimize $ccflags $ldflags -o ${mc_file}$_exe $* ${mc_file}.c $libs;' +$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;' echo " " echo "Checking for GNU C Library..." >&4 @@ -4012,7 +4061,7 @@ case "$usenm" in ;; esac case "$dflt" in - '') dflt=`egrep 'inlibc|csym' ../Configure | wc -l 2>/dev/null` + '') dflt=`$egrep 'inlibc|csym' $rsrc/Configure | wc -l 2>/dev/null` if $test $dflt -gt 20; then dflt=y else @@ -4758,10 +4807,6 @@ $undef) ;; esac ;; - sunos) - dflt=n - also='Building a shared libperl will definitely not work on SunOS 4.' - ;; *) dflt=n ;; esac @@ -6504,7 +6549,7 @@ $define|y|true) $cat << EOM On a few systems, the dynamically loaded modules that perl generates and uses -will need a different extension then shared libs. The default will probably +will need a different extension than shared libs. The default will probably be appropriate. EOM @@ -7185,13 +7230,13 @@ main() } EOCP set try - if eval $compile_ok; then + if eval $compile; then longdblsize=`./try` $echo " $longdblsize bytes." >&4 else dflt='8' echo " " - echo "(I can't seem to compile the test program. Guessing...)" + echo "(I can't seem to compile the test program. Guessing...)" >&4 rp="What is the size of a long double (in bytes)?" . ./myread longdblsize="$ans" @@ -7558,6 +7603,14 @@ $define) set d_pwcomment eval $setvar + if $contains 'pw_gecos' $$.h >/dev/null 2>&1; then + val="$define" + else + val="$undef" + fi + set d_pwgecos + eval $setvar + $rm -f $$.h ;; *) @@ -7568,6 +7621,7 @@ $define) set d_pwclass; eval $setvar set d_pwexpire; eval $setvar set d_pwcomment; eval $setvar + set d_pwgecos; eval $setvar ;; esac @@ -8432,6 +8486,9 @@ case "$varval" in for inc in $inclist; do echo "#include <$inc>" >>temp.c; done; + echo "#ifdef $type" >> temp.c; + echo "printf(\"We have $type\");" >> temp.c; + echo "#endif" >> temp.c; $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null; if $contains $type temp.E >/dev/null 2>&1; then eval "$var=\$type"; @@ -8454,6 +8511,9 @@ case "$varval" in for inc in $inclist; do echo "#include <$inc>" >>temp.c; done; + echo "#ifdef $type" >> temp.c; + echo "printf(\"We have $type\");" >> temp.c; + echo "#endif" >> temp.c; $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null; echo " " ; echo "$rp" | $sed -e "s/What is/Looking for/" -e "s/?/./"; @@ -9105,7 +9165,7 @@ EOCP set try if eval $compile_ok; then doublesize=`./try` - $echo $doublesize >&4 + $echo " $doublesize bytes." >&4 else dflt='8' echo "(I can't seem to compile the test program. Guessing...)" @@ -9220,24 +9280,6 @@ rp="What is the type used for file modes for system calls (e.g. fchmod())?" set mode_t modetype int stdio.h sys/types.h eval $typedef_ask -: Cruising for prototypes -echo " " -echo "Checking out function prototypes..." >&4 -$cat >prototype.c <<'EOCP' -main(int argc, char *argv[]) { - exit(0);} -EOCP -if $cc $ccflags -c prototype.c >prototype.out 2>&1 ; then - echo "Your C compiler appears to support function prototypes." - val="$define" -else - echo "Your C compiler doesn't seem to understand function prototypes." - val="$undef" -fi -set prototype -eval $setvar -$rm -f prototype* - : define a fucntion to check prototypes $cat > protochk <&4 for file in $loclist $trylist; do - eval $file="\$file" + if test X$file != Xln -a X$file != Xar -o X$osname != Xos2; then + eval $file="\$file" + fi done ;; esac @@ -10876,6 +10920,7 @@ _exe='$_exe' _o='$_o' afs='$afs' alignbytes='$alignbytes' +ansi2knr='$ansi2knr' aphostname='$aphostname' ar='$ar' archlib='$archlib' @@ -11038,6 +11083,7 @@ d_pwchange='$d_pwchange' d_pwclass='$d_pwclass' d_pwcomment='$d_pwcomment' d_pwexpire='$d_pwexpire' +d_pwgecos='$d_pwgecos' d_pwquota='$d_pwquota' d_readdir='$d_readdir' d_readlink='$d_readlink' diff --git a/INSTALL b/INSTALL index f99be4d..f62e4fd 100644 --- a/INSTALL +++ b/INSTALL @@ -170,6 +170,14 @@ be done, system administrators are strongly encouraged to put into a directory typically found along a user's PATH, or in another obvious and convenient place. +It may seem obvious to say, but Perl is useful only when users can +easily find it. When possible, it's good for both /usr/bin/perl and +/usr/local/bin/perl to be symlinks to the actual binary. If that can't +be done, system administrators are strongly encouraged to put +(symlinks to) perl and its accompanying utilities, such as perldoc, +into a directory typically found along a user's PATH, or in another +obvious and convenient place. + By default, Configure will compile perl to use dynamic loading if your system supports it. If you want to force perl to be compiled statically, you can either choose this when Configure prompts you or @@ -507,6 +515,14 @@ system. For most users, the defaults are sensible and will work. Some users, however, may wish to further customize perl. Here are some of the main things you can change. +=head2 Installing perl under different names + +If you want to install perl under a name other than "perl" (for example, +when installing perl with special features enabled, such as debugging), +indicate the alternate name on the "make install" line, such as: + + make install PERLNAME=myperl + =head2 Threads On some platforms, perl5.005 can be compiled to use threads. To @@ -1225,6 +1241,8 @@ Note that you can't run the tests in background if this disables opening of /dev/tty. You can use 'make test-notty' in that case but a few tty tests will be skipped. +=head2 What if make test doesn't work? + If make test bombs out, just cd to the t directory and run ./TEST by hand to see if it makes any difference. If individual tests bomb, you can run them by hand, e.g., @@ -1242,6 +1260,10 @@ complicated constructs). You should also read the individual tests to see if there are any helpful comments that apply to your system. +=over 4 + +=item locale + Note: One possible reason for errors is that some external programs may be broken due to the combination of your environment and the way B exercises them. For example, this may happen if you have @@ -1265,6 +1287,29 @@ things like: exec, `backquoted command`, system, open("|...") or open("...|"). All these mean that Perl is trying to run some external program. +=item Out of memory + +On some systems, particularly those with smaller amounts of RAM, some +of the tests in t/op/pat.t may fail with an "Out of memory" message. +Specifically, in perl5.004_64, tests 74 and 78 have been reported to +fail on some systems. On my SparcStation IPC with 8 MB of RAM, test 78 +will fail if the system is running any other significant tasks at the +same time. + +Try stopping other jobs on the system and then running the test by itself: + + cd t; ./perl op/pat.t + +to see if you have any better luck. If your perl still fails this +test, it does not necessarily mean you have a broken perl. This test +tries to exercise the regular expression subsystem quite thoroughly, +and may well be far more demanding than your normal usage. + +You may also be able to reduce perl's memory usage by using some of +the ideas described above in L<"Malloc Performance Flags">. + +=back + =head1 make install This will put perl into the public directory you specified to @@ -1543,4 +1588,4 @@ above. =head1 LAST MODIFIED -$Id: INSTALL,v 1.32 1998/03/20 19:20:08 doughera Released $ +$Id: INSTALL,v 1.34 1998/04/23 18:19:41 doughera Released $ diff --git a/MANIFEST b/MANIFEST index 8830dca..e1365e3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -13,6 +13,7 @@ INTERN.h Included before domestic .h files MANIFEST This list of files Makefile.SH A script that generates Makefile Policy_sh.SH Hold site-wide preferences between Configure runs. +Porting/Contract Social contract for contributed modules in Perl core Porting/Glossary Glossary of config.sh variables Porting/config.sh Sample config.sh Porting/config_H Sample config.h @@ -21,6 +22,7 @@ Porting/patchls Flexible patch file listing utility Porting/pumpkin.pod Guidelines and hints for Perl maintainers README The Instructions README.amiga Notes about AmigaOS port +README.beos Notes about BeOS port README.cygwin32 Notes about Cygwin32 port README.dos Notes about dos/djgpp port README.os2 Notes about OS/2 port @@ -35,6 +37,7 @@ XSUB.h Include file for extension subroutines atomic.h Atomic refcount handling for multi-threading av.c Array value code av.h Array value header +beos/nm.c BeOS port bytecode.h Bytecode header for compiler bytecode.pl Produces byterun.h, byterun.c and ext/B/Asmdata.pm byterun.c Runtime support for compiler-generated bytecode @@ -225,8 +228,12 @@ ext/POSIX/Makefile.PL POSIX extension makefile writer ext/POSIX/POSIX.pm POSIX extension Perl module ext/POSIX/POSIX.pod POSIX extension documentation ext/POSIX/POSIX.xs POSIX extension external subroutines +ext/POSIX/hints/bsdos.pl Hint for POSIX for named architecture +ext/POSIX/hints/freebsd.pl Hint for POSIX for named architecture ext/POSIX/hints/linux.pl Hint for POSIX for named architecture +ext/POSIX/hints/netbsd.pl Hint for POSIX for named architecture ext/POSIX/hints/next_3.pl Hint for POSIX for named architecture +ext/POSIX/hints/openbsd.pl Hint for POSIX for named architecture ext/POSIX/hints/sunos_4.pl Hint for POSIX for named architecture ext/POSIX/typemap POSIX extension interface types ext/SDBM_File/Makefile.PL SDBM extension makefile writer @@ -319,6 +326,7 @@ hints/altos486.sh Hints for named architecture hints/amigaos.sh Hints for named architecture hints/apollo.sh Hints for named architecture hints/aux_3.sh Hints for named architecture +hints/beos.sh Hints for named architecture hints/broken-db.msg Warning message for systems with broken DB library hints/bsdos.sh Hints for named architecture hints/convexos.sh Hints for named architecture @@ -649,6 +657,7 @@ pod/perlcall.pod Callback info pod/perldata.pod Data structure info pod/perldebug.pod Debugger info pod/perldelta.pod Changes since last version +pod/perldelta4.pod Changes from 5.003 to 5.004 pod/perldiag.pod Diagnostic info pod/perldsc.pod Data Structures Cookbook pod/perlembed.pod Embedding info @@ -908,6 +917,7 @@ utils/perlbug.PL A simple tool to submit a bug report utils/perldoc.PL A simple tool to find & display perl's documentation utils/pl2pm.PL A pl to pm translator utils/splain.PL Stand-alone version of diagnostics.pm +utils/perlcc.PL Front-end for compiler vms/config.vms default config.h for VMS vms/descrip.mms MM[SK] description file for build vms/ext/DCLsym/0README.txt ReadMe file for VMS::DCLsym diff --git a/Makefile.SH b/Makefile.SH index c1689cd..a70b53e 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -25,8 +25,13 @@ esac linklibperl='$(LIBPERL)' shrpldflags='$(LDDLFLAGS)' +ldlibpth='' case "$useshrplib" in true) + # Prefix all runs of 'miniperl' and 'perl' with + # $ldlibpth so that ./perl finds *this* libperl.so. + ldlibpth="LD_LIBRARY_PATH=`pwd`:$LD_LIBRARY_PATH" + pldlflags="$cccdlflags" # NeXT-4 specific stuff. Can't we do this in the hint file? case "${osname}${osvers}" in @@ -35,6 +40,11 @@ true) lddlflags="-dynamic -undefined warning -framework System \ -compatibility_version 1 -current_version $patchlevel \ -prebind -seg1addr 0x27000000 -install_name \$(shrpdir)/\$@" + # NeXT uses a different name. + ldlibpth="DYLD_LIBRARY_PATH=`pwd`:$DYLD_LIBRARY_PATH" + ;; + os2*) # OS/2 doesn't need anything special for LD_LIBRARY_PATH. + ldlibpth='' ;; sunos*|freebsd[23]*|netbsd*) linklibperl="-lperl" @@ -124,6 +134,10 @@ LIBPERL = $libperl LLIBPERL= $linklibperl SHRPENV = $shrpenv +# The following is used to include the current directory in +# LD_LIBRARY_PATH if you are building a shared libperl.so. +LDLIBPTH = $ldlibpth + dynamic_ext = $dynamic_list static_ext = $static_list ext = \$(dynamic_ext) \$(static_ext) @@ -219,11 +233,17 @@ lintflags = -hbvxac all: $(FIRSTMAKEFILE) miniperl $(private) $(plextract) $(public) $(dynamic_ext) @echo " "; echo " Everything is up to date." +compile: all + echo "testing compilation" > testcompile; + cd utils; $(MAKE) compile; + cd x2p; $(MAKE) compile; + cd pod; $(MAKE) compile; + translators: miniperl lib/Config.pm FORCE - @echo " "; echo " Making x2p stuff"; cd x2p; $(MAKE) all + @echo " "; echo " Making x2p stuff"; cd x2p; $(LDLIBPTH) $(MAKE) all utilities: miniperl lib/Config.pm FORCE - @echo " "; echo " Making utilities"; cd utils; $(MAKE) all + @echo " "; echo " Making utilities"; cd utils; $(LDLIBPTH) $(MAKE) all # This is now done by installman only if you actually want the man pages. @@ -299,20 +319,20 @@ $(LIBPERL): $& perl$(OBJ_EXT) $(obj) # The Module used here must not depend on Config or any extensions. miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) - $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL) $(libs) - @./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest + $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL) $(libs) + @ $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest perl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs - $(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs - $(SHRPENV) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) purecovperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs - $(SHRPENV) purecov $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) purecov $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs - $(SHRPENV) quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) # This version, if specified in Configure, does ONLY those scripts which need # set-id emulation. Suidperl must be setuid root. It contains the "taint" @@ -320,7 +340,7 @@ quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs # has been invoked correctly. suidperl: $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs - $(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) !NO!SUBS! @@ -340,34 +360,40 @@ sperl$(OBJ_EXT): perl.c perly.h patchlevel.h $(h) preplibrary: miniperl lib/Config.pm $(plextract) @sh ./makedir lib/auto @echo " AutoSplitting perl library" - @./miniperl -Ilib -e 'use AutoSplit; \ + @$(LDLIBPTH) ./miniperl -Ilib -e 'use AutoSplit; \ autosplit_lib_modules(@ARGV)' lib/*.pm lib/*/*.pm # Take care to avoid modifying lib/Config.pm without reason # (If trying to create a new port and having problems with the configpm script, # try 'make minitest' and/or commenting out the tests at the end of configpm.) lib/Config.pm: config.sh miniperl configpm - ./miniperl configpm tmp + $(LDLIBPTH) ./miniperl configpm tmp sh mv-if-diff tmp lib/Config.pm lib/ExtUtils/Miniperl.pm: miniperlmain.c miniperl minimod.pl lib/Config.pm - ./miniperl minimod.pl > tmp && mv tmp $@ + $(LDLIBPTH) ./miniperl minimod.pl > tmp && mv tmp $@ $(plextract): miniperl lib/Config.pm - `echo ./miniperl -Ilib $@.PL` - + $(LDLIBPTH) ./miniperl -Ilib $@.PL + install: all install.perl install.man install.perl: all installperl - ./perl installperl + if [ -n "$(COMPILE)" ]; \ + then \ + cd utils; $(MAKE) compile; \ + cd ../x2p; $(MAKE) compile; \ + cd ../pod; $(MAKE) compile; \ + fi + $(LDLIBPTH) ./perl installperl install.man: all installman - ./perl installman + $(LDLIBPTH) ./perl installman # XXX Experimental. Hardwired values, but useful for testing. # Eventually Configure could ask for some of these values. install.html: all installhtml - ./perl installhtml \ + $(LDLIBPTH) ./perl installhtml \ --podroot=. --podpath=. --recurse \ --htmldir=$(privlib)/html \ --htmlroot=$(privlib)/html \ @@ -438,13 +464,13 @@ regen_headers: FORCE # DynaLoader may be needed for extensions that use Makefile.PL. $(DYNALOADER): miniperl preplibrary FORCE - @sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) + @$(LDLIBPTH) sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) d_dummy $(dynamic_ext): miniperl preplibrary $(DYNALOADER) FORCE - @sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) + @$(LDLIBPTH) sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) s_dummy $(static_ext): miniperl preplibrary $(DYNALOADER) FORCE - @sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) + @$(LDLIBPTH) sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) clean: _tidy _mopup @@ -471,6 +497,7 @@ _tidy: -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) ; do \ sh ext/util/make_ext clean $$x MAKE=$(MAKE) ; \ done + rm -f testcompile compilelog # Do not 'make _cleaner' directly. _cleaner: @@ -489,6 +516,7 @@ _cleaner: rm -f lib/.exists rm -f h2ph.man pstruct rm -rf .config + rm -f testcompile compilelog # The following lint has practically everything turned on. Unfortunately, # you have to wade through a lot of mumbo jumbo that can't be suppressed. @@ -528,11 +556,11 @@ test-prep: miniperl perl preplibrary $(dynamic_ext) cd t && (rm -f perl$(EXE_EXT); $(LNS) ../perl$(EXE_EXT) perl$(EXE_EXT)) test check: test-prep - cd t && ./perl TEST .clist diff --git a/Policy_sh.SH b/Policy_sh.SH index acac3ed..4ae0bb1 100644 --- a/Policy_sh.SH +++ b/Policy_sh.SH @@ -46,7 +46,7 @@ esac # Installation directives. Note that each one comes in three flavors. # For example, we have privlib, privlibexp, and installprivlib. # privlib is for private (to perl) library files. -# privlibexp is the same, expcept any '~' the user gave to Configure +# privlibexp is the same, except any '~' the user gave to Configure # is expanded to the user's home directory. This is figured # out automatically by Configure, so you don't have to include it here. # installprivlib is for systems (such as those running AFS) that @@ -82,7 +82,13 @@ for var in bin scriptdir privlib archlib \ case "$var" in bin) dflt=$prefix/bin ;; # The scriptdir test is more complex, but this is probably usually ok. - scriptdir) dflt=$prefix/script ;; + scriptdir) + if $test -d $prefix/script; then + dflt=$prefix/script + else + dflt=$bin + fi + ;; privlib) case "$prefix" in *perl*) dflt=$prefix/lib ;; @@ -97,7 +103,7 @@ for var in bin scriptdir privlib archlib \ case "$prefix" in *perl*) dflt=`echo $man1dir | sed -e 's/man1/man3/g' -e 's/man\.1/man\.3/g'` ;; - *) dflt=$privlib/man3 ;; + *) dflt=$privlib/man/man3 ;; esac ;; @@ -122,7 +128,6 @@ for var in bin scriptdir privlib archlib \ echo "# $var='$dflt'" else echo "# Preserving custom $var" - eval val=$var echo "$var='$val'" fi diff --git a/Porting/Contract b/Porting/Contract new file mode 100644 index 0000000..75a24a7 --- /dev/null +++ b/Porting/Contract @@ -0,0 +1,103 @@ + Contributed Modules in Perl Core + A Social Contract about Artistic Control + +What follows is a statement about artistic control, defined as the ability +of authors of packages to guide the future of their code and maintain +control over their work. It is a recognition that authors should have +control over their work, and that it is a responsibility of the rest of +the Perl community to ensure that they retain this control. It is an +attempt to document the standards to which we, as Perl developers, intend +to hold ourselves. It is an attempt to write down rough guidelines about +the respect we owe each other as Perl developers. + +This statement is not a legal contract. This statement is not a legal +document in any way, shape, or form. Perl is distributed under the GNU +Public License and under the Artistic License; those are the precise legal +terms. This statement isn't about the law or licenses. It's about +community, mutual respect, trust, and good-faith cooperation. + +We recognize that the Perl core, defined as the software distributed with +the heart of Perl itself, is a joint project on the part of all of us. +>From time to time, a script, module, or set of modules (hereafter referred +to simply as a "module") will prove so widely useful and/or so integral to +the correct functioning of Perl itself that it should be distributed with +Perl core. This should never be done without the author's explicit +consent, and a clear recognition on all parts that this means the module +is being distributed under the same terms as Perl itself. A module author +should realize that inclusion of a module into the Perl core will +necessarily mean some loss of control over it, since changes may +occasionally have to be made on short notice or for consistency with the +rest of Perl. + +Once a module has been included in the Perl core, however, everyone +involved in maintaining Perl should be aware that the module is still the +property of the original author unless the original author explicitly +gives up their ownership of it. In particular: + + 1) The version of the module in the core should still be considered the + work of the original author. All patches, bug reports, and so forth + should be fed back to them. Their development directions should be + respected whenever possible. + + 2) Patches may be applied by the pumpkin holder without the explicit + cooperation of the module author if and only if they are very minor, + time-critical in some fashion (such as urgent security fixes), or if + the module author cannot be reached. Those patches must still be + given back to the author when possible, and if the author decides on + an alternate fix in their version, that fix should be strongly + preferred unless there is a serious problem with it. Any changes not + endorsed by the author should be marked as such, and the contributor + of the change acknowledged. + + 3) The version of the module distributed with Perl should, whenever + possible, be the latest version of the module as distributed by the + author (the latest non-beta version in the case of public Perl + releases), although the pumpkin holder may hold off on upgrading the + version of the module distributed with Perl to the latest version + until the latest version has had sufficient testing. + +In other words, the author of a module should be considered to have final +say on modifications to their module whenever possible (bearing in mind +that it's expected that everyone involved will work together and arrive at +reasonable compromises when there are disagreements). + +As a last resort, however: + + 4) If the author's vision of the future of their module is sufficiently + different from the vision of the pumpkin holder and perl5-porters as a + whole so as to cause serious problems for Perl, the pumpkin holder may + choose to formally fork the version of the module in the core from the + one maintained by the author. This should not be done lightly and + should *always* if at all possible be done only after direct input + from Larry. If this is done, it must then be made explicit in the + module as distributed with Perl core that it is a forked version and + that while it is based on the original author's work, it is no longer + maintained by them. This must be noted in both the documentation and + in the comments in the source of the module. + +Again, this should be a last resort only. Ideally, this should never +happen, and every possible effort at cooperation and compromise should be +made before doing this. If it does prove necessary to fork a module for +the overall health of Perl, proper credit must be given to the original +author in perpetuity and the decision should be constantly re-evaluated to +see if a remerging of the two branches is possible down the road. + +In all dealings with contributed modules, everyone maintaining Perl should +keep in mind that the code belongs to the original author, that they may +not be on perl5-porters at any given time, and that a patch is not +official unless it has been integrated into the author's copy of the +module. To aid with this, and with points #1, #2, and #3 above, contact +information for the authors of all contributed modules should be kept with +the Perl distribution. + +Finally, the Perl community as a whole recognizes that respect for +ownership of code, respect for artistic control, proper credit, and active +effort to prevent unintentional code skew or communication gaps is vital +to the health of the community and Perl itself. Members of a community +should not normally have to resort to rules and laws to deal with each +other, and this document, although it contains rules so as to be clear, is +about an attitude and general approach. The first step in any dispute +should be open communication, respect for opposing views, and an attempt +at a compromise. In nearly every circumstance nothing more will be +necessary, and certainly no more drastic measure should be used until +every avenue of communication and discussion has failed. diff --git a/Porting/Glossary b/Porting/Glossary index 6a37060..15ca4f9 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -26,6 +26,10 @@ alignbytes (alignbytes.U): This variable holds the number of bytes required to align a double. Usual values are 2, 4 and 8. +ansi2knr (ansi2knr.U): + This variable is set if the user needs to run ansi2knr. + Currently, this is not supported, so we just abort. + aphostname (d_gethname.U): Thie variable contains the command which can be used to compute the host name. The command is fully qualified by its absolute path, to make @@ -699,27 +703,31 @@ d_pthreads_created_joinable (d_pthreadj.U): state. d_pwage (i_pwd.U): - This varaible conditionally defines PWAGE, which indicates + This variable conditionally defines PWAGE, which indicates that struct passwd contains pw_age. d_pwchange (i_pwd.U): - This varaible conditionally defines PWCHANGE, which indicates + This variable conditionally defines PWCHANGE, which indicates that struct passwd contains pw_change. d_pwclass (i_pwd.U): - This varaible conditionally defines PWCLASS, which indicates + This variable conditionally defines PWCLASS, which indicates that struct passwd contains pw_class. d_pwcomment (i_pwd.U): - This varaible conditionally defines PWCOMMENT, which indicates + This variable conditionally defines PWCOMMENT, which indicates that struct passwd contains pw_comment. d_pwexpire (i_pwd.U): - This varaible conditionally defines PWEXPIRE, which indicates + This variable conditionally defines PWEXPIRE, which indicates that struct passwd contains pw_expire. +d_pwgecos (i_pwd.U): + This variable conditionally defines PWGECOS, which indicates + that struct passwd contains pw_gecos. + d_pwquota (i_pwd.U): - This varaible conditionally defines PWQUOTA, which indicates + This variable conditionally defines PWQUOTA, which indicates that struct passwd contains pw_quota. d_readdir (d_readdir.U): diff --git a/Porting/config.sh b/Porting/config.sh index ff4f725..69da4a9 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -8,7 +8,7 @@ # Package name : perl5 # Source directory : . -# Configuration time: Tue Mar 31 15:51:58 EST 1998 +# Configuration time: Wed May 13 13:36:52 EDT 1998 # Configured by : doughera # Target system : linux fractal 2.0.33 #1 tue feb 3 10:11:46 est 1998 i686 unknown @@ -28,10 +28,11 @@ _exe='' _o='.o' afs='false' alignbytes='4' +ansi2knr='' aphostname='' ar='ar' -archlib='/opt/perl/lib/i686-linux-thread/5.00463' -archlibexp='/opt/perl/lib/i686-linux-thread/5.00463' +archlib='/opt/perl/lib/i686-linux-thread/5.00464' +archlibexp='/opt/perl/lib/i686-linux-thread/5.00464' archname='i686-linux-thread' archobjs='' awk='awk' @@ -51,7 +52,7 @@ ccdlflags='-rdynamic' ccflags='-D_REENTRANT -Dbool=char -DHAS_BOOL -I/usr/local/include' cf_by='doughera' cf_email='yourname@yourhost.yourplace.com' -cf_time='Tue Mar 31 15:51:58 EST 1998' +cf_time='Wed May 13 13:36:52 EDT 1998' chgrp='' chmod='' chown='' @@ -190,6 +191,7 @@ d_pwchange='undef' d_pwclass='undef' d_pwcomment='undef' d_pwexpire='undef' +d_pwgecos='define' d_pwquota='undef' d_readdir='define' d_readlink='define' @@ -370,7 +372,7 @@ i_varhdr='stdarg.h' i_vfork='undef' incpath='' inews='' -installarchlib='/opt/perl/lib/i686-linux-thread/5.00463' +installarchlib='/opt/perl/lib/i686-linux-thread/5.00464' installbin='/opt/perl/bin' installman1dir='/opt/perl/man/man1' installman3dir='/opt/perl/man/man3' @@ -516,7 +518,7 @@ stdio_filbuf='' stdio_ptr='((fp)->_IO_read_ptr)' strings='/usr/include/string.h' submit='' -subversion='63' +subversion='64' sysman='/usr/man/man1' tail='' tar='' @@ -549,5 +551,5 @@ xlibpth='/usr/lib/386 /lib/386' zcat='' zip='zip' PATCHLEVEL=4 -SUBVERSION=63 +SUBVERSION=64 CONFIG=true diff --git a/Porting/config_H b/Porting/config_H index 2f07d01..de0cfd6 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -17,7 +17,7 @@ /* * Package name : perl5 * Source directory : . - * Configuration time: Tue Mar 31 15:51:58 EST 1998 + * Configuration time: Wed May 13 13:36:52 EDT 1998 * Configured by : doughera * Target system : linux fractal 2.0.33 #1 tue feb 3 10:11:46 est 1998 i686 unknown */ @@ -904,42 +904,6 @@ */ #define I_NETINET_IN /**/ -/* I_PWD: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* PWQUOTA: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_quota. - */ -/* PWAGE: - * 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. - */ -/* PWCOMMENT: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_comment. - */ -#define I_PWD /**/ -/*#define PWQUOTA / **/ -/*#define PWAGE / **/ -/*#define PWCHANGE / **/ -/*#define PWCLASS / **/ -/*#define PWEXPIRE / **/ -/*#define PWCOMMENT / **/ - /* I_SFIO: * This symbol, if defined, indicates to the C program that it should * include . @@ -1490,8 +1454,8 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "/opt/perl/lib/i686-linux-thread/5.00463" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/i686-linux-thread/5.00463" /**/ +#define ARCHLIB "/opt/perl/lib/i686-linux-thread/5.00464" /**/ +#define ARCHLIB_EXP "/opt/perl/lib/i686-linux-thread/5.00464" /**/ /* CAT2: * This macro catenates 2 tokens together. @@ -1725,6 +1689,47 @@ */ #define I_NETDB /**/ +/* I_PWD: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* PWQUOTA: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_quota. + */ +/* PWAGE: + * 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. + */ +/* PWCOMMENT: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_comment. + */ +/* PWGECOS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_gecos. + */ +#define I_PWD /**/ +/*#define PWQUOTA / **/ +/*#define PWAGE / **/ +/*#define PWCHANGE / **/ +/*#define PWCLASS / **/ +/*#define PWEXPIRE / **/ +/*#define PWCOMMENT / **/ +#define PWGECOS /**/ + /* I_SYS_TYPES: * This symbol, if defined, indicates to the C program that it should * include . @@ -1744,6 +1749,37 @@ #define PRIVLIB "/opt/perl/lib" /**/ #define PRIVLIB_EXP "/opt/perl/lib" /**/ +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. + */ +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. + */ +#define SIG_NAME "ZERO", "HUP", "INT", "QUIT", "ILL", "TRAP", "ABRT", "BUS", "FPE", "KILL", "USR1", "SEGV", "USR2", "PIPE", "ALRM", "TERM", "STKFLT", "CHLD", "CONT", "STOP", "TSTP", "TTIN", "TTOU", "URG", "XCPU", "XFSZ", "VTALRM", "PROF", "WINCH", "IO", "PWR", "UNUSED", "IOT", "CLD", "POLL", 0 /**/ +#define SIG_NUM 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 6, 17, 29, 0 /**/ + /* SITEARCH: * This symbol contains the name of the private library for this package. * The library is private in the sense that it needn't be in anyone's @@ -1884,37 +1920,6 @@ */ #define Select_fd_set_t fd_set * /**/ -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. - */ -#define SIG_NAME "ZERO", "HUP", "INT", "QUIT", "ILL", "TRAP", "ABRT", "BUS", "FPE", "KILL", "USR1", "SEGV", "USR2", "PIPE", "ALRM", "TERM", "STKFLT", "CHLD", "CONT", "STOP", "TSTP", "TTIN", "TTOU", "URG", "XCPU", "XFSZ", "VTALRM", "PROF", "WINCH", "IO", "PWR", "UNUSED", "IOT", "CLD", "POLL", 0 /**/ -#define SIG_NUM 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 6, 17, 29, 0 /**/ - /* ARCHNAME: * This symbol holds a string representing the architecture name. * It may be used to construct an architecture-dependant pathname @@ -1928,7 +1933,13 @@ * routine is available to yield the execution of the current * thread. */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. + */ /*#define HAS_PTHREAD_YIELD / **/ +#define HAS_SCHED_YIELD /**/ /* PTHREADS_CREATED_JOINABLE: * This symbol, if defined, indicates that pthreads are created diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod index 27cf119..724f1ba 100644 --- a/Porting/pumpkin.pod +++ b/Porting/pumpkin.pod @@ -508,6 +508,9 @@ You might like, early in your pumpkin-holding career, to see if you can find champions for partiticular issues on the to-do list: an issue owned is an issue more likely to be resolved. +There are also some more porting-specific L items later in this +file. + =head2 OS/2-specific updates In the os2 directory is F, a set of OS/2-specific @@ -1071,6 +1074,62 @@ distribution modules. If you do then perl.c will put /my/override ahead of ARCHLIB and PRIVLIB. +=head2 Shared libperl.so location + +Why isn't the shared libperl.so installed in /usr/lib/ along +with "all the other" shared libraries? Instead, it is installed +in $archlib, which is typically something like + + /usr/local/lib/perl5/archname/5.00404 + +and is architecture- and version-specific. + +The basic reason why a shared libperl.so gets put in $archlib is so that +you can have more than one version of perl on the system at the same time, +and have each refer to its own libperl.so. + +Three examples might help. All of these work now; none would work if you +put libperl.so in /usr/lib. + +=over + +=item 1. + +Suppose you want to have both threaded and non-threaded perl versions +around. Configure will name both perl libraries "libperl.so" (so that +you can link to them with -lperl). The perl binaries tell them apart +by having looking in the appropriate $archlib directories. + +=item 2. + +Suppose you have perl5.004_04 installed and you want to try to compile +it again, perhaps with different options or after applying a patch. +If you already have libperl.so installed in /usr/lib/, then it may be +either difficult or impossible to get ld.so to find the new libperl.so +that you're trying to build. If, instead, libperl.so is tucked away in +$archlib, then you can always just change $archlib in the current perl +you're trying to build so that ld.so won't find your old libperl.so. +(The INSTALL file suggests you do this when building a debugging perl.) + +=item 3. + +The shared perl library is not a "well-behaved" shared library with +proper major and minor version numbers, so you can't necessarily +have perl5.004_04 and perl5.004_05 installed simultaneously. Suppose +perl5.004_04 were to install /usr/lib/libperl.so.4.4, and perl5.004_05 +were to install /usr/lib/libperl.so.4.5. Now, when you try to run +perl5.004_04, ld.so might try to load libperl.so.4.5, since it has +the right "major version" number. If this works at all, it almost +certainly defeats the reason for keeping perl5.004_04 around. Worse, +with development subversions, you certaily can't guarantee that +libperl.so.4.4 and libperl.so.4.55 will be compatible. + +Anyway, all this leads to quite obscure failures that are sure to drive +casual users crazy. Even experienced users will get confused :-). Upon +reflection, I'd say leave libperl.so in $archlib. + +=back + =head1 Upload Your Work to CPAN You can upload your work to CPAN if you have a CPAN id. Check out @@ -1114,12 +1173,13 @@ described in F. AFS users also are treated specially. We should probably duplicate the metaconfig prefix stuff for an install prefix. -=item Configure -Dsrcdir=/blah/blah +=item Configure -Dsrc=/blah/blah We should be able to emulate B. Tom Tromey tromey@creche.cygnus.com has submitted some patches to -the dist-users mailing list along these lines. Eventually, they ought -to get folded back into the main distribution. +the dist-users mailing list along these lines. They have been folded +back into the main distribution, but various parts of the perl +Configure/build/install process still assume src='.'. =item Hint file fixes @@ -1131,6 +1191,47 @@ Configure so that most of them aren't needed. Some of the hint file information (particularly dynamic loading stuff) ought to be fed back into the main metaconfig distribution. +=item Catch GNU Libc "Stub" functions + +Some functions (such as lchown()) are present in libc, but are +unimplmented. That is, they always fail and set errno=ENOSYS. + +Thomas Bushnell provided the following sample code and the explanation +that follows: + + /* System header to define __stub macros and hopefully few prototypes, + which can conflict with char FOO(); below. */ + #include + /* Override any gcc2 internal prototype to avoid an error. */ + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char FOO(); + + int main() { + + /* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ + #if defined (__stub_FOO) || defined (__stub___FOO) + choke me + #else + FOO(); + #endif + + ; return 0; } + +The choice of is essentially arbitrary. The GNU libc +macros are found in . You can include that file instead +of (which itself includes ) if you test for +its existence first. is assumed to exist on every system, +which is why it's used here. Any GNU libc header file will include +the stubs macros. If either __stub_NAME or __stub___NAME is defined, +then the function doesn't actually exist. Tests using work +on every system around. + +The declaration of FOO is there to override builtin prototypes for +ANSI C functions. + =back =head2 Probably good ideas waiting for round tuits @@ -1176,12 +1277,6 @@ Get some of the Macintosh stuff folded back into the main distribution. Maybe include a replacement function that doesn't lose data in rare cases of coercion between string and numerical values. -=item long long - -Can we support C on systems where C is larger -than what we've been using for C? What if you can't C -a C? - =item Improve makedepend The current makedepend process is clunky and annoyingly slow, but it @@ -1218,4 +1313,4 @@ All opinions expressed herein are those of the authorZ<>(s). =head1 LAST MODIFIED -$Id: pumpkin.pod,v 1.14 1998/03/03 17:14:47 doughera Released $ +$Id: pumpkin.pod,v 1.15 1998/04/23 17:03:48 doughera Released $ diff --git a/README.beos b/README.beos new file mode 100644 index 0000000..8c24393 --- /dev/null +++ b/README.beos @@ -0,0 +1,75 @@ +$Id: README.beos,v 1.2 1998/05/02 01:55:04 dogcow Exp dogcow $ + +Notes on building perl under BeOS: + +GENERAL ISSUES +-------------- +perl will almost compile straight out of the box with ./Configure -d, but +there are a few gotchas: + +Currently, you have to edit config.sh and remove SDBM_File from the +dynamic_ext= and extensions= lines. SDBM_File does not build properly +at this time. You need to run ./Configure -S after editing config.sh. + +In addition, with mwcc, after doing `make depend`, you need to edit +makefile and x2p/makefile and remove the lines that mention 'Bletch:'. +This is not necessary if you're using gnu cpp. + +in short: +./Configure -d +remove SDBM_File from config.sh +./Configure -S +make depend +remove Bletch: from makefile and x2p/makefile +make + +Other than that, perl should build without problems. There are some +technical comments in hints/beos.sh. + +OS RELEASE-SPECIFIC NOTES +------------------------- + +PR1/PPC: +See R3/X86. Same bug, different form. + +PR2/PPC: +Signals are somewhat unreliable, but they can work. Use caution. +The POSIX module is still somewhat buggy. + +R3/X86: +Under R3 x86, there are some serious problems with the math routines +such that numbers are incorrectly printed. This causes problems with +modules that encode their version numbers - in particular, IO.pm will +probably not work properly. This should be fixed under R3.1. + +The problem has manifested itself if you see something similar to the +following during the compile: + +cc -c -I/usr/local/include -O -DVERSION=\"1.1504\" -DXS_VERSION=\"1.1499999999\" -fpic -I../.. IO.c +(lots of 9's are the indication of the problem.) + +In the meantime, you can use the following workaround: + +make perl +cd ext/IO +cc -c -I/usr/local/include -O -DVERSION=\"1.1504\" -DXS_VERSION=\"1.15\" -fpic -I../.. IO.c +cd .. +make + +(Substitute the correct numbers if IO has been updated.) + +R3/PPC- +There's math problems, but of a different kind. In particular, +perl -e 'print (240000 - (3e4<<3))' gives a non-zero answer. +I'm looking into this. There is no workaround as yet. Hopefully, +this will be fixed in R3.1. + +CONTACT INFORMATION +------------------- +If you have comments, problem reports, or even patches or bugfixes (gasp!) +please email me. + +1 May 1998 +Tom Spindler +dogcow@merit.edu + diff --git a/Todo b/Todo index ab28e00..4752030 100644 --- a/Todo +++ b/Todo @@ -21,7 +21,7 @@ Would be nice to have reference to compiled regexp lexically scoped functions: my sub foo { ... } lvalue functions - Full 64 bit support + Full 64 bit support (i.e. "long long") Possible pragmas debugger diff --git a/beos/nm.c b/beos/nm.c new file mode 100644 index 0000000..4f53f74 --- /dev/null +++ b/beos/nm.c @@ -0,0 +1,53 @@ +/* nm.c - a feeble shared-lib library parser + * Copyright 1997, 1998 Tom Spindler + * This software is covered under perl's Artistic license. + */ + +/* $Id: nm.c,v 1.1 1998/02/16 03:51:26 dogcow Exp $ */ + +#include +#include +#include +#include +#include +#include + +main(int argc, char **argv) { +char *path, *symname; +image_id img; +int32 n = 0; +volatile int32 symnamelen, symtype; +void *symloc; + +if (argc != 2) { printf("more args, bozo\n"); exit(1); } + +path = (void *) malloc((size_t) 2048); +symname = (void *) malloc((size_t) 2048); + +if (!getcwd(path, 2048)) { printf("aiee!\n"); exit(1); } +if (!strcat(path, "/")) {printf("naah.\n"); exit (1); } +/*printf("%s\n",path);*/ + +if ('/' != argv[1][0]) { + if (!strcat(path, argv[1])) { printf("feh1\n"); exit(1); } +} else { + if (!strcpy(path, argv[1])) { printf("gah!\n"); exit(1); } +} +/*printf("%s\n",path);*/ + +img = load_add_on(path); +if (B_ERROR == img) {printf("Couldn't load_add_on() %s.\n", path); exit(2); } + +symnamelen=2047; + +while (B_BAD_INDEX != get_nth_image_symbol(img, n++, symname, &symnamelen, + &symtype, &symloc)) { + printf("%s |%s |GLOB %Lx | \n", symname, + ((B_SYMBOL_TYPE_ANY == symtype) || (B_SYMBOL_TYPE_TEXT == symtype)) ? "FUNC" : "VAR ", symloc); + symnamelen=2047; +} +printf("number of symbols: %d\n", n); +if (B_ERROR == unload_add_on(img)) {printf("err while closing.\n"); exit(3); } +free(path); +return(0); +} diff --git a/cflags.SH b/cflags.SH index 6d46102..8a1ba82 100755 --- a/cflags.SH +++ b/cflags.SH @@ -124,6 +124,7 @@ for file do optimize="$optdebug" fi + : Can we perhaps use $ansi2knr here echo "$cc -c -DPERL_CORE $ccflags $optimize $perltype $large $split" eval "$also "'"$cc -DPERL_CORE -c $ccflags $optimize $perltype $large $split"' diff --git a/config_h.SH b/config_h.SH index 1d3a13d..5d4cffc 100644 --- a/config_h.SH +++ b/config_h.SH @@ -918,42 +918,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_niin I_NETINET_IN /**/ -/* I_PWD: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* PWQUOTA: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_quota. - */ -/* PWAGE: - * 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. - */ -/* PWCOMMENT: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_comment. - */ -#$i_pwd I_PWD /**/ -#$d_pwquota PWQUOTA /**/ -#$d_pwage PWAGE /**/ -#$d_pwchange PWCHANGE /**/ -#$d_pwclass PWCLASS /**/ -#$d_pwexpire PWEXPIRE /**/ -#$d_pwcomment PWCOMMENT /**/ - /* I_SFIO: * This symbol, if defined, indicates to the C program that it should * include . @@ -1739,6 +1703,47 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_netdb I_NETDB /**/ +/* I_PWD: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* PWQUOTA: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_quota. + */ +/* PWAGE: + * 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. + */ +/* PWCOMMENT: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_comment. + */ +/* PWGECOS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_gecos. + */ +#$i_pwd I_PWD /**/ +#$d_pwquota PWQUOTA /**/ +#$d_pwage PWAGE /**/ +#$d_pwchange PWCHANGE /**/ +#$d_pwclass PWCLASS /**/ +#$d_pwexpire PWEXPIRE /**/ +#$d_pwcomment PWCOMMENT /**/ +#$d_pwgecos PWGECOS /**/ + /* I_SYS_TYPES: * This symbol, if defined, indicates to the C program that it should * include . @@ -1758,6 +1763,37 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define PRIVLIB "$privlib" /**/ #define PRIVLIB_EXP "$privlibexp" /**/ +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. + */ +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. + */ +#define SIG_NAME $sig_name_init /**/ +#define SIG_NUM $sig_num /**/ + /* SITEARCH: * This symbol contains the name of the private library for this package. * The library is private in the sense that it needn't be in anyone's @@ -1898,37 +1934,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define Select_fd_set_t $selecttype /**/ -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. - */ -#define SIG_NAME $sig_name_init /**/ -#define SIG_NUM $sig_num /**/ - /* ARCHNAME: * This symbol holds a string representing the architecture name. * It may be used to construct an architecture-dependant pathname @@ -1942,7 +1947,13 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * routine is available to yield the execution of the current * thread. */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. + */ #$d_pthread_yield HAS_PTHREAD_YIELD /**/ +#$d_sched_yield HAS_SCHED_YIELD /**/ /* PTHREADS_CREATED_JOINABLE: * This symbol, if defined, indicates that pthreads are created diff --git a/djgpp/djgppsed.sh b/djgpp/djgppsed.sh index 5acf0ce..96a6885 100644 --- a/djgpp/djgppsed.sh +++ b/djgpp/djgppsed.sh @@ -25,7 +25,7 @@ SSTAT='s=\.\(stat\.\)=_\1=g' STMP2='s=tmp2=tm2=g' SPACKLIST='s=\.\(packlist\)=_\1=g' -sed -e $SCONFIG -e $SGREPTMP -e $SECHOTMP -e $SDDC -e $SOUT Configure |tr -d '\r' >s; mv -f s Configure +sed -e $SCONFIG -e $SGREPTMP -e $SECHOTMP -e $SDDC -e $SOUT -e 's=\.\( \./\$file\)$=sh\1=g' Configure |tr -d '\r' >s; mv -f s Configure sed -e $SEXISTS -e $SLIST -e $SCONFIG Makefile.SH |tr -d '\r' >s; mv -f s Makefile.SH sed -e $SEXISTS -e $SPACKLIST lib/ExtUtils/Install.pm |tr -d '\r' >s; mv -f s lib/ExtUtils/Install.pm sed -e $SEXISTS -e $SPACKLIST lib/ExtUtils/MM_Unix.pm |tr -d '\r' >s; mv -f s lib/ExtUtils/MM_Unix.pm diff --git a/doop.c b/doop.c index 2de9376..11dc837 100644 --- a/doop.c +++ b/doop.c @@ -474,7 +474,7 @@ do_kv(ARGSproto) RETURN; if (gimme == G_SCALAR) { - I32 i; + IV i; dTARGET; if (op->op_flags & OPf_MOD) { /* lvalue */ diff --git a/emacs/ptags b/emacs/ptags index 8831988..d71d1b3 100755 --- a/emacs/ptags +++ b/emacs/ptags @@ -29,10 +29,13 @@ xsfiles="`find . -name '*.xs' -print | sort`" ## IEXT char * Isplitstr IINIT(" "); ## dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; ## PP(pp_const) +## PERLVARI(Grsfp, PerlIO *, Nullfp) +## PERLVAR(cvcache, HV *) set x -d -l c \ -r '/[dI]?EXT\(CONST\)?[ \t*]+\([a-zA-Z_0-9]+[ \t*]+\)*\([a-zA-Z_0-9]+\)[ \t]*\($\|;\|\[\|[ \t]I+NIT[ \t]*(\|\/\*\)/\3/' \ -r '/IEXT[ \t][^\/]*[ \t*]I\([a-zA-Z_][a-zA-Z_0-9]*\)[\[; \t]/\1/' \ + -r '/PERLVAR[a-zA-Z_0-9]*[ \t]*([ \t]*[GIT]?\([a-zA-Z_][a-zA-Z_0-9]*\)[ \t]*,/\1/' \ -r '/PP[ \t]*([ \t]*\([^ \t()]*\)[ \t]*)/\1/' shift diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm index fc7cf6d..4c877d9 100644 --- a/ext/B/B/CC.pm +++ b/ext/B/B/CC.pm @@ -788,7 +788,7 @@ BEGIN { my $divide_op = infix_op("/"); my $modulo_op = infix_op("%"); my $lshift_op = infix_op("<<"); - my $rshift_op = infix_op("<<"); + my $rshift_op = infix_op(">>"); my $ncmp_op = sub { "($_[0] > $_[1] ? 1 : ($_[0] < $_[1]) ? -1 : 0)" }; my $scmp_op = prefix_op("sv_cmp"); my $seq_op = prefix_op("sv_eq"); @@ -1438,7 +1438,7 @@ sub compile { last OPTION; } elsif ($opt eq "o") { $arg ||= shift @options; - open(STDOUT, ">$arg") or return "$arg: $!\n"; + open(STDOUT, ">$arg") or return "open '>$arg': $!\n"; } elsif ($opt eq "n") { $arg ||= shift @options; $module_name = $arg; diff --git a/ext/B/byteperl.c b/ext/B/byteperl.c index a42edfb..323d63a 100644 --- a/ext/B/byteperl.c +++ b/ext/B/byteperl.c @@ -37,7 +37,11 @@ main(int argc, char **argv, char **env) if (!do_undump) { my_perl = perl_alloc(); if (!my_perl) +#ifdef VMS + exit(vaxc$errno); +#else exit(1); +#endif perl_construct( my_perl ); } @@ -56,7 +60,11 @@ main(int argc, char **argv, char **env) #endif if (!fp) { perror(argv[1]); +#ifdef VMS + exit(vaxc$errno); +#else exit(1); +#endif } argv++; argc--; diff --git a/ext/POSIX/hints/bsdos.pl b/ext/POSIX/hints/bsdos.pl new file mode 100644 index 0000000..62732ac --- /dev/null +++ b/ext/POSIX/hints/bsdos.pl @@ -0,0 +1,3 @@ +# BSD platforms have extra fields in struct tm that need to be initialized. +# XXX A Configure test is needed. +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff --git a/ext/POSIX/hints/freebsd.pl b/ext/POSIX/hints/freebsd.pl new file mode 100644 index 0000000..62732ac --- /dev/null +++ b/ext/POSIX/hints/freebsd.pl @@ -0,0 +1,3 @@ +# BSD platforms have extra fields in struct tm that need to be initialized. +# XXX A Configure test is needed. +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff --git a/ext/POSIX/hints/netbsd.pl b/ext/POSIX/hints/netbsd.pl new file mode 100644 index 0000000..62732ac --- /dev/null +++ b/ext/POSIX/hints/netbsd.pl @@ -0,0 +1,3 @@ +# BSD platforms have extra fields in struct tm that need to be initialized. +# XXX A Configure test is needed. +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff --git a/ext/POSIX/hints/openbsd.pl b/ext/POSIX/hints/openbsd.pl new file mode 100644 index 0000000..62732ac --- /dev/null +++ b/ext/POSIX/hints/openbsd.pl @@ -0,0 +1,3 @@ +# BSD platforms have extra fields in struct tm that need to be initialized. +# XXX A Configure test is needed. +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff --git a/ext/Thread/Thread.pm b/ext/Thread/Thread.pm index cf7069c..c8bca0d 100644 --- a/ext/Thread/Thread.pm +++ b/ext/Thread/Thread.pm @@ -32,7 +32,132 @@ Thread - multithreading =head1 DESCRIPTION -The C module provides multithreading. +The C module provides multithreading support for perl. + +=head1 FUNCTIONS + +=over 8 + +=item new \&start_sub + +=item new \&start_sub, LIST + +C starts a new thread of execution in the referenced subroutine. The +optional list is passed as parameters to the subroutine. Execution +continues in both the subroutine and the code after the C call. + +C returns a thread object representing the newly created +thread. + +=item lock VARIABLE + +C places a lock on a variable until the lock goes out of scope. If +the variable is locked by another thread, the C call will block until +it's available. C is recursive, so multiple calls to C are +safe--the variable will remain locked until the outermost lock on the +variable goes out of scope. + +Locks on variables only affect C calls--they do I affect normal +access to a variable. (Locks on subs are different, and covered in a bit) +If you really, I want locks to block access, then go ahead and tie +them to something and manage this yourself. This is done on purpose. While +managing access to variables is a good thing, perl doesn't force you out of +its living room... + +If a container object, such as a hash or array, is locked, all the elements +of that container are not locked. For example, if a thread does a C, any other thread doing a C won't block. + +You may also C a sub, using C. Any calls to that sub from +another thread will block until the lock is released. This behaviour is not +equvalent to C in the sub. C +serializes access to a subroutine, but allows different threads +non-simultaneous access. C, on the other hand, will not allow +I other thread access for the duration of the lock. + +Finally, C will traverse up references exactly I level. +C is equivalent to C, while C is not. + +=item async BLOCK; + +C creates a thread to execute the block immediately following +it. This block is treated as an anonymous sub, and so must have a +semi-colon after the closing brace. Like C, C returns a +thread object. + +=item Thread->self + +The Cself> function returns a thread object that represents +the thread making the Cself> call. + +=item Thread->list + +Clist> returns a list of thread objects for all running and +finished but un-Ced threads. + +=item cond_wait VARIABLE + +The C function takes a B variable as a parameter, +unlocks the variable, and blocks until another thread does a C +or C for that same locked variable. The variable that +C blocked on is relocked after the C is satisfied. +If there are multiple threads Cing on the same variable, all but +one will reblock waiting to reaquire the lock on the variable. (So if +you're only using C for synchronization, give up the lock as +soon as possible) + +=item cond_signal VARIABLE + +The C function takes a locked variable as a parameter and +unblocks one thread that's Cing on that variable. If more than +one thread is blocked in a C on that variable, only one (and +which one is indeterminate) will be unblocked. + +If there are no threads blocked in a C on the variable, the +signal is discarded. + +=item cond_broadcast VARIABLE + +The C function works similarly to C. +C, though, will unblock B the threads that are blocked +in a C on the locked variable, rather than only one. + +=back + +=head1 METHODS + +=over 8 + +=item join + +C waits for a thread to end and returns any values the thread exited +with. C will block until the thread has ended, though it won't block +if the thread has already terminated. + +If the thread being Ced Cd, the error it died with will be +returned at this time. If you don't want the thread performing the C +to die as well, you should either wrap the C in an C or use the +C thread method instead of C. + +=item eval + +The C method wraps an C around a C, and so waits for a +thread to exit, passing along any values the thread might have returned. +Errors, of course, get placed into C<$@>. + +=item tid + +The C method returns the tid of a thread. The tid is a monotonically +increasing integer assigned when a thread is created. The main thread of a +program will have a tid of zero, while subsequent threads will have tids +assigned starting with one. + +=head1 LIMITATIONS + +The sequence number used to assign tids is a simple integer, and no +checking is done to make sure the tid isn't currently in use. If a program +creates more than 2^32 - 1 threads in a single run, threads may be assigned +duplicate tids. This limitation may be lifted in a future version of Perl. =head1 SEE ALSO diff --git a/handy.h b/handy.h index 233304b..e74a306 100644 --- a/handy.h +++ b/handy.h @@ -119,7 +119,7 @@ typedef unsigned short U16; #define U16_MAX PERL_USHORT_MAX #define U16_MIN PERL_USHORT_MIN -#if BYTEORDER > 0x4321 +#if LONGSIZE > 4 typedef int I32; typedef unsigned int U32; # define I32_MAX PERL_INT_MAX @@ -263,6 +263,9 @@ typedef U16 line_t; */ #ifndef lint + +#define NEWSV(x,len) newSV(len) + #ifndef LEAKTEST #define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))) @@ -274,7 +277,6 @@ typedef U16 line_t; #define Renewc(v,n,t,c) \ (v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))) #define Safefree(d) safefree((Malloc_t)(d)) -#define NEWSV(x,len) newSV(len) #else /* LEAKTEST */ @@ -287,7 +289,6 @@ typedef U16 line_t; #define Renewc(v,n,t,c) \ (v = (c*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))) #define Safefree(d) safexfree((Malloc_t)(d)) -#define NEWSV(x,len) newSV(x,len) #define MAXXCOUNT 1400 #define MAXY_SIZE 80 diff --git a/hints/beos.sh b/hints/beos.sh new file mode 100644 index 0000000..d8d4fd0 --- /dev/null +++ b/hints/beos.sh @@ -0,0 +1,45 @@ +# BeOS hints file +# $Id: beos.sh,v 1.1 1998/02/16 03:51:45 dogcow Exp $ + +if [ ! -f ../beos/nm ]; then mwcc -w all -o ../beos/nm ../beos/nm.c; fi + +prefix="/boot/home/config" + +cpp="mwcc -e" + +libpth='/boot/beos/system/lib /boot/home/config/lib' +usrinc='/boot/develop/headers/posix' +locinc='/boot/develop/headers/ /boot/home/config/include' + +libc='/boot/beos/system/lib/libroot.so' +libs=' ' + +d_bcmp='define' +d_bcopy='define' +d_bzero='define' +d_index='define' +#d_htonl='define' # It exists, but much hackery would be required to support. +# a bunch of extra includes would have to be added, and it's only used at +# one place in the non-socket perl code. + +#these are all in libdll.a, which my version of nm doesn't know how to parse. +#if I can get it to both do that, and scan multiple library files, perhaps +#these can be gotten rid of. + +usemymalloc='n' +# Hopefully, Be's malloc knows better than perl's. + +d_link='undef' +dont_use_nlink='define' +# no posix (aka hard) links for us! + +d_syserrlst='undef' +# the array syserrlst[] is useless for the most part. +# large negative numbers really kind of suck in arrays. + +#d_socket='undef' +# Sockets really don't work with the current version of perl and the +# current BeOS sockets; I suspect that a new module a la GSAR's WIN32 port +# will be required. + +export PATH="$PATH:$PWD/beos" diff --git a/hints/dos_djgpp.sh b/hints/dos_djgpp.sh index ae6a7ca..73bae63 100644 --- a/hints/dos_djgpp.sh +++ b/hints/dos_djgpp.sh @@ -7,7 +7,7 @@ archname='dos-djgpp' archobjs='djgpp.o' path_sep=\; -startsh="#!sh" +startsh="#! /bin/sh" cc='gcc' ld='gcc' @@ -23,8 +23,6 @@ firstmakefile='GNUmakefile' exe_ext='.exe' randbits=31 - -ln='cp' # no REAL ln on dos lns='cp' usenm='true' @@ -54,17 +52,6 @@ sitearch=$sitelib eagain='EAGAIN' rd_nodata='-1' -: set up the translation script tr - -cat > UU/tr < # Richard Yeh # +# Use of semctl() can crash system: disable -- Dominic Dunlop 980506 # Raise stack size further; slight tweaks to accomodate MT 4.1 # -- Dominic Dunlop 980211 # Raise perl's stack size -- Dominic Dunlop 970922 @@ -53,6 +54,9 @@ alignbytes=8 # friends. Use setjmp and friends instead. expr "$osvers" \< "4.0.3" > /dev/null && d_sigsetjmp='undef' +# semctl(.., .., IPC_STATUS, ..) hangs system: say we don't have semctl() +d_semctl='undef' + # Get rid of some extra libs which it takes Configure a tediously # long time never to find on MachTen set `echo X "$libswanted "|sed -e 's/ net / /' -e 's/ socket / /' \ @@ -75,11 +79,14 @@ dont_use_nlink=define cat <<'EOM' >&4 -Tests - io/fs test 4 and - op/stat test 3 -may fail since MachTen may not return a useful nlinks field to stat -on directories. +During Configure, you may see the message + +*** WHOA THERE!!! *** + The recommended value for $d_semctl on this machine was "undef"! + Keep the recommended value? [y] + +Select the default answer: semctl() is buggy, and perl should be built +without it. At the end of Configure, you will see a harmless message @@ -88,5 +95,12 @@ Hmm...You had some extra variables I don't know about...I'll try to keep 'em. Propagating recommended variable nmopts Read the File::Find documentation for more information about dont_use_nlink +Tests + io/fs test 4 and + op/stat test 3 +may fail since MachTen may not return a useful nlinks field to stat +on directories. + EOM -expr "$osvers" \< "4.1" && test -r ./broken-db.msg && . ./broken-db.msg +expr "$osvers" \< "4.1" >/dev/null && test -r ./broken-db.msg && \ + . ./broken-db.msg diff --git a/hints/netbsd.sh b/hints/netbsd.sh index b0736bf..71d5084 100644 --- a/hints/netbsd.sh +++ b/hints/netbsd.sh @@ -72,3 +72,8 @@ case "$osvers" in d_setruid="$undef" ;; esac + +# vfork is ok on NetBSD. +case "$usevfork" in +'') usevfork=true ;; +esac diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh index 047e4cf..744b131 100644 --- a/hints/solaris_2.sh +++ b/hints/solaris_2.sh @@ -123,8 +123,10 @@ cat > UU/cc.cbu <<'EOSH' # If the C compiler is gcc: # - check the fixed-includes # - check as(1) and ld(1), they should not be GNU +# (GNU ad and ld 2.8.1 and later are reportedly ok, however.) # If the C compiler is not gcc: # - check as(1) and ld(1), they should not be GNU +# (GNU ad and ld 2.8.1 and later are reportedly ok, however.) # # Watch out in case they have not set $cc. @@ -236,9 +238,25 @@ if [ "X$usethreads" = "X$define" ]; then # as -lgdbm and such like. We assume here that -lc is present in # libswanted. If that fails to be true in future, then this can be # changed to add pthread to the very end of libswanted. - set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` + # sched_yield is in -lposix4 + set `echo X "$libswanted "| sed -e 's/ c / posix4 pthread c /'` shift libswanted="$*" + + # On Solaris 2.6 x86 there is a bug with sigsetjmp() and siglongjmp() + # when linked with the threads library, such that whatever positive value + # you pass to siglongjmp(), sigsetjmp() returns 1. + # Thanks to Simon Parsons for this report. + if test "`arch`" = i86pc -a "$osvers" = 2.6; then + d_sigaction=$undef + cat << 'EOM' >&2 + +You will see a *** WHOA THERE!!! *** message from Configure for +d_sigaction. Keep the recommended value. See hints/solaris_2.sh +for more information. + +EOM + fi fi # This is just a trick to include some useful notes. diff --git a/hints/svr4.sh b/hints/svr4.sh index eb875e1..2939e4e 100644 --- a/hints/svr4.sh +++ b/hints/svr4.sh @@ -1,15 +1,19 @@ # svr4 hints, System V Release 4.x -# Last modified 1995/01/28 by Tye McQueen, tye@metronet.com +# Last modified 1996/10/25 by Tye McQueen, tye@metronet.com +# Merged 1998/04/23 with perl5.004_04 distribution by +# Andy Dougherty + # Use Configure -Dcc=gcc to use gcc. case "$cc" in '') cc='/bin/cc' test -f $cc || cc='/usr/ccs/bin/cc' ;; esac + # We include support for using libraries in /usr/ucblib, but the setting -# of libswanted excludes some libraries found there. You may want to -# prevent "ucb" from being removed from libswanted and see if perl will -# build on your system. +# of libswanted excludes some libraries found there. If you run into +# problems, you may have to remove "ucb" from libswanted. Just delete +# the comment '#' from the sed command below. ldflags='-L/usr/ccs/lib -L/usr/ucblib' ccflags='-I/usr/include -I/usr/ucbinclude' # Don't use problematic libraries: @@ -17,26 +21,57 @@ libswanted=`echo " $libswanted " | sed -e 's/ malloc / /'` # -e 's/ ucb / /'` # libmalloc.a - Probably using Perl's malloc() anyway. # libucb.a - Remove it if you have problems ld'ing. We include it because # it is needed for ODBM_File and NDBM_File extensions. + if [ -r /usr/ucblib/libucb.a ]; then # If using BSD-compat. library: - d_gconvert='undef' # Unusuable under UnixWare 1.1 [use gcvt() instead] + d_Gconvert='gcvt' # Try gcvt() before gconvert(). # Use the "native" counterparts, not the BSD emulation stuff: d_bcmp='undef' d_bcopy='undef' d_bzero='undef' d_safebcpy='undef' d_index='undef' d_killpg='undef' d_getprior='undef' d_setprior='undef' - d_setlinebuf='undef' d_setregid='undef' d_setreuid='undef' + d_setlinebuf='undef' + # d_setregid='undef' d_setreuid='undef' # ??? fi -d_suidsafe='define' # "./Configure -d" can't figure this out easilly -usevfork='false' -# Configure may fail to find lstat() since it's a static/inline -# function in on Unisys U6000 SVR4, and possibly -# other SVR4 derivatives. -d_lstat=define +# UnixWare has /usr/lib/libc.so.1, /usr/lib/libc.so.1.1, and +# /usr/ccs/lib/libc.so. Configure chooses libc.so.1.1 while it +# appears that /usr/ccs/lib/libc.so contains more symbols: +# +# Try the following if you want to use nm-extraction. We'll just +# skip the nm-extraction phase, since searching for all the different +# library versions will be hard to keep up-to-date. +# +# if [ "" = "$libc" -a -f /usr/ccs/lib/libc.so -a \ +# -f /usr/lib/libc.so.1 -a -f /usr/lib/libc.so.1.1 ]; then +# if nm -h /usr/ccs/lib/libc.so | egrep '\<_?select$' >/dev/null; then +# if nm -h /usr/lib/libc.so.1 | egrep '\<_?select$'` >/dev/null || +# nm -h /usr/lib/libc.so.1.1 | egrep '\<_?select$'` >/dev/null; then +# : +# else +# libc=/usr/ccs/lib/libc.so +# fi +# fi +# fi +# +# Don't bother with nm. Just compile & link a small C program. +case "$usenm" in +'') usenm=false;; +esac + +# Broken C-Shell tests (Thanks to Tye McQueen): +# The OS-specific checks may be obsoleted by the this generic test. + sh_cnt=`sh -c 'echo /*' | wc -c` + csh_cnt=`csh -f -c 'glob /*' 2>/dev/null | wc -c` + csh_cnt=`expr 1 + $csh_cnt` +if [ "$sh_cnt" -ne "$csh_cnt" ]; then + echo "You're csh has a broken 'glob', disabling..." >&2 + d_csh='undef' +fi # UnixWare has a broken csh. The undocumented -X argument to uname is probably # a reasonable way of detecting UnixWare. Also in 2.1.1 the fields in # FILE* got renamed! Plus 1.1 can't cast large floats to 32-bit ints. -uw_ver=`uname -v` -uw_isuw=`uname -X 2>&1 | grep Release` +# Leave leading tabs so Configure doesn't propagate these variables + uw_ver=`uname -v` + uw_isuw=`uname -X 2>&1 | grep Release` if [ "$uw_isuw" = "Release = 4.2" ]; then case $uw_ver in 1.1) @@ -47,33 +82,42 @@ fi if [ "$uw_isuw" = "Release = 4.2MP" ]; then case $uw_ver in 2.1) - d_csh='undef' - ;; + d_csh='undef' + ;; 2.1.*) - d_csh='undef' - stdio_cnt='((fp)->__cnt)' - d_stdio_cnt_lval='define' - stdio_ptr='((fp)->__ptr)' - d_stdio_ptr_lval='define' - ;; + d_csh='undef' + stdio_cnt='((fp)->__cnt)' + d_stdio_cnt_lval='define' + stdio_ptr='((fp)->__ptr)' + d_stdio_ptr_lval='define' + ;; esac fi # DDE SMES Supermax Enterprise Server case "`uname -sm`" in "UNIX_SV SMES") - if test "$cc" = '/bin/cc' -o "$gccversion" = "" - then - # for cc we need -K PIC (not -K pic) - cccdlflags="$cccdlflags -K PIC" - fi - # the *grent functions are in libgen. - libswanted="$libswanted gen" - # csh is broken (also) in SMES - d_csh='undef' + # the *grent functions are in libgen. + libswanted="$libswanted gen" + # csh is broken (also) in SMES + # This may already be detected by the generic test above. + d_csh='undef' + case "$cc" in + *gcc*) ;; + *) # for cc we need -K PIC (not -K pic) + cccdlflags="$cccdlflags -K PIC" ;; + esac + ;; esac +# Configure may fail to find lstat() since it's a static/inline function +# in on Unisys U6000 SVR4, UnixWare 2.x, and possibly other +# SVR4 derivatives. (Though UnixWare has it in /usr/ccs/lib/libc.so.) +d_lstat=define + +d_suidsafe='define' # "./Configure -d" can't figure this out easilly + cat <<'EOM' >&4 If you wish to use dynamic linking, you must use diff --git a/hints/unicos.sh b/hints/unicos.sh index 7579eed..111cbb9 100644 --- a/hints/unicos.sh +++ b/hints/unicos.sh @@ -1,10 +1,13 @@ case `uname -r` in 6.1*) shellflags="-m+65536" ;; esac -optimize="-O1" +case "$optimize" in +'') optimize="-O1" ;; +esac d_setregid='undef' d_setreuid='undef' case "$usemymalloc" in -'') usemymalloc='y' ;; +'') usemymalloc='y' + ccflags="$ccflags -DNO_RCHECK" + ;; esac - diff --git a/hints/unicosmk.sh b/hints/unicosmk.sh index 90784b5..f0b63cb 100644 --- a/hints/unicosmk.sh +++ b/hints/unicosmk.sh @@ -1,3 +1,10 @@ -optimize="-O1" +case "$optimize" in +'') optimize="-O1" ;; +esac d_setregid='undef' d_setreuid='undef' +case "$usemymalloc" in +'') usemymalloc='y' + ccflags="$ccflags -DNO_RCHECK" + ;; +esac diff --git a/hv.h b/hv.h index 20af4ea..91b6fec 100644 --- a/hv.h +++ b/hv.h @@ -22,11 +22,12 @@ struct hek { char hek_key[1]; }; +/* This structure must match the beginning of struct xpvmg in sv.h. */ struct xpvhv { char * xhv_array; /* pointer to malloced string */ STRLEN xhv_fill; /* how full xhv_array currently is */ STRLEN xhv_max; /* subscript of last element of xhv_array */ - I32 xhv_keys; /* how many elements in the array */ + IV xhv_keys; /* how many elements in the array */ double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ diff --git a/installperl b/installperl index fe168c9..a8bcd35 100755 --- a/installperl +++ b/installperl @@ -26,6 +26,9 @@ sub mkpath { $mainperldir = "/usr/bin"; $exe_ext = $Config{exe_ext}; +# Allow ``make install PERLNAME=something_besides_perl'': +$perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl'; + while (@ARGV) { $nonono = 1 if $ARGV[0] eq '-n'; $versiononly = 1 if $ARGV[0] eq '-v'; @@ -35,8 +38,8 @@ while (@ARGV) { umask 022 unless $Is_VMS; @scripts = qw( utils/c2ph utils/h2ph utils/h2xs - utils/perlbug utils/perldoc utils/pl2pm utils/splain - x2p/s2p x2p/find2perl + utils/perlbug utils/perldoc utils/pl2pm utils/splain utils/perlcc + x2p/s2p x2p/find2perl pod/pod2man pod/pod2html pod/pod2latex pod/pod2text); if ($Is_VMS) { @scripts = map { "$_.Com" } @scripts; } @@ -50,6 +53,11 @@ if ($^O eq 'dos') { $archpms{config} = $archpms{filehand} = 1; } +if ((-e "testcompile") && (defined($ENV{'COMPILE'}))) +{ + push(@scripts, map("$_.exe", @scripts)); +} + find(sub { if ("$File::Find::dir/$_" =~ m{^ext/[^/]+/(.*)\.pm$}) { (my $pm = $1) =~ s{^lib/}{}; @@ -112,9 +120,9 @@ if ($^O eq 'MSWin32') { # Install the DLL -safe_unlink("$installbin/perl.$dlext"); -copy("perl.$dlext", "$installbin/perl.$dlext"); -chmod(0755, "$installbin/perl.$dlext"); +safe_unlink("$installbin/$perl.$dlext"); +copy("perl.$dlext", "$installbin/$perl.$dlext"); +chmod(0755, "$installbin/$perl.$dlext"); } # This will be used to store the packlist @@ -123,26 +131,26 @@ $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist"); # First we install the version-numbered executables. if ($Is_VMS) { - safe_unlink("$installbin/perl$exe_ext"); - copy("perl$exe_ext", "$installbin/perl$exe_ext"); - chmod(0755, "$installbin/perl$exe_ext"); - safe_unlink("$installbin/perlshr$exe_ext"); - copy("perlshr$exe_ext", "$installbin/perlshr$exe_ext"); - chmod(0755, "$installbin/perlshr$exe_ext"); + safe_unlink("$installbin/$perl$exe_ext"); + copy("perl$exe_ext", "$installbin/$perl$exe_ext"); + chmod(0755, "$installbin/$perl$exe_ext"); + safe_unlink("$installbin/${perl}shr$exe_ext"); + copy("perlshr$exe_ext", "$installbin/${perl}shr$exe_ext"); + chmod(0755, "$installbin/${perl}shr$exe_ext"); } elsif ($^O ne 'dos') { - safe_unlink("$installbin/perl$ver$exe_ext"); - copy("perl$exe_ext", "$installbin/perl$ver$exe_ext"); - chmod(0755, "$installbin/perl$ver$exe_ext"); + safe_unlink("$installbin/$perl$ver$exe_ext"); + copy("perl$exe_ext", "$installbin/$perl$ver$exe_ext"); + chmod(0755, "$installbin/$perl$ver$exe_ext"); } else { - safe_unlink("$installbin/perl.exe"); - copy("perl.exe", "$installbin/perl.exe"); + safe_unlink("$installbin/$perl.exe"); + copy("perl.exe", "$installbin/$perl.exe"); } -safe_unlink("$installbin/sperl$ver$exe_ext"); +safe_unlink("$installbin/s$perl$ver$exe_ext"); if ($d_dosuid) { - copy("suidperl$exe_ext", "$installbin/sperl$ver$exe_ext"); - chmod(04711, "$installbin/sperl$ver$exe_ext"); + copy("suidperl$exe_ext", "$installbin/s$perl$ver$exe_ext"); + chmod(04711, "$installbin/s$perl$ver$exe_ext"); } # Install library files. @@ -194,9 +202,9 @@ foreach $file (@corefiles) { # Make links to ordinary names if installbin directory isn't current directory. if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) { - safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext"); - link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext"); - link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") + safe_unlink("$installbin/$perl$exe_ext", "$installbin/suid$perl$exe_ext"); + link("$installbin/$perl$ver$exe_ext", "$installbin/$perl$exe_ext"); + link("$installbin/s$perl$ver$exe_ext", "$installbin/suid$perl$exe_ext") if $d_dosuid; } @@ -206,9 +214,9 @@ $mainperl_is_instperl = 0; if (!$versiononly && !$nonono && $^O ne 'MSWin32' && !$Is_VMS && -t STDIN && -t STDERR && -w $mainperldir && ! samepath($mainperldir, $installbin)) { - local($usrbinperl) = "$mainperldir/perl$exe_ext"; - local($instperl) = "$installbin/perl$exe_ext"; - local($expinstperl) = "$binexp/perl$exe_ext"; + local($usrbinperl) = "$mainperldir/$perl$exe_ext"; + local($instperl) = "$installbin/$perl$exe_ext"; + local($expinstperl) = "$binexp/$perl$exe_ext"; # First make sure $usrbinperl is not already the same as the perl we # just installed. @@ -338,11 +346,11 @@ if (!$versiononly) { # to $mainperldir (like SunOS) next if samepath($_, $binexp); next if ($mainperl_is_instperl && samepath($_, $mainperldir)); - push(@otherperls, "$_/perl$exe_ext") - if (-x "$_/perl$exe_ext" && ! -d "$_/perl$exe_ext"); + push(@otherperls, "$_/$perl$exe_ext") + if (-x "$_/$perl$exe_ext" && ! -d "$_/$perl$exe_ext"); } if (@otherperls) { - print STDERR "\nWarning: perl appears in your path in the following " . + print STDERR "\nWarning: $perl appears in your path in the following " . "locations beyond where\nwe just installed it:\n"; for (@otherperls) { print STDERR " ", $_, "\n"; diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm index e09bc92..fe77dd0 100644 --- a/lib/Benchmark.pm +++ b/lib/Benchmark.pm @@ -82,6 +82,30 @@ Results will be printed to STDOUT as TITLE followed by the times. TITLE defaults to "timethis COUNT" if none is provided. STYLE determines the format of the output, as described for timestr() below. +The COUNT can be zero or negative: this means the I to run. A zero signifies the default of 3 seconds. For +example to run at least for 10 seconds: + + timethis(-10, $code) + +or to run two pieces of code tests for at least 3 seconds: + + timethese(0, { test1 => '...', test2 => '...'}) + +CPU seconds is, in UNIX terms, the user time plus the system time of +the process itself, as opposed to the real (wallclock) time and the +time spent by the child processes. Less than 0.1 seconds is not +accepted (-0.01 as the count, for example, will cause a fatal runtime +exception). + +Note that the CPU seconds is the B time: CPU scheduling and +other operating system factors may complicate the attempt so that a +little bit more time is spent. The benchmark output will, however, +also tell the number of C<$code> runs/second, which should be a more +interesting number than the actually spent seconds. + +Returns a Benchmark object. + =item timethese ( COUNT, CODEHASHREF, [ STYLE ] ) The CODEHASHREF is a reference to a hash containing names as keys @@ -91,12 +115,14 @@ call timethis(COUNT, VALUE, KEY, STYLE) +The Count can be zero or negative, see timethis(). + =item timediff ( T1, T2 ) Returns the difference between two Benchmark times as a Benchmark object suitable for passing to timestr(). -=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ]] ) +=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] ) Returns a string that formats the times in the TIMEDIFF object in the requested STYLE. TIMEDIFF is expected to be a Benchmark object @@ -205,6 +231,9 @@ March 28th, 1997; by Hugo van der Sanden: added support for code references and the already documented 'debug' method; revamped documentation. +April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time +functionality. + =cut use Carp; @@ -237,7 +266,9 @@ sub disablecache { $cache = 0; } # --- Functions to process the 'time' data type -sub new { my @t = (time, times); print "new=@t\n" if $debug; bless \@t; } +sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0); + print "new=@t\n" if $debug; + bless \@t; } sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; } sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; } @@ -256,20 +287,21 @@ sub timediff { sub timestr { my($tr, $style, $f) = @_; my @t = @$tr; - warn "bad time value" unless @t==5; - my($r, $pu, $ps, $cu, $cs) = @t; + warn "bad time value (@t)" unless @t==6; + my($r, $pu, $ps, $cu, $cs, $n) = @t; my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a); $f = $defaultfmt unless defined $f; # format a time in the required style, other formats may be added here $style ||= $defaultstyle; $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto'; my $s = "@t $style"; # default for unknown style - $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)", + $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU secs)", @t,$t) if $style eq 'all'; - $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)", - $r,$pu,$ps,$pt) if $style eq 'noc'; - $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)", - $r,$cu,$cs,$ct) if $style eq 'nop'; + $s=sprintf("%$f CPU secs (%$f usr + %$f sys)", + $pt,$pu,$ps) if $style eq 'noc'; + $s=sprintf("%$f CPU secs (%$f cusr %$f csys)", + $ct,$cu,$cs) if $style eq 'nop'; + $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n; $s; } @@ -302,9 +334,9 @@ sub runloop { croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; print STDERR "runloop $n '$subcode'\n" if $debug; - $t0 = &new; + $t0 = Benchmark->new(0); &$subref; - $t1 = &new; + $t1 = Benchmark->new($n); $td = &timediff($t1, $t0); timedebug("runloop:",$td); @@ -336,16 +368,98 @@ sub timeit { $wd; } + +my $default_for = 3; +my $min_for = 0.1; + +sub runfor { + my ($code, $tmax) = @_; + + if ( not defined $tmax or $tmax == 0 ) { + $tmax = $default_for; + } elsif ( $tmax < 0 ) { + $tmax = -$tmax; + } + + die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n" + if $tmax < $min_for; + + my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot ); + + # First find the minimum $n that gives a non-zero timing. + + my $nmin; + + for ($n = 1, $tc = 0; $tc <= 0; $n *= 2 ) { + $td = timeit($n, $code); + $tc = $td->[1] + $td->[2]; + } + + $nmin = $n; + + my $ttot = 0; + my $tpra = 0.05 * $tmax; # Target/time practice. + + # Double $n until we have think we have practiced enough. + for ( $n = 1; $ttot < $tpra; $n *= 2 ) { + $td = timeit($n, $code); + $tc = $td->cpu_p; + $ntot += $n; + $rtot += $td->[0]; + $utot += $td->[1]; + $stot += $td->[2]; + $ttot = $utot + $stot; + $cutot += $td->[3]; + $cstot += $td->[4]; + } + + my $r; + + # Then iterate towards the $tmax. + while ( $ttot < $tmax ) { + $r = $tmax / $ttot - 1; # Linear approximation. + $n = int( $r * $n ); + $n = $nmin if $n < $nmin; + $td = timeit($n, $code); + $ntot += $n; + $rtot += $td->[0]; + $utot += $td->[1]; + $stot += $td->[2]; + $ttot = $utot + $stot; + $cutot += $td->[3]; + $cstot += $td->[4]; + } + + return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ]; +} + # --- Functions implementing high-level time-then-print utilities +sub n_to_for { + my $n = shift; + return $n == 0 ? $default_for : $n < 0 ? -$n : undef; +} + sub timethis{ my($n, $code, $title, $style) = @_; - my $t = timeit($n, $code); + my($t, $for, $forn); + + if ( $n > 0 ) { + croak "non-integer loopcount $n, stopped" if int($n)<$n; + $t = timeit($n, $code); + $title = "timethis $n" unless defined $title; + } else { + $fort = n_to_for( $n ); + $t = runfor($code, $fort); + $title = "timethis for $fort" unless defined $title; + $forn = $t->[-1]; + } local $| = 1; - $title = "timethis $n" unless defined $title; $style = "" unless defined $style; printf("%10s: ", $title); - print timestr($t, $style),"\n"; + print timestr($t, $style, $defaultfmt),"\n"; + + $n = $forn if defined $forn; # A conservative warning to spot very silly tests. # Don't assume that your benchmark is ok simply because @@ -363,7 +477,19 @@ sub timethese{ unless ref $alt eq HASH; my @names = sort keys %$alt; $style = "" unless defined $style; - print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n"; + print "Benchmark: "; + if ( $n > 0 ) { + croak "non-integer loopcount $n, stopped" if int($n)<$n; + print "timing $n iterations of"; + } else { + print "running"; + } + print " ", join(', ',@names); + unless ( $n > 0 ) { + my $for = n_to_for( $n ); + print ", each for at least $for CPU seconds"; + } + print "...\n"; # we could save the results in an array and produce a summary here # sum, min, max, avg etc etc diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index 992d178..6a5c184 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -81,10 +81,13 @@ sub install { #there are any files in arch. So we depend on having ./blib/arch #hardcoded here. my $targetroot = $hash{$source}; - if ($source eq "./blib/lib" and - exists $hash{"./blib/arch"} and - directory_not_empty("./blib/arch")) { - $targetroot = $hash{"./blib/arch"}; + if ($source eq "blib/lib" and + exists $hash{"blib/arch"} and + directory_not_empty("blib/arch")) { + $targetroot = $hash{"blib/arch"}; + print "Files found in blib/arch --> Installing files in " + . "blib/lib into architecture dependend library tree!\n" + ; #if $verbose>1; } chdir($source) or next; find(sub { diff --git a/lib/ExtUtils/MM_OS2.pm b/lib/ExtUtils/MM_OS2.pm index 7661901..5a603ca 100644 --- a/lib/ExtUtils/MM_OS2.pm +++ b/lib/ExtUtils/MM_OS2.pm @@ -28,7 +28,8 @@ $self->{BASEEXT}.def: Makefile.PL '", "DLBASE" => "',$self->{DLBASE}, '", "DL_FUNCS" => ',neatvalue($funcs), ', "IMPORTS" => ',neatvalue($imports), - ', "DL_VARS" => ', neatvalue($vars), ');\' + ', "VERSION" => "',$self->{VERSION}, + '", "DL_VARS" => ', neatvalue($vars), ');\' '); } join('',@m); diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index f2cf735..4f861df 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -1268,7 +1268,7 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) my($self) = @_; my($name, %dir, %xs, %c, %h, %ignore, %pl_files, %manifypods); local(%pm); #the sub in find() has to see this hash - $ignore{'test.pl'} = 1; + @ignore{qw(Makefile.PL test.pl)} = (1,1); $ignore{'makefile.pl'} = 1 if $Is_VMS; foreach $name ($self->lsdir($self->curdir)){ next if $name =~ /\#/; @@ -1286,13 +1286,16 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) unless $name =~ m/perlmain\.c/; # See MAP_TARGET } elsif ($name =~ /\.h$/i){ $h{$name} = 1; + } elsif ($name =~ /\.PL$/) { + ($pl_files{$name} = $name) =~ s/\.PL$// ; + } elsif ($Is_VMS && $name =~ /\.pl$/) { # case-insensitive filesystem + local($/); open(PL,$name); my $txt = ; close PL; + if ($txt =~ /Extracting \S+ \(with variable substitutions/) { + ($pl_files{$name} = $name) =~ s/\.pl$// ; + } + else { $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name); } } elsif ($name =~ /\.(p[ml]|pod)$/){ $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name); - } elsif ($name =~ /\.PL$/ && $name ne "Makefile.PL") { - ($pl_files{$name} = $name) =~ s/\.PL$// ; - } elsif ($Is_VMS && $name =~ /\.pl$/ && $name ne 'makefile.pl' && - $name ne 'test.pl') { # case-insensitive filesystem - ($pl_files{$name} = $name) =~ s/\.pl$// ; } } @@ -1496,7 +1499,7 @@ sub init_main { $modfname = &DynaLoader::mod2fname(\@modparts); } - ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!([\w:]+::)?(\w+)$! ; + ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!(?:([\w:]+)::)?(\w+)$! ; if (defined &DynaLoader::mod2fname) { # As of 5.001m, dl_os2 appends '_' diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 29bfaf2..a1eae37 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -14,7 +14,7 @@ use VMS::Filespec; use File::Basename; use vars qw($Revision); -$Revision = '5.3901 (6-Mar-1997)'; +$Revision = '5.42 (31-Mar-1997)'; unshift @MM::ISA, 'ExtUtils::MM_VMS'; @@ -90,8 +90,10 @@ are all macro, so that we can tell how long the expansion is, and avoid overrunning DCL's command buffer when MM[KS] is running. If optional second argument has a TRUE value, then the return string is -a VMS-syntax directory specification, otherwise it is a VMS-syntax file -specification. +a VMS-syntax directory specification, if it is FALSE, the return string +is a VMS-syntax file specification, and if it is not specified, fixpath() +checks to see whether it matches the name of a directory in the current +default directory, and returns a directory or file specification accordingly. =cut @@ -122,8 +124,10 @@ sub fixpath { $fixedpath = $path; $fixedpath = vmspath($fixedpath) if $force_path; } - # Convert names without directory or type to paths - if (!$force_path and $fixedpath !~ /[:>(.\]]/) { $fixedpath = vmspath($fixedpath); } + # No hints, so we try to guess + if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) { + $fixedpath = vmspath($fixedpath) if -d $fixedpath; + } # Trim off root dirname if it's had other dirs inserted in front of it. $fixedpath =~ s/\.000000([\]>])/$1/; print "fixpath($path) = |$fixedpath|\n" if $Verbose >= 3; @@ -436,7 +440,7 @@ sub find_perl { } foreach $name (@snames){ if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); } - else { push(@cand,$self->fixpath($name)); } + else { push(@cand,$self->fixpath($name,0)); } } } foreach $name (@cand) { @@ -639,9 +643,9 @@ sub constants { if ($self->{OBJECT} =~ /\s/) { $self->{OBJECT} =~ s/(\\)?\n+\s+/ /g; - $self->{OBJECT} = $self->wraplist(map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT}))); + $self->{OBJECT} = $self->wraplist(map($self->fixpath($_,0),split(/,?\s+/,$self->{OBJECT}))); } - $self->{LDFROM} = $self->wraplist(map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM}))); + $self->{LDFROM} = $self->wraplist(map($self->fixpath($_,0),split(/,?\s+/,$self->{LDFROM}))); # Fix up directory specs @@ -664,7 +668,7 @@ sub constants { # Fix up file specs foreach $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKE_APERL_FILE MYEXTLIB] ) { next unless defined $self->{$macro}; - $self->{$macro} = $self->fixpath($self->{$macro}); + $self->{$macro} = $self->fixpath($self->{$macro},0); } foreach $macro (qw/ @@ -702,7 +706,7 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision FULLEXT VERSION_FROM OBJECT LDFROM / ) { next unless defined $self->{$tmp}; - push @m, "$tmp = ",$self->fixpath($self->{$tmp}),"\n"; + push @m, "$tmp = ",$self->fixpath($self->{$tmp},0),"\n"; } for $tmp (qw/ @@ -716,7 +720,7 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision next unless defined $self->{$tmp}; my(%tmp,$key); for $key (keys %{$self->{$tmp}}) { - $tmp{$self->fixpath($key)} = $self->fixpath($self->{$tmp}{$key}); + $tmp{$self->fixpath($key,0)} = $self->fixpath($self->{$tmp}{$key},0); } $self->{$tmp} = \%tmp; } @@ -725,7 +729,7 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision next unless defined $self->{$tmp}; my(@tmp,$val); for $val (@{$self->{$tmp}}) { - push(@tmp,$self->fixpath($val)); + push(@tmp,$self->fixpath($val,0)); } $self->{$tmp} = \@tmp; } @@ -1011,7 +1015,7 @@ sub tool_xsubpp { warn "Typemap $typemap not found.\n"; } else{ - push(@tmdeps, $self->fixpath($typemap)); + push(@tmdeps, $self->fixpath($typemap,0)); } } } @@ -1464,31 +1468,6 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) } -# sub installpm_x { # called by installpm perl file -# my($self, $dist, $inst, $splitlib) = @_; -# if ($inst =~ m!#!) { -# warn "Warning: MM[SK] would have problems processing this file: $inst, SKIPPED\n"; -# return ''; -# } -# $inst = $self->fixpath($inst); -# $dist = $self->fixpath($dist); -# my($instdir) = $inst =~ /([^\)]+\))[^\)]*$/ ? $1 : dirname($inst); -# my(@m); -# -# push(@m, " -# $inst : $dist \$(MAKEFILE) ${instdir}.exists \$(INST_ARCHAUTODIR).exists -# ",' $(NOECHO) $(RM_F) $(MMS$TARGET) -# $(NOECHO) $(CP) ',"$dist $inst",' -# $(CHMOD) 644 $(MMS$TARGET) -# '); -# push(@m, ' $(AUTOSPLITFILE) $(MMS$TARGET) ', -# $self->catdir($splitlib,'auto')."\n\n") -# if ($splitlib and $inst =~ /\.pm$/); -# push(@m,$self->dir_target($instdir)); -# -# join('',@m); -# } - =item manifypods (override) Use VMS-style quoting on command line, and VMS logical name @@ -1674,7 +1653,7 @@ clean :: if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') { push(@otherfiles, @{$self->{$key}}); } - else { push(@otherfiles, $attribs{FILES}); } + else { push(@otherfiles, $word); } } } push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]); @@ -1748,7 +1727,7 @@ realclean :: clean if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') { push(@allfiles, @{$self->{$key}}); } - else { push(@allfiles, $attribs{FILES}); } + else { push(@allfiles, $word); } } $line = ''; # Occasionally files are repeated several times from different sources @@ -2037,7 +2016,7 @@ $(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl Set Default $(PERL_SRC) $(MMS)],$mmsquals,); if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) { - my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm')); + my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0)); $target =~ s/\Q$prefix/[/; push(@m," $target"); } @@ -2047,7 +2026,7 @@ $(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl ]); } - push(@m, join(" ", map($self->fixpath($_),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n") + push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n") if %{$self->{XS}}; join('',@m); @@ -2330,8 +2309,8 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE) push @m, ' # Fill in the target you want to produce if it\'s not perl -MAP_TARGET = ',$self->fixpath($target),' -MAP_SHRTARGET = ',$self->fixpath($shrtarget)," +MAP_TARGET = ',$self->fixpath($target,0),' +MAP_SHRTARGET = ',$self->fixpath($shrtarget,0)," MAP_LINKCMD = $linkcmd MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',' # We use the linker options files created with each extension, rather than @@ -2339,7 +2318,7 @@ MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',' MAP_STATIC = ',@staticopts ? join(' ', @staticopts) : '',' MAP_OPTS = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : ''," MAP_EXTRA = $extralist -MAP_LIBPERL = ",$self->fixpath($libperl),' +MAP_LIBPERL = ",$self->fixpath($libperl,0),' '; diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm index 4ec091d..48a4b15 100644 --- a/lib/ExtUtils/Mksymlists.pm +++ b/lib/ExtUtils/Mksymlists.pm @@ -7,7 +7,7 @@ use Exporter; use vars qw( @ISA @EXPORT $VERSION ); @ISA = 'Exporter'; @EXPORT = '&Mksymlists'; -$VERSION = substr q$Revision: 1.16 $, 10; +$VERSION = substr q$Revision: 1.17 $, 10; sub Mksymlists { my(%spec) = @_; @@ -69,6 +69,8 @@ sub _write_aix { sub _write_os2 { my($data) = @_; + require Config; + my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : ""); if (not $data->{DLBASE}) { ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://; @@ -79,6 +81,7 @@ sub _write_os2 { open(DEF,">$data->{FILE}.def") or croak("Can't create $data->{FILE}.def: $!\n"); print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n"; + print DEF "DESCRIPTION 'Perl (v$]$threaded) module $data->{NAME} v$data->{VERSION}'\n"; print DEF "CODE LOADONCALL\n"; print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n"; print DEF "EXPORTS\n "; diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index 5b5b495..fe7e12f 100644 --- a/lib/Getopt/Long.pm +++ b/lib/Getopt/Long.pm @@ -955,6 +955,12 @@ identifier is $opt_ . The linkage specifier can be a reference to a scalar, a reference to an array, a reference to a hash or a reference to a subroutine. +Note that, if your code is running under the recommended C pragma, it may be helpful to declare these package variables +via C perhaps something like this: + + use vars qw/ $opt_size @opt_sizes $opt_bar /; + If a REF SCALAR is supplied, the new value is stored in the referenced variable. If the option occurs more than once, the previous value is overwritten. diff --git a/lib/Getopt/Std.pm b/lib/Getopt/Std.pm index 2788293..18b5739 100644 --- a/lib/Getopt/Std.pm +++ b/lib/Getopt/Std.pm @@ -27,6 +27,12 @@ switch name) to the value of the argument, or 1 if no argument. Switches which take an argument don't care whether there is a space between the switch and the argument. +Note that, if your code is running under the recommended C pragma, it may be helpful to declare these package variables +via C perhaps something like this: + + use vars qw/ $opt_foo $opt_bar /; + For those of you who don't like additional variables being created, getopt() and getopts() will also accept a hash reference as an optional second argument. Hash keys will be x (where x is the switch name) with key values the value of diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm index 6b0b5e7..2183c8d 100644 --- a/lib/Term/ReadLine.pm +++ b/lib/Term/ReadLine.pm @@ -193,7 +193,7 @@ sub findConsole { $console = "sys\$command"; } - if ($^O eq 'amigaos') { + if (($^O eq 'amigaos') || ($^O eq 'beos')) { $console = undef; } elsif ($^O eq 'os2') { diff --git a/lib/Test.pm b/lib/Test.pm index b10d104..5f198c2 100644 --- a/lib/Test.pm +++ b/lib/Test.pm @@ -2,8 +2,9 @@ use strict; package Test; use Test::Harness 1.1601 (); use Carp; -use vars qw($VERSION @ISA @EXPORT $ntest %todo %history $TestLevel); -$VERSION = '0.08'; +use vars (qw($VERSION @ISA @EXPORT $ntest $TestLevel), #public-ish + qw($ONFAIL %todo %history $planned @FAILDETAIL)); #private-ish +$VERSION = '1.04'; require Exporter; @ISA=('Exporter'); @EXPORT= qw(&plan &ok &skip $ntest); @@ -19,12 +20,17 @@ $ENV{REGRESSION_TEST} = $0; sub plan { croak "Test::plan(%args): odd number of arguments" if @_ & 1; + croak "Test::plan(): should not be called more than once" if $planned; my $max=0; for (my $x=0; $x < @_; $x+=2) { my ($k,$v) = @_[$x,$x+1]; if ($k =~ /^test(s)?$/) { $max = $v; } elsif ($k eq 'todo' or $k eq 'failok') { for (@$v) { $todo{$_}=1; }; } + elsif ($k eq 'onfail') { + ref $v eq 'CODE' or croak "Test::plan(onfail => $v): must be CODE"; + $ONFAIL = $v; + } else { carp "Test::plan(): skipping unrecognized directive '$k'" } } my @todo = sort { $a <=> $b } keys %todo; @@ -33,6 +39,7 @@ sub plan { } else { print "1..$max\n"; } + ++$planned; } sub to_value { @@ -40,79 +47,89 @@ sub to_value { (ref $v or '') eq 'CODE' ? $v->() : $v; } -# prototypes are not used for maximum flexibility - -# STDERR is NOT used for diagnostic output that should be fixed before -# the module is released. +# STDERR is NOT used for diagnostic output which should have been +# fixed before release. Is this appropriate? -sub ok { +sub ok ($;$$) { + croak "ok: plan before you test!" if !$planned; my ($pkg,$file,$line) = caller($TestLevel); my $repetition = ++$history{"$file:$line"}; my $context = ("$file at line $line". - ($repetition > 1 ? " (\#$repetition)" : '')); + ($repetition > 1 ? " fail \#$repetition" : '')); my $ok=0; - + my $result = to_value(shift); + my ($expected,$diag); if (@_ == 0) { - print "not ok $ntest\n"; - print "# test $context: DOESN'T TEST ANYTHING!\n"; + $ok = $result; } else { - my $result = to_value(shift); - my ($expected,$diag); - if (@_ == 0) { - $ok = $result; + $expected = to_value(shift); + # until regex can be manipulated like objects... + my ($regex,$ignore); + if (($regex) = ($expected =~ m,^ / (.+) / $,sx) or + ($ignore, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) { + $ok = $result =~ /$regex/; } else { - $expected = to_value(shift); $ok = $result eq $expected; } - if ($todo{$ntest}) { - if ($ok) { - print "ok $ntest # Wow!\n"; + } + if ($todo{$ntest}) { + if ($ok) { + print "ok $ntest # Wow! ($context)\n"; + } else { + $diag = to_value(shift) if @_; + if (!$diag) { + print "not ok $ntest # (failure expected in $context)\n"; } else { - $diag = to_value(shift) if @_; + print "not ok $ntest # (failure expected: $diag)\n"; + } + } + } else { + print "not " if !$ok; + print "ok $ntest\n"; + + if (!$ok) { + my $detail = { 'repetition' => $repetition, 'package' => $pkg, + 'result' => $result }; + $$detail{expected} = $expected if defined $expected; + $diag = $$detail{diagnostic} = to_value(shift) if @_; + if (!defined $expected) { if (!$diag) { - print "not ok $ntest # (failure expected)\n"; + print STDERR "# Failed test $ntest in $context\n"; } else { - print "not ok $ntest # (failure expected: $diag)\n"; + print STDERR "# Failed test $ntest in $context: $diag\n"; } - } - } else { - print "not " if !$ok; - print "ok $ntest\n"; - - if (!$ok) { - $diag = to_value(shift) if @_; - if (!defined $expected) { - if (!$diag) { - print STDERR "# Failed $context\n"; - } else { - print STDERR "# Failed $context: $diag\n"; - } + } else { + my $prefix = "Test $ntest"; + print STDERR "# $prefix got: '$result' ($context)\n"; + $prefix = ' ' x (length($prefix) - 5); + if (!$diag) { + print STDERR "# $prefix Expected: '$expected'\n"; } else { - print STDERR "# Got: '$result' ($context)\n"; - if (!$diag) { - print STDERR "# Expected: '$expected'\n"; - } else { - print STDERR "# Expected: '$expected' ($diag)\n"; - } + print STDERR "# $prefix Expected: '$expected' ($diag)\n"; } } + push @FAILDETAIL, $detail; } } ++ $ntest; $ok; } -sub skip { +sub skip ($$;$$) { if (to_value(shift)) { print "ok $ntest # skip\n"; ++ $ntest; 1; } else { - local($TestLevel) += 1; #ignore this stack frame - ok(@_); + local($TestLevel) = $TestLevel+1; #ignore this stack frame + &ok; } } +END { + $ONFAIL->(\@FAILDETAIL) if @FAILDETAIL && $ONFAIL; +} + 1; __END__ @@ -124,7 +141,7 @@ __END__ use strict; use Test; - BEGIN { plan tests => 12, todo => [3,4] } + BEGIN { plan tests => 13, todo => [3,4] } ok(0); # failure ok(1); # success @@ -141,7 +158,8 @@ __END__ ok(0, int(rand(2)); # (just kidding! :-) my @list = (0,0); - ok(scalar(@list), 3, "\@list=".join(',',@list)); #extra diagnostics + ok @list, 3, "\@list=".join(',',@list); #extra diagnostics + ok 'segmentation fault', '/(?i)success/'; #regex match skip($feature_is_missing, ...); #do platform specific test @@ -175,10 +193,32 @@ test would be on the new feature list, not the TODO list). Packages should NOT be released with successful TODO tests. As soon as a TODO test starts working, it should be promoted to a normal test -and the new feature should be documented in the release notes. +and the newly minted feature should be documented in the release +notes. =back +=head1 ONFAIL + + BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } } + +The test failures can trigger extra diagnostics at the end of the test +run. C is passed an array ref of hash refs that describe each +test failure. Each hash will contain at least the following fields: +package, repetition, and result. (The file, line, and test number are +not included because their correspondance to a particular test is +fairly weak.) If the test had an expected value or a diagnostic +string, these will also be included. + +This optional feature might be used simply to print out the version of +your package and/or how to report problems. It might also be used to +generate extremely sophisticated diagnostics for a particular test +failure. It's not a panacea, however. Core dumps or other +unrecoverable errors will prevent the C hook from running. +(It is run inside an END block.) Besides, C is probably +over-kill in the majority of cases. (Your test code should be simpler +than the code it is testing, yes?) + =head1 SEE ALSO L and various test coverage analysis tools. diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 8102ff4..e2c47d6 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -68,7 +68,9 @@ sub runtests { my $s = $switches; $s .= q[ "-T"] if $first =~ /^#!.*\bperl.*-\w*T/; $fh->close or print "can't close $test. $!\n"; - my $cmd = "$^X $s $test|"; + my $cmd = ($ENV{'COMPILE_TEST'})? +"./perl -I../lib ../utils/perlcc $test -run -verbose dcf -log ./compilelog |" + : "$^X $s $test|"; $cmd = "MCR $cmd" if $^O eq 'VMS'; $fh->open($cmd) or print "can't run $test. $!\n"; $ok = $next = $max = 0; diff --git a/lib/chat2.pl b/lib/chat2.pl index 0d9a7d3..094d3df 100644 --- a/lib/chat2.pl +++ b/lib/chat2.pl @@ -275,7 +275,9 @@ sub print { ## public if ($_[0] =~ /$nextpat/) { *S = shift; } - print S @_; + + local $out = join $, , @_; + syswrite(S, $out, length $out); if( $chat'debug ){ print STDERR "printed:"; print STDERR @_; diff --git a/lib/perl5db.pl b/lib/perl5db.pl index a4a1b1a..3ca0adc 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -178,7 +178,8 @@ $inhibit_exit = $option{PrintRet} = 1; globPrint PrintRet UsageOnly frame AutoTrace TTY noTTY ReadLine NonStop LineInfo maxTraceLen recallCommand ShellBang pager tkRunning ornaments - signalLevel warnLevel dieLevel inhibit_exit); + signalLevel warnLevel dieLevel inhibit_exit + ImmediateStop); %optionVars = ( hashDepth => \$dumpvar::hashDepth, @@ -194,6 +195,7 @@ $inhibit_exit = $option{PrintRet} = 1; AutoTrace => \$trace, inhibit_exit => \$inhibit_exit, maxTraceLen => \$maxtrace, + ImmediateStop => \$ImmediateStop, ); %optionAction = ( @@ -363,6 +365,9 @@ sub DB { } $single = 0; # return; # Would not print trace! + } elsif ($ImmediateStop) { + $ImmediateStop = 0; + $signal = 1; } } $runnonstop = 0 if $single or $signal; # Disable it if interactive. @@ -1255,6 +1260,10 @@ sub postponed_sub { } sub postponed { + if ($ImmediateStop) { + $ImmediateStop = 0; + $signal = 1; + } return &postponed_sub unless ref \$_[0] eq 'GLOB'; # A subroutine is compiled. # Cannot be done before the file is compiled @@ -1795,6 +1804,7 @@ B [I[B<=>I]] [IB<\">IB<\">] [IB]... I: run Tk while prompting (with ReadLine); I I I: level of verbosity; I Allows stepping off the end of the script. + I Debugger should stop as early as possible. The following options affect what happens with B, B, and B commands: I, I: print only first N elements ('' for all); I, I: change style of array and hash dump; diff --git a/lib/strict.pm b/lib/strict.pm index 176af38..d9eaba1 100644 --- a/lib/strict.pm +++ b/lib/strict.pm @@ -38,6 +38,7 @@ use symbolic references (see L). =item C This generates a compile-time error if you access a variable that wasn't +declared via C, localized via C or wasn't fully qualified. Because this is to avoid variable suicide problems and subtle dynamic scoping issues, a merely local() variable isn't good enough. See L and @@ -48,6 +49,10 @@ L. my $foo = 10; # ok, my() var local $foo = 9; # blows up + package Cinna; + use vars qw/ $bar /; # Declares $bar in current package + $bar = 'HgS'; # ok, global declared via pragma + The local() generated a compile-time error because you just touched a global name without fully qualifying it. @@ -80,6 +85,14 @@ subs => 0x00000200, vars => 0x00000400 ); +$strict::VERSION = "1.01"; + +my %bitmask = ( +refs => 0x00000002, +subs => 0x00000200, +vars => 0x00000400 +); + sub bits { my $bits = 0; foreach my $s (@_){ $bits |= $bitmask{$s} || 0; }; diff --git a/op.c b/op.c index 704ccde..1f564de 100644 --- a/op.c +++ b/op.c @@ -1045,8 +1045,6 @@ modkids(OP *o, I32 type) return o; } -static I32 modcount; - OP * mod(OP *o, I32 type) { @@ -2422,6 +2420,7 @@ newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right) } if (list_assignment(left)) { + dTHR; modcount = 0; eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/ left = mod(left, OP_AASSIGN); diff --git a/os2/Changes b/os2/Changes index a46b7a5..344939c 100644 --- a/os2/Changes +++ b/os2/Changes @@ -166,3 +166,7 @@ after 5.004_03: after 5.004_53: Minimal thread support added. One needs to manually move pthread.h + +after 5.004_64: + Make DLL names different if thread-enabled. + Emit more informative internal DLL descriptions. diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index 5506a39..fd3766e 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -6,8 +6,17 @@ # Additional rules supported: perl_, aout_test, aout_install, use them # for a.out style perl (which may fork). +perl_version="5.00${PATCHLEVEL}_$SUBVERSION" +case "$archname" in + *-thread) dll_post=_thr + perl_version="${perl_version}-threaded";; + *) dll_post='' ;; +esac + $spitshell >>Makefile <>Makefile <<'!NO!SUBS!' -$(LIBPERL): perl.imp perl.dll perl5.def +$(LIBPERL): perl.imp $(PERL_DLL) perl5.def emximp -o $(LIBPERL) perl.imp -$(AOUT_LIBPERL_DLL): perl.imp perl.dll perl5.def +$(AOUT_LIBPERL_DLL): perl.imp $(PERL_DLL) perl5.def emximp -o $(AOUT_LIBPERL_DLL) perl.imp perl.imp: perl5.def @@ -38,12 +50,12 @@ perl.imp: perl5.def echo 'emx_malloc emxlibcm 402 ?' >> $@ echo 'emx_realloc emxlibcm 403 ?' >> $@ -perl.dll: $(obj) perl5.def perl$(OBJ_EXT) +$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT) $(LD) $(LD_OPT) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def perl5.def: perl.linkexp - echo "LIBRARY 'Perl' INITINSTANCE TERMINSTANCE" > $@ - echo DESCRIPTION "'Perl interpreter, export autogenerated'" >>$@ + echo "LIBRARY '$(PERL_DLL_BASE)' INITINSTANCE TERMINSTANCE" > $@ + echo DESCRIPTION "'Perl interpreter v$(PERL_VERSION), export autogenerated'" >>$@ echo STACKSIZE 32768 >>$@ echo CODE LOADONCALL >>$@ echo DATA LOADONCALL NONSHARED MULTIPLE >>$@ @@ -68,7 +80,7 @@ perl.exports: perl.exp EXTERN.h perl.h $(CC) -DEMBED -E - | \ awk '{if ($$2 == "") print $$1}' | sort | uniq > $@ -perl.linkexp: perl.exports perl.map +perl.linkexp: perl.exports perl.map os2/os2.sym cat perl.exports os2/os2.sym perl.map | sort | uniq -d | sed -e 's/\w\+/ "\0"/' > perl.linkexp # We link miniperl statically, since .DLL depends on $(DYNALOADER) diff --git a/os2/os2.c b/os2/os2.c index d4050ac..94d25e2 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -40,16 +40,16 @@ const char *pthreads_states[] = { typedef struct { void *status; - pthread_cond_t cond; + perl_cond cond; enum pthreads_state state; } thread_join_t; thread_join_t *thread_join_data; int thread_join_count; -pthread_mutex_t start_thread_mutex; +perl_mutex start_thread_mutex; int -pthread_join(pthread_t tid, void **status) +pthread_join(perl_os_thread tid, void **status) { MUTEX_LOCK(&start_thread_mutex); switch (thread_join_data[tid].state) { @@ -117,7 +117,7 @@ pthread_startit(void *arg) } int -pthread_create(pthread_t *tid, const pthread_attr_t *attr, +pthread_create(perl_os_thread *tid, const pthread_attr_t *attr, void *(*start_routine)(void*), void *arg) { void *args[2]; @@ -134,7 +134,7 @@ pthread_create(pthread_t *tid, const pthread_attr_t *attr, } int -pthread_detach(pthread_t tid) +pthread_detach(perl_os_thread tid) { MUTEX_LOCK(&start_thread_mutex); switch (thread_join_data[tid].state) { @@ -157,7 +157,7 @@ pthread_detach(pthread_t tid) /* This is a very bastardized version: */ int -os2_cond_wait(pthread_cond_t *c, pthread_mutex_t *m) +os2_cond_wait(perl_cond *c, perl_mutex *m) { int rc; if ((rc = DosResetEventSem(*c,&na)) && (rc != ERROR_ALREADY_RESET)) @@ -963,6 +963,9 @@ mod2fname(sv) } avlen --; } +#ifdef USE_THREADS + sum++; /* Avoid conflict of DLLs in memory. */ +#endif fname[pos] = 'A' + (sum % 26); fname[pos + 1] = 'A' + (sum / 26 % 26); fname[pos + 2] = '\0'; diff --git a/os2/os2thread.h b/os2/os2thread.h index 44dec3f..d56fe16 100644 --- a/os2/os2thread.h +++ b/os2/os2thread.h @@ -1,10 +1,16 @@ #include #include #include -typedef int pthread_t; -typedef _rmutex pthread_mutex_t; -/*typedef HEV pthread_cond_t;*/ -typedef unsigned long pthread_cond_t; -typedef int pthread_key_t; +typedef int perl_os_thread; + +typedef _rmutex perl_mutex; + +/*typedef HEV perl_cond;*/ /* Will include os2.h into all C files. */ +typedef unsigned long perl_cond; + +typedef int perl_key; + typedef unsigned long pthread_attr_t; #define PTHREADS_INCLUDED +#define pthread_attr_init(arg) 0 +#define pthread_attr_setdetachstate(arg1,arg2) 0 diff --git a/patchlevel.h b/patchlevel.h index be0c773..292d76f 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,6 +1,6 @@ #ifndef __PATCHLEVEL_H_INCLUDED__ #define PATCHLEVEL 4 -#define SUBVERSION 64 +#define SUBVERSION 65 /* local_patches -- list of locally applied less-than-subversion patches. diff --git a/perl.c b/perl.c index 16c5b9f..464a49b 100644 --- a/perl.c +++ b/perl.c @@ -699,7 +699,7 @@ setuid perl scripts securely.\n"); if (euid != uid || egid != gid) croak("No -e allowed in setuid scripts"); if (!e_fp) { -#ifdef HAS_UMASK +#if defined(HAS_UMASK) && !defined(VMS) int oldumask = PerlLIO_umask(0177); #endif e_tmpname = savepv(TMPPATH); @@ -726,7 +726,7 @@ setuid perl scripts securely.\n"); #endif if (!e_fp) croak("Cannot create temporary file \"%s\"", e_tmpname); -#ifdef HAS_UMASK +#if defined(HAS_UMASK) && !defined(VMS) (void)PerlLIO_umask(oldumask); #endif } diff --git a/perl.h b/perl.h index 537da4f..42250ed 100644 --- a/perl.h +++ b/perl.h @@ -91,7 +91,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); #define SOFT_CAST(type) (type) #endif -#ifndef BYTEORDER +#ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */ # define BYTEORDER 0x1234 #endif @@ -695,12 +695,21 @@ Free_t Perl_free _((Malloc_t where)); # ifdef convex # define Quad_t long long # else -# if BYTEORDER > 0xFFFF +# if LONGSIZE == 8 # define Quad_t long # endif # endif #endif +/* XXX Experimental set-up for long long. Just add -DUSE_LONG_LONG + to your ccflags. --Andy Dougherty 4/1998 +*/ +#ifdef USE_LONG_LONG +# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8 +# define Quad_t long long +# endif +#endif + #ifdef Quad_t # define HAS_QUAD typedef Quad_t IV; diff --git a/plan9/config.plan9 b/plan9/config.plan9 index 463c094..6916622 100644 --- a/plan9/config.plan9 +++ b/plan9/config.plan9 @@ -1144,12 +1144,17 @@ * This symbol, if defined, indicates to the C program that struct passwd * contains pw_comment. */ +/* PWGECOS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_gecos. + */ #define I_PWD /**/ #undef PWQUOTA /**/ #undef PWAGE /**/ #undef PWCHANGE /**/ #undef PWCLASS /**/ #undef PWEXPIRE /**/ +#define PWGECOS /**/ #undef PWCOMMENT /**/ /* I_STDDEF: diff --git a/pod/Makefile b/pod/Makefile index 7eeabd9..e9623a6 100644 --- a/pod/Makefile +++ b/pod/Makefile @@ -9,6 +9,7 @@ POD2HTML = pod2html \ all: $(CONVERTERS) man PERL = ../miniperl +REALPERL = ../perl POD = \ perl.pod \ @@ -240,7 +241,7 @@ toc: clean: rm -f $(MAN) $(HTML) $(TEX) rm -f pod2html-*cache - rm -f *.aux *.log + rm -f *.aux *.log *.exe realclean: clean rm -f $(CONVERTERS) @@ -267,4 +268,7 @@ pod2text: pod2text.PL ../lib/Config.pm checkpods: checkpods.PL ../lib/Config.pm $(PERL) -I ../lib checkpods.PL +compile: all + $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' pod2latex pod2man pod2text checkpods -prog -verbose dcf -log ../compilelog; + diff --git a/pod/perldebug.pod b/pod/perldebug.pod index a02fd5c..8937c7e 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -290,6 +290,14 @@ For example, this will print out C<$foo> every time line Delete all installed actions. +=item W [expr] + +Add a global watch-expression. + +=item W + +Delete all watch-expressions. + =item O [opt[=val]] [opt"val"] [opt?]... Set or query values of options. val defaults to 1. opt can @@ -392,6 +400,10 @@ Dump arrays holding debugged files. Dump symbol tables of packages. +=item C + +Dump contents of "reused" addresses. + =item C, C, C Change style of string dump. Default value of C is C, one diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 9443f38..4ec71c8 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -1,1580 +1,27 @@ =head1 NAME -perldelta - what's new for perl5.004 +perldelta - what's new for perl5.005 =head1 DESCRIPTION -This document describes differences between the 5.003 release (as -documented in I, second edition--the Camel Book) and -this one. +This document describes differences between the 5.004 release and this one. -=head1 Supported Environments - -Perl5.004 builds out of the box on Unix, Plan 9, LynxOS, VMS, OS/2, -QNX, AmigaOS, and Windows NT. Perl runs on Windows 95 as well, but it -cannot be built there, for lack of a reasonable command interpreter. +=head1 Incompatible Changes =head1 Core Changes -Most importantly, many bugs were fixed, including several security -problems. See the F file in the distribution for details. - -=head2 List assignment to %ENV works - -C<%ENV = ()> and C<%ENV = @list> now work as expected (except on VMS -where it generates a fatal error). - -=head2 "Can't locate Foo.pm in @INC" error now lists @INC - -=head2 Compilation option: Binary compatibility with 5.003 - -There is a new Configure question that asks if you want to maintain -binary compatibility with Perl 5.003. If you choose binary -compatibility, you do not have to recompile your extensions, but you -might have symbol conflicts if you embed Perl in another application, -just as in the 5.003 release. By default, binary compatibility -is preserved at the expense of symbol table pollution. - -=head2 $PERL5OPT environment variable - -You may now put Perl options in the $PERL5OPT environment variable. -Unless Perl is running with taint checks, it will interpret this -variable as if its contents had appeared on a "#!perl" line at the -beginning of your script, except that hyphens are optional. PERL5OPT -may only be used to set the following switches: B<-[DIMUdmw]>. - -=head2 Limitations on B<-M>, B<-m>, and B<-T> options - -The C<-M> and C<-m> options are no longer allowed on the C<#!> line of -a script. If a script needs a module, it should invoke it with the -C pragma. - -The B<-T> option is also forbidden on the C<#!> line of a script, -unless it was present on the Perl command line. Due to the way C<#!> -works, this usually means that B<-T> must be in the first argument. -Thus: - - #!/usr/bin/perl -T -w - -will probably work for an executable script invoked as C, -while: - - #!/usr/bin/perl -w -T - -will probably fail under the same conditions. (Non-Unix systems will -probably not follow this rule.) But C is guaranteed -to fail, since then there is no chance of B<-T> being found on the -command line before it is found on the C<#!> line. - -=head2 More precise warnings - -If you removed the B<-w> option from your Perl 5.003 scripts because it -made Perl too verbose, we recommend that you try putting it back when -you upgrade to Perl 5.004. Each new perl version tends to remove some -undesirable warnings, while adding new warnings that may catch bugs in -your scripts. - -=head2 Deprecated: Inherited C for non-methods - -Before Perl 5.004, C functions were looked up as methods -(using the C<@ISA> hierarchy), even when the function to be autoloaded -was called as a plain function (e.g. C), not a method -(e.g. Cbar()> or C<$obj-Ebar()>). - -Perl 5.005 will use method lookup only for methods' Cs. -However, there is a significant base of existing code that may be using -the old behavior. So, as an interim step, Perl 5.004 issues an optional -warning when a non-method uses an inherited C. - -The simple rule is: Inheritance will not work when autoloading -non-methods. The simple fix for old code is: In any module that used to -depend on inheriting C for non-methods from a base class named -C, execute C<*AUTOLOAD = \&BaseClass::AUTOLOAD> during startup. - -=head2 Previously deprecated %OVERLOAD is no longer usable - -Using %OVERLOAD to define overloading was deprecated in 5.003. -Overloading is now defined using the overload pragma. %OVERLOAD is -still used internally but should not be used by Perl scripts. See -L for more details. - -=head2 Subroutine arguments created only when they're modified - -In Perl 5.004, nonexistent array and hash elements used as subroutine -parameters are brought into existence only if they are actually -assigned to (via C<@_>). - -Earlier versions of Perl vary in their handling of such arguments. -Perl versions 5.002 and 5.003 always brought them into existence. -Perl versions 5.000 and 5.001 brought them into existence only if -they were not the first argument (which was almost certainly a bug). -Earlier versions of Perl never brought them into existence. - -For example, given this code: - - undef @a; undef %a; - sub show { print $_[0] }; - sub change { $_[0]++ }; - show($a[2]); - change($a{b}); - -After this code executes in Perl 5.004, $a{b} exists but $a[2] does -not. In Perl 5.002 and 5.003, both $a{b} and $a[2] would have existed -(but $a[2]'s value would have been undefined). - -=head2 Group vector changeable with C<$)> - -The C<$)> special variable has always (well, in Perl 5, at least) -reflected not only the current effective group, but also the group list -as returned by the C C function (if there is one). -However, until this release, there has not been a way to call the -C C function from Perl. - -In Perl 5.004, assigning to C<$)> is exactly symmetrical with examining -it: The first number in its string value is used as the effective gid; -if there are any numbers after the first one, they are passed to the -C C function (if there is one). - -=head2 Fixed parsing of $$, &$, etc. - -Perl versions before 5.004 misinterpreted any type marker followed by -"$" and a digit. For example, "$$0" was incorrectly taken to mean -"${$}0" instead of "${$0}". This bug is (mostly) fixed in Perl 5.004. - -However, the developers of Perl 5.004 could not fix this bug completely, -because at least two widely-used modules depend on the old meaning of -"$$0" in a string. So Perl 5.004 still interprets "$$" in the -old (broken) way inside strings; but it generates this message as a -warning. And in Perl 5.005, this special treatment will cease. - -=head2 Fixed localization of $, $&, etc. - -Perl versions before 5.004 did not always properly localize the -regex-related special variables. Perl 5.004 does localize them, as -the documentation has always said it should. This may result in $1, -$2, etc. no longer being set where existing programs use them. - -=head2 No resetting of $. on implicit close - -The documentation for Perl 5.0 has always stated that C<$.> is I -reset when an already-open file handle is reopened with no intervening -call to C. Due to a bug, perl versions 5.000 through 5.003 -I reset C<$.> under that circumstance; Perl 5.004 does not. - -=head2 C may return undef - -The C operator returns true if a subroutine is expected to -return a list, and false otherwise. In Perl 5.004, C can -also return the undefined value if a subroutine's return value will -not be used at all, which allows subroutines to avoid a time-consuming -calculation of a return value if it isn't going to be used. - -=head2 C determines value of EXPR in scalar context - -Perl (version 5) used to determine the value of EXPR inconsistently, -sometimes incorrectly using the surrounding context for the determination. -Now, the value of EXPR (before being parsed by eval) is always determined in -a scalar context. Once parsed, it is executed as before, by providing -the context that the scope surrounding the eval provided. This change -makes the behavior Perl4 compatible, besides fixing bugs resulting from -the inconsistent behavior. This program: - - @a = qw(time now is time); - print eval @a; - print '|', scalar eval @a; - -used to print something like "timenowis881399109|4", but now (and in perl4) -prints "4|4". - -=head2 Changes to tainting checks - -A bug in previous versions may have failed to detect some insecure -conditions when taint checks are turned on. (Taint checks are used -in setuid or setgid scripts, or when explicitly turned on with the -C<-T> invocation option.) Although it's unlikely, this may cause a -previously-working script to now fail -- which should be construed -as a blessing, since that indicates a potentially-serious security -hole was just plugged. - -The new restrictions when tainting include: - -=over - -=item No glob() or <*> - -These operators may spawn the C shell (csh), which cannot be made -safe. This restriction will be lifted in a future version of Perl -when globbing is implemented without the use of an external program. - -=item No spawning if tainted $CDPATH, $ENV, $BASH_ENV - -These environment variables may alter the behavior of spawned programs -(especially shells) in ways that subvert security. So now they are -treated as dangerous, in the manner of $IFS and $PATH. - -=item No spawning if tainted $TERM doesn't look like a terminal name - -Some termcap libraries do unsafe things with $TERM. However, it would be -unnecessarily harsh to treat all $TERM values as unsafe, since only shell -metacharacters can cause trouble in $TERM. So a tainted $TERM is -considered to be safe if it contains only alphanumerics, underscores, -dashes, and colons, and unsafe if it contains other characters (including -whitespace). - -=back - -=head2 New Opcode module and revised Safe module - -A new Opcode module supports the creation, manipulation and -application of opcode masks. The revised Safe module has a new API -and is implemented using the new Opcode module. Please read the new -Opcode and Safe documentation. - -=head2 Embedding improvements - -In older versions of Perl it was not possible to create more than one -Perl interpreter instance inside a single process without leaking like a -sieve and/or crashing. The bugs that caused this behavior have all been -fixed. However, you still must take care when embedding Perl in a C -program. See the updated perlembed manpage for tips on how to manage -your interpreters. - -=head2 Internal change: FileHandle class based on IO::* classes - -File handles are now stored internally as type IO::Handle. The -FileHandle module is still supported for backwards compatibility, but -it is now merely a front end to the IO::* modules -- specifically, -IO::Handle, IO::Seekable, and IO::File. We suggest, but do not -require, that you use the IO::* modules in new code. - -In harmony with this change, C<*GLOB{FILEHANDLE}> is now just a -backward-compatible synonym for C<*GLOB{IO}>. - -=head2 Internal change: PerlIO abstraction interface - -It is now possible to build Perl with AT&T's sfio IO package -instead of stdio. See L for more details, and -the F file for how to use it. - -=head2 New and changed syntax - -=over - -=item $coderef->(PARAMS) - -A subroutine reference may now be suffixed with an arrow and a -(possibly empty) parameter list. This syntax denotes a call of the -referenced subroutine, with the given parameters (if any). - -This new syntax follows the pattern of S{FOO}>> and -S[$foo]>>: You may now write S> as -S($foo)>>. All of these arrow terms may be chained; -thus, S{FOO}}($bar)>> may now be written -S{FOO}-E($bar)>>. - -=back - -=head2 New and changed builtin constants - -=over - -=item __PACKAGE__ - -The current package name at compile time, or the undefined value if -there is no current package (due to a C directive). Like -C<__FILE__> and C<__LINE__>, C<__PACKAGE__> does I interpolate -into strings. - -=back - -=head2 New and changed builtin variables - -=over - -=item $^E - -Extended error message on some platforms. (Also known as -$EXTENDED_OS_ERROR if you C). - -=item $^H - -The current set of syntax checks enabled by C. See the -documentation of C for more details. Not actually new, but -newly documented. -Because it is intended for internal use by Perl core components, -there is no C long name for this variable. - -=item $^M - -By default, running out of memory it is not trappable. However, if -compiled for this, Perl may use the contents of C<$^M> as an emergency -pool after die()ing with this message. Suppose that your Perl were -compiled with -DPERL_EMERGENCY_SBRK and used Perl's malloc. Then - - $^M = 'a' x (1<<16); - -would allocate a 64K buffer for use when in emergency. -See the F file for information on how to enable this option. -As a disincentive to casual use of this advanced feature, -there is no C long name for this variable. - -=back - -=head2 New and changed builtin functions - -=over - -=item delete on slices - -This now works. (e.g. C) - -=item flock - -is now supported on more platforms, prefers fcntl to lockf when -emulating, and always flushes before (un)locking. - -=item printf and sprintf - -Perl now implements these functions itself; it doesn't use the C -library function sprintf() any more, except for floating-point -numbers, and even then only known flags are allowed. As a result, it -is now possible to know which conversions and flags will work, and -what they will do. - -The new conversions in Perl's sprintf() are: - - %i a synonym for %d - %p a pointer (the address of the Perl value, in hexadecimal) - %n special: *stores* the number of characters output so far - into the next variable in the parameter list - -The new flags that go between the C<%> and the conversion are: - - # prefix octal with "0", hex with "0x" - h interpret integer as C type "short" or "unsigned short" - V interpret integer as Perl's standard integer type - -Also, where a number would appear in the flags, an asterisk ("*") may -be used instead, in which case Perl uses the next item in the -parameter list as the given number (that is, as the field width or -precision). If a field width obtained through "*" is negative, it has -the same effect as the '-' flag: left-justification. - -See L for a complete list of conversion and flags. - -=item keys as an lvalue - -As an lvalue, C allows you to increase the number of hash buckets -allocated for the given hash. This can gain you a measure of efficiency if -you know the hash is going to get big. (This is similar to pre-extending -an array by assigning a larger number to $#array.) If you say - - keys %hash = 200; - -then C<%hash> will have at least 200 buckets allocated for it. These -buckets will be retained even if you do C<%hash = ()>; use C if you want to free the storage while C<%hash> is still in scope. -You can't shrink the number of buckets allocated for the hash using -C in this way (but you needn't worry about doing this by accident, -as trying has no effect). - -=item my() in Control Structures - -You can now use my() (with or without the parentheses) in the control -expressions of control structures such as: - - while (defined(my $line = <>)) { - $line = lc $line; - } continue { - print $line; - } - - if ((my $answer = ) =~ /^y(es)?$/i) { - user_agrees(); - } elsif ($answer =~ /^n(o)?$/i) { - user_disagrees(); - } else { - chomp $answer; - die "`$answer' is neither `yes' nor `no'"; - } - -Also, you can declare a foreach loop control variable as lexical by -preceding it with the word "my". For example, in: - - foreach my $i (1, 2, 3) { - some_function(); - } - -$i is a lexical variable, and the scope of $i extends to the end of -the loop, but not beyond it. - -Note that you still cannot use my() on global punctuation variables -such as $_ and the like. - -=item pack() and unpack() - -A new format 'w' represents a BER compressed integer (as defined in -ASN.1). Its format is a sequence of one or more bytes, each of which -provides seven bits of the total value, with the most significant -first. Bit eight of each byte is set, except for the last byte, in -which bit eight is clear. - -If 'p' or 'P' are given undef as values, they now generate a NULL -pointer. - -Both pack() and unpack() now fail when their templates contain invalid -types. (Invalid types used to be ignored.) - -=item sysseek() - -The new sysseek() operator is a variant of seek() that sets and gets the -file's system read/write position, using the lseek(2) system call. It is -the only reliable way to seek before using sysread() or syswrite(). Its -return value is the new position, or the undefined value on failure. - -=item use VERSION - -If the first argument to C is a number, it is treated as a version -number instead of a module name. If the version of the Perl interpreter -is less than VERSION, then an error message is printed and Perl exits -immediately. Because C occurs at compile time, this check happens -immediately during the compilation process, unlike C, -which waits until runtime for the check. This is often useful if you -need to check the current Perl version before Cing library modules -which have changed in incompatible ways from older versions of Perl. -(We try not to do this more than we have to.) - -=item use Module VERSION LIST - -If the VERSION argument is present between Module and LIST, then the -C will call the VERSION method in class Module with the given -version as an argument. The default VERSION method, inherited from -the UNIVERSAL class, croaks if the given version is larger than the -value of the variable $Module::VERSION. (Note that there is not a -comma after VERSION!) - -This version-checking mechanism is similar to the one currently used -in the Exporter module, but it is faster and can be used with modules -that don't use the Exporter. It is the recommended method for new -code. - -=item prototype(FUNCTION) - -Returns the prototype of a function as a string (or C if the -function has no prototype). FUNCTION is a reference to or the name of the -function whose prototype you want to retrieve. -(Not actually new; just never documented before.) - -=item srand - -The default seed for C, which used to be C