diff options
73 files changed, 2281 insertions, 1207 deletions
@@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Mon Mar 9 14:02:25 EST 1998 [metaconfig 3.0 PL70] +# Generated on Thu Apr 2 09:30:50 EST 1998 [metaconfig 3.0 PL70] cat >/tmp/c1$$ <<EOF ARGGGHHHH!!!!! @@ -176,7 +176,6 @@ emacs='' expr='' find='' flex='' -gcc='' grep='' gzip='' inews='' @@ -332,10 +331,12 @@ aphostname='' d_gethname='' d_phostname='' d_uname='' +d_gethostprotos='' d_getlogin='' d_getnbyaddr='' d_getnbyname='' d_getnent='' +d_getnetprotos='' d_getpent='' d_getpgid='' d_getpgrp2='' @@ -345,7 +346,9 @@ d_getppid='' d_getprior='' d_getpbyname='' d_getpbynumber='' +d_getprotoprotos='' d_getsent='' +d_getservprotos='' d_getsbyname='' d_getsbyport='' d_gnulibc='' @@ -358,6 +361,8 @@ d_locconv='' d_lockf='' d_longdbl='' longdblsize='' +d_longlong='' +longlongsize='' d_lstat='' d_mblen='' d_mbstowcs='' @@ -1904,6 +1909,8 @@ EOM *.08.*) osvers=9 ;; *.09.*) osvers=9 ;; *.10.*) osvers=10 ;; + *.11.*) osvers=11 ;; + *.12.*) osvers=12 ;; *) osvers="$3" ;; esac ;; @@ -2277,8 +2284,8 @@ esac set usethreads eval $setvar : Look for a hint-file generated 'call-back-unit'. Now that the -: user has specified the compiler, we may need to set or change some -: other defaults. +: user has specified if a threading perl is to be built, we may need +: to set or change some other defaults. if $test -f usethreads.cbu; then . ./usethreads.cbu fi @@ -3055,393 +3062,6 @@ else echo "Could not find manual pages in source form." >&4 fi -: determine where manual pages go -set man1dir man1dir none -eval $prefixit -$cat <<EOM - -$spackage has manual pages available in source form. -EOM -case "$nroff" in -nroff) - echo "However, you don't have nroff, so they're probably useless to you." - case "$man1dir" in - '') man1dir="none";; - esac;; -esac -echo "If you don't want the manual sources installed, answer 'none'." -case "$man1dir" in -' ') dflt=none - ;; -'') - lookpath="$prefixexp/man/man1 $prefixexp/man/l_man/man1" - lookpath="$lookpath $prefixexp/man/p_man/man1" - lookpath="$lookpath $prefixexp/man/u_man/man1" - lookpath="$lookpath $prefixexp/man/man.1" - case "$sysman" in - */?_man*) dflt=`./loc . $prefixexp/l_man/man1 $lookpath` ;; - *) dflt=`./loc . $prefixexp/man/man1 $lookpath` ;; - esac - set dflt - eval $prefixup - ;; -*) dflt="$man1dir" - ;; -esac -echo " " -fn=dn+~ -rp="Where do the main $spackage manual pages (source) go?" -. ./getfile -if $test "X$man1direxp" != "X$ansexp"; then - installman1dir='' -fi -man1dir="$ans" -man1direxp="$ansexp" -case "$man1dir" in -'') man1dir=' ' - installman1dir='';; -esac -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in which -manual pages reside from the directory in which they are installed (and from -which they are presumably copied to the former directory by occult means). - -EOM - case "$installman1dir" in - '') dflt=`echo $man1direxp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installman1dir";; - esac - fn=de~ - rp='Where will man pages be installed?' - . ./getfile - installman1dir="$ans" -else - installman1dir="$man1direxp" -fi - -: What suffix to use on installed man pages - -case "$man1dir" in -' ') - man1ext='0' - ;; -*) - rp="What suffix should be used for the main $spackage man pages?" - case "$man1ext" in - '') case "$man1dir" in - *1) dflt=1 ;; - *1p) dflt=1p ;; - *1pm) dflt=1pm ;; - *l) dflt=l;; - *n) dflt=n;; - *o) dflt=o;; - *p) dflt=p;; - *C) dflt=C;; - *L) dflt=L;; - *L1) dflt=L1;; - *) dflt=1;; - esac - ;; - *) dflt="$man1ext";; - esac - . ./myread - man1ext="$ans" - ;; -esac - -: see if we can have long filenames -echo " " -rmlist="$rmlist /tmp/cf$$" -$test -d /tmp/cf$$ || mkdir /tmp/cf$$ -first=123456789abcdef -second=/tmp/cf$$/$first -$rm -f $first $second -if (echo hi >$first) 2>/dev/null; then - if $test -f 123456789abcde; then - echo 'You cannot have filenames longer than 14 characters. Sigh.' >&4 - val="$undef" - else - if (echo hi >$second) 2>/dev/null; then - if $test -f /tmp/cf$$/123456789abcde; then - $cat <<'EOM' -That's peculiar... You can have filenames longer than 14 characters, but only -on some of the filesystems. Maybe you are using NFS. Anyway, to avoid problems -I shall consider your system cannot support long filenames at all. -EOM - val="$undef" - else - echo 'You can have filenames longer than 14 characters.' >&4 - val="$define" - fi - else - $cat <<'EOM' -How confusing! Some of your filesystems are sane enough to allow filenames -longer than 14 characters but some others like /tmp can't even think about them. -So, for now on, I shall assume your kernel does not allow them at all. -EOM - val="$undef" - fi - fi -else - $cat <<'EOM' -You can't have filenames longer than 14 chars. You can't even think about them! -EOM - val="$undef" -fi -set d_flexfnam -eval $setvar -$rm -rf /tmp/cf$$ 123456789abcde* - -: determine where library module manual pages go -set man3dir man3dir none -eval $prefixit -$cat <<EOM - -$spackage has manual pages for many of the library modules. -EOM - -case "$nroff" in -nroff) - $cat <<'EOM' -However, you don't have nroff, so they're probably useless to you. -EOM - case "$man3dir" in - '') man3dir="none";; - esac;; -esac - -case "$d_flexfnam" in -undef) - $cat <<'EOM' -However, your system can't handle the long file names like File::Basename.3. -EOM - case "$man3dir" in - '') man3dir="none";; - esac;; -esac - -echo "If you don't want the manual sources installed, answer 'none'." -prog=`echo $package | $sed 's/-*[0-9.]*$//'` -case "$man3dir" in -'') case "$prefix" in - *$prog*) dflt=`echo $man1dir | - $sed -e 's/man1/man3/g' -e 's/man\.1/man\.3/g'` ;; - *) dflt="$privlib/man/man3" ;; - esac - ;; -' ') dflt=none;; -*) dflt="$man3dir" ;; -esac -echo " " - -fn=dn+~ -rp="Where do the $package library man pages (source) go?" -. ./getfile -if test "X$man3direxp" != "X$ansexp"; then - installman3dir='' -fi - -man3dir="$ans" -man3direxp="$ansexp" -case "$man3dir" in -'') man3dir=' ' - installman3dir='';; -esac -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in which -manual pages reside from the directory in which they are installed (and from -which they are presumably copied to the former directory by occult means). - -EOM - case "$installman3dir" in - '') dflt=`echo $man3direxp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installman3dir";; - esac - fn=de~ - rp='Where will man pages be installed?' - . ./getfile - installman3dir="$ans" -else - installman3dir="$man3direxp" -fi - -: What suffix to use on installed man pages - -case "$man3dir" in -' ') - man3ext='0' - ;; -*) - rp="What suffix should be used for the $package library man pages?" - case "$man3ext" in - '') case "$man3dir" in - *3) dflt=3 ;; - *3p) dflt=3p ;; - *3pm) dflt=3pm ;; - *l) dflt=l;; - *n) dflt=n;; - *o) dflt=o;; - *p) dflt=p;; - *C) dflt=C;; - *L) dflt=L;; - *L3) dflt=L3;; - *) dflt=3;; - esac - ;; - *) dflt="$man3ext";; - esac - . ./myread - man3ext="$ans" - ;; -esac - -: determine where public executable scripts go -set scriptdir scriptdir -eval $prefixit -case "$scriptdir" in -'') - dflt="$bin" - : guess some guesses - $test -d /usr/share/scripts && dflt=/usr/share/scripts - $test -d /usr/share/bin && dflt=/usr/share/bin - $test -d /usr/local/script && dflt=/usr/local/script - $test -d $prefixexp/script && dflt=$prefixexp/script - set dflt - eval $prefixup - ;; -*) dflt="$scriptdir" - ;; -esac -$cat <<EOM - -Some installations have a separate directory just for executable scripts so -that they can mount it across multiple architectures but keep the scripts in -one spot. You might, for example, have a subdirectory of /usr/share for this. -Or you might just lump your scripts in with all your other executables. - -EOM -fn=d~ -rp='Where do you keep publicly executable scripts?' -. ./getfile -if $test "X$ansexp" != "X$scriptdirexp"; then - installscript='' -fi -scriptdir="$ans" -scriptdirexp="$ansexp" -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in which -scripts reside from the directory in which they are installed (and from -which they are presumably copied to the former directory by occult means). - -EOM - case "$installscript" in - '') dflt=`echo $scriptdirexp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installscript";; - esac - fn=de~ - rp='Where will public scripts be installed?' - . ./getfile - installscript="$ans" -else - installscript="$scriptdirexp" -fi - -: determine where site specific libraries go. -set sitelib sitelib -eval $prefixit -case "$sitelib" in -'') - prog=`echo $package | $sed 's/-*[0-9.]*$//'` - dflt="$privlib/site_$prog" ;; -*) dflt="$sitelib" ;; -esac -$cat <<EOM - -The installation process will also create a directory for -site-specific extensions and modules. Some users find it convenient -to place all local files in this directory rather than in the main -distribution directory. - -EOM -fn=d~+ -rp='Pathname for the site-specific library files?' -. ./getfile -if $test "X$sitelibexp" != "X$ansexp"; then - installsitelib='' -fi -sitelib="$ans" -sitelibexp="$ansexp" -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in -which site-specific files reside from the directory in which they are -installed (and from which they are presumably copied to the former -directory by occult means). - -EOM - case "$installsitelib" in - '') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installsitelib";; - esac - fn=de~ - rp='Where will site-specific files be installed?' - . ./getfile - installsitelib="$ans" -else - installsitelib="$sitelibexp" -fi - -: determine where site specific architecture-dependent libraries go. -xxx=`echo $sitelib/$archname | sed 's!^$prefix!!'` -: xxx is usuually lib/site_perl/archname. -set sitearch sitearch none -eval $prefixit -case "$sitearch" in -'') dflt="$sitelib/$archname" ;; -*) dflt="$sitearch" ;; -esac -$cat <<EOM - -The installation process will also create a directory for -architecture-dependent site-specific extensions and modules. - -EOM -fn=nd~+ -rp='Pathname for the site-specific architecture-dependent library files?' -. ./getfile -if $test "X$sitearchexp" != "X$ansexp"; then - installsitearch='' -fi -sitearch="$ans" -sitearchexp="$ansexp" -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in -which site-specific architecture-dependent library files reside from -the directory in which they are installed (and from which they are -presumably copied to the former directory by occult means). - -EOM - case "$installsitearch" in - '') dflt=`echo $sitearchexp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installsitearch";; - esac - fn=de~ - rp='Where will site-specific architecture-dependent files be installed?' - . ./getfile - installsitearch="$ans" -else - installsitearch="$sitearchexp" -fi - : see what memory models we can support case "$models" in '') @@ -4341,7 +3961,12 @@ $rm -f try try.* core compile=' mc_file=$1; shift; -$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs > /dev/null 2>&1;' +$cc $optimize $ccflags $ldflags -o ${mc_file}$_exe $* ${mc_file}.c $libs > /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;' echo " " echo "Checking for GNU C Library..." >&4 @@ -4354,7 +3979,7 @@ main() EOM set gnulibc if eval $compile && \ - ./gnulibc | $contains '^GNU C Library' >/dev/null 2>&1; then + ./gnulibc | $contains '^GNU C Library'; then val="$define" echo "You are using the GNU C Library" else @@ -4368,12 +3993,26 @@ eval $setvar : see if nm is to be used to determine whether a symbol is defined or not case "$usenm" in '') + dflt='' case "$d_gnulibc" in - $define) + "$define") + echo " " + echo "nm probably won't work on the GNU C Library." >&4 dflt=n ;; - *) - dflt=`egrep 'inlibc|csym' ../Configure | wc -l 2>/dev/null` + esac + case "$dflt" in + '') + if $test "$osname" = aix -a ! -f /lib/syscalls.exp; then + echo " " + echo "Whoops! This is an AIX system without /lib/syscalls.exp!" >&4 + echo "'nm' won't be sufficient on this sytem." >&4 + dflt=n + fi + ;; + esac + case "$dflt" in + '') dflt=`egrep 'inlibc|csym' ../Configure | wc -l 2>/dev/null` if $test $dflt -gt 20; then dflt=y else @@ -4384,26 +4023,28 @@ case "$usenm" in ;; *) case "$usenm" in - true) dflt=y;; + true|$define) dflt=y;; *) dflt=n;; esac ;; esac $cat <<EOM -I can use '$nm' to extract the symbols from your C libraries. This is a time -consuming task which may generate huge output on the disk (up to 3 megabytes) -but that should make the symbols extraction faster. The alternative is to skip -the 'nm' extraction part and to compile a small test program instead to -determine whether each symbol is present. If you have a fast C compiler and/or -if your 'nm' output cannot be parsed, this may be the best solution. -You shouldn't let me use 'nm' if you have the GNU C Library. +I can use $nm to extract the symbols from your C libraries. This +is a time consuming task which may generate huge output on the disk (up +to 3 megabytes) but that should make the symbols extraction faster. The +alternative is to skip the 'nm' extraction part and to compile a small +test program instead to determine whether each symbol is present. If +you have a fast C compiler and/or if your 'nm' output cannot be parsed, +this may be the best solution. + +You probably shouldn't let me use 'nm' if you are using the GNU C Library. EOM rp="Shall I use $nm to extract C symbols from the libraries?" . ./myread case "$ans" in -n|N) usenm=false;; +[Nn]*) usenm=false;; *) usenm=true;; esac @@ -4666,12 +4307,27 @@ else echo " " echo "$nm didn't seem to work right. Trying $ar instead..." >&4 com='' - if $ar t $libc > libc.tmp; then - for thisname in $libnames; do + if $ar t $libc > libc.tmp && $contains '^fprintf$' libc.tmp >/dev/null 2>&1; then + for thisname in $libnames $libc; do $ar t $thisname >>libc.tmp done $sed -e "s/\\$_o\$//" < libc.tmp > libc.list echo "Ok." >&4 + elif test "X$osname" = "Xos2" && $ar tv $libc > libc.tmp; then + # Repeat libc to extract forwarders to DLL entries too + for thisname in $libnames $libc; do + $ar tv $thisname >>libc.tmp + # Revision 50 of EMX has bug in $ar. + # it will not extract forwarders to DLL entries + # Use emximp which will extract exactly them. + emximp -o tmp.imp $thisname \ + 2>/dev/null && \ + $sed -e 's/^\([_a-zA-Z0-9]*\) .*$/\1/p' \ + < tmp.imp >>libc.tmp + $rm tmp.imp + done + $sed -e "s/\\$_o\$//" -e 's/^ \+//' < libc.tmp > libc.list + echo "Ok." >&4 else echo "$ar didn't seem to work right." >&4 echo "Maybe this is a Cray...trying bld instead..." >&4 @@ -4885,7 +4541,7 @@ $undef|n|false) $define) dflt='y' ;; esac : Does a dl_xxx.xs file exist for this operating system - $test -f ../$dldir/dl_${osname}.xs && dflt='y' + $test -f $rsrc/$dldir/dl_${osname}.xs && dflt='y' ;; esac rp="Do you wish to use dynamic loading?" @@ -4895,7 +4551,7 @@ case "$ans" in y*) usedl="$define" case "$dlsrc" in '') - if $test -f ../$dldir/dl_${osname}.xs ; then + if $test -f $rsrc/$dldir/dl_${osname}.xs ; then dflt="$dldir/dl_${osname}.xs" elif $test "$d_dlopen" = "$define" ; then dflt="$dldir/dl_dlopen.xs" @@ -4910,15 +4566,17 @@ y*) usedl="$define" esac echo "The following dynamic loading files are available:" : Can not go over to $dldir because getfile has path hard-coded in. - cd ..; ls -C $dldir/dl*.xs; cd UU - rp="Source file to use for dynamic loading" - fn="fne" - . ./getfile + tdir=`pwd`; cd $rsrc; $ls -C $dldir/dl*.xs; cd $tdir + rp="Source file to use for dynamic loading" + fn="fne" + # XXX This getfile call will fail the existence check if you try + # building away from $src (this is not supported yet). + . ./getfile usedl="$define" : emulate basename dlsrc=`echo $ans | $sed -e 's@.*/\([^/]*\)$@\1@'` - $cat << EOM + $cat << EOM Some systems may require passing special flags to $cc -c to compile modules that will be used to create a shared library. @@ -5135,11 +4793,11 @@ EOM # Why does next4 have to be so different? case "${osname}${osvers}" in next4*) xxx='DYLD_LIBRARY_PATH' ;; + os2*) xxx='' ;; # Nothing special needed. *) xxx='LD_LIBRARY_PATH' ;; esac - case "$osname" in - os2) ;; - *) $cat <<EOM | $tee -a ../config.msg >&4 + if test X"$xxx" != "X"; then + $cat <<EOM | $tee -a ../config.msg >&4 To build perl, you must add the current working directory to your $xxx environment variable before running make. You can do @@ -5150,7 +4808,7 @@ for Bourne-style shells, or for Csh-style shells. You *MUST* do this before running make. EOM - esac + fi ;; *) useshrplib='false' ;; esac @@ -5296,6 +4954,250 @@ case "$shrpenv" in '') shrpenv="$tmp_shrpenv" ;; esac +: determine where manual pages go +set man1dir man1dir none +eval $prefixit +$cat <<EOM + +$spackage has manual pages available in source form. +EOM +case "$nroff" in +nroff) + echo "However, you don't have nroff, so they're probably useless to you." + case "$man1dir" in + '') man1dir="none";; + esac;; +esac +echo "If you don't want the manual sources installed, answer 'none'." +case "$man1dir" in +' ') dflt=none + ;; +'') + lookpath="$prefixexp/man/man1 $prefixexp/man/l_man/man1" + lookpath="$lookpath $prefixexp/man/p_man/man1" + lookpath="$lookpath $prefixexp/man/u_man/man1" + lookpath="$lookpath $prefixexp/man/man.1" + case "$sysman" in + */?_man*) dflt=`./loc . $prefixexp/l_man/man1 $lookpath` ;; + *) dflt=`./loc . $prefixexp/man/man1 $lookpath` ;; + esac + set dflt + eval $prefixup + ;; +*) dflt="$man1dir" + ;; +esac +echo " " +fn=dn+~ +rp="Where do the main $spackage manual pages (source) go?" +. ./getfile +if $test "X$man1direxp" != "X$ansexp"; then + installman1dir='' +fi +man1dir="$ans" +man1direxp="$ansexp" +case "$man1dir" in +'') man1dir=' ' + installman1dir='';; +esac +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in which +manual pages reside from the directory in which they are installed (and from +which they are presumably copied to the former directory by occult means). + +EOM + case "$installman1dir" in + '') dflt=`echo $man1direxp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installman1dir";; + esac + fn=de~ + rp='Where will man pages be installed?' + . ./getfile + installman1dir="$ans" +else + installman1dir="$man1direxp" +fi + +: What suffix to use on installed man pages + +case "$man1dir" in +' ') + man1ext='0' + ;; +*) + rp="What suffix should be used for the main $spackage man pages?" + case "$man1ext" in + '') case "$man1dir" in + *1) dflt=1 ;; + *1p) dflt=1p ;; + *1pm) dflt=1pm ;; + *l) dflt=l;; + *n) dflt=n;; + *o) dflt=o;; + *p) dflt=p;; + *C) dflt=C;; + *L) dflt=L;; + *L1) dflt=L1;; + *) dflt=1;; + esac + ;; + *) dflt="$man1ext";; + esac + . ./myread + man1ext="$ans" + ;; +esac + +: see if we can have long filenames +echo " " +rmlist="$rmlist /tmp/cf$$" +$test -d /tmp/cf$$ || mkdir /tmp/cf$$ +first=123456789abcdef +second=/tmp/cf$$/$first +$rm -f $first $second +if (echo hi >$first) 2>/dev/null; then + if $test -f 123456789abcde; then + echo 'You cannot have filenames longer than 14 characters. Sigh.' >&4 + val="$undef" + else + if (echo hi >$second) 2>/dev/null; then + if $test -f /tmp/cf$$/123456789abcde; then + $cat <<'EOM' +That's peculiar... You can have filenames longer than 14 characters, but only +on some of the filesystems. Maybe you are using NFS. Anyway, to avoid problems +I shall consider your system cannot support long filenames at all. +EOM + val="$undef" + else + echo 'You can have filenames longer than 14 characters.' >&4 + val="$define" + fi + else + $cat <<'EOM' +How confusing! Some of your filesystems are sane enough to allow filenames +longer than 14 characters but some others like /tmp can't even think about them. +So, for now on, I shall assume your kernel does not allow them at all. +EOM + val="$undef" + fi + fi +else + $cat <<'EOM' +You can't have filenames longer than 14 chars. You can't even think about them! +EOM + val="$undef" +fi +set d_flexfnam +eval $setvar +$rm -rf /tmp/cf$$ 123456789abcde* + +: determine where library module manual pages go +set man3dir man3dir none +eval $prefixit +$cat <<EOM + +$spackage has manual pages for many of the library modules. +EOM + +case "$nroff" in +nroff) + $cat <<'EOM' +However, you don't have nroff, so they're probably useless to you. +EOM + case "$man3dir" in + '') man3dir="none";; + esac;; +esac + +case "$d_flexfnam" in +undef) + $cat <<'EOM' +However, your system can't handle the long file names like File::Basename.3. +EOM + case "$man3dir" in + '') man3dir="none";; + esac;; +esac + +echo "If you don't want the manual sources installed, answer 'none'." +prog=`echo $package | $sed 's/-*[0-9.]*$//'` +case "$man3dir" in +'') case "$prefix" in + *$prog*) dflt=`echo $man1dir | + $sed -e 's/man1/man3/g' -e 's/man\.1/man\.3/g'` ;; + *) dflt="$privlib/man/man3" ;; + esac + ;; +' ') dflt=none;; +*) dflt="$man3dir" ;; +esac +echo " " + +fn=dn+~ +rp="Where do the $package library man pages (source) go?" +. ./getfile +if test "X$man3direxp" != "X$ansexp"; then + installman3dir='' +fi + +man3dir="$ans" +man3direxp="$ansexp" +case "$man3dir" in +'') man3dir=' ' + installman3dir='';; +esac +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in which +manual pages reside from the directory in which they are installed (and from +which they are presumably copied to the former directory by occult means). + +EOM + case "$installman3dir" in + '') dflt=`echo $man3direxp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installman3dir";; + esac + fn=de~ + rp='Where will man pages be installed?' + . ./getfile + installman3dir="$ans" +else + installman3dir="$man3direxp" +fi + +: What suffix to use on installed man pages + +case "$man3dir" in +' ') + man3ext='0' + ;; +*) + rp="What suffix should be used for the $package library man pages?" + case "$man3ext" in + '') case "$man3dir" in + *3) dflt=3 ;; + *3p) dflt=3p ;; + *3pm) dflt=3pm ;; + *l) dflt=l;; + *n) dflt=n;; + *o) dflt=o;; + *p) dflt=p;; + *C) dflt=C;; + *L) dflt=L;; + *L3) dflt=L3;; + *) dflt=3;; + esac + ;; + *) dflt="$man3ext";; + esac + . ./myread + man3ext="$ans" + ;; +esac + : see if we have to deal with yellow pages, now NIS. if $test -d /usr/etc/yp || $test -d /etc/yp; then if $test -f /usr/etc/nibindd; then @@ -5658,6 +5560,149 @@ case "$startperl" in *) echo "I'll use $perlpath in \"eval 'exec'\"" ;; esac +: determine where public executable scripts go +set scriptdir scriptdir +eval $prefixit +case "$scriptdir" in +'') + dflt="$bin" + : guess some guesses + $test -d /usr/share/scripts && dflt=/usr/share/scripts + $test -d /usr/share/bin && dflt=/usr/share/bin + $test -d /usr/local/script && dflt=/usr/local/script + $test -d $prefixexp/script && dflt=$prefixexp/script + set dflt + eval $prefixup + ;; +*) dflt="$scriptdir" + ;; +esac +$cat <<EOM + +Some installations have a separate directory just for executable scripts so +that they can mount it across multiple architectures but keep the scripts in +one spot. You might, for example, have a subdirectory of /usr/share for this. +Or you might just lump your scripts in with all your other executables. + +EOM +fn=d~ +rp='Where do you keep publicly executable scripts?' +. ./getfile +if $test "X$ansexp" != "X$scriptdirexp"; then + installscript='' +fi +scriptdir="$ans" +scriptdirexp="$ansexp" +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in which +scripts reside from the directory in which they are installed (and from +which they are presumably copied to the former directory by occult means). + +EOM + case "$installscript" in + '') dflt=`echo $scriptdirexp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installscript";; + esac + fn=de~ + rp='Where will public scripts be installed?' + . ./getfile + installscript="$ans" +else + installscript="$scriptdirexp" +fi + +: determine where site specific libraries go. +set sitelib sitelib +eval $prefixit +case "$sitelib" in +'') + prog=`echo $package | $sed 's/-*[0-9.]*$//'` + dflt="$privlib/site_$prog" ;; +*) dflt="$sitelib" ;; +esac +$cat <<EOM + +The installation process will also create a directory for +site-specific extensions and modules. Some users find it convenient +to place all local files in this directory rather than in the main +distribution directory. + +EOM +fn=d~+ +rp='Pathname for the site-specific library files?' +. ./getfile +if $test "X$sitelibexp" != "X$ansexp"; then + installsitelib='' +fi +sitelib="$ans" +sitelibexp="$ansexp" +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in +which site-specific files reside from the directory in which they are +installed (and from which they are presumably copied to the former +directory by occult means). + +EOM + case "$installsitelib" in + '') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installsitelib";; + esac + fn=de~ + rp='Where will site-specific files be installed?' + . ./getfile + installsitelib="$ans" +else + installsitelib="$sitelibexp" +fi + +: determine where site specific architecture-dependent libraries go. +xxx=`echo $sitelib/$archname | sed 's!^$prefix!!'` +: xxx is usuually lib/site_perl/archname. +set sitearch sitearch none +eval $prefixit +case "$sitearch" in +'') dflt="$sitelib/$archname" ;; +*) dflt="$sitearch" ;; +esac +$cat <<EOM + +The installation process will also create a directory for +architecture-dependent site-specific extensions and modules. + +EOM +fn=nd~+ +rp='Pathname for the site-specific architecture-dependent library files?' +. ./getfile +if $test "X$sitearchexp" != "X$ansexp"; then + installsitearch='' +fi +sitearch="$ans" +sitearchexp="$ansexp" +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in +which site-specific architecture-dependent library files reside from +the directory in which they are installed (and from which they are +presumably copied to the former directory by occult means). + +EOM + case "$installsitearch" in + '') dflt=`echo $sitearchexp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installsitearch";; + esac + fn=de~ + rp='Where will site-specific architecture-dependent files be installed?' + . ./getfile + installsitearch="$ans" +else + installsitearch="$sitearchexp" +fi + cat <<EOM Previous version of $package used the standard IO mechanisms as defined @@ -6010,7 +6055,7 @@ main() } EOCP set intsize - if eval $compile && ./intsize > /dev/null; then + if eval $compile_ok && ./intsize > /dev/null; then eval `./intsize` echo "Your integers are $intsize bytes long." echo "Your long integers are $longsize bytes long." @@ -6096,7 +6141,7 @@ $cat >try.c <<EOCP #include <stdio.h> #include <sys/types.h> #include <signal.h> -$signal_t blech() { exit(3); } +$signal_t blech(s) int s; { exit(3); } main() { $xxx i32; @@ -6120,7 +6165,7 @@ main() } EOCP set try -if eval $compile; then +if eval $compile_ok; then ./try yyy=$? else @@ -6146,8 +6191,8 @@ $cat >try.c <<EOCP #include <stdio.h> #include <sys/types.h> #include <signal.h> -$signal_t blech() { exit(7); } -$signal_t blech_in_list() { exit(4); } +$signal_t blech(s) int s; { exit(7); } +$signal_t blech_in_list(s) int s; { exit(4); } unsigned long dummy_long(p) unsigned long p; { return p; } unsigned int dummy_int(p) unsigned int p; { return p; } unsigned short dummy_short(p) unsigned short p; { return p; } @@ -6208,7 +6253,7 @@ main() } EOCP set try -if eval $compile; then +if eval $compile_ok; then ./try castflags=$? else @@ -6662,7 +6707,7 @@ main() { } EOCP set try - if eval $compile; then + if eval $compile_ok; then o_nonblock=`./try` case "$o_nonblock" in '') echo "I can't figure it out, assuming O_NONBLOCK will do.";; @@ -6686,7 +6731,9 @@ case "$eagain" in #include <sys/types.h> #include <signal.h> #define MY_O_NONBLOCK $o_nonblock +#ifndef errno /* XXX need better Configure test */ extern int errno; +#endif $signal_t blech(x) int x; { exit(3); } EOCP $cat >> try.c <<'EOCP' @@ -6741,7 +6788,7 @@ main() } EOCP set try - if eval $compile; then + if eval $compile_ok; then echo "$startsh" >mtry echo "./try >try.out 2>try.ret 3>try.err || exit 4" >>mtry chmod +x mtry @@ -6852,6 +6899,34 @@ eval $inlibc set gethostent d_gethent eval $inlibc +hasproto='varname=$1; func=$2; shift; shift; +while $test $# -ge 2; do + case "$1" in + $define) echo "#include <$2>";; + esac ; + shift 2; +done > try.c; +$cppstdin $cppflags $cppminus < try.c > tryout.c 2>/dev/null; +if $contains "$func.*(" tryout.c >/dev/null 2>&1; then + echo "$func() prototype found."; + val="$define"; +else + echo "$func() prototype NOT found."; + val="$undef"; +fi; +set $varname; +eval $setvar; +$rm -f try.c tryout.c' + +: see if this is a netdb.h system +set netdb.h i_netdb +eval $inhdr + +: see if prototypes for various gethostxxx netdb.h functions are available +echo " " +set d_gethostprotos gethostent $i_netdb netdb.h +eval $hasproto + : see if getlogin exists set getlogin d_getlogin eval $inlibc @@ -6868,6 +6943,11 @@ eval $inlibc set getnetent d_getnent eval $inlibc +: see if prototypes for various getnetxxx netdb.h functions are available +echo " " +set d_getnetprotos getnetent $i_netdb netdb.h +eval $hasproto + : see if getprotobyname exists set getprotobyname d_getpbyname @@ -6897,6 +6977,11 @@ eval $inlibc set getpriority d_getprior eval $inlibc +: see if prototypes for various getprotoxxx netdb.h functions are available +echo " " +set d_getprotoprotos getprotoent $i_netdb netdb.h +eval $hasproto + : see if getservbyname exists set getservbyname d_getsbyname @@ -6910,6 +6995,11 @@ eval $inlibc set getservent d_getsent eval $inlibc +: see if prototypes for various getservxxx netdb.h functions are available +echo " " +set d_getservprotos getservent $i_netdb netdb.h +eval $hasproto + : see if gettimeofday or ftime exists set gettimeofday d_gettimeod eval $inlibc @@ -7071,7 +7161,7 @@ eval $inlibc echo " " echo $n "Checking to see if your system supports long doubles...$c" >&4 echo 'long double foo() { long double x; x = 7.0; return x; }' > try.c -if $cc $optimize $ccflags -c try.c; then +if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then val="$define" echo " Yup, it does." >&4 else @@ -7083,10 +7173,9 @@ set d_longdbl eval $setvar : check for length of long double -echo " " - case "${d_longdbl}${longdblsize}" in $define) + echo " " $echo $n "Checking to see how big your long doubles are...$c" >&4 $cat >try.c <<'EOCP' #include <stdio.h> @@ -7096,16 +7185,60 @@ main() } EOCP set try - if eval $compile; then + if eval $compile_ok; then longdblsize=`./try` + $echo " $longdblsize bytes." >&4 else dflt='8' + echo " " echo "(I can't seem to compile the test program. Guessing...)" rp="What is the size of a long double (in bytes)?" . ./myread longdblsize="$ans" fi - $echo " $longdblsize bytes." + ;; +esac +$rm -f try.c try + +: check for long long +echo " " +echo $n "Checking to see if your system supports long long...$c" >&4 +echo 'long long foo() { long long x; x = 7; return x; }' > try.c +if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then + val="$define" + echo " Yup, it does." >&4 +else + val="$undef" + echo " Nope, it doesn't." >&4 +fi +$rm try.* +set d_longlong +eval $setvar + +: check for length of long long +case "${d_longlong}${longlongsize}" in +$define) + echo " " + $echo $n "Checking to see how big your long longs are...$c" >&4 + $cat >try.c <<'EOCP' +#include <stdio.h> +main() +{ + printf("%d\n", sizeof(long long)); +} +EOCP + set try + if eval $compile_ok; then + longlongsize=`./try` + $echo " $longlongsize bytes." >&4 + else + dflt='8' + echo " " + echo "(I can't seem to compile the test program. Guessing...)" + rp="What is the size of a long long (in bytes)?" + . ./myread + longlongsize="$ans" + fi ;; esac $rm -f try.c try @@ -7538,7 +7671,7 @@ exit(0); } EOCP set try - if eval $compile; then + if eval $compile_ok; then if ./try 2>/dev/null; then echo "Yes, it can." val="$define" @@ -7616,7 +7749,7 @@ exit(0); } EOCP set try - if eval $compile; then + if eval $compile_ok; then if ./try 2>/dev/null; then echo "Yes, it can." val="$define" @@ -7676,7 +7809,7 @@ exit(0); } EOCP set try - if eval $compile; then + if eval $compile_ok; then if ./try 2>/dev/null; then echo "Yes, it can." val="$define" @@ -7916,12 +8049,7 @@ echo " " : see if we have sigaction if set sigaction val -f d_sigaction; eval $csym; $val; then echo 'sigaction() found.' >&4 - val="$define" -else - echo 'sigaction NOT found.' >&4 - val="$undef" -fi -$cat > try.c <<'EOP' + $cat > try.c <<'EOP' #include <stdio.h> #include <sys/types.h> #include <signal.h> @@ -7930,11 +8058,15 @@ main() struct sigaction act, oact; } EOP -set try -if eval $compile; then - : + set try + if eval $compile_ok; then + val="$define" + else + echo "But you don't seem to have a useable struct sigaction." >&4 + val="$undef" + fi else - echo "But you don't seem to have a useable struct sigaction." >&4 + echo 'sigaction NOT found.' >&4 val="$undef" fi set d_sigaction; eval $setvar @@ -8008,7 +8140,7 @@ else else echo "You don't have Berkeley networking in libc$_a..." >&4 if test -f /usr/lib/libnet$_a; then - ( (nm $nm_opt /usr/lib/libnet$_a | eval $nm_extract) || \ + ( ($nm $nm_opt /usr/lib/libnet$_a | eval $nm_extract) || \ $ar t /usr/lib/libnet$_a) 2>/dev/null >> libc.list if $contains socket libc.list >/dev/null 2>&1; then echo "...but the Wollongong group seems to have hacked it in." >&4 @@ -8310,6 +8442,34 @@ case "$varval" in *) eval "$var=\$varval";; esac' +: define an is-a-typedef? function that prompts if the type is not available. +typedef_ask='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@; +case "$inclist" in +"") inclist="sys/types.h";; +esac; +eval "varval=\$$var"; +case "$varval" in +"") + $rm -f temp.c; + for inc in $inclist; do + echo "#include <$inc>" >>temp.c; + done; + $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null; + echo " " ; + echo "$rp" | $sed -e "s/What is/Looking for/" -e "s/?/./"; + if $contains $type temp.E >/dev/null 2>&1; then + echo "$type found." >&4; + eval "$var=\$type"; + else + echo "$type NOT found." >&4; + dflt="$def"; + . ./myread ; + eval "$var=\$ans"; + fi; + $rm -f temp.?;; +*) eval "$var=\$varval";; +esac' + : see if this is a sys/times.h system set sys/times.h i_systimes eval $inhdr @@ -8323,13 +8483,9 @@ if set times val -f d_times; eval $csym; $val; then case "$i_systimes" in "$define") inc='sys/times.h';; esac + rp="What is the type returned by times() on this system?" set clock_t clocktype long stdio.h sys/types.h $inc - eval $typedef - dflt="$clocktype" - echo " " - rp="What type is returned by times() on this system?" - . ./myread - clocktype="$ans" + eval $typedef_ask else echo 'times() NOT found, hope that will do.' >&4 d_times="$undef" @@ -8472,7 +8628,7 @@ case "$d_closedir" in int main() { return closedir(opendir(".")); } EOM set closedir - if eval $compile; then + if eval $compile_ok; then if ./closedir > /dev/null 2>&1 ; then echo "Yes, it does." val="$undef" @@ -8561,7 +8717,7 @@ main() } EOCP set try - if eval $compile; then + if eval $compile_ok; then dflt=`./try` else dflt='8' @@ -8673,51 +8829,6 @@ set db.h i_db eval $inhdr case "$i_db" in -define) - : Check the return type needed for hash - echo " " - echo "Checking return type needed for hash for Berkeley DB ..." >&4 - $cat >try.c <<EOCP -#$d_const HASCONST -#ifndef HASCONST -#define const -#endif -#include <sys/types.h> -#include <db.h> - -#ifndef DB_VERSION_MAJOR -u_int32_t hash_cb (ptr, size) -const void *ptr; -size_t size; -{ -} -HASHINFO info; -main() -{ - info.hash = hash_cb; -} -#endif -EOCP - if $cc $ccflags -c try.c >try.out 2>&1 ; then - if $contains warning try.out >>/dev/null 2>&1 ; then - db_hashtype='int' - else - db_hashtype='u_int32_t' - fi - else - : XXX Maybe we should just give up here. - db_hashtype=u_int32_t - echo "Help: I can't seem to compile the db test program." >&4 - echo "Something's wrong, but I'll assume you use $db_hashtype." >&4 - fi - $rm -f try.* - echo "Your version of Berkeley DB uses $db_hashtype for hash." - ;; -*) db_hashtype=u_int32_t - ;; -esac - -case "$i_db" in $define) : Check db version. echo " " @@ -8795,6 +8906,51 @@ esac case "$i_db" in define) + : Check the return type needed for hash + echo " " + echo "Checking return type needed for hash for Berkeley DB ..." >&4 + $cat >try.c <<EOCP +#$d_const HASCONST +#ifndef HASCONST +#define const +#endif +#include <sys/types.h> +#include <db.h> + +#ifndef DB_VERSION_MAJOR +u_int32_t hash_cb (ptr, size) +const void *ptr; +size_t size; +{ +} +HASHINFO info; +main() +{ + info.hash = hash_cb; +} +#endif +EOCP + if $cc $ccflags -c try.c >try.out 2>&1 ; then + if $contains warning try.out >>/dev/null 2>&1 ; then + db_hashtype='int' + else + db_hashtype='u_int32_t' + fi + else + : XXX Maybe we should just give up here. + db_hashtype=u_int32_t + $cat try.out >&4 + echo "Help: I can't seem to compile the db test program." >&4 + echo "Something's wrong, but I'll assume you use $db_hashtype." >&4 + fi + $rm -f try.* + echo "Your version of Berkeley DB uses $db_hashtype for hash." + ;; +*) db_hashtype=u_int32_t + ;; +esac +case "$i_db" in +define) : Check the return type needed for prefix echo " " echo "Checking return type needed for prefix for Berkeley DB ..." >&4 @@ -8828,6 +8984,7 @@ EOCP else db_prefixtype='size_t' : XXX Maybe we should just give up here. + $cat try.out >&4 echo "Help: I can't seem to compile the db test program." >&4 echo "Something's wrong, but I'll assume you use $db_prefixtype." >&4 fi @@ -8946,7 +9103,7 @@ main() } EOCP set try - if eval $compile; then + if eval $compile_ok; then doublesize=`./try` $echo $doublesize >&4 else @@ -8961,13 +9118,9 @@ esac $rm -f try.c try : see what type file positions are declared as in the library -set fpos_t fpostype long stdio.h sys/types.h -eval $typedef -echo " " -dflt="$fpostype" rp="What is the type for file position used by fsetpos()?" -. ./myread -fpostype="$ans" +set fpos_t fpostype long stdio.h sys/types.h +eval $typedef_ask : get csh whereabouts case "$csh" in @@ -8985,6 +9138,8 @@ esac full_sed=$sed : see what type gids are declared as in the kernel +echo " " +echo "Looking for the type for group ids returned by getgid()." set gid_t gidtype xxx stdio.h sys/types.h eval $typedef case "$gidtype" in @@ -8998,10 +9153,13 @@ xxx) ;; *) dflt="$gidtype";; esac -echo " " -rp="What is the type for group ids returned by getgid()?" -. ./myread -gidtype="$ans" +case "$gidtype" in +gid_t) echo "gid_t found." ;; +*) rp="What is the type for group ids returned by getgid()?" + . ./myread + gidtype="$ans" + ;; +esac : see if getgroups exists set getgroups d_getgrps @@ -9021,11 +9179,11 @@ case "$d_getgrps$d_setgrps" in *) dflt="$groupstype" ;; esac $cat <<EOM -What is the type of the second argument to getgroups() and setgroups()? +What type of pointer is the second argument to getgroups() and setgroups()? Usually this is the same as group ids, $gidtype, but not always. EOM - rp='What type is the second argument to getgroups() and setgroups()?' + rp='What type pointer is the second argument to getgroups() and setgroups()?' . ./myread groupstype="$ans" ;; @@ -9033,13 +9191,9 @@ EOM esac : see what type lseek is declared as in the kernel +rp="What is the type used for lseek's offset on this system?" set off_t lseektype long stdio.h sys/types.h -eval $typedef -echo " " -dflt="$lseektype" -rp="What type is lseek's offset on this system declared as?" -. ./myread -lseektype="$ans" +eval $typedef_ask echo " " echo "Checking if your $make program sets \$(MAKE)..." >&4 @@ -9062,13 +9216,9 @@ case "$make_set_make" in esac : see what type is used for mode_t +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 -dflt="$modetype" -echo " " -rp="What type is used for file modes?" -. ./myread -modetype="$ans" +eval $typedef_ask : Cruising for prototypes echo " " @@ -9129,18 +9279,10 @@ EOSH chmod +x protochk $eunicefix protochk -: see if this is a netdb.h system -set netdb.h i_netdb -eval $inhdr - : see what type is used for size_t +rp="What is the type used for the length parameter for string functions?" set size_t sizetype 'unsigned int' stdio.h sys/types.h -eval $typedef -dflt="$sizetype" -echo " " -rp="What type is used for the length parameter for string functions?" -. ./myread -sizetype="$ans" +eval $typedef_ask : check for type of arguments to gethostbyaddr. if test "X$netdb_host_type" = X -o "X$netdb_hlen_type" = X; then @@ -9295,19 +9437,15 @@ rp='What pager is used on your system?' pager="$ans" : see what type pids are declared as in the kernel +rp="What is the type of process ids on this system?" set pid_t pidtype int stdio.h sys/types.h -eval $typedef -dflt="$pidtype" -echo " " -rp="What type are process ids on this system declared as?" -. ./myread -pidtype="$ans" +eval $typedef_ask : check for length of pointer echo " " case "$ptrsize" in '') - echo "Checking to see how big your pointers are..." >&4 + $echo $n "Checking to see how big your pointers are...$c" >&4 if test "$voidflags" -gt 7; then echo '#define VOID_PTR char *' > try.c else @@ -9322,8 +9460,9 @@ main() } EOCP set try - if eval $compile; then + if eval $compile_ok; then ptrsize=`./try` + $echo " $ptrsize bytes." >&4 else dflt='4' echo "(I can't seem to compile the test program. Guessing...)" >&4 @@ -9368,7 +9507,7 @@ main() } EOCP set try - if eval $compile; then + if eval $compile_ok; then dflt=`./try$_exe` else dflt='?' @@ -9665,9 +9804,10 @@ xxx="$xxx LOST PHONE PIPE POLL PROF PWR QUIT SEGV STKFLT STOP SYS TERM TRAP" xxx="$xxx TSTP TTIN TTOU URG USR1 USR2 USR3 USR4 VTALRM" xxx="$xxx WINCH WIND WINDOW XCPU XFSZ" : generate a few handy files for later -$cat > signal.c <<'EOP' +$cat > signal.c <<'EOCP' #include <sys/types.h> #include <signal.h> +#include <stdio.h> int main() { /* Strange style to avoid deeply-nested #if/#else/#endif */ @@ -9722,7 +9862,10 @@ int main() { printf("NSIG %d\n", NSIG); -EOP +#ifndef JUST_NSIG + +EOCP + echo $xxx | $tr ' ' '\012' | $sort | $uniq | $awk ' { printf "#ifdef SIG"; printf $1; printf "\n" @@ -9731,6 +9874,7 @@ echo $xxx | $tr ' ' '\012' | $sort | $uniq | $awk ' printf "#endif\n" } END { + printf "#endif /* JUST_NSIG */\n"; printf "}\n"; } ' >>signal.c @@ -9767,22 +9911,69 @@ END { EOP $cat >signal_cmd <<EOS $startsh -$test -s signal.lst && exit 0 -if $cc $optimize $ccflags $ldflags -o signal signal.c $libs >/dev/null 2>&1; then +if $test -s signal.lst; then + echo "Using your existing signal.lst file" + exit 0 +fi +xxx="$xxx" +EOS +$cat >>signal_cmd <<'EOS' + +set signal +if eval $compile_ok; then ./signal$_exe | $sort -n +1 | $uniq | $awk -f signal.awk >signal.lst else - echo "(I can't seem be able to compile the test program -- Guessing)" + echo "(I can't seem be able to compile the whole test program)" >&4 + echo "(I'll try it in little pieces.)" >&4 + set signal -DJUST_NSIG + if eval $compile_ok; then + ./signal$_exe > signal.nsg + $cat signal.nsg + else + echo "I can't seem to figure out how many signals you have." >&4 + echo "Guessing 50." >&4 + echo 'NSIG 50' > signal.nsg + fi + : Now look at all the signal names, one at a time. + for xx in `echo $xxx | $tr ' ' '\012' | $sort | $uniq`; do + $cat > signal.c <<EOCP +#include <sys/types.h> +#include <signal.h> +#include <stdio.h> +int main() { +printf("$xx %d\n", SIG${xx}); +return 0; +} +EOCP + set signal + if eval $compile; then + echo "SIG${xx} found." + ./signal$_exe >> signal.ls1 + else + echo "SIG${xx} NOT found." + fi + done + if $test -s signal.ls1; then + $cat signal.nsg signal.ls1 | + $sort -n +1 | $uniq | $awk -f signal.awk >signal.lst + fi + +fi +if $test -s signal.lst; then + : +else + echo "(AAK! I can't compile the test programs -- Guessing)" >&4 echo 'kill -l' >signal - set X \`csh -f <signal\` + set X `csh -f <signal` $rm -f signal shift - case \$# in + case $# in 0) set HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM;; esac - echo \$@ | $tr ' ' '\012' | \ - $awk '{ printf \$1; printf " %d\n", ++s; }' >signal.lst + echo $@ | $tr ' ' '\012' | \ + $awk '{ printf $1; printf " %d\n", ++s; }' >signal.lst fi -$rm -f signal.c signal signal$_o +$rm -f signal.c signal$_exe signal$_o signal.nsg signal.ls1 EOS chmod a+x signal_cmd $eunicefix signal_cmd @@ -9792,7 +9983,7 @@ echo " " case "$sig_name_init" in '') echo "Generating a list of signal names and numbers..." >&4 - ./signal_cmd + . ./signal_cmd sig_name=`$awk '{printf "%s ", $1}' signal.lst` sig_name="ZERO $sig_name" sig_name_init=`$awk 'BEGIN { printf "\"ZERO\", " } @@ -9843,7 +10034,7 @@ main() EOM echo " " set ssize -if eval $compile && ./ssize > /dev/null; then +if eval $compile_ok && ./ssize > /dev/null; then ssizetype=`./ssize` echo "I'll be using $ssizetype for functions returning a byte count." >&4 else @@ -9877,13 +10068,9 @@ echo " " if set time val -f d_time; eval $csym; $val; then echo 'time() found.' >&4 val="$define" + rp="What is the type returned by time() on this system?" set time_t timetype long stdio.h sys/types.h - eval $typedef - dflt="$timetype" - echo " " - rp="What type is returned by time() on this system?" - . ./myread - timetype="$ans" + eval $typedef_ask else echo 'time() not found, hope that will do.' >&4 val="$undef" @@ -9893,6 +10080,8 @@ set d_time eval $setvar : see what type uids are declared as in the kernel +echo " " +echo "Looking for the type for user ids returned by getuid()." set uid_t uidtype xxx stdio.h sys/types.h eval $typedef case "$uidtype" in @@ -9906,10 +10095,13 @@ xxx) ;; *) dflt="$uidtype";; esac -echo " " -rp="What is the type for user ids returned by getuid()?" -. ./myread -uidtype="$ans" +case "$uidtype" in +uid_t) echo "uid_t found." ;; +*) rp="What is the type for user ids returned by getuid()?" + . ./myread + uidtype="$ans" + ;; +esac : see if dbm.h is available : see if dbmclose exists @@ -10405,7 +10597,8 @@ eval $setvar echo " " echo "Looking for extensions..." >&4 -cd ../ext +tdir=`pwd` +cd $rsrc/ext : If we are using the old config.sh, known_extensions may contain : old or inaccurate or duplicate values. known_extensions='' @@ -10426,7 +10619,7 @@ for xxx in * ; do known_extensions="$known_extensions $xxx/$yyy" fi done - cd .. + cd .. fi fi ;; @@ -10435,7 +10628,7 @@ done set X $known_extensions shift known_extensions="$*" -cd ../UU +cd $tdir : Now see which are supported on this system. avail_ext='' @@ -10779,10 +10972,12 @@ d_gethbyaddr='$d_gethbyaddr' d_gethbyname='$d_gethbyname' d_gethent='$d_gethent' d_gethname='$d_gethname' +d_gethostprotos='$d_gethostprotos' d_getlogin='$d_getlogin' d_getnbyaddr='$d_getnbyaddr' d_getnbyname='$d_getnbyname' d_getnent='$d_getnent' +d_getnetprotos='$d_getnetprotos' d_getpbyname='$d_getpbyname' d_getpbynumber='$d_getpbynumber' d_getpent='$d_getpent' @@ -10791,9 +10986,11 @@ d_getpgrp2='$d_getpgrp2' d_getpgrp='$d_getpgrp' d_getppid='$d_getppid' d_getprior='$d_getprior' +d_getprotoprotos='$d_getprotoprotos' d_getsbyname='$d_getsbyname' d_getsbyport='$d_getsbyport' d_getsent='$d_getsent' +d_getservprotos='$d_getservprotos' d_gettimeod='$d_gettimeod' d_gnulibc='$d_gnulibc' d_htonl='$d_htonl' @@ -10805,6 +11002,7 @@ d_link='$d_link' d_locconv='$d_locconv' d_lockf='$d_lockf' d_longdbl='$d_longdbl' +d_longlong='$d_longlong' d_lstat='$d_lstat' d_mblen='$d_mblen' d_mbstowcs='$d_mbstowcs' @@ -10953,7 +11151,6 @@ fpostype='$fpostype' freetype='$freetype' full_csh='$full_csh' full_sed='$full_sed' -gcc='$gcc' gccversion='$gccversion' gidtype='$gidtype' glibpth='$glibpth' @@ -11051,6 +11248,7 @@ lns='$lns' locincpth='$locincpth' loclibpth='$loclibpth' longdblsize='$longdblsize' +longlongsize='$longlongsize' longsize='$longsize' lp='$lp' lpr='$lpr' @@ -18,6 +18,10 @@ #undef EXTCONST #undef dEXTCONST #if defined(VMS) && !defined(__GNUC__) + /* Suppress portability warnings from DECC for VMS-specific extensions */ +# ifdef __DECC +# pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT) +# endif # define EXT globalref # define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare # define EXTCONST globalref @@ -6,7 +6,7 @@ Install - Build and Installation guide for perl5. The basic steps to build and install perl5 on a Unix system are: - rm -f config.sh + rm -f config.sh Policy.sh sh Configure make make test @@ -70,10 +70,10 @@ pod/perldelta.pod for a description of what's changed. =head1 Space Requirements -The complete perl5 source tree takes up about 7 MB of disk space. The -complete tree after completing make takes roughly 15 MB, though the +The complete perl5 source tree takes up about 10 MB of disk space. The +complete tree after completing make takes roughly 20 MB, though the actual total is likely to be quite system-dependent. The installation -directories need something on the order of 7 MB, though again that +directories need something on the order of 10 MB, though again that value is system-dependent. =head1 Start with a Fresh Distribution @@ -81,13 +81,20 @@ value is system-dependent. If you have built perl before, you should clean out the build directory with the command + make distclean + +or + make realclean -The results of a Configure run are stored in the config.sh file. If -you are upgrading from a previous version of perl, or if you change -systems or compilers or make other significant changes, or if you are -experiencing difficulties building perl, you should probably not -re-use your old config.sh. Simply remove it or rename it, e.g. +The only difference between the two is that make distclean also removes +your old config.sh and Policy.sh files. + +The results of a Configure run are stored in the config.sh and Policy.sh +files. If you are upgrading from a previous version of perl, or if you +change systems or compilers or make other significant changes, or if +you are experiencing difficulties building perl, you should probably +not re-use your old config.sh. Simply remove it or rename it, e.g. mv config.sh config.sh.old @@ -108,6 +115,11 @@ pick up a precompiled binary, it might not use the same name. In short, if you wish to use your old config.sh, I recommend running Configure interactively rather than blindly accepting the defaults. +If your reason to reuse your old config.sh is to save your +particular installation choices, then you can probably achieve the +same effect by using the new Policy.sh file. See the section on +L<"Site-wide Policy settings"> below. + =head1 Run Configure Configure will figure out various things about your system. Some @@ -167,11 +179,11 @@ For my Solaris system, I usually use =head2 GNU-style configure If you prefer the GNU-style configure command line interface, you can -use the supplied configure command, e.g. +use the supplied configure.gnu command, e.g. CC=gcc ./configure.gnu -The configure script emulates a few of the more common configure +The configure.gnu script emulates a few of the more common configure options. Try ./configure.gnu --help @@ -180,7 +192,7 @@ for a listing. Cross compiling is not supported. -(The file is called configugre.gnu to avoid problems on systems +(The file is called configure.gnu to avoid problems on systems that would not distinguish the files "Configure" and "configure".) =head2 Extensions @@ -236,6 +248,11 @@ Note: The DB_File module will only work with version 1.x of Berkeley DB or newer releases of version 2. Configure will automatically detect this for you and refuse to try to build DB_File with version 2. +If you re-use your old config.sh but change your system (e.g. by +adding libgdbm) Configure will still offer your old choices of extensions +for the default answer, but it will also point out the discrepancy to +you. + Finally, if you have dynamic loading (most modern Unix systems do) remember that these extensions do not increase the size of your perl executable, nor do they impact start-up time, so you probably might as @@ -457,7 +474,7 @@ installed on multiple systems. Here's one way to do that: cd /usr/local # Or wherever you specified as $prefix tar xvf perl5-archive.tar -=head2 Site-wide "Policy" settings +=head2 Site-wide Policy settings After Configure runs, it stores a number of common site-wide "policy" answers (such as installation directories and the local perl contact @@ -466,6 +483,15 @@ system using the same policy defaults, simply copy the Policy.sh file to the new system and Configure will use it along with the appropriate hint file for your system. +Alternatively, if you wish to change some or all of those policy +answers, you should + + rm -f Policy.sh + +to ensure that Configure doesn't re-use them. + +Further information is in the Policy_sh.SH file itself. + =head2 Configure-time Options There are several different ways to Configure and build perl for your @@ -962,8 +988,8 @@ at Perl startup. =item malloc duplicates -If you get duplicates upon linking for malloc et al, add -DHIDEMYMALLOC -or -DEMBEDMYMALLOC to your ccflags variable in config.sh. +If you get duplicates upon linking for malloc et al, add -DEMBEDMYMALLOC +to your ccflags variable in config.sh. =item varargs @@ -1300,7 +1326,7 @@ In general, you can usually safely upgrade from one version of Perl (e.g. all of your add-on extensions. You can also safely leave the old version around in case the new version causes you problems for some reason. For example, if you want to be sure that your script continues to run -with 5.004_04, simplly replace the '#!/usr/local/bin/perl' line at the +with 5.004_04, simply replace the '#!/usr/local/bin/perl' line at the top of the script with the particular version you want to run, e.g. #!/usr/local/bin/perl5.00404. @@ -1376,7 +1402,7 @@ to be recompiled to be used with 5.004_50 and later. If you wish to continue using those extensions under 5.004_04, for example, then you need to move those extensions from their current -direcotries, which are something like +directories, which are something like /usr/local/lib/perl5/site_perl/ /usr/local/lib/perl5/site_perl/archname @@ -1509,4 +1535,4 @@ above. =head1 LAST MODIFIED -$Id: INSTALL,v 1.31 1998/03/03 18:08:52 doughera Released $ +$Id: INSTALL,v 1.32 1998/03/20 19:20:08 doughera Released $ @@ -18,6 +18,10 @@ #undef EXTCONST #undef dEXTCONST #if defined(VMS) && !defined(__GNUC__) + /* Suppress portability warnings from DECC for VMS-specific extensions */ +# ifdef __DECC +# pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT) +# endif # define EXT globaldef {"$GLOBAL_RW_VARS"} noshare # define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare # define EXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly @@ -267,6 +267,7 @@ ext/Thread/Thread.pm Thread extension Perl module ext/Thread/Thread.xs Thread extension external subroutines ext/Thread/Thread/Queue.pm Thread synchronised queue objects ext/Thread/Thread/Semaphore.pm Thread semaphore objects +ext/Thread/Thread/Signal.pm Start a thread to run signal handlers ext/Thread/Thread/Specific.pm Thread specific data access ext/Thread/create.t Test thread creation ext/Thread/die.t Test thread die() @@ -825,6 +826,7 @@ t/op/glob.t See if <*> works t/op/goto.t See if goto works t/op/groups.t See if $( works t/op/gv.t See if typeglobs work +t/op/hashwarn.t See if warnings for bad hash assignments work t/op/inc.t See if inc/dec of integers near 32 bit limit work t/op/index.t See if index works t/op/int.t See if int works diff --git a/Policy_sh.SH b/Policy_sh.SH index 1f84d7a332..acac3ed8af 100644 --- a/Policy_sh.SH +++ b/Policy_sh.SH @@ -13,70 +13,59 @@ $startsh # # The idea here is to distill in one place the common site-wide # "policy" answers (such as installation directories) that are -# to be "sticky". That is, if you keep the file Policy.sh around in +# to be "sticky". If you keep the file Policy.sh around in # the same directory as you are building Perl, then Configure will # (by default) load up the Policy.sh file just before the # platform-specific hints file. -# +# #Credits: # The original design for this Policy.sh file came from Wayne Davison, # maintainer of trn. -# This version for Perl5.004_61 originally written by +# This version for Perl5.004_61 originally written by # Andy Dougherty <doughera@lafcol.lafayette.edu>. # This file may be distributed under the same terms as Perl itself. +# Allow Configure command-line overrides; usually these won't be +# needed, but something like -Dprefix=/test/location can be quite +# useful for testing out new versions. -# Site-specific values +#Site-specific values: -perladmin='$perladmin' +case "\$perladmin" in +'') perladmin='$perladmin' ;; +esac + +# Installation prefix. Allow a Configure -D override. You +# may wish to reinstall perl under a different prefix, perhaps +# in order to test a different configuration. +case "\$prefix" in +'') prefix='$prefix' ;; +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 # is expanded to the user's home directory. This is figured -# out automatically by Configure, so you don't have to include it here. +# out automatically by Configure, so you don't have to include it here. # installprivlib is for systems (such as those running AFS) that # need to distinguish between the place where things # get installed and where they finally will reside. - -# Installation Prefix. -prefix='$prefix' - -bin='$bin' -installbin='$installbin' - -scriptdir='$scriptdir' -installscript='$installscript' - -privlib='$privlib' -installprivlib='$installprivlib' - -sitelib='$sitelib' -installsitelib='$installsitelib' - -# man1 and man3 manpage directories and extensions. -man1dir='$man1dir' -man1ext='$man1ext' -installman1dir='$installman1dir' -man3dir='$man3dir' -man3ext='$man3ext' -installman3dir='$installman3dir' - -# NOTE: Be careful about architecture-dependent names. If you have -# accepted the default, the following definitions will be commented out. -# That way you can carry this file to another architecture and this file -# won't mistakenly set architecture-dependent names to the wrong value. +# +# In each case, if your previous value was the default, leave it commented +# out. That way, if you override prefix, all of these will be +# automatically adjusted. # -# If you have not accepted the default, then be sure to check the -# following lines before copying this file to another system. +# NOTE: Be especially careful about architecture-dependent and +# version-dependent names, particularly if you reuse this file for +# different versions of perl. !GROK!THIS! if test 0 -eq "$subversion"; then version=`LC_ALL=C; export LC_ALL; \ - echo $baserev $patchlevel | + echo $baserev $patchlevel | $awk '{ printf "%.3f\n", $1 + $2/1000.0 }'` else version=`LC_ALL=C; export LC_ALL; \ @@ -84,34 +73,68 @@ else $awk '{ printf "%.5f\n", $1 + $2/1000.0 + $3/100000.0 }'` fi -dflt="$privlib/$archname/$version" -if test X"$archlib" = X"$dflt"; then - echo "# archlib='$archlib'" - echo "# installarchlib='$installarchlib'" -else - echo '# NOTE: Preserving your custom archlib.' - echo "archlib='$archlib'" - echo "installarchlib='$installarchlib'" -fi >> Policy.sh -echo >> Policy.sh - -# Now consider sitearch. -dflt="$sitelib/$archname" -if test X"$sitearch" = X"$dflt"; then - echo "# sitearch='$sitearch'" - echo "# installsitearch='$installsitearch'" -else - echo '# NOTE: Preserving your custom sitearch.' - echo "sitearch='$sitearch'" - echo "installsitearch='$installsitearch'" -fi >> Policy.sh +for var in bin scriptdir privlib archlib \ + man1dir man3dir sitelib sitearch \ + installbin installscript installprivlib installarchlib \ + installman1dir installman3dir installsitelib installsitearch \ + man1ext man3ext; do + + case "$var" in + bin) dflt=$prefix/bin ;; + # The scriptdir test is more complex, but this is probably usually ok. + scriptdir) dflt=$prefix/script ;; + privlib) + case "$prefix" in + *perl*) dflt=$prefix/lib ;; + *) dflt=$prefix/lib/$package ;; + esac + ;; + archlib) dflt="$privlib/$archname/$version" ;; + sitelib) dflt="$privlib/site_perl" ;; + sitearch) dflt="$sitelib/$archname" ;; + man1dir) dflt="$prefix/man/man1" ;; + man3dir) + case "$prefix" in + *perl*) dflt=`echo $man1dir | + sed -e 's/man1/man3/g' -e 's/man\.1/man\.3/g'` ;; + *) dflt=$privlib/man3 ;; + esac + ;; + + # Can we assume all sed's have greedy matching? + man1ext) dflt=`echo $man1dir | sed -e 's!.*man!!' -e 's!^\.!!'` ;; + man3ext) dflt=`echo $man3dir | sed -e 's!.*man!!' -e 's!^\.!!'` ;; + + # It might be possible to fool these next tests. Please let + # me know if they don't work right for you. + installbin) dflt=`echo $binexp | sed 's#^/afs/#/afs/.#'`;; + installscript) dflt=`echo $scriptdirexp | sed 's#^/afs/#/afs/.#'`;; + installprivlib) dflt=`echo $privlibexp | sed 's#^/afs/#/afs/.#'`;; + installarchlib) dflt=`echo $archlibexp | sed 's#^/afs/#/afs/.#'`;; + installsitelib) dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;; + installsitearch) dflt=`echo $sitearchexp | sed 's#^/afs/#/afs/.#'`;; + installman1dir) dflt=`echo $man1direxp | sed 's#^/afs/#/afs/.#'`;; + installman3dir) dflt=`echo $man3direxp | sed 's#^/afs/#/afs/.#'`;; + esac + + eval val="\$$var" + if test X"$val" = X"$dflt"; then + echo "# $var='$dflt'" + else + echo "# Preserving custom $var" + eval val=$var + echo "$var='$val'" + fi + +done >> Policy.sh $spitshell <<!GROK!THIS! >>Policy.sh -# Lastly, you may add additional items here. For example, to set the +# Lastly, you may add additional items here. For example, to set the # pager to your local favorite value, uncomment the following line in # the original Policy_sh.SH file and re-run sh Policy_sh.SH. -# $pager='$pager' +# +# pager='$pager' # # A full Glossary of all the config.sh variables is in the file # Porting/Glossary. diff --git a/Porting/Glossary b/Porting/Glossary index b0840a990d..6a37060020 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -184,6 +184,11 @@ d_archlib (archlib.U): of architecture-dependent library files for $package. If $archlib is the same as $privlib, then this is set to undef. +d_attribut (d_attribut.U): + This variable conditionally defines HASATTRIBUTE, which + indicates the C compiler can check for function attributes, + such as printf formats. + d_bcmp (d_bcmp.U): This variable conditionally defines the HAS_BCMP symbol if the bcmp() routine is available to compare strings. @@ -200,6 +205,11 @@ d_bsdgetpgrp (d_getpgrp.U): This variable conditionally defines USE_BSD_GETPGRP if getpgrp needs one arguments whereas USG one needs none. +d_bsdsetpgrp (d_setpgrp.U): + This variable conditionally defines USE_BSD_SETPGRP if + setpgrp needs two arguments whereas USG one needs none. + See also d_setpgid for a POSIX interface. + d_bzero (d_bzero.U): This variable conditionally defines the HAS_BZERO symbol if the bzero() routine is available to set memory to 0. @@ -384,6 +394,11 @@ d_gethbyaddr (d_gethbyad.U): indicates to the C program that the gethostbyaddr() routine is available to look up hosts by their IP addresses. +d_gethbyname (d_gethbynm.U): + This variable conditionally defines the HAS_GETHOSTBYNAME symbol, which + indicates to the C program that the gethostbyname() routine is available + to look up host names in some data base or other. + d_gethent (d_gethent.U): This variable conditionally defines HAS_GETHOSTENT if gethostent() is available to look up host names in some data base or another. @@ -393,6 +408,12 @@ d_gethname (d_gethname.U): indicates to the C program that the gethostname() routine may be used to derive the host name. +d_gethostprotos (d_gethostprotos.U): + This variable conditionally defines the HAS_GETHOST_PROTOS symbol, + which indicates to the C program that <netdb.h> supplies + prototypes for the various gethost*() functions. + See also netdbtype.U for probing for various netdb types. + d_getlogin (d_getlogin.U): This variable conditionally defines the HAS_GETLOGIN symbol, which indicates to the C program that the getlogin() routine is available @@ -412,6 +433,12 @@ d_getnent (d_getnent.U): This variable conditionally defines HAS_GETNETENT if getnetent() is available to look up network names in some data base or another. +d_getnetprotos (d_getnetprotos.U): + This variable conditionally defines the HAS_GETNET_PROTOS symbol, + which indicates to the C program that <netdb.h> supplies + prototypes for the various getnet*() functions. + See also netdbtype.U for probing for various netdb types. + d_getpbyname (d_getprotby.U): This variable conditionally defines the HAS_GETPROTOBYNAME symbol, which indicates to the C program that the @@ -451,6 +478,12 @@ d_getprior (d_getprior.U): This variable conditionally defines HAS_GETPRIORITY if getpriority() is available to get a process's priority. +d_getprotoprotos (d_getprotoprotos.U): + This variable conditionally defines the HAS_GETPROTO_PROTOS symbol, + which indicates to the C program that <netdb.h> supplies + prototypes for the various getproto*() functions. + See also netdbtype.U for probing for various netdb types. + d_getsbyname (d_getsrvby.U): This variable conditionally defines the HAS_GETSERVBYNAME symbol, which indicates to the C program that the @@ -467,6 +500,12 @@ d_getsent (d_getsent.U): This variable conditionally defines HAS_GETSERVENT if getservent() is available to look up network services in some data base or another. +d_getservprotos (d_getservprotos.U): + This variable conditionally defines the HAS_GETSERV_PROTOS symbol, + which indicates to the C program that <netdb.h> supplies + prototypes for the various getserv*() functions. + See also netdbtype.U for probing for various netdb types. + d_gettimeod (d_ftime.U): This variable conditionally defines the HAS_GETTIMEOFDAY symbol, which indicates that the gettimeofday() system call exists (to obtain a @@ -513,6 +552,10 @@ d_longdbl (d_longdbl.U): This variable conditionally defines HAS_LONG_DOUBLE if the long double type is supported. +d_longlong (d_longlong.U): + This variable conditionally defines HAS_LONG_LONG if + the long long type is supported. + d_lstat (d_lstat.U): This variable conditionally defines HAS_LSTAT if lstat() is available to do file stats on symbolic links. @@ -1205,6 +1248,11 @@ i_db (i_db.U): This variable conditionally defines the I_DB symbol, and indicates whether a C program may include Berkeley's DB include file <db.h>. +i_dbm (i_dbm.U): + This variable conditionally defines the I_DBM symbol, which + indicates to the C program that <dbm.h> exists and should + be included. + i_dirent (i_dirent.U): This variable conditionally defines I_DIRENT, which indicates to the C program that it should include <dirent.h>. @@ -1228,6 +1276,11 @@ i_float (i_float.U): whether a C program may include <float.h> to get symbols like DBL_MAX or DBL_MIN, i.e. machine dependent floating point values. +i_gdbm (i_gdbm.U): + This variable conditionally defines the I_GDBM symbol, which + indicates to the C program that <gdbm.h> exists and should + be included. + i_grp (i_grp.U): This variable conditionally defines the I_GRP symbol, and indicates whether a C program should include <grp.h>. @@ -1253,6 +1306,11 @@ i_memory (i_memory.U): This variable conditionally defines the I_MEMORY symbol, and indicates whether a C program should include <memory.h>. +i_ndbm (i_ndbm.U): + This variable conditionally defines the I_NDBM symbol, which + indicates to the C program that <ndbm.h> exists and should + be included. + i_netdb (i_netdb.U): This variable conditionally defines the I_NETDB symbol, and indicates whether a C program should include <netdb.h>. @@ -1547,6 +1605,11 @@ longdblsize (d_longdbl.U): indicates to the C program how many bytes there are in a long double, if this system supports long doubles. +longlongsize (d_longlong.U): + This variable contains the value of the LONGLONGSIZE symbol, which + indicates to the C program how many bytes there are in a long long, + if this system supports long long. + longsize (intsize.U): This variable contains the value of the LONGSIZE symbol, which indicates to the C program how many bytes there are in a long. @@ -1643,6 +1706,12 @@ mydomain (myhostname.U): The domain must be appended to myhostname to form a complete host name. The dot comes with mydomain, and need not be supplied by the program. +myhostname (myhostname.U): + This variable contains the eventual value of the MYHOSTNAME symbol, + which is the name of the host the program is going to run on. + The domain is not kept with hostname, but must be gotten from mydomain. + The dot comes with mydomain, and need not be supplied by the program. + myuname (Oldconfig.U): The output of 'uname -a' if available, otherwise the hostname. On Xenix, pseudo variables assignments in the output are stripped, thank you. The @@ -1949,6 +2018,11 @@ split (models.U): machines that support separation of instruction and data space. It is up to the Makefile to use this. +src (src.U): + This variable holds the path to the package source. It is up to + the Makefile to use this variable and set VPATH accordingly to + find the sources remotely. + ssizetype (ssizetype.U): This variable defines ssizetype to be something like ssize_t, long or int. It is used by functions that return a count diff --git a/Porting/config.sh b/Porting/config.sh index b709411220..ff4f72528b 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -8,7 +8,7 @@ # Package name : perl5 # Source directory : . -# Configuration time: Mon Mar 9 14:20:14 EST 1998 +# Configuration time: Tue Mar 31 15:51:58 EST 1998 # Configured by : doughera # Target system : linux fractal 2.0.33 #1 tue feb 3 10:11:46 est 1998 i686 unknown @@ -30,8 +30,8 @@ afs='false' alignbytes='4' aphostname='' ar='ar' -archlib='/opt/perl/lib/i686-linux-thread/5.00462' -archlibexp='/opt/perl/lib/i686-linux-thread/5.00462' +archlib='/opt/perl/lib/i686-linux-thread/5.00463' +archlibexp='/opt/perl/lib/i686-linux-thread/5.00463' archname='i686-linux-thread' archobjs='' awk='awk' @@ -51,7 +51,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='Mon Mar 9 14:20:14 EST 1998' +cf_time='Tue Mar 31 15:51:58 EST 1998' chgrp='' chmod='' chown='' @@ -124,10 +124,12 @@ d_gethbyaddr='define' d_gethbyname='define' d_gethent='define' d_gethname='undef' +d_gethostprotos='define' d_getlogin='define' d_getnbyaddr='define' d_getnbyname='define' d_getnent='define' +d_getnetprotos='define' d_getpbyname='define' d_getpbynumber='define' d_getpent='define' @@ -136,9 +138,11 @@ d_getpgrp2='undef' d_getpgrp='define' d_getppid='define' d_getprior='define' +d_getprotoprotos='define' d_getsbyname='define' d_getsbyport='define' d_getsent='define' +d_getservprotos='define' d_gettimeod='define' d_gnulibc='define' d_htonl='define' @@ -150,6 +154,7 @@ d_link='define' d_locconv='define' d_lockf='define' d_longdbl='define' +d_longlong='define' d_lstat='define' d_mblen='define' d_mbstowcs='define' @@ -298,7 +303,6 @@ fpostype='fpos_t' freetype='void' full_csh='/bin/csh' full_sed='/bin/sed' -gcc='' gccversion='2.7.2.3' gidtype='gid_t' glibpth='/usr/shlib /shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/local/lib ' @@ -366,7 +370,7 @@ i_varhdr='stdarg.h' i_vfork='undef' incpath='' inews='' -installarchlib='/opt/perl/lib/i686-linux-thread/5.00462' +installarchlib='/opt/perl/lib/i686-linux-thread/5.00463' installbin='/opt/perl/bin' installman1dir='/opt/perl/man/man1' installman3dir='/opt/perl/man/man3' @@ -396,6 +400,7 @@ lns='/bin/ln -s' locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include' loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib' longdblsize='12' +longlongsize='8' longsize='4' lp='' lpr='' @@ -511,7 +516,7 @@ stdio_filbuf='' stdio_ptr='((fp)->_IO_read_ptr)' strings='/usr/include/string.h' submit='' -subversion='62' +subversion='63' sysman='/usr/man/man1' tail='' tar='' @@ -544,5 +549,5 @@ xlibpth='/usr/lib/386 /lib/386' zcat='' zip='zip' PATCHLEVEL=4 -SUBVERSION=62 +SUBVERSION=63 CONFIG=true diff --git a/Porting/config_H b/Porting/config_H index 52acfdc8e1..2f07d01ee4 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -17,7 +17,7 @@ /* * Package name : perl5 * Source directory : . - * Configuration time: Mon Mar 9 14:20:14 EST 1998 + * Configuration time: Tue Mar 31 15:51:58 EST 1998 * Configured by : doughera * Target system : linux fractal 2.0.33 #1 tue feb 3 10:11:46 est 1998 i686 unknown */ @@ -641,17 +641,6 @@ #define Shmat_t void * /**/ #define HAS_SHMAT_PROTOTYPE /**/ -/* HAS_SOCKET: - * This symbol, if defined, indicates that the BSD socket interface is - * supported. - */ -/* HAS_SOCKETPAIR: - * This symbol, if defined, indicates that the BSD socketpair() call is - * supported. - */ -#define HAS_SOCKET /**/ -#define HAS_SOCKETPAIR /**/ - /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. @@ -762,20 +751,6 @@ */ #define HAS_TCSETPGRP /**/ -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case <sys/types.h> should be - * included). - */ -#define Time_t time_t /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include <sys/times.h>. - */ -#define HAS_TIMES /**/ - /* HAS_TRUNCATE: * This symbol, if defined, indicates that the truncate routine is * available to truncate files. @@ -831,22 +806,6 @@ */ #define HAS_WCTOMB /**/ -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Fpos_t fpos_t /* File position type */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * uid_t, etc... It may be necessary to include <sys/types.h> to get - * any typedef'ed information. - */ -#define Gid_t gid_t /* Type for getgid(), etc... */ - /* I_DBM: * This symbol, if defined, indicates that <dbm.h> exists and should * be included. @@ -1059,12 +1018,6 @@ */ #define I_SYS_TIMES /**/ -/* I_SYS_TYPES: - * This symbol, if defined, indicates to the C program that it should - * include <sys/types.h>. - */ -#define I_SYS_TYPES /**/ - /* I_SYS_UN: * This symbol, if defined, indicates to the C program that it should * include <sys/un.h> to get UNIX domain socket definitions. @@ -1134,13 +1087,6 @@ */ /*#define I_VFORK / **/ -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Off_t off_t /* <offset> type */ - /* Free_t: * This variable contains the return type of free(). It is usually * void, but occasionally int. @@ -1156,21 +1102,6 @@ */ /*#define MYMALLOC / **/ -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include <sys/types.h> - * to get any typedef'ed information. - */ -#define Mode_t mode_t /* file mode parameter for system calls */ - -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Pid_t pid_t /* PID type */ - /* CAN_PROTOTYPE: * If defined, this macro indicates that the C compiler can handle * function prototypes. @@ -1198,27 +1129,12 @@ */ #define SH_PATH "/bin/sh" /**/ -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Size_t size_t /* length paramater for string functions */ - /* STDCHAR: * This symbol is defined to be the type of char used in stdio.h. * It has the values "unsigned char" or "char". */ #define STDCHAR char /**/ -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Uid_t uid_t /* UID type */ - /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this * compiler. What various bits mean: @@ -1574,8 +1490,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.00462" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/i686-linux-thread/5.00462" /**/ +#define ARCHLIB "/opt/perl/lib/i686-linux-thread/5.00463" /**/ +#define ARCHLIB_EXP "/opt/perl/lib/i686-linux-thread/5.00463" /**/ /* CAT2: * This macro catenates 2 tokens together. @@ -1713,6 +1629,20 @@ #define LONG_DOUBLESIZE 12 /**/ #endif +/* HAS_LONG_LONG: + * This symbol will be defined if the C compiler supports + * long long. + */ +/* LONGLONGSIZE: + * This symbol contains the size of a long long, so that the + * C preprocessor can make decisions based on it. It is only + * defined if the system supports long long. + */ +#define HAS_LONG_LONG /**/ +#ifdef HAS_LONG_LONG +#define LONGLONGSIZE 8 /**/ +#endif + /* HAS_MKSTEMP: * This symbol, if defined, indicates that the mkstemp routine is * available to create and open a unique temporary file. @@ -1757,6 +1687,17 @@ */ #define HAS_SETVBUF /**/ +/* HAS_SOCKET: + * This symbol, if defined, indicates that the BSD socket interface is + * supported. + */ +/* HAS_SOCKETPAIR: + * This symbol, if defined, indicates that the BSD socketpair() call is + * supported. + */ +#define HAS_SOCKET /**/ +#define HAS_SOCKETPAIR /**/ + /* Signal_t: * This symbol's value is either "void" or "int", corresponding to the * appropriate return type of a signal handler. Thus, you can declare @@ -1784,6 +1725,12 @@ */ #define I_NETDB /**/ +/* I_SYS_TYPES: + * This symbol, if defined, indicates to the C program that it should + * include <sys/types.h>. + */ +#define I_SYS_TYPES /**/ + /* PRIVLIB: * 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 @@ -1797,37 +1744,6 @@ #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 @@ -1907,6 +1823,38 @@ */ /*#define USE_PERLIO / **/ +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETHOST_PROTOS /**/ + +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETNET_PROTOS /**/ + +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETPROTO_PROTOS /**/ + +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETSERV_PROTOS /**/ + /* Netdb_host_t: * This symbol holds the type used for the 1st argument * to gethostbyaddr(). @@ -1936,6 +1884,37 @@ */ #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 @@ -1968,4 +1947,71 @@ #define USE_THREADS /**/ /*#define OLD_PTHREADS_API / **/ +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case <sys/types.h> should be + * included). + */ +#define Time_t time_t /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include <sys/times.h>. + */ +#define HAS_TIMES /**/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Fpos_t fpos_t /* File position type */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * uid_t, etc... It may be necessary to include <sys/types.h> to get + * any typedef'ed information. + */ +#define Gid_t gid_t /* Type for getgid(), etc... */ + +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Off_t off_t /* <offset> type */ + +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include <sys/types.h> + * to get any typedef'ed information. + */ +#define Mode_t mode_t /* file mode parameter for system calls */ + +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Pid_t pid_t /* PID type */ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Size_t size_t /* length paramater for string functions */ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Uid_t uid_t /* UID type */ + #endif diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod index 28d428bea4..27cf1198ee 100644 --- a/Porting/pumpkin.pod +++ b/Porting/pumpkin.pod @@ -494,6 +494,20 @@ ought to go in the Changes file or whether they ought to be available separately in the patch file (or both). There is no disagreement that detailed descriptions ought to be easily available somewhere. +=head2 Todo + +The F<Todo> file contains a roughly-catgorized unordered list of +aspects of Perl that could use enhancement, features that could be +added, areas that could be cleaned up, and so on. During your term as +pumpkin-holder, you will probably address some of these issues, and +perhaps identify others which, while you decide not to address them +this time around, may be tackled in the future. Update the file +reflect the situation as it stands when you hand over the pumpkin. + +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. + =head2 OS/2-specific updates In the os2 directory is F<diff.configure>, a set of OS/2-specific @@ -21,6 +21,7 @@ Would be nice to have reference to compiled regexp lexically scoped functions: my sub foo { ... } lvalue functions + Full 64 bit support Possible pragmas debugger diff --git a/config_h.SH b/config_h.SH index 77750cd98c..1d3a13d209 100644 --- a/config_h.SH +++ b/config_h.SH @@ -655,17 +655,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define Shmat_t $shmattype /**/ #$d_shmatprototype HAS_SHMAT_PROTOTYPE /**/ -/* HAS_SOCKET: - * This symbol, if defined, indicates that the BSD socket interface is - * supported. - */ -/* HAS_SOCKETPAIR: - * This symbol, if defined, indicates that the BSD socketpair() call is - * supported. - */ -#$d_socket HAS_SOCKET /**/ -#$d_sockpair HAS_SOCKETPAIR /**/ - /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. @@ -776,20 +765,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_tcsetpgrp HAS_TCSETPGRP /**/ -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case <sys/types.h> should be - * included). - */ -#define Time_t $timetype /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include <sys/times.h>. - */ -#$d_times HAS_TIMES /**/ - /* HAS_TRUNCATE: * This symbol, if defined, indicates that the truncate routine is * available to truncate files. @@ -845,22 +820,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_wctomb HAS_WCTOMB /**/ -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Fpos_t $fpostype /* File position type */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * uid_t, etc... It may be necessary to include <sys/types.h> to get - * any typedef'ed information. - */ -#define Gid_t $gidtype /* Type for getgid(), etc... */ - /* I_DBM: * This symbol, if defined, indicates that <dbm.h> exists and should * be included. @@ -1073,12 +1032,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_systimes I_SYS_TIMES /**/ -/* I_SYS_TYPES: - * This symbol, if defined, indicates to the C program that it should - * include <sys/types.h>. - */ -#$i_systypes I_SYS_TYPES /**/ - /* I_SYS_UN: * This symbol, if defined, indicates to the C program that it should * include <sys/un.h> to get UNIX domain socket definitions. @@ -1148,13 +1101,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_vfork I_VFORK /**/ -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Off_t $lseektype /* <offset> type */ - /* Free_t: * This variable contains the return type of free(). It is usually * void, but occasionally int. @@ -1170,21 +1116,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_mymalloc MYMALLOC /**/ -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include <sys/types.h> - * to get any typedef'ed information. - */ -#define Mode_t $modetype /* file mode parameter for system calls */ - -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Pid_t $pidtype /* PID type */ - /* CAN_PROTOTYPE: * If defined, this macro indicates that the C compiler can handle * function prototypes. @@ -1212,27 +1143,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define SH_PATH "$sh" /**/ -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Size_t $sizetype /* length paramater for string functions */ - /* STDCHAR: * This symbol is defined to be the type of char used in stdio.h. * It has the values "unsigned char" or "char". */ #define STDCHAR $stdchar /**/ -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Uid_t $uidtype /* UID type */ - /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this * compiler. What various bits mean: @@ -1727,6 +1643,20 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define LONG_DOUBLESIZE $longdblsize /**/ #endif +/* HAS_LONG_LONG: + * This symbol will be defined if the C compiler supports + * long long. + */ +/* LONGLONGSIZE: + * This symbol contains the size of a long long, so that the + * C preprocessor can make decisions based on it. It is only + * defined if the system supports long long. + */ +#$d_longlong HAS_LONG_LONG /**/ +#ifdef HAS_LONG_LONG +#define LONGLONGSIZE $longlongsize /**/ +#endif + /* HAS_MKSTEMP: * This symbol, if defined, indicates that the mkstemp routine is * available to create and open a unique temporary file. @@ -1771,6 +1701,17 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_setvbuf HAS_SETVBUF /**/ +/* HAS_SOCKET: + * This symbol, if defined, indicates that the BSD socket interface is + * supported. + */ +/* HAS_SOCKETPAIR: + * This symbol, if defined, indicates that the BSD socketpair() call is + * supported. + */ +#$d_socket HAS_SOCKET /**/ +#$d_sockpair HAS_SOCKETPAIR /**/ + /* Signal_t: * This symbol's value is either "void" or "int", corresponding to the * appropriate return type of a signal handler. Thus, you can declare @@ -1798,6 +1739,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_netdb I_NETDB /**/ +/* I_SYS_TYPES: + * This symbol, if defined, indicates to the C program that it should + * include <sys/types.h>. + */ +#$i_systypes I_SYS_TYPES /**/ + /* PRIVLIB: * 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 @@ -1811,37 +1758,6 @@ sed <<!GROK!THIS! >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 @@ -1921,6 +1837,38 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$useperlio USE_PERLIO /**/ +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_gethostprotos HAS_GETHOST_PROTOS /**/ + +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_getnetprotos HAS_GETNET_PROTOS /**/ + +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_getprotoprotos HAS_GETPROTO_PROTOS /**/ + +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_getservprotos HAS_GETSERV_PROTOS /**/ + /* Netdb_host_t: * This symbol holds the type used for the 1st argument * to gethostbyaddr(). @@ -1950,6 +1898,37 @@ sed <<!GROK!THIS! >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 @@ -1982,5 +1961,72 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$usethreads USE_THREADS /**/ #$d_oldpthreads OLD_PTHREADS_API /**/ +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case <sys/types.h> should be + * included). + */ +#define Time_t $timetype /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include <sys/times.h>. + */ +#$d_times HAS_TIMES /**/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Fpos_t $fpostype /* File position type */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * uid_t, etc... It may be necessary to include <sys/types.h> to get + * any typedef'ed information. + */ +#define Gid_t $gidtype /* Type for getgid(), etc... */ + +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Off_t $lseektype /* <offset> type */ + +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include <sys/types.h> + * to get any typedef'ed information. + */ +#define Mode_t $modetype /* file mode parameter for system calls */ + +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Pid_t $pidtype /* PID type */ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Size_t $sizetype /* length paramater for string functions */ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Uid_t $uidtype /* UID type */ + #endif !GROK!THIS! diff --git a/cygwin32/perlgcc b/cygwin32/perlgcc index dbb9962ccf..202ed29a4f 100644 --- a/cygwin32/perlgcc +++ b/cygwin32/perlgcc @@ -60,13 +60,6 @@ $libdir =~ s/libcygwin\.a//g; $crt0 =~ s:\\:/:g; $libdir =~ s:\\:/:g; -# when $crt0 and $libdir get used in the system calls below, the \'s -# from the gcc -print-file-name get used to create special characters, -# such as \n, \t. Replace the \'s with /'s so that this does not -# happen: -$crt0 =~ s:\\:/:g; -$libdir =~ s:\\:/:g; - # Link exe: $command = "ld --base-file perl.base -o perl.exe $crt0 $obsString $libstring -L$libdir $libflagString"; print "$command\n"; diff --git a/djgpp/config.over b/djgpp/config.over index a1c562c107..ed443d31c4 100644 --- a/djgpp/config.over +++ b/djgpp/config.over @@ -14,9 +14,3 @@ known_extensions=$(repair "$known_extensions") # I use Dos::UseLFN in AutoSplit.pm to override this under win0.95 d_flexfnam='undef' - -# I should explain here, why I added these lines ;-) -castflags='0' -d_casti32='undef' -d_castneg='define' - diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 2885c0d84c..33dc73d8f2 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -179,6 +179,7 @@ Exporter::export_tags(); alarm chdir chown close fork getlogin getppid getpgrp link pipe read rmdir sleep unlink write utime + nice ); # Grandfather old foo_h form to new :foo_h form diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 8807d68189..922438dca5 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -268,7 +268,13 @@ init_tm(ptm) /* see mktime, strftime and asctime */ #endif -#ifndef HAS_LONG_DOUBLE /* XXX What to do about long doubles? */ +#ifdef HAS_LONG_DOUBLE +# if LONG_DOUBLESIZE > DOUBLESIZE +# undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */ +# endif +#endif + +#ifndef HAS_LONG_DOUBLE #ifdef LDBL_MAX #undef LDBL_MAX #endif @@ -287,7 +293,12 @@ not_here(char *s) return -1; } -static double +static +#ifdef HAS_LONG_DOUBLE +long double +#else +double +#endif constant(char *name, int arg) { errno = 0; @@ -2549,6 +2560,7 @@ new(packname = "POSIX::Termios", ...) RETVAL = (struct termios*)safemalloc(sizeof(struct termios)); #else not_here("termios"); + RETVAL = 0; #endif } OUTPUT: @@ -2598,7 +2610,8 @@ getiflag(termios_ref) #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_iflag; #else - not_here("getiflag"); + not_here("getiflag"); + RETVAL = 0; #endif OUTPUT: RETVAL @@ -2610,7 +2623,8 @@ getoflag(termios_ref) #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_oflag; #else - not_here("getoflag"); + not_here("getoflag"); + RETVAL = 0; #endif OUTPUT: RETVAL @@ -2622,7 +2636,8 @@ getcflag(termios_ref) #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_cflag; #else - not_here("getcflag"); + not_here("getcflag"); + RETVAL = 0; #endif OUTPUT: RETVAL @@ -2634,7 +2649,8 @@ getlflag(termios_ref) #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ RETVAL = termios_ref->c_lflag; #else - not_here("getlflag"); + not_here("getlflag"); + RETVAL = 0; #endif OUTPUT: RETVAL @@ -2649,7 +2665,8 @@ getcc(termios_ref, ccix) croak("Bad getcc subscript"); RETVAL = termios_ref->c_cc[ccix]; #else - not_here("getcc"); + not_here("getcc"); + RETVAL = 0; #endif OUTPUT: RETVAL diff --git a/ext/SDBM_File/Makefile.PL b/ext/SDBM_File/Makefile.PL index c0daa064c7..b639b2948f 100644 --- a/ext/SDBM_File/Makefile.PL +++ b/ext/SDBM_File/Makefile.PL @@ -6,13 +6,8 @@ use ExtUtils::MakeMaker; # which perform the corresponding actions in the subdirectory. $define = ($^O eq 'MSWin32') ? '-DMSDOS' : ''; -if ($^O eq 'MSWin32') { - $myextlib = 'sdbm\\libsdbm$(LIB_EXT)'; -} elsif ($^O eq 'VMS') { - $myextlib = 'sdbm/libsdbm$(LIB_EXT)'; -} else { - $myextlib = 'sdbm/libsdbm$(LIB_EXT)'; -} +if ($^O eq 'MSWin32') { $myextlib = 'sdbm\\libsdbm$(LIB_EXT)'; } +else { $myextlib = 'sdbm/libsdbm$(LIB_EXT)'; } WriteMakefile( NAME => 'SDBM_File', @@ -21,8 +16,6 @@ WriteMakefile( XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'SDBM_File.pm', DEFINE => $define, -# NORECURS => $^O eq 'VMS', -# SKIP => $^O eq 'VMS' ? 'subdirs' : '', # Don't do the subdirs section for VMS ); sub MY::postamble { @@ -33,7 +26,7 @@ $(MYEXTLIB): sdbm/Makefile '; } else { ' -$(MYEXTLIB): [.sdbm]descrip.mms +$(MYEXTLIB) : [.sdbm]descrip.mms set def [.sdbm] $(MMS) all set def [-] diff --git a/ext/SDBM_File/sdbm/Makefile.PL b/ext/SDBM_File/sdbm/Makefile.PL index e9d4dcd0fa..96f5b7af91 100644 --- a/ext/SDBM_File/sdbm/Makefile.PL +++ b/ext/SDBM_File/sdbm/Makefile.PL @@ -3,13 +3,19 @@ use ExtUtils::MakeMaker; $define = '-DSDBM -DDUFF'; $define .= ' -DWIN32' if ($^O eq 'MSWin32'); +if ($^O eq 'VMS') { # Old VAXC compiler can't handle Duff's device + require Config; + $define =~ s/\s+-DDUFF// if $Config::Config{'vms_cc_type'} eq 'vaxc'; +} + WriteMakefile( NAME => 'sdbm', # (doesn't matter what the name is here) oh yes it does # LINKTYPE => 'static', DEFINE => $define, INC => '-I$(PERL_INC)', # force PERL_INC dir ahead of system -I's - SKIP => [qw(dynamic dynamic_lib)], - OBJECT => ($^O eq 'VMS') ? 'sdbm.obj pair.obj hash.obj' : '$(O_FILES)', + INST_ARCHLIB => '.', + SKIP => [qw(dynamic dynamic_lib dlsyms)], + OBJECT => '$(O_FILES)', clean => {'FILES' => 'dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag'}, H => [qw(tune.h sdbm.h pair.h $(PERL_INC)/config.h)], C => [qw(sdbm.c pair.c hash.c)] @@ -24,8 +30,10 @@ INST_STATIC = libsdbm$(LIB_EXT) sub MY::top_targets { ' all :: static + $(NOECHO) $(NOOP) config :: + $(NOECHO) $(NOOP) lint: lint -abchx $(LIBSRCS) diff --git a/ext/SDBM_File/sdbm/dba.c b/ext/SDBM_File/sdbm/dba.c index 4f227e5245..05e70c8961 100644 --- a/ext/SDBM_File/sdbm/dba.c +++ b/ext/SDBM_File/sdbm/dba.c @@ -4,6 +4,7 @@ #include <stdio.h> #include <sys/file.h> +#include "EXTERN.h" #include "sdbm.h" char *progname; diff --git a/ext/SDBM_File/sdbm/dbd.c b/ext/SDBM_File/sdbm/dbd.c index 697a547597..04ab842e2d 100644 --- a/ext/SDBM_File/sdbm/dbd.c +++ b/ext/SDBM_File/sdbm/dbd.c @@ -4,6 +4,7 @@ #include <stdio.h> #include <sys/file.h> +#include "EXTERN.h" #include "sdbm.h" char *progname; diff --git a/ext/SDBM_File/sdbm/dbu.c b/ext/SDBM_File/sdbm/dbu.c index 106262872e..a3c0004da9 100644 --- a/ext/SDBM_File/sdbm/dbu.c +++ b/ext/SDBM_File/sdbm/dbu.c @@ -1,6 +1,7 @@ #include <stdio.h> #include <sys/file.h> #ifdef SDBM +#include "EXTERN.h" #include "sdbm.h" #else #include <ndbm.h> diff --git a/ext/SDBM_File/sdbm/hash.c b/ext/SDBM_File/sdbm/hash.c index 514bb5ed1a..9b27648599 100644 --- a/ext/SDBM_File/sdbm/hash.c +++ b/ext/SDBM_File/sdbm/hash.c @@ -8,6 +8,7 @@ */ #include "config.h" +#include "EXTERN.h" #include "sdbm.h" /* * polynomial conversion ignoring overflows diff --git a/ext/SDBM_File/sdbm/pair.c b/ext/SDBM_File/sdbm/pair.c index e1a6ee6f43..6b41f88471 100644 --- a/ext/SDBM_File/sdbm/pair.c +++ b/ext/SDBM_File/sdbm/pair.c @@ -12,6 +12,7 @@ static char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $"; #endif #include "config.h" +#include "EXTERN.h" #include "sdbm.h" #include "tune.h" #include "pair.h" diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c index 7fbba0f00a..7bf9d3a97b 100644 --- a/ext/SDBM_File/sdbm/sdbm.c +++ b/ext/SDBM_File/sdbm/sdbm.c @@ -11,6 +11,7 @@ static char rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $"; #endif +#include "INTERN.h" #include "config.h" #include "sdbm.h" #include "tune.h" @@ -39,7 +40,7 @@ extern int errno; extern Malloc_t malloc proto((MEM_SIZE)); extern Free_t free proto((Malloc_t)); -extern Off_t lseek(int, off_t, int); +extern Off_t lseek(int, Off_t, int); #endif /* @@ -72,8 +73,6 @@ static long masks[] = { 001777777777, 003777777777, 007777777777, 017777777777 }; -datum nullitem = {NULL, 0}; - DBM * sdbm_open(register char *file, register int flags, register int mode) { diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h index b3ed2d4b8b..0747b74dfa 100644 --- a/ext/SDBM_File/sdbm/sdbm.h +++ b/ext/SDBM_File/sdbm/sdbm.h @@ -51,7 +51,11 @@ typedef struct { int dsize; } datum; -extern datum nullitem; +EXTCONST datum nullitem +#ifdef DOINIT + = {0, 0} +#endif + ; #if defined(__STDC__) || defined(__cplusplus) || defined(CAN_PROTOTYPE) #define proto(p) p @@ -120,12 +124,13 @@ extern long sdbm_hash proto((char *, int)); #include <ctype.h> #include <setjmp.h> -#if defined(I_UNISTD) || defined(VMS) +#if defined(I_UNISTD) #include <unistd.h> #endif #ifdef VMS -# include <fcntl.h> +# include <file.h> +# include <unixio.h> #endif #if !defined(MSDOS) && !defined(WIN32) && !defined(VMS) diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs index 3664368cab..823e704ed8 100644 --- a/ext/Socket/Socket.xs +++ b/ext/Socket/Socket.xs @@ -323,8 +323,14 @@ constant(char *name, int arg) case 'L': break; case 'M': + if (strEQ(name, "MSG_CTRUNC")) +#if defined(MSG_CTRUNC) || defined(HAS_GNULIBC) /* XXX it's an enum */ + return MSG_CTRUNC; +#else + goto not_there; +#endif if (strEQ(name, "MSG_DONTROUTE")) -#ifdef MSG_DONTROUTE +#if defined(MSG_DONTROUTE) || defined(HAS_GNULIBC) /* XXX it's an enum */ return MSG_DONTROUTE; #else goto not_there; @@ -336,17 +342,23 @@ constant(char *name, int arg) goto not_there; #endif if (strEQ(name, "MSG_OOB")) -#ifdef MSG_OOB +#if defined(MSG_OOB) || defined(HAS_GNULIBC) /* XXX it's an enum */ return MSG_OOB; #else goto not_there; #endif if (strEQ(name, "MSG_PEEK")) -#ifdef MSG_PEEK +#if defined(MSG_PEEK) || defined(HAS_GNULIBC) /* XXX it's an enum */ return MSG_PEEK; #else goto not_there; #endif + if (strEQ(name, "MSG_PROXY")) +#if defined(MSG_PROXY) || defined(HAS_GNULIBC) /* XXX it's an enum */ + return MSG_PROXY; +#else + goto not_there; +#endif break; case 'N': break; diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index aea72f4a46..28583a19bd 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -126,7 +126,7 @@ threadstart(void *arg) av_store(av, 0, &sv_no); av_store(av, 1, newSVsv(thr->errsv)); DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", - SvPV(thr->errsv, na))); + thr, SvPV(thr->errsv, na))); } else { DEBUG_L(STMT_START { for (i = 1; i <= retval; i++) { @@ -280,8 +280,15 @@ static Signal_t handle_thread_signal _((int sig)); static Signal_t handle_thread_signal(int sig) { - char c = (char) sig; - write(sig_pipe[0], &c, 1); + unsigned char c = (unsigned char) sig; + /* + * We're not really allowed to call fprintf in a signal handler + * so don't be surprised if this isn't robust while debugging + * with -DL. + */ + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "handle_thread_signal: got signal %d\n", sig);); + write(sig_pipe[1], &c, 1); } MODULE = Thread PACKAGE = Thread @@ -555,7 +562,7 @@ MODULE = Thread PACKAGE = Thread::Signal void kill_sighandler_thread() PPCODE: - write(sig_pipe[0], "\0", 1); + write(sig_pipe[1], "\0", 1); PUSHs(&sv_yes); void @@ -566,22 +573,22 @@ init_thread_signals() XSRETURN_UNDEF; PUSHs(&sv_yes); -SV * +void await_signal() PREINIT: - char c; + unsigned char c; SSize_t ret; CODE: do { - ret = read(sig_pipe[1], &c, 1); + ret = read(sig_pipe[0], &c, 1); } while (ret == -1 && errno == EINTR); if (ret == -1) croak("panic: await_signal"); - if (ret == 0) - XSRETURN_UNDEF; - RETVAL = c ? psig_ptr[c] : &sv_no; - OUTPUT: - RETVAL + ST(0) = sv_newmortal(); + if (ret) + sv_setsv(ST(0), c ? psig_ptr[c] : &sv_no); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "await_signal returning %s\n", SvPEEK(ST(0)));); MODULE = Thread PACKAGE = Thread::Specific diff --git a/ext/Thread/Thread/Signal.pm b/ext/Thread/Thread/Signal.pm new file mode 100644 index 0000000000..f5f03db8a8 --- /dev/null +++ b/ext/Thread/Thread/Signal.pm @@ -0,0 +1,50 @@ +package Thread::Signal; +use Thread qw(async); + +=head1 NAME + +Thread::Signal - Start a thread which runs signal handlers reliably + +=head1 SYNOPSIS + + use Thread::Signal; + + $SIG{HUP} = \&some_handler; + +=head1 DESCRIPTION + +The C<Thread::Signal> module starts up a special signal handler thread. +All signals to the process are delivered to it and it runs the +associated C<$SIG{FOO}> handlers for them. Without this module, +signals arriving at inopportune moments (such as when perl's internals +are in the middle of updating critical structures) cause the perl +code of the handler to be run unsafely which can cause memory corruption +or worse. + +=head1 BUGS + +This module changes the semantics of signal handling slightly in that +the signal handler is run separately from the main thread (and in +parallel with it). This means that tricks such as calling C<die> from +a signal handler behave differently (and, in particular, can't be +used to exit directly from a system call). + +=cut + +if (!init_thread_signals()) { + require Carp; + Carp::croak("init_thread_signals failed: $!"); +} + +async { + my $sig; + while ($sig = await_signal()) { + &$sig(); + } +}; + +END { + kill_sighandler_thread(); +} + +1; diff --git a/ext/Thread/io.t b/ext/Thread/io.t index 8ade26504d..6012008ef5 100644 --- a/ext/Thread/io.t +++ b/ext/Thread/io.t @@ -1,5 +1,13 @@ use Thread; +sub counter { +$count = 10; +while ($count--) { + sleep 1; + print "ping $count\n"; +} +} + sub reader { my $line; while ($line = <STDIN>) { @@ -17,7 +25,13 @@ finished counting down and the I/O thread has seen end-of-file on the terminal/stdin. EOT -$r = new Thread \&reader; +$r = new Thread \&counter; + +&reader; + +__END__ + + $count = 10; while ($count--) { sleep 1; @@ -82,31 +82,27 @@ expecting an int), but the disadvantage that an I32 is not 32 bits. Andy Dougherty August 1996 - In the future, we may perhaps want to think about something like - #if INTSIZE == 4 - typedef I32 int; - #else - # if LONGSIZE == 4 - typedef I32 long; - # else - # if SHORTSIZE == 4 - typedef I32 short; - # else - typedef I32 int; - # endif - # endif - #endif - - except that still won't work if a system has no integral type - with a size that is 32 bytes. - - Further, we need to know about PTRSIZE == sizeof(void *) and - DOUBLESIZE == sizeof(double) if we really want to try to handle - 32/64-bit combinations. Finally, we might also need to know - HAS_LONG_DOUBLE and LONG_DOUBLESIZE. - - For the moment, these are only mentioned here so metaconfig will - construct Configure to figure out the various sizes. + There is no guarantee that there is *any* integral type with + exactly 32 bits. It is perfectly legal for a system to have + sizeof(short) == sizeof(int) == sizeof(long) == 8. + + Similarly, there is no guarantee that I16 and U16 have exactly 16 + bits. + + For dealing with issues that may arise from various 32/64-bit + systems, we will ask Configure to check out + SHORTSIZE == sizeof(short) + INTSIZE == sizeof(int) + LONGSIZE == sizeof(long) + LONGLONGSIZE == sizeof(long long) (if HAS_LONG_LONG) + PTRSIZE == sizeof(void *) + DOUBLESIZE == sizeof(double) + LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE). + Most of these are currently unused, but they are mentioned here so + metaconfig will include the appropriate tests in Configure and + we can then start to consider how best to deal with long long + variables. + Andy Dougherty April 1998 */ typedef char I8; diff --git a/hints/dos_djgpp.sh b/hints/dos_djgpp.sh index 1b4a845fc2..ae6a7cab4c 100644 --- a/hints/dos_djgpp.sh +++ b/hints/dos_djgpp.sh @@ -28,7 +28,6 @@ ln='cp' # no REAL ln on dos lns='cp' usenm='true' -d_bincompat3='undef' d_link='undef' # these are empty functions in libc.a d_symlink='undef' diff --git a/hints/hpux.sh b/hints/hpux.sh index cbf80cc669..9b272aef76 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -169,6 +169,11 @@ case "$prefix" in '') prefix='/opt/perl5' ;; esac +# HP-UX can't do setuid emulation offered by Configure +case "$d_dosuid" in +'') d_dosuid="$undef" ;; +esac + # Date: Fri, 6 Sep 96 23:15:31 CDT # From: "Daniel S. Lewart" <d-lewart@uiuc.edu> # I looked through the gcc.info and found this: diff --git a/hints/irix_6.sh b/hints/irix_6.sh index ed3c112ffa..9b54d2b842 100644 --- a/hints/irix_6.sh +++ b/hints/irix_6.sh @@ -23,6 +23,8 @@ # Threaded by Jarkko Hietaniemi <jhi@iki.fi> on 11/18/97 # - POSIX threads knowledge by IRIX version +# gcc-enabled by Kurt Starsinic <kstar@isinet.com> on 3/24/1998 + # Use sh Configure -Dcc='cc -n32' to try compiling with -n32. # or -Dcc='cc -n32 -mips3' (or -mips4) to force (non)portability # Don't bother with -n32 unless you have the 7.1 or later compilers. @@ -76,6 +78,11 @@ case "$cc" in nm_opt='-p' nm_so_opt='-p' ;; +*gcc*) + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -D_POSIX_C_SOURCE" + optimize="-O3" + usenm='undef' + ;; *) # this is needed to force the old-32 paths # since the system default can be changed. diff --git a/hints/linux.sh b/hints/linux.sh index 7347945c48..545f50eb3d 100644 --- a/hints/linux.sh +++ b/hints/linux.sh @@ -170,8 +170,8 @@ fi if [ ! "`csh -c 'echo $version' 2>/dev/null`" ] then echo 'Real csh found (might break); looking for tcsh ...' - # Use ../UU/loc to find tcsh. (We run in the hints/ directory.) - if xxx=`../UU/loc tcsh blurfl $pth`; $test -f "$xxx"; then + # Use ./UU/loc to find tcsh. (We no longer run in the hints/ directory) + if xxx=`./UU/loc tcsh blurfl $pth`; $test -f "$xxx"; then echo "Found tcsh. I'll use it for globbing." # We can't change Configure's setting of $csh, due to the way # Configure handles $d_portable and commands found in $loclist. diff --git a/hints/qnx.sh b/hints/qnx.sh index 7b7c9e616b..b53a33d737 100644 --- a/hints/qnx.sh +++ b/hints/qnx.sh @@ -143,7 +143,7 @@ if [ -z "`which nm 2>/dev/null`" ]; then Creating a quick-and-dirty nm cover for Configure to use: EOF - cat >../UU/nm <<-'EOF' + cat >./UU/nm <<-'EOF' #! /bin/sh #__USAGE #%C <lib> [<lib> ...] @@ -159,7 +159,7 @@ if [ -z "`which nm 2>/dev/null`" ]; then } }' EOF - chmod +x ../UU/nm + chmod +x ./UU/nm fi cppstdin=`which cpp 2>/dev/null` diff --git a/hints/unicos.sh b/hints/unicos.sh index 1d828550cc..7579eed65a 100644 --- a/hints/unicos.sh +++ b/hints/unicos.sh @@ -5,6 +5,6 @@ optimize="-O1" d_setregid='undef' d_setreuid='undef' case "$usemymalloc" in -'') usemymalloc='n' ;; +'') usemymalloc='y' ;; esac diff --git a/installperl b/installperl index 4c87f553cf..fe168c9217 100755 --- a/installperl +++ b/installperl @@ -5,6 +5,8 @@ BEGIN { chdir '..' if !-d 'lib' and -d '..\lib'; @INC = 'lib'; $ENV{PERL5LIB} = 'lib'; + $Is_VMS = $^O eq 'VMS'; + if ($Is_VMS) { eval 'use VMS::Filespec;' } } use File::Find; @@ -30,13 +32,15 @@ while (@ARGV) { shift; } -umask 022; +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 pod/pod2man pod/pod2html pod/pod2latex pod/pod2text); +if ($Is_VMS) { @scripts = map { "$_.Com" } @scripts; } + @pods = (<pod/*.pod>); %archpms = (Config => 1, FileHandle => 1, overload => 1); @@ -77,6 +81,14 @@ $dlext = $Config{dlext}; $d_dosuid = $Config{d_dosuid}; $binexp = $Config{binexp}; +if ($Is_VMS) { # Hang in there until File::Spec hits the big time + foreach ( \$installbin, \$installscript, \$installprivlib, + \$installarchlib, \$installsitelib, \$installsitearch, + \$installman1dir ) { + $$_ = unixify($$_); $$_ =~ s:/$::; + } +} + # Do some quick sanity checks. if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; } @@ -110,7 +122,15 @@ $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist"); # First we install the version-numbered executables. -if ($^O ne 'dos') { +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"); +} +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"); @@ -150,11 +170,18 @@ else { # Install header files and libraries. mkpath("$installarchlib/CORE", 1, 0777); -@corefiles = <*.h libperl*.*>; -# AIX needs perl.exp installed as well. -push(@corefiles,'perl.exp') if $^O eq 'aix'; -# If they have built sperl.o... -push(@corefiles,'sperl.o') if -f 'sperl.o'; +if ($Is_VMS) { # We did core file selection during build + my $coredir = "lib/$Config{'arch'}/$]"; + $coredir =~ tr/./_/; + @corefiles = <$coredir/*.*>; +} +else { + @corefiles = <*.h libperl*.*>; + # AIX needs perl.exp installed as well. + push(@corefiles,'perl.exp') if $^O eq 'aix'; + # If they have built sperl.o... + push(@corefiles,'sperl.o') if -f 'sperl.o'; +} foreach $file (@corefiles) { # HP-UX (at least) needs to maintain execute permissions # on dynamically-loadable libraries. So we do it for all. @@ -166,7 +193,7 @@ foreach $file (@corefiles) { # Install main perl executables # Make links to ordinary names if installbin directory isn't current directory. -if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos')) { +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") @@ -177,7 +204,7 @@ if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos')) { $mainperl_is_instperl = 0; -if (!$versiononly && !$nonono && $^O ne 'MSWin32' && -t STDIN && -t STDERR +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"; @@ -241,9 +268,10 @@ if (! $versiononly) { # pstruct should be a link to c2ph if (! $versiononly) { - safe_unlink("$installscript/pstruct"); - if ($^O eq 'dos') { - copy("$installscript/c2ph","$installscript/pstruct"); + safe_unlink("$installscript/pstruct" . ($Is_VMS ? '.Com' : '')); + if ($^O eq 'dos' or $Is_VMS) { + copy("$installscript/c2ph" . ($Is_VMS ? '.Com' : ''), + "$installscript/pstruct" . ($Is_VMS ? '.Com' : '')); } else { link("$installscript/c2ph","$installscript/pstruct"); } @@ -296,6 +324,13 @@ if (!$versiononly) { $dirsep = ($^O eq 'os2' || $^O eq 'MSWin32') ? ';' : ':' ; ($path = $ENV{"PATH"}) =~ s:\\:/:g ; @path = split(/$dirsep/, $path); + if ($Is_VMS) { + my $i = 0; + while (exists $ENV{'DCL$PATH' . $i}) { + $dir = unixpath($ENV{'DCL$PATH' . $i}); $dir =~ s-/$--; + push(@path,$dir); + } + } @otherperls = (); for (@path) { next unless m,^/,; @@ -338,6 +373,8 @@ sub unlink { local(@names) = @_; my($cnt) = 0; + return scalar(@names) if $Is_VMS; + foreach $name (@names) { next unless -e $name; chmod 0777, $name if ($^O eq 'os2' || $^O eq 'MSWin32'); @@ -349,7 +386,7 @@ sub unlink { } sub safe_unlink { - return if $nonono; + return if $nonono or $Is_VMS; local @names = @_; foreach $name (@names) { next unless -e $name; @@ -394,6 +431,7 @@ sub link { $packlist->{$to} = { from => $from, type => 'link' }; }; if ($@) { + print STDERR " creating new version of $to\n" if $Is_VMS and -e $to; File::Copy::copy($from, $to) ? $success++ : warn "Couldn't copy $from to $to: $!\n" @@ -417,6 +455,7 @@ sub copy { my($from,$to) = @_; print STDERR " cp $from $to\n"; + print STDERR " creating new version of $to\n" if $Is_VMS and -e $to; File::Copy::copy($from, $to) || warn "Couldn't copy $from to $to: $!\n" unless $nonono; diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 87c27dff8b..29bfaf2e55 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -61,15 +61,22 @@ sub eliminate_macros { if ($self->{$2}) { ($head,$macro,$tail) = ($1,$2,$3); if (ref $self->{$macro}) { - carp "Can't expand macro containing " . ref $self->{$macro}; - $npath = "$head\cB$macro\cB$tail"; - $complex = 1; + if (ref $self->{$macro} eq 'ARRAY') { + print "Note: expanded array macro \$($macro) in $path\n" if $Verbose; + $macro = join ' ', @{$self->{$macro}}; + } + else { + print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}), + "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n"; + $macro = "\cB$macro\cB"; + $complex = 1; + } } else { ($macro = unixify($self->{$macro})) =~ s#/$##; } $npath = "$head$macro$tail"; } } - if ($complex) { $npath =~ s#\cB(.*?)\cB#\$($1)#g; } + if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#g; } print "eliminate_macros($path) = |$npath|\n" if $Verbose >= 3; $npath; } @@ -193,7 +200,7 @@ sub wraplist { # traversing array (scalar(@array) doesn't show them, but # foreach(@array) does) (5.00307) next unless $word =~ /\w/; - $line .= ', ' if length($line); + $line .= ' ' if length($line); if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; } $line .= $word; $hlen += length($word) + 2; @@ -632,9 +639,9 @@ sub constants { if ($self->{OBJECT} =~ /\s/) { $self->{OBJECT} =~ s/(\\)?\n+\s+/ /g; - $self->{OBJECT} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT}))); + $self->{OBJECT} = $self->wraplist(map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT}))); } - $self->{LDFROM} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM}))); + $self->{LDFROM} = $self->wraplist(map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM}))); # Fix up directory specs @@ -726,12 +733,12 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision push @m,' # Handy lists of source code files: -XS_FILES = ',$self->wraplist(', ', sort keys %{$self->{XS}}),' -C_FILES = ',$self->wraplist(', ', @{$self->{C}}),' -O_FILES = ',$self->wraplist(', ', @{$self->{O_FILES}} ),' -H_FILES = ',$self->wraplist(', ', @{$self->{H}}),' -MAN1PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN1PODS}}),' -MAN3PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN3PODS}}),' +XS_FILES = ',$self->wraplist(sort keys %{$self->{XS}}),' +C_FILES = ',$self->wraplist(@{$self->{C}}),' +O_FILES = ',$self->wraplist(@{$self->{O_FILES}} ),' +H_FILES = ',$self->wraplist(@{$self->{H}}),' +MAN1PODS = ',$self->wraplist(sort keys %{$self->{MAN1PODS}}),' +MAN3PODS = ',$self->wraplist(sort keys %{$self->{MAN3PODS}}),' '; @@ -764,21 +771,22 @@ INST_DYNAMIC = $(INST_ARCHAUTODIR)$(BASEEXT).$(DLEXT) INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs '; } else { + my $shr = $Config{'dbgprefix'} . 'PERLSHR'; push @m,' INST_STATIC = INST_DYNAMIC = INST_BOOT = EXPORT_LIST = $(BASEEXT).opt -PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : "Sys\$Share:PerlShr.$Config{'dlext'}"),' +PERL_ARCHIVE = ',($ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}"),' '; } $self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ]; $self->{PM_TO_BLIB} = [ %{$self->{PM}} ]; push @m,' -TO_INST_PM = ',$self->wraplist(', ',@{$self->{TO_INST_PM}}),' +TO_INST_PM = ',$self->wraplist(@{$self->{TO_INST_PM}}),' -PM_TO_BLIB = ',$self->wraplist(', ',@{$self->{PM_TO_BLIB}}),' +PM_TO_BLIB = ',$self->wraplist(@{$self->{PM_TO_BLIB}}),' '; join('',@m); @@ -1365,6 +1373,7 @@ sub dynamic_lib { my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; + my $shr = $Config{'dbgprefix'} . 'PerlShr'; my(@m); push @m," @@ -1375,7 +1384,7 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep push @m, ' $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) - $(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config{'dlext'},' + $(NOECHO) If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",' Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option '; @@ -1436,27 +1445,20 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) '; # If this extension has it's own library (eg SDBM_File) # then copy that to $(INST_STATIC) and add $(OBJECT) into it. - push(@m, ' $(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB}; + push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB}; + + push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n"); - push(@m,' - If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET) -'); # if there was a library to copy, then we can't use MMS$SOURCE_LIST, # 'cause it's a library and you can't stick them in other libraries. # In that case, we use $OBJECT instead and hope for the best if ($self->{MYEXTLIB}) { - push(@m,' - Library/Object/Replace $(MMS$TARGET) $(OBJECT) -'); + push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n"); } else { - push(@m,' - Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST) -'); + push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n"); } - push(@m, ' - $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;" -'); + push(@m,"\t",'$(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"',"\n"); push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); join('',@m); } @@ -1679,6 +1681,9 @@ clean :: push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all')); my($file,$line); $line = ''; #avoid unitialized var warning + # Occasionally files are repeated several times from different sources + { my(%of) = map { ($_,1) } @otherfiles; @otherfiles = keys %of; } + foreach $file (@otherfiles) { $file = $self->fixpath($file); if (length($line) + length($file) > 80) { @@ -1723,6 +1728,8 @@ realclean :: clean } push(@files, values %{$self->{PM}}); $line = ''; #avoid unitialized var warning + # Occasionally files are repeated several times from different sources + { my(%f) = map { ($_,1) } @files; @files = keys %f; } foreach $file (@files) { $file = $self->fixpath($file); if (length($line) + length($file) > 80 || ++$fcnt >= 2) { @@ -1744,6 +1751,8 @@ realclean :: clean else { push(@allfiles, $attribs{FILES}); } } $line = ''; + # Occasionally files are repeated several times from different sources + { my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; } foreach $file (@allfiles) { $file = $self->fixpath($file); if (length($line) + length($file) > 80) { diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm index 91077ddad1..495b82f95b 100644 --- a/lib/Net/Ping.pm +++ b/lib/Net/Ping.pm @@ -106,7 +106,7 @@ sub new } elsif ($self->{"proto"} eq "icmp") { - croak("icmp ping requires root privilege") if $>; + croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS'); $self->{"proto_num"} = (getprotobyname('icmp'))[2] || croak("Can't get icmp protocol by name"); $self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid @@ -684,7 +684,7 @@ magic_setenv(SV *sv, MAGIC *mg) s++; if (i >= sizeof tmpbuf /* too long -- assume the worst */ || *tmpbuf != '/' - || (Stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) { + || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) { MgTAINTEDDIR_on(mg); return 0; } diff --git a/mv-if-diff b/mv-if-diff index 1112a10dd3..ada6040c07 100644 --- a/mv-if-diff +++ b/mv-if-diff @@ -8,7 +8,7 @@ if test $# -lt 2 ; then fi if cmp $1 $2 >/dev/null 2>&1; then echo "File $2 not changed." - rm -f tmp + rm -f $1 else mv $1 $2 fi @@ -17,7 +17,6 @@ fi # Note that the text lines /^Summary of/ .. /^\s*$/ are copied into Config.pm. $spitshell <<!GROK!THIS! - Summary of my $package ($baserev patchlevel $PATCHLEVEL subversion $SUBVERSION) configuration: Platform: osname=$osname, osvers=$osvers, archname=$archname @@ -30,13 +29,13 @@ Summary of my $package ($baserev patchlevel $PATCHLEVEL subversion $SUBVERSION) ccflags ='$ccflags' stdchar='$stdchar', d_stdstdio=$d_stdstdio, usevfork=$usevfork intsize=$intsize, longsize=$longsize, ptrsize=$ptrsize, doublesize=$doublesize + d_longlong=$d_longlong, longlongsize=$longlongsize, d_longdbl=$d_longdbl, longdblsize=$longdblsize alignbytes=$alignbytes, usemymalloc=$usemymalloc, prototype=$prototype Linker and Libraries: ld='$ld', ldflags ='$ldflags' libpth=$libpth libs=$libs - libc=$libc, so=$so - useshrplib=$useshrplib, libperl=$libperl + libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl Dynamic Linking: dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags' cccdlflags='$cccdlflags', lddlflags='$lddlflags' diff --git a/patchlevel.h b/patchlevel.h index efcda310cd..be0c773a97 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,6 +1,6 @@ #ifndef __PATCHLEVEL_H_INCLUDED__ #define PATCHLEVEL 4 -#define SUBVERSION 63 +#define SUBVERSION 64 /* local_patches -- list of locally applied less-than-subversion patches. @@ -24,6 +24,13 @@ char *getenv _((char *)); /* Usually in <stdlib.h> */ #endif +#ifdef I_FCNTL +#include <fcntl.h> +#endif +#ifdef I_SYS_FILE +#include <sys/file.h> +#endif + dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; #ifdef IAMSUID @@ -486,7 +493,7 @@ perl_destruct(register PerlInterpreter *sv_interp) if (hent) { warn("Unbalanced string table refcount: (%d) for \"%s\"", HeVAL(hent) - Nullsv, HeKEY(hent)); - HeVAL(hent) = Nullsv; + HeVAL(hent) = &sv_undef; hent = HeNEXT(hent); } if (!hent) { @@ -675,21 +682,36 @@ setuid perl scripts securely.\n"); if (euid != uid || egid != gid) croak("No -e allowed in setuid scripts"); if (!e_fp) { +#ifdef HAS_UMASK + int oldumask = PerlLIO_umask(0177); +#endif e_tmpname = savepv(TMPPATH); #ifdef HAS_MKSTEMP e_tmpfd = PerlLIO_mkstemp(e_tmpname); - - if (e_tmpfd < 0) - croak("Can't mkstemp() temporary file \"%s\"", e_tmpname); - e_fp = PerlIO_fdopen(e_tmpfd,"w"); #else /* use mktemp() */ (void)PerlLIO_mktemp(e_tmpname); if (!*e_tmpname) - croak("Can't mktemp() temporary file \"%s\"", e_tmpname); + croak("Cannot generate temporary filename"); +# if defined(HAS_OPEN3) && defined(O_EXCL) + e_tmpfd = open(e_tmpname, + O_WRONLY | O_CREAT | O_EXCL, + 0600); +# else + (void)UNLINK(e_tmpname); + /* Yes, potential race. But at least we can say we tried. */ e_fp = PerlIO_open(e_tmpname,"w"); -#endif /* HAS_MKSTEMP */ +# endif +#endif /* ifdef HAS_MKSTEMP */ +#if defined(HAS_MKSTEMP) || (defined(HAS_OPEN3) && defined(O_EXCL)) + if (e_tmpfd < 0) + croak("Cannot create temporary file \"%s\"", e_tmpname); + e_fp = PerlIO_fdopen(e_tmpfd,"w"); +#endif if (!e_fp) - croak("Cannot open temporary file \"%s\"", e_tmpname); + croak("Cannot create temporary file \"%s\"", e_tmpname); +#ifdef HAS_UMASK + (void)PerlLIO_umask(oldumask); +#endif } if (*++s) PerlIO_puts(e_fp,s); @@ -1854,7 +1876,7 @@ open_script(char *scriptname, bool dosearch, SV *sv) #endif DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",cur)); - if (Stat(cur,&statbuf) >= 0) { + if (PerlLIO_stat(cur,&statbuf) >= 0) { dosearch = 0; scriptname = cur; #ifdef SEARCH_EXTS @@ -1922,7 +1944,7 @@ open_script(char *scriptname, bool dosearch, SV *sv) do { #endif DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf)); - retval = Stat(tokenbuf,&statbuf); + retval = PerlLIO_stat(tokenbuf,&statbuf); #ifdef SEARCH_EXTS } while ( retval < 0 /* not there */ && extidx>=0 && ext[extidx] /* try an extension? */ @@ -1945,7 +1967,7 @@ open_script(char *scriptname, bool dosearch, SV *sv) xfailed = savepv(tokenbuf); } #ifndef DOSISH - if (!xfound && !seen_dot && !xfailed && (Stat(scriptname,&statbuf) < 0)) + if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0)) #endif seen_dot = 1; /* Disable message. */ if (!xfound) @@ -2070,7 +2092,7 @@ sed %s -e \"/^[^#]/b\" \ if (!rsfp) { #ifdef DOSUID #ifndef IAMSUID /* in case script is not readable before setuid */ - if (euid && Stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 && + if (euid && PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) { /* try again */ PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv); @@ -2148,7 +2170,7 @@ validate_suid(char *validarg, char *scriptname) #endif || getuid() != euid || geteuid() != uid) croak("Can't swap uid and euid"); /* really paranoid */ - if (Stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0) + if (PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0) croak("Permission denied"); /* testing full pathname here */ if (tmpstatbuf.st_dev != statbuf.st_dev || tmpstatbuf.st_ino != statbuf.st_ino) { @@ -2749,7 +2771,7 @@ incpush(char *p, int addsubdirs) /* .../archname/version if -d .../archname/version/auto */ sv_setsv(subdir, libdir); sv_catpv(subdir, archpat_auto); - if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 && + if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(incgv), newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto")); @@ -2757,7 +2779,7 @@ incpush(char *p, int addsubdirs) /* .../archname if -d .../archname/auto */ sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME), strlen(patchlevel) + 1, "", 0); - if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 && + if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(incgv), newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto")); @@ -4,7 +4,11 @@ #ifdef PERL_OBJECT #else #define PerlDir_mkdir(name, mode) Mkdir((name), (mode)) -#define PerlDir_chdir(name) chdir((name)) +#ifdef VMS +# define PerlDir_chdir(name) chdir(((name) && *(name)) ? (name) : "SYS$LOGIN") +#else +# define PerlDir_chdir(name) chdir((name)) +#endif #define PerlDir_rmdir(name) rmdir((name)) #define PerlDir_close(dir) closedir((dir)) #define PerlDir_open(name) opendir((name)) diff --git a/perlsdio.h b/perlsdio.h index 9825f8ed92..a539a0a3d9 100644 --- a/perlsdio.h +++ b/perlsdio.h @@ -55,7 +55,12 @@ #define PerlIO_clearerr(f) clearerr(f) #define PerlIO_flush(f) Fflush(f) #define PerlIO_tell(f) ftell(f) -#define PerlIO_seek(f,o,w) fseek(f,o,w) +#if defined(VMS) && !defined(__DECC) + /* Old VAXC RTL doesn't reset EOF on seek; Perl folk seem to expect this */ +# define PerlIO_seek(f,o,w) (((f) && (*f) && ((*f)->_flag &= ~_IOEOF)),fseek(f,o,w)) +#else +# define PerlIO_seek(f,o,w) fseek(f,o,w) +#endif #ifdef HAS_FGETPOS #define PerlIO_getpos(f,p) fgetpos(f,p) #endif diff --git a/perlsock.h b/perlsock.h index 1a147f9479..dc1a374f71 100644 --- a/perlsock.h +++ b/perlsock.h @@ -10,17 +10,30 @@ #define PerlSock_accept(s, a, l) accept(s, a, l) #define PerlSock_bind(s, n, l) bind(s, n, l) #define PerlSock_connect(s, n, l) connect(s, n, l) + #define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr(a, l, t) #define PerlSock_gethostbyname(n) gethostbyname(n) -#define PerlSock_gethostent() gethostent() +#define PerlSock_gethostent gethostent +#define PerlSock_endhostent endhostent #define PerlSock_gethostname(n, l) gethostname(n, l) + +#define PerlSock_getnetbyaddr(n, t) getnetbyaddr(n, t) +#define PerlSock_getnetbyname(n) getnetbyname(n) +#define PerlSock_getnetent getnetent +#define PerlSock_endnetent endnetent + #define PerlSock_getpeername(s, n, l) getpeername(s, n, l) + #define PerlSock_getprotobyname(n) getprotobyname(n) #define PerlSock_getprotobynumber(n) getprotobynumber(n) -#define PerlSock_getprotoent() getprotoent() +#define PerlSock_getprotoent getprotoent +#define PerlSock_endprotoent endprotoent + #define PerlSock_getservbyname(n, p) getservbyname(n, p) #define PerlSock_getservbyport(port, p) getservbyport(port, p) -#define PerlSock_getservent() getservent() +#define PerlSock_getservent getservent +#define PerlSock_endservent endservent + #define PerlSock_getsockname(s, n, l) getsockname(s, n, l) #define PerlSock_getsockopt(s, l, n, v, i) getsockopt(s, l, n, v, i) #define PerlSock_listen(s, b) listen(s, b) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 25f3b68fce..96f5c671ea 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -693,18 +693,6 @@ to exist. (F) List assignment to %ENV is not supported on some systems, notably VMS. -=item Can't mkstemp() temporary file %s - -(F) The mkstemp() routine failed for some reason while trying to -process a B<-e> switch. Maybe your temporary file partition -is full, or over-protected, or clobbered. - -=item Can't mktemp() temporary file %s - -(F) The mktemp() routine failed for some reason while trying to -process a B<-e> switch. Maybe your temporary file partition -is full, or over-protected, or clobbered. - =item Can't modify %s in %s (F) You aren't allowed to assign to the item indicated, or otherwise try to @@ -901,16 +889,22 @@ a B<-e> switch. Maybe your /tmp partition is full, or clobbered. an assignment operator, which implies modifying the value itself. Perhaps you need to copy the value to a temporary, and repeat that. +=item Cannot create temporary file "%s" + +(F) A temporary file could not created for some reason while trying to +process a B<-e> switch. Maybe your temporary file partition is full, +or over-protected, or clobbered. + =item Cannot find an opnumber for "%s" (F) A string of a form C<CORE::word> was given to prototype(), but there is no builtin with the name C<word>. -=item Cannot open temporary file %s +=item Cannot generate temporary filename -(F) A temporary file could not created for some reason while trying to -process a B<-e> switch. Maybe your temporary file partition is full, -or over-protected, or clobbered. +(F) While trying to process a B<-e> switch, a filename for a temporary +file could not be generated. Maybe your temporary file partition is +full, or over-protected, or clobbered. =item Cannot resolve method `%s' overloading `%s' in package `%s' @@ -1717,10 +1711,10 @@ about 250 characters. You've exceeded that length. Future versions of Perl are likely to eliminate this arbitrary limitation. In the meantime, try using scientific notation (e.g. "1e6" instead of "1_000_000"). -=item Odd number of elements in hash list +=item Odd number of elements in hash assignment -(S) You specified an odd number of elements to a hash list, which is odd, -because hash lists come in key/value pairs. +(S) You specified an odd number of elements to initialize a hash, which +is odd, because hashes come in key/value pairs. =item Offset outside string @@ -2069,6 +2063,18 @@ which is why it's currently left out of your copy. (F) More than 100 levels of inheritance were used. Probably indicates an unintended loop in your inheritance hierarchy. +=item Reference found where even-sized list expected + +(W) You gave a single reference where Perl was expecting a list with +an even number of elements (for assignment to a hash). This +usually means that you used the anon hash constructor when you meant +to use parens. In any case, a hash requires key/value B<pairs>. + + %hash = { one => 1, two => 2, }; # WRONG + %hash = [ qw/ an anon array / ]; # WRONG + %hash = ( one => 1, two => 2, ); # right + %hash = qw( one 1 two 2 ); # also fine + =item Reference miscount in sv_replace() (W) The internal sv_replace() function was handed a new SV with a diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 01ad16783d..87173492d1 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -72,7 +72,7 @@ The sequences "-*" and "- " are specifically ignored so that you could, if you were so inclined, say #!/bin/sh -- # -*- perl -*- -p - eval 'exec /usr/bin/perl $0 -S ${1+"$@"}' + eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; to let Perl see the B<-p> switch. @@ -618,7 +618,8 @@ look in COMSPEC to find a shell fit for interactive use). =item PERL_DEBUG_MSTATS -Relevant only if your perl executable was built with B<-DDEBUGGING_MSTATS>, +Relevant only if perl is compiled with the malloc included with the perl +distribution (that is, if C<perl -V:d_mymalloc> is 'define'), if set, this causes memory statistics to be dumped after execution. If set to an integer greater than one, also causes memory statistics to be dumped after compilation. diff --git a/pod/pod2latex.PL b/pod/pod2latex.PL index 3d0b55b32f..1d188099cb 100644 --- a/pod/pod2latex.PL +++ b/pod/pod2latex.PL @@ -472,6 +472,9 @@ while (<POD>) { noindex: ; } + elsif ($cmd eq 'pod') { + ; # recognise the pod directive, as no op (hs) + } else { warn "Unrecognized directive: $cmd\n"; } @@ -676,7 +679,7 @@ BEGIN { "otilde" => "\\~{o}", # small o, tilde "Ouml" => '\\"{O}', # capital O, dieresis or umlaut mark "ouml" => '\\"{o}', # small o, dieresis or umlaut mark - "szlig" => '\\ss', # small sharp s, German (sz ligature) + "szlig" => '\\ss{}', # small sharp s, German (sz ligature) "THORN" => '\\L', # capital THORN, Icelandic "thorn" => '\\l',, # small thorn, Icelandic "Uacute" => "\\'{U}", # capital U, acute accent @@ -69,7 +69,11 @@ typedef unsigned UBW; * If they're not right on your machine, then pack() and unpack() * wouldn't work right anyway; you'll need to apply the Cray hack. * (I'd like to check them with #if, but you can't use sizeof() in - * the preprocessor.) + * the preprocessor.) --??? + */ +/* + The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE + defines are now in config.h. --Andy Dougherty April 1998 */ #define SIZE16 2 #define SIZE32 4 @@ -1776,6 +1780,7 @@ PP(pp_substr) len = POPi; pos = POPi; sv = POPs; + PUTBACK; tmps = SvPV(sv, curlen); if (pos >= arybase) { pos -= arybase; @@ -1842,6 +1847,7 @@ PP(pp_substr) LvTARGLEN(TARG) = rem; } } + SPAGAIN; PUSHs(TARG); /* avoid SvSETMAGIC here */ RETURN; } @@ -2483,7 +2489,7 @@ PP(pp_anonhash) if (MARK < SP) sv_setsv(val, *++MARK); else if (dowarn) - warn("Odd number of elements in hash list"); + warn("Odd number of elements in hash assignment"); (void)hv_store_ent(hv,key,val,0); } SP = ORIGMARK; @@ -644,8 +644,15 @@ PP(pp_aassign) } TAINT_NOT; } - if (relem == lastrelem && dowarn) - warn("Odd number of elements in hash list"); + if (relem == lastrelem && dowarn) { + if (relem == firstrelem && + SvROK(*relem) && + ( SvTYPE(SvRV(*relem)) == SVt_PVAV || + SvTYPE(SvRV(*relem)) == SVt_PVHV ) ) + warn("Reference found where even-sized list expected"); + else + warn("Odd number of elements in hash assignment"); + } } break; default: @@ -1078,7 +1085,7 @@ do_readline(void) } if ((tmpfp = PerlIO_open(tmpfnam,"w+","fop=dlt")) != NULL) { Stat_t st; - if (!Stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode)) + if (!PerlLIO_stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode)) ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL); else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL); if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer); @@ -1227,7 +1234,7 @@ do_readline(void) if (!isALPHA(*tmps) && !isDIGIT(*tmps) && strchr("$&*(){}[]'\";\\|?<>~`", *tmps)) break; - if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) { + if (*tmps && PerlLIO_stat(SvPVX(sv), &statbuf) < 0) { (void)POPs; /* Unmatched wildcard? Chuck it... */ continue; } @@ -54,7 +54,11 @@ extern "C" int syscall(unsigned long,...); #endif #endif -#ifdef HOST_NOT_FOUND +/* XXX Configure test needed. + h_errno might not be a simple 'int', especially for multi-threaded + applications. HOST_NOT_FOUND is typically defined in <netdb.h>. +*/ +#if defined(HOST_NOT_FOUND) && !defined(h_errno) extern int h_errno; #endif @@ -2107,7 +2111,7 @@ PP(pp_stat) laststatval = PerlLIO_lstat(SvPV(statname, na), &statcache); else #endif - laststatval = Stat(SvPV(statname, na), &statcache); + laststatval = PerlLIO_stat(SvPV(statname, na), &statcache); if (laststatval < 0) { if (dowarn && strchr(SvPV(statname, na), '\n')) warn(warn_nl, "stat"); @@ -2678,11 +2682,11 @@ PP(pp_rename) #ifdef HAS_RENAME anum = rename(tmps, tmps2); #else - if (!(anum = Stat(tmps, &statbuf))) { + if (!(anum = PerlLIO_stat(tmps, &statbuf))) { if (same_dirent(tmps2, tmps)) /* can always rename to same name */ anum = 1; else { - if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode)) + if (euid || PerlLIO_stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode)) (void)UNLINK(tmps2); if (!(anum = link(tmps, tmps2))) anum = UNLINK(tmps); @@ -2819,7 +2823,7 @@ char *filename; return 0; } else { /* some mkdirs return no failure indication */ - anum = (Stat(save_filename, &statbuf) >= 0); + anum = (PerlLIO_stat(save_filename, &statbuf) >= 0); if (op->op_type == OP_RMDIR) anum = !anum; if (anum) @@ -3621,33 +3625,38 @@ PP(pp_ghostent) I32 which = op->op_type; register char **elem; register SV *sv; -#if defined(HAS_GETHOSTENT) && !defined(DONT_DECLARE_STD) +#ifndef HAS_GETHOST_PROTOS /* XXX Do we need individual probes? */ struct hostent *PerlSock_gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int); struct hostent *PerlSock_gethostbyname(Netdb_name_t); -#ifndef PerlSock_gethostent struct hostent *PerlSock_gethostent(void); #endif -#endif struct hostent *hent; unsigned long len; EXTEND(SP, 10); - if (which == OP_GHBYNAME) { + if (which == OP_GHBYNAME) +#ifdef HAS_GETHOSTBYNAME hent = PerlSock_gethostbyname(POPp); - } +#else + DIE(no_sock_func, "gethostbyname"); +#endif else if (which == OP_GHBYADDR) { +#ifdef HAS_GETHOSTBYADDR int addrtype = POPi; SV *addrsv = POPs; STRLEN addrlen; Netdb_host_t addr = (Netdb_host_t) SvPV(addrsv, addrlen); hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype); +#else + DIE(no_sock_func, "gethostbyaddr"); +#endif } else #ifdef HAS_GETHOSTENT hent = PerlSock_gethostent(); #else - DIE("gethostent not implemented"); + DIE(no_sock_func, "gethostent"); #endif #ifdef HOST_NOT_FOUND @@ -3724,22 +3733,34 @@ PP(pp_gnetent) I32 which = op->op_type; register char **elem; register SV *sv; -#ifdef NETDB_H_OMITS_GETNET - struct netent *getnetbyaddr(Netdb_net_t, int); - struct netent *getnetbyname(Netdb_name_t); - struct netent *getnetent(void); +#ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */ + struct netent *PerlSock_getnetbyaddr(Netdb_net_t, int); + struct netent *PerlSock_getnetbyname(Netdb_name_t); + struct netent *PerlSock_getnetent(void); #endif struct netent *nent; if (which == OP_GNBYNAME) - nent = getnetbyname(POPp); +#ifdef HAS_GETNETBYNAME + nent = PerlSock_getnetbyname(POPp); +#else + DIE(no_sock_func, "getnetbyname"); +#endif else if (which == OP_GNBYADDR) { +#ifdef HAS_GETNETBYADDR int addrtype = POPi; Netdb_net_t addr = (Netdb_net_t) U_L(POPn); - nent = getnetbyaddr(addr, addrtype); + nent = PerlSock_getnetbyaddr(addr, addrtype); +#else + DIE(no_sock_func, "getnetbyaddr"); +#endif } else - nent = getnetent(); +#ifdef HAS_GETNETENT + nent = PerlSock_getnetent(); +#else + DIE(no_sock_func, "getnetent"); +#endif EXTEND(SP, 4); if (GIMME != G_ARRAY) { @@ -3799,13 +3820,11 @@ PP(pp_gprotoent) I32 which = op->op_type; register char **elem; register SV *sv; -#ifndef DONT_DECLARE_STD +#ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */ struct protoent *PerlSock_getprotobyname(Netdb_name_t); struct protoent *PerlSock_getprotobynumber(int); -#ifndef PerlSock_getprotoent struct protoent *PerlSock_getprotoent(void); #endif -#endif struct protoent *pent; if (which == OP_GPBYNAME) @@ -3883,16 +3902,15 @@ PP(pp_gservent) I32 which = op->op_type; register char **elem; register SV *sv; -#ifndef DONT_DECLARE_STD +#ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */ struct servent *PerlSock_getservbyname(Netdb_name_t, Netdb_name_t); struct servent *PerlSock_getservbyport(int, Netdb_name_t); -#ifndef PerlSock_getservent struct servent *PerlSock_getservent(void); #endif -#endif struct servent *sent; if (which == OP_GSBYNAME) { +#ifdef HAS_GETSERVBYNAME char *proto = POPp; char *name = POPp; @@ -3900,8 +3918,12 @@ PP(pp_gservent) proto = Nullch; sent = PerlSock_getservbyname(name, proto); +#else + DIE(no_sock_func, "getservbyname"); +#endif } else if (which == OP_GSBYPORT) { +#ifdef HAS_GETSERVBYPORT char *proto = POPp; unsigned short port = POPu; @@ -3909,6 +3931,9 @@ PP(pp_gservent) port = PerlSock_htons(port); #endif sent = PerlSock_getservbyport(port, proto); +#else + DIE(no_sock_func, "getservbyport"); +#endif } else #ifdef HAS_GETSERVENT @@ -4007,7 +4032,7 @@ PP(pp_ehostent) { djSP; #ifdef HAS_ENDHOSTENT - endhostent(); + PerlSock_endhostent(); EXTEND(SP,1); RETPUSHYES; #else @@ -4019,7 +4044,7 @@ PP(pp_enetent) { djSP; #ifdef HAS_ENDNETENT - endnetent(); + PerlSock_endnetent(); EXTEND(SP,1); RETPUSHYES; #else @@ -4031,7 +4056,7 @@ PP(pp_eprotoent) { djSP; #ifdef HAS_ENDPROTOENT - endprotoent(); + PerlSock_endprotoent(); EXTEND(SP,1); RETPUSHYES; #else @@ -4043,7 +4068,7 @@ PP(pp_eservent) { djSP; #ifdef HAS_ENDSERVENT - endservent(); + PerlSock_endservent(); EXTEND(SP,1); RETPUSHYES; #else @@ -271,7 +271,10 @@ struct regnode_2 { #endif -#define REG_INFTY I16_MAX +/* I16_MAX is no good for REG_INFTY because sizeof(short) > 2 + * is perfectly fine. In Cray C90 sizeof(short) == 4, + * in Cray T90 sizeof(short) == 8. */ +#define REG_INFTY ((1<<15)-1) #ifdef REGALIGN # define ARG_VALUE(arg) (arg) @@ -1313,7 +1313,7 @@ regmatch(regnode *prog) *reglastparen = paren; } #endif - scan = NEXTOPER(scan) + 4/sizeof(regnode); + scan = NEXTOPER(scan) + NODE_STEP_REGNODE; if (paren) scan += NEXT_OFF(scan); /* Skip former OPEN. */ reginput = locinput; @@ -1427,13 +1427,13 @@ regmatch(regnode *prog) *reglastparen = paren; ln = ARG1(scan); /* min to match */ n = ARG2(scan); /* max to match */ - scan = regnext(NEXTOPER(scan) + 4/sizeof(regnode)); + scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE); goto repeat; case CURLY: paren = 0; ln = ARG1(scan); /* min to match */ n = ARG2(scan); /* max to match */ - scan = NEXTOPER(scan) + 4/sizeof(regnode); + scan = NEXTOPER(scan) + NODE_STEP_REGNODE; goto repeat; case STAR: ln = 0; @@ -2718,6 +2718,7 @@ sv_replace(register SV *sv, register SV *nsv) void sv_clear(register SV *sv) { + HV* stash; assert(sv); assert(SvREFCNT(sv) == 0); @@ -2726,7 +2727,6 @@ sv_clear(register SV *sv) if (defstash) { /* Still have a symbol table? */ djSP; GV* destructor; - HV* stash; SV ref; Zero(&ref, 1, SV); @@ -2772,6 +2772,7 @@ sv_clear(register SV *sv) } if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) mg_free(sv); + stash = NULL; switch (SvTYPE(sv)) { case SVt_PVIO: if (IoIFP(sv) != PerlIO_stdin() && @@ -2797,7 +2798,11 @@ sv_clear(register SV *sv) case SVt_PVGV: gp_free((GV*)sv); Safefree(GvNAME(sv)); - SvREFCNT_dec(GvSTASH(sv)); + /* cannot decrease stash refcount yet, as we might recursively delete + ourselves when the refcnt drops to zero. Delay SvREFCNT_dec + of stash until current sv is completely gone. + -- JohnPC, 27 Mar 1998 */ + stash = GvSTASH(sv); /* FALL THROUGH */ case SVt_PVLV: case SVt_PVMG: @@ -2859,7 +2864,13 @@ sv_clear(register SV *sv) break; case SVt_PVGV: del_XPVGV(SvANY(sv)); - break; + /* code duplication for increased performance. */ + SvFLAGS(sv) &= SVf_BREAK; + SvFLAGS(sv) |= SVTYPEMASK; + /* decrease refcount of the stash that owns this GV, if any */ + if (stash) + SvREFCNT_dec(stash); + return; /* not break, SvFLAGS reset already happened */ case SVt_PVBM: del_XPVBM(SvANY(sv)); break; @@ -5007,7 +5018,8 @@ sv_dump(SV *sv) case SVt_PVGV: PerlIO_printf(Perl_debug_log, " NAME = \"%s\"\n", GvNAME(sv)); PerlIO_printf(Perl_debug_log, " NAMELEN = %ld\n", (long)GvNAMELEN(sv)); - PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n", HvNAME(GvSTASH(sv))); + PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n", + SvTYPE(GvSTASH(sv)) == SVt_PVHV ? HvNAME(GvSTASH(sv)) : "(deleted)"); PerlIO_printf(Perl_debug_log, " GP = 0x%lx\n", (long)GvGP(sv)); PerlIO_printf(Perl_debug_log, " SV = 0x%lx\n", (long)GvSV(sv)); PerlIO_printf(Perl_debug_log, " REFCNT = %ld\n", (long)GvREFCNT(sv)); diff --git a/t/lib/english.t b/t/lib/english.t index 1a96c772fe..9691229be0 100755 --- a/t/lib/english.t +++ b/t/lib/english.t @@ -5,7 +5,7 @@ print "1..16\n"; BEGIN { @INC = '../lib' } use English; use Config; -my $threads = $Config{archname} =~ /-thread$/; +my $threads = $Config{'usethreads'} || 0; print $PID == $$ ? "ok 1\n" : "not ok 1\n"; diff --git a/t/op/hashwarn.t b/t/op/hashwarn.t new file mode 100755 index 0000000000..741982622b --- /dev/null +++ b/t/op/hashwarn.t @@ -0,0 +1,70 @@ +#!./perl + +use strict; + +BEGIN { + chdir 't' if -d 't'; +} + +use vars qw{ @warnings }; + +BEGIN { + $^W |= 1; # Insist upon warnings + # ...and save 'em as we go + $SIG{'__WARN__'} = sub { push @warnings, @_ }; + $| = 1; + print "1..7\n"; +} + +END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings } + +sub test ($$;$) { + my($num, $bool, $diag) = @_; + if ($bool) { + print "ok $num\n"; + return; + } + print "not ok $num\n"; + return unless defined $diag; + $diag =~ s/\Z\n?/\n/; # unchomp + print map "# $num : $_", split m/^/m, $diag; +} + +sub test_warning ($$$) { + my($num, $got, $expected) = @_; + my($pattern, $ok); + if (($pattern) = ($expected =~ m#^/(.+)/$#s) or + (undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) { + # it's a regexp + $ok = ($got =~ /$pattern/); + test $num, $ok, "Expected pattern /$pattern/, got '$got'\n"; + } else { + $ok = ($got eq $expected); + test $num, $ok, "Expected string '$expected', got '$got'\n"; + } +# print "# $num: $got\n"; +} + +my $odd_msg = '/^Odd number of elements in hash/'; +my $ref_msg = '/^Reference found where even-sized list expected/'; + +{ + my %hash = (1..3); + test_warning 1, shift @warnings, $odd_msg; + + %hash = 1; + test_warning 2, shift @warnings, $odd_msg; + + %hash = { 1..3 }; + test_warning 3, shift @warnings, $odd_msg; + test_warning 4, shift @warnings, $ref_msg; + + %hash = [ 1..3 ]; + test_warning 5, shift @warnings, $ref_msg; + + %hash = sub { print "ok" }; + test_warning 6, shift @warnings, $odd_msg; + + $_ = { 1..10 }; + test 7, ! @warnings, "Unexpected warning"; +} @@ -2848,7 +2848,8 @@ yylex(void) s = scan_word(s, tokenbuf + len, sizeof tokenbuf - len, TRUE, &morelen); if (!morelen) - croak("Bad name after %s::", tokenbuf); + croak("Bad name after %s%s", tokenbuf, + *s == '\'' ? "'" : "::"); len += morelen; } @@ -2345,13 +2345,13 @@ char *b; sv_setpv(tmpsv, "."); else sv_setpvn(tmpsv, a, fa - a); - if (Stat(SvPVX(tmpsv), &tmpstatbuf1) < 0) + if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf1) < 0) return FALSE; if (fb == b) sv_setpv(tmpsv, "."); else sv_setpvn(tmpsv, b, fb - b); - if (Stat(SvPVX(tmpsv), &tmpstatbuf2) < 0) + if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf2) < 0) return FALSE; return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev && tmpstatbuf1.st_ino == tmpstatbuf2.st_ino; diff --git a/utils/perldoc.PL b/utils/perldoc.PL index ee56e0206d..3a6059b4fd 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -206,7 +206,11 @@ sub minus_f_nocase { sub check_file { my($file) = @_; - return minus_f_nocase($file) && containspod($file) ? $file : ""; + if ($opt_m) { + return minus_f_nocase($file) ? $file : ""; + } else { + return minus_f_nocase($file) && containspod($file) ? $file : ""; + } } diff --git a/vms/config.vms b/vms/config.vms index 24a3906743..35abbdb00f 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -76,7 +76,7 @@ * when Perl is built. Please do not change it by hand; make * any changes to FndVers.Com instead. */ -#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00462" /**/ +#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00463" /**/ #define ARCHLIB ARCHLIB_EXP /*config-skip*/ @@ -177,6 +177,7 @@ * This symbol, if defined, indicates that the C-shell exists. * If defined, contains the full pathname of csh. */ +#undef HAS_CSH /**/ #undef CSH /**/ /* HAS_DUP2: @@ -242,6 +243,26 @@ # define Timeval struct timeval /*config-skip*/ #endif +/* HAS_LONG_DOUBLE: + * This symbol will be defined if the C compiler supports long + * doubles. + */ +/* LONG_DOUBLESIZE: + * This symbol contains the size of a long double, so that the + * C preprocessor can make decisions based on it. It is only + * defined if the system supports long doubles. + */ +#undef HAS_LONG_DOUBLE /**/ +#ifdef HAS_LONG_DOUBLE +# define LONG_DOUBLESIZE 8 /**/ +#endif + +/* HAS_MKSTEMP: + * This symbol, if defined, indicates that the mkstemp routine is + * available to create and open a unique temporary file. + */ +#undef HAS_MKSTEMP /**/ + /* HAS_GETGROUPS: * This symbol, if defined, indicates that the getgroups() routine is * available to get the list of process groups. If unavailable, multiple @@ -1847,6 +1868,13 @@ */ #undef USE_PERLIO /**/ +/* HAS_SETVBUF: + * This symbol, if defined, indicates that the setvbuf routine is + * available to change buffering on an open stdio stream. + * to a line-buffered mode. + */ +#define HAS_SETVBUF /**/ + /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this * compiler. What various bits mean: @@ -1916,8 +1944,8 @@ * This symbol, if defined, indicates that the getprotobynumber() * routine is available to look up protocols by their number. */ -#define HAS_GETPROTOBYNAME /**/ -#define HAS_GETPROTOBYNUMBER /**/ +#define HAS_GETPROTOBYNAME /*config-skip*/ +#define HAS_GETPROTOBYNUMBER /*config-skip*/ /* HAS_GETHOSTBYNAME: * This symbol, if defined, indicates that the gethostbyname routine is @@ -1952,9 +1980,30 @@ * available to lookup networks by their names. */ #define HAS_GETNETBYNAME /*config-skip*/ + +/* HAS_GETNETENT: + * This symbol, if defined, indicates that the getnetent() routine is + * available to look up network names in some data base or another. + */ +#define HAS_GETNETENT /*config-skip*/ + +/* HAS_SETNETENT: + * This symbol, if defined, indicates that the setnetent() routine is + * available. + */ +#define HAS_SETNETENT /*config-skip*/ + +/* HAS_ENDNETENT: + * This symbol, if defined, indicates that the endnetent() routine is + * available to close whatever was being used for network queries. + */ +#define HAS_ENDNETENT /*config-skip*/ #else -#undef HAS_GETNETBYADDR /*config-skip*/ +#undef HAS_GETNETBYADDR /*config-skip*/ #undef HAS_GETNETBYNAME /*config-skip*/ +#undef HAS_GETNETENT /*config-skip*/ +#undef HAS_SETNETENT /*config-skip*/ +#undef HAS_ENDNETENT /*config-skip*/ #endif /* HAS_GETPROTOBYNAME: @@ -2014,6 +2063,48 @@ */ #define HAS_SELECT /**/ /* config-skip */ +/* HAS_ENDHOSTENT: + * This symbol, if defined, indicates that the endhostent() routine is + * available to close whatever was being used for host queries. + */ +#define HAS_ENDHOSTENT /*config-skip*/ + +/* HAS_GETPROTOENT: + * This symbol, if defined, indicates that the getprotoent() routine is + * available to look up protocols in some data base or another. + */ +#define HAS_GETPROTOENT /*config-skip*/ + +/* HAS_ENDPROTOENT: + * This symbol, if defined, indicates that the endprotoent() routine is + * available to close whatever was being used for protocol queries. + */ +#define HAS_ENDPROTOENT /*config-skip*/ + +/* HAS_SETPROTOENT: + * This symbol, if defined, indicates that the setprotoent() routine is + * available. + */ +#define HAS_SETPROTOENT /*config-skip*/ + +/* HAS_GETSERVENT: + * This symbol, if defined, indicates that the getservent() routine is + * available to look up network services in some data base or another. + */ +#define HAS_GETSERVENT /*config-skip*/ + +/* HAS_SETSERVENT: + * This symbol, if defined, indicates that the setservent() routine is + * available. + */ +#define HAS_SETSERVENT /*config-skip*/ + +/* HAS_ENDSERVENT: + * This symbol, if defined, indicates that the endservent() routine is + * available to close whatever was being used for service queries. + */ +#define HAS_ENDSERVENT /*config-skip*/ + #else /* VMS_DO_SOCKETS */ #undef HAS_SOCKET /*config-skip*/ @@ -2026,12 +2117,22 @@ #undef HAS_SELECT /*config-skip*/ #undef HAS_GETHOSTBYADDR /*config-skip*/ #undef HAS_GETNETBYADDR /*config-skip*/ +#undef HAS_GETNETENT /*config-skip*/ +#undef HAS_SETNETENT /*config-skip*/ +#undef HAS_ENDNETENT /*config-skip*/ #undef HAS_GETHOSTBYNAME /*config-skip*/ #undef HAS_GETNETBYNAME /*config-skip*/ #undef HAS_GETPROTOBYNAME /*config-skip*/ #undef HAS_GETPROTOBYNUMBER /*config-skip*/ #undef HAS_GETSERVBYNAME /*config-skip*/ #undef HAS_GETSERVBYPORT /*config-skip*/ +#undef HAS_ENDHOSTENT /*config-skip*/ +#undef HAS_GETPROTOENT /*config-skip*/ +#undef HAS_SETPROTOENT /*config-skip*/ +#undef HAS_ENDPROTOENT /*config-skip*/ +#undef HAS_GETSERVENT /*config-skip*/ +#undef HAS_SETSERVENT /*config-skip*/ +#undef HAS_ENDSERVENT /*config-skip*/ #endif /* !VMS_DO_SOCKETS */ diff --git a/vms/descrip.mms b/vms/descrip.mms index 683f40dfe9..00a5c0b425 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -74,7 +74,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O) .endif # Updated by fndvers.com -- do not edit by hand -PERL_VERSION = 5_00462# +PERL_VERSION = 5_00463# .ifdef DECC_SOCKETS SOCKET=1 @@ -395,8 +395,8 @@ byteperl.c : [.ext.B]byteperl.c .ifdef __DEBUG__ # Link an extra perl that doesn't invoke the debugger perl : $(DBG)perl$(E) $(DBG)byteperl$(E) - Link $(LINKFLAGS)/NoDebug/Trace/NoMap/NoCross/NoFull/Exe=N$(DBG)perl$(E) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option - Link $(LINKFLAGS)/NoDebug/Trace/NoMap/NoCross/NoFull/Exe=N$(DBG)byteperl$(E) byteperl$(O), perlshr.opt/Option, perlshr_attr.opt/Option + Link $(LINKFLAGS)/NoDebug/Trace/NoMap/NoCross/NoFull/Exe=N$(DBG)perl$(E) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option $(CRTLOPTS) + Link $(LINKFLAGS)/NoDebug/Trace/NoMap/NoCross/NoFull/Exe=N$(DBG)byteperl$(E) byteperl$(O), perlshr.opt/Option, perlshr_attr.opt/Option $(CRTLOPTS) .else perl : $(DBG)perl$(E) $(DBG)byteperl$(E) @ Continue @@ -404,11 +404,11 @@ perl : $(DBG)perl$(E) $(DBG)byteperl$(E) $(DBG)perl$(E) : perlmain$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE) @ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share" - Link $(LINKFLAGS)/Exe=$(MMS$TARGET) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option + Link $(LINKFLAGS)/Exe=$(MMS$TARGET) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option $(CRTLOPTS) $(DBG)byteperl$(E) : byteperl$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE) @ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share" - Link $(LINKFLAGS)/Exe=$(MMS$TARGET) byteperl$(O), perlshr.opt/Option, perlshr_attr.opt/Option + Link $(LINKFLAGS)/Exe=$(MMS$TARGET) byteperl$(O), perlshr.opt/Option, perlshr_attr.opt/Option $(CRTLOPTS) $(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts Link $(LINKFLAGS)/Share=$(MMS$TARGET) $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option @@ -1342,6 +1342,17 @@ clean : tidy Set Default [.ext.Opcode] - $(MMS) clean Set Default [--] + Set Default [.ext.attrs] + - $(MMS) clean + Set Default [--] + Set Default [.ext.B] + - $(MMS) clean + Set Default [--] +.ifdef THREAD + Set Default [.ext.Thread] + - $(MMS) realclean + Set Default [--] +.endif .ifdef DECC Set Default [.ext.POSIX] - $(MMS) clean @@ -1384,6 +1395,9 @@ realclean : clean Set Default [.ext.attrs] - $(MMS) realclean Set Default [--] + Set Default [.ext.B] + - $(MMS) realclean + Set Default [--] .ifdef THREAD Set Default [.ext.Thread] - $(MMS) realclean diff --git a/vms/ext/Filespec.pm b/vms/ext/Filespec.pm index db3283c571..b0b1414599 100644 --- a/vms/ext/Filespec.pm +++ b/vms/ext/Filespec.pm @@ -12,7 +12,7 @@ VMS::Filespec - convert between VMS and Unix file specification syntax =head1 SYNOPSIS use VMS::Filespec; -$fullspec = rmsexpand('[.VMS]file.specification'); +$fullspec = rmsexpand('[.VMS]file.specification'[, 'default:[file.spec]']); $vmsspec = vmsify('/my/Unix/file/specification'); $unixspec = unixify('my:[VMS]file.specification'); $path = pathify('my:[VMS.or.Unix.directory]specification.dir'); @@ -65,9 +65,11 @@ The routines provided are: =head2 rmsexpand Uses the RMS $PARSE and $SEARCH services to expand the input -specification to its fully qualified form. (If the file does -not exist, the input specification is expanded as much as -possible.) If an error occurs, returns C<undef> and sets C<$!> +specification to its fully qualified form, except that a null type +or version is not added unless it was present in either the original +file specification or the default specification passed to C<rmsexpand>. +(If the file does not exist, the input specification is expanded as much +as possible.) If an error occurs, returns C<undef> and sets C<$!> and C<$^E>. =head2 vmsify diff --git a/vms/ext/Stdio/0README.txt b/vms/ext/Stdio/0README.txt index 28f82b3a14..25329f9334 100644 --- a/vms/ext/Stdio/0README.txt +++ b/vms/ext/Stdio/0README.txt @@ -3,26 +3,6 @@ VMS::Stdio, which provides access from Perl to VMS-specific stdio functions. For more specific documentation of its function, please see the pod section of Stdio.pm. - *** Please Note *** - -This package is the direct descendant of VMS::stdio, but as of Perl -5.002, the name has been changed to VMS::Stdio, in order to conform -to the Perl naming convention that extensions whose name begins -with a lowercase letter represent compile-time "pragmas", while -extensions which provide added functionality have names whose parts -begin with uppercase letters. In addition, the functions -vmsfopen and fgetname have been renamed vmsopen and getname, -respectively, in order to more closely resemble related Perl -I/O operators, which do not retain the 'f' from corresponding -C routine names. - -A transitional interface to the old routine names has been -provided, so that calls to these routines will generate a -warning, and be routed to the corresponding VMS::Stdio -routine. This interface will be removed in a future release, -so please update your code to use the new names. - - ===> Installation This extension, like most Perl extensions, should be installed @@ -45,3 +25,6 @@ the Perl distribution tree, and then saying 2.0 28-Feb-1996 Charles Bailey bailey@genetics.upenn.edu major rewrite for Perl 5.002: name changed to VMS::Stdio, new functions added, and prototypes incorporated +2.1 24-Mar-1998 Charles Bailey bailey@newman.upenn.edu + Added writeof() + Removed old VMs::stdio compatibility interface diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm index 01ff32db64..ea5d9074ef 100644 --- a/vms/ext/Stdio/Stdio.pm +++ b/vms/ext/Stdio/Stdio.pm @@ -1,8 +1,8 @@ # VMS::Stdio - VMS extensions to Perl's stdio calls # # Author: Charles Bailey bailey@genetics.upenn.edu -# Version: 2.02 -# Revised: 15-Feb-1997 +# Version: 2.1 +# Revised: 24-Mar-1998 package VMS::Stdio; @@ -12,17 +12,18 @@ use Carp '&croak'; use DynaLoader (); use Exporter (); -$VERSION = '2.02'; +$VERSION = '2.1'; @ISA = qw( Exporter DynaLoader IO::File ); @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY &O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC &O_WRONLY ); -@EXPORT_OK = qw( &flush &getname &remove &rewind &sync &tmpnam - &vmsopen &vmssysopen &waitfh ); +@EXPORT_OK = qw( &flush &getname &remove &rewind &sync &setdef &tmpnam + &vmsopen &vmssysopen &waitfh &writeof ); %EXPORT_TAGS = ( CONSTANTS => [ qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY &O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC &O_WRONLY ) ], - FUNCTIONS => [ qw( &flush &getname &remove &rewind &sync - &tmpnam &vmsopen &vmssysopen &waitfh ) ] ); + FUNCTIONS => [ qw( &flush &getname &remove &rewind &setdef + &sync &tmpnam &vmsopen &vmssysopen + &waitfh &writeof ) ] ); bootstrap VMS::Stdio $VERSION; @@ -80,8 +81,9 @@ VMS::Stdio - standard I/O functions via VMS extensions =head1 SYNOPSIS -use VMS::Stdio qw( &flush &getname &remove &rewind &sync &tmpnam - &vmsopen &vmssysopen &waitfh ); +use VMS::Stdio qw( &flush &getname &remove &rewind &setdef &sync &tmpnam + &vmsopen &vmssysopen &waitfh &writeof ); +setdef("new:[default.dir]"); $uniquename = tmpnam; $fh = vmsopen("my.file","rfm=var","alq=100",...) or die $!; $name = getname($fh); @@ -96,7 +98,7 @@ sysread($fh,$data,128); waitfh($fh); close($fh); remove("another.file"); - +writeof($pipefh); =head1 DESCRIPTION This package gives Perl scripts access via VMS extensions to several @@ -175,6 +177,13 @@ to the beginning of the file. It's really just a convenience method equivalent in effect to C<seek($fh,0,0)>. It returns a true value if successful, and C<undef> if it fails. +=item setdef + +This function sets the default device and directory for the process. +It is identical to the built-in chdir() operator, except that the change +persists after Perl exits. It returns a true value on success, and +C<undef> if it encounters and error. + =item sync This function flushes buffered data for the specified file handle @@ -231,6 +240,14 @@ operation on the file handle specified as its argument. It is used with handles opened for asynchronous I/O, and performs its task by calling the CRTL routine fwait(). +=item writeof + +This function writes an EOF to a file handle, if the device driver +supports this operation. Its primary use is to send an EOF to a +subprocess through a pipe opened for writing without closing the +pipe. It returns a true value if successful, and C<undef> if +it encounters an error. + =head1 REVISION This document was last revised on 10-Dec-1996, for Perl 5.004. diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs index b10fec0d48..0a7b47e514 100644 --- a/vms/ext/Stdio/Stdio.xs +++ b/vms/ext/Stdio/Stdio.xs @@ -1,8 +1,8 @@ /* VMS::Stdio - VMS extensions to stdio routines * - * Version: 2.02 + * Version: 2.1 * Author: Charles Bailey bailey@genetics.upenn.edu - * Revised: 15-Feb-1997 + * Revised: 24-Mar-1998 * */ @@ -10,6 +10,9 @@ #include "perl.h" #include "XSUB.h" #include <file.h> +#include <iodef.h> +#include <rms.h> +#include <starlet.h> static bool constant(name, pval) @@ -121,12 +124,10 @@ constant(name) ST(0) = &sv_undef; void -flush(sv) - SV * sv +flush(fp) + FILE * fp PROTOTYPE: $ CODE: - FILE *fp = Nullfp; - if (SvOK(sv)) fp = IoIFP(sv_2io(sv)); if (fflush(fp)) { ST(0) = &sv_undef; } else { clearerr(fp); ST(0) = &sv_yes; } @@ -135,7 +136,7 @@ getname(fp) FILE * fp PROTOTYPE: $ CODE: - char fname[257]; + char fname[NAM$C_MAXRSS+1]; ST(0) = sv_newmortal(); if (fgetname(fp,fname) != NULL) sv_setpv(ST(0),fname); @@ -154,6 +155,59 @@ remove(name) ST(0) = remove(name) ? &sv_undef : &sv_yes; void +setdef(...) + PROTOTYPE: @ + CODE: + char vmsdef[NAM$C_MAXRSS+1], es[NAM$C_MAXRSS], sep; + unsigned long int retsts; + struct FAB deffab = cc$rms_fab; + struct NAM defnam = cc$rms_nam; + struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + if (items) { + SV *defsv = ST(items-1); /* mimic chdir() */ + ST(0) = &sv_undef; + if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); } + if (tovmsspec(SvPV(defsv,na),vmsdef) == NULL) { XSRETURN(1); } + deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef); + } + else { + deffab.fab$l_fna = "SYS$LOGIN"; deffab.fab$b_fns = 9; + EXTEND(sp,1); ST(0) = &sv_undef; + } + defnam.nam$l_esa = es; defnam.nam$b_ess = sizeof es; + deffab.fab$l_nam = &defnam; + retsts = sys$parse(&deffab,0,0); + if (retsts & 1) { + if (defnam.nam$v_wildcard) retsts = RMS$_WLD; + else if (defnam.nam$b_name || defnam.nam$b_type > 1 || + defnam.nam$b_ver > 1) retsts = RMS$_DIR; + } + defnam.nam$b_nop |= NAM$M_SYNCHK; defnam.nam$l_rlf = NULL; deffab.fab$b_dns = 0; + if (!(retsts & 1)) { + set_vaxc_errno(retsts); + switch (retsts) { + case RMS$_DNF: + set_errno(ENOENT); break; + case RMS$_SYN: case RMS$_DIR: case RMS$_DEV: + set_errno(EINVAL); break; + case RMS$_PRV: + set_errno(EACCES); break; + default: + set_errno(EVMSERR); break; + } + (void) sys$parse(&deffab,0,0); /* free up context */ + XSRETURN(1); + } + sep = *defnam.nam$l_dir; + *defnam.nam$l_dir = '\0'; + my_setenv("SYS$DISK",defnam.nam$b_node ? defnam.nam$l_node : defnam.nam$l_dev); + *defnam.nam$l_dir = sep; + dirdsc.dsc$a_pointer = defnam.nam$l_dir; dirdsc.dsc$w_length = defnam.nam$b_dir; + if ((retsts = sys$setddir(&dirdsc,0,0)) & 1) ST(0) = &sv_yes; + else { set_errno(EVMSERR); set_vaxc_errno(retsts); } + (void) sys$parse(&deffab,0,0); /* free up context */ + +void sync(fp) FILE * fp PROTOTYPE: $ @@ -295,3 +349,43 @@ waitfh(fp) PROTOTYPE: $ CODE: ST(0) = fwait(fp) ? &sv_undef : &sv_yes; + +void +writeof(mysv) + SV * mysv + PROTOTYPE: $ + CODE: + char devnam[257], *cp; + unsigned long int chan, iosb[2], retsts, retsts2; + struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam}; + IO *io = sv_2io(mysv); + FILE *fp = io ? IoOFP(io) : NULL; + if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == Nullch) { + set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); + ST(0) = &sv_undef; XSRETURN(1); + } + if (fgetname(fp,devnam) == Nullch) { ST(0) = &sv_undef; XSRETURN(1); } + if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0'; + devdsc.dsc$w_length = strlen(devnam); + retsts = sys$assign(&devdsc,&chan,0,0); + if (retsts & 1) retsts = sys$qiow(0,chan,IO$_WRITEOF,iosb,0,0,0,0,0,0,0,0); + if (retsts & 1) retsts = iosb[0]; + retsts2 = sys$dassgn(chan); /* Be sure to deassign the channel */ + if (retsts & 1) retsts = retsts2; + if (retsts & 1) { ST(0) = &sv_yes; } + else { + set_vaxc_errno(retsts); + switch (retsts) { + case SS$_EXQUOTA: case SS$_INSFMEM: case SS$_MBFULL: + case SS$_MBTOOSML: case SS$_NOIOCHAN: case SS$_NOLINKS: + case SS$_BUFFEROVF: + set_errno(ENOSPC); break; + case SS$_ILLIOFUNC: case SS$_DEVOFFLINE: case SS$_NOSUCHDEV: + set_errno(EBADF); break; + case SS$_NOPRIV: + set_errno(EACCES); break; + default: /* Includes "shouldn't happen" cases that might map */ + set_errno(EVMSERR); break; /* to other errno values */ + } + ST(0) = &sv_undef; + } diff --git a/vms/ext/Stdio/test.pl b/vms/ext/Stdio/test.pl index 0b50d63e3a..36353d91b3 100755 --- a/vms/ext/Stdio/test.pl +++ b/vms/ext/Stdio/test.pl @@ -1,8 +1,8 @@ -# Tests for VMS::Stdio v2.01 +# Tests for VMS::Stdio v2.1 use VMS::Stdio; -import VMS::Stdio qw(&flush &getname &rewind &sync); +import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam); -print "1..14\n"; +print "1..19\n"; print +(defined(&getname) ? '' : 'not '), "ok 1\n"; $name = "test$$"; @@ -42,3 +42,27 @@ undef $sfh; print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n"; print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n"; + +if (open(P, qq[| MCR $^X -e "1 while (<STDIN>);print 'Foo';1 while (<STDIN>); print 'Bar'" >$name.tmp])) { + print P "Baz\nQuux\n"; + print +(VMS::Stdio::writeof(P) ? '' : 'not '),"ok 15\n"; + print P "Baz\nQuux\n"; + print +(close(P) ? '' : 'not '),"ok 16\n"; + $fh = VMS::Stdio::vmsopen("$name.tmp"); + chomp($line = <$fh>); + close $fh; + unlink("$name.tmp"); + print +($line eq 'FooBar' ? '' : 'not '),"ok 17\n"; +} +else { print "not ok 15\nnot ok 16\nnot ok 17\n"; } + +$sfh = VMS::Stdio::vmsopen(">$name.tmp"); +$setuperl = "\$ MCR $^X\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);"; +print $sfh qq[\$ here = F\$Environment("Default")\n]; +print $sfh "$setuperl\nsetdef();\n\$ Show Default\n\$ Set Default 'here'\n"; +print $sfh "$setuperl\nsetdef('..');\n\$ Show Default\n"; +close $sfh; +@defs = map { /(\S+)/ && $1 } `\@$name.tmp`; +unlink("$name.tmp"); +print +($defs[0] eq uc($ENV{'SYS$LOGIN'}) ? '' : "not ($defs[0]) "),"ok 18\n"; +print +($defs[1] eq VMS::Filespec::rmsexpand('[-]') ? '' : "not ($defs[1]) "),"ok 19\n"; diff --git a/vms/ext/filespec.t b/vms/ext/filespec.t index 1b31f06dff..05644917b6 100644 --- a/vms/ext/filespec.t +++ b/vms/ext/filespec.t @@ -10,7 +10,7 @@ foreach (<DATA>) { next if /^\s*$/; push(@tests,$_); } -print '1..',scalar(@tests)+5,"\n"; +print '1..',scalar(@tests)+6,"\n"; foreach $test (@tests) { ($arg,$func,$expect) = split(/\t+/,$test); @@ -25,14 +25,17 @@ foreach $test (@tests) { } } +$defwarn = <<'EOW'; +# Note: This failure may have occurred because your default device +# was set using a non-concealed logical name. If this is the case, +# you will need to determine by inspection that the two resultant +# file specifications shwn above are in fact equivalent. +EOW + if (rmsexpand('[]') eq "\U$ENV{DEFAULT}") { print 'ok ',++$idx,"\n"; } else { print 'not ok ', ++$idx, ": rmsexpand('[]') = |", rmsexpand('[]'), - "|, \$ENV{DEFAULT} = |\U$ENV{DEFAULT}|\n"; - print "# Note: This failure may have occurred because your default device\n"; - print "# was set using a non-concealed logical name. If this is the case,\n"; - print "# you will need to determine by inspection that the two resultant\n"; - print "# file specifications shwn above are in fact equivalent.\n"; + "|, \$ENV{DEFAULT} = |\U$ENV{DEFAULT}|\n$defwarn"; } if (rmsexpand('from.here') eq "\L$ENV{DEFAULT}from.here") { print 'ok ', ++$idx, "\n"; @@ -40,11 +43,15 @@ if (rmsexpand('from.here') eq "\L$ENV{DEFAULT}from.here") { else { print 'not ok ', ++$idx, ": rmsexpand('from.here') = |", rmsexpand('from.here'), - "|, \$ENV{DEFAULT}from.here = |\L$ENV{DEFAULT}from.here|\n"; - print "# Note: This failure may have occurred because your default device\n"; - print "# was set using a non-concealed logical name. If this is the case,\n"; - print "# you will need to determine by inspection that the two resultant\n"; - print "# file specifications shwn above are in fact equivalent.\n"; + "|, \$ENV{DEFAULT}from.here = |\L$ENV{DEFAULT}from.here|\n$defwarn"; +} +if (rmsexpand('from') eq "\L$ENV{DEFAULT}from") { + print 'ok ', ++$idx, "\n"; +} +else { + print 'not ok ', ++$idx, ": rmsexpand('from') = |", + rmsexpand('from'), + "|, \$ENV{DEFAULT}from = |\L$ENV{DEFAULT}from|\n$defwarn"; } if (rmsexpand('from.here','cant:[get.there];2') eq 'cant:[get.there]from.here;2') { print 'ok ',++$idx,"\n"; } diff --git a/vms/genconfig.pl b/vms/genconfig.pl index 94fcdd7c14..4e0cf31655 100644 --- a/vms/genconfig.pl +++ b/vms/genconfig.pl @@ -180,6 +180,13 @@ foreach (@ARGV) { print OUT "d_getpbynumber=",$dosock ? "'define'\n" : "'undef'\n"; print OUT "d_getsbyname=",$dosock ? "'define'\n" : "'undef'\n"; print OUT "d_getsbyport=",$dosock ? "'define'\n" : "'undef'\n"; + print OUT "d_endhent=",$dosock ? "'define'\n" : "'undef'\n"; + print OUT "d_getpent=",$dosock ? "'define'\n" : "'undef'\n"; + print OUT "d_setpent=",$dosock ? "'define'\n" : "'undef'\n"; + print OUT "d_endpent=",$dosock ? "'define'\n" : "'undef'\n"; + print OUT "d_getsent=",$dosock ? "'define'\n" : "'undef'\n"; + print OUT "d_setsent=",$dosock ? "'define'\n" : "'undef'\n"; + print OUT "d_endsent=",$dosock ? "'define'\n" : "'undef'\n"; print OUT "netdb_name_type=",$dosock ? "'char *'\n" : "'undef'\n"; print OUT "netdb_host_type=",$dosock ? "'char *'\n" : "'undef'\n"; print OUT "netdb_hlen_type=",$dosock ? "'int'\n" : "'undef'\n"; @@ -188,12 +195,18 @@ foreach (@ARGV) { print OUT "selecttype='fd_set'\n"; print OUT "d_getnbyaddr='define'\n"; print OUT "d_getnbyname='define'\n"; + print OUT "d_getnent='define'\n"; + print OUT "d_setnent='define'\n"; + print OUT "d_endnent='define'\n"; print OUT "netdb_net_type='long'\n"; } else { print OUT "selecttype='int'\n"; print OUT "d_getnybname='undef'\n"; print OUT "d_getnybaddr='undef'\n"; + print OUT "d_getnent='undef'\n"; + print OUT "d_setnent='undef'\n"; + print OUT "d_endnent='undef'\n"; print OUT "netdb_net_type='undef'\n"; } diff --git a/vms/perly_c.vms b/vms/perly_c.vms index 2e68d12bc8..5f2a6f9384 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1276,7 +1276,7 @@ dEXT YYSTYPE yyval; dEXT YYSTYPE yylval; #line 636 "perly.y" /* PROGRAM */ -#line 1349 "y_tab.c" +#line 1349 "perly.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab @@ -1375,7 +1375,7 @@ yyloop: yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; - fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", yystate, + PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } #endif @@ -1385,7 +1385,7 @@ yyloop: { #if YYDEBUG if (yydebug) - fprintf(stderr, "yydebug: state %d, shifting to state %d\n", + PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n", yystate, yytable[yyn]); #endif if (yyssp >= yyss + yystacksize - 1) @@ -1440,7 +1440,7 @@ yyinrecovery: { #if YYDEBUG if (yydebug) - fprintf(stderr, + PerlIO_printf(Perl_debug_log, "yydebug: state %d, error recovery shifting to state %d\n", *yyssp, yytable[yyn]); #endif @@ -1470,7 +1470,7 @@ yyinrecovery: { #if YYDEBUG if (yydebug) - fprintf(stderr, + PerlIO_printf(Perl_debug_log, "yydebug: error recovery discarding state %d\n", *yyssp); #endif @@ -1489,7 +1489,7 @@ yyinrecovery: yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; - fprintf(stderr, + PerlIO_printf(Perl_debug_log, "yydebug: state %d, error recovery discards token %d (%s)\n", yystate, yychar, yys); } @@ -1500,7 +1500,7 @@ yyinrecovery: yyreduce: #if YYDEBUG if (yydebug) - fprintf(stderr, "yydebug: state %d, reducing by rule %d (%s)\n", + PerlIO_printf(Perl_debug_log, "yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif yym = yylen[yyn]; @@ -2285,7 +2285,7 @@ case 176: #line 633 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -#line 2267 "y_tab.c" +#line 2267 "perly.c" } yyssp -= yym; yystate = *yyssp; @@ -2295,7 +2295,7 @@ break; { #if YYDEBUG if (yydebug) - fprintf(stderr, + PerlIO_printf(Perl_debug_log, "yydebug: after reduction, shifting from state 0 to state %d\n", YYFINAL); #endif @@ -2311,7 +2311,7 @@ break; yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; - fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", + PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } #endif @@ -2326,7 +2326,7 @@ break; yystate = yydgoto[yym]; #if YYDEBUG if (yydebug) - fprintf(stderr, + PerlIO_printf(Perl_debug_log, "yydebug: after reduction, shifting from state %d to state %d\n", *yyssp, yystate); #endif @@ -11,6 +11,7 @@ #include <armdef.h> #include <atrdef.h> #include <chpdef.h> +#include <clidef.h> #include <climsgdef.h> #include <descrip.h> #include <dvidef.h> @@ -174,7 +175,9 @@ my_getenv(char *lnm) } /* end of my_getenv() */ /*}}}*/ -static FILE *safe_popen(char *, char *); +static void create_mbx(unsigned short int *, struct dsc$descriptor_s *); + +static void riseandshine(unsigned long int dummy) { sys$wake(0,0); } /*{{{ void prime_env_iter() */ void @@ -184,12 +187,21 @@ prime_env_iter(void) */ { dTHR; - static int primed = 0; /* XXX Not thread-safe!!! */ + static int primed = 0; HV *envhv = GvHVn(envgv); - FILE *sholog; - char eqv[LNM$C_NAMLENGTH+1],*start,*end; + PerlIO *sholog; + char eqv[LNM$C_NAMLENGTH+1],mbxnam[LNM$C_NAMLENGTH+1],*start,*end; + unsigned short int chan; +#ifndef CLI$M_TRUSTED +# define CLI$M_TRUSTED 0x40 /* Missing from VAXC headers */ +#endif + unsigned long int flags = CLI$M_NOWAIT | CLI$M_NOCLISYM | CLI$M_NOKEYPAD | CLI$M_TRUSTED; + unsigned long int retsts, substs = 0, wakect = 0; STRLEN eqvlen; SV *oldrs, *linesv, *eqvsv; + $DESCRIPTOR(cmddsc,"Show Logical *"); $DESCRIPTOR(nldsc,"_NLA0:"); + $DESCRIPTOR(clidsc,"DCL"); $DESCRIPTOR(tabdsc,"DCLTABLES"); + $DESCRIPTOR(mbxdsc,mbxnam); #ifdef USE_THREADS static perl_mutex primenv_mutex = PTHREAD_MUTEX_INITIALIZER; #endif @@ -198,7 +210,7 @@ prime_env_iter(void) MUTEX_LOCK(&primenv_mutex); if (primed) { MUTEX_UNLOCK(&primenv_mutex); return; } /* Perform a dummy fetch as an lval to insure that the hash table is - * set up. Otherwise, the hv_store() will turn into a nullop */ + * set up. Otherwise, the hv_store() will turn into a nullop. */ (void) hv_fetch(envhv,"DEFAULT",7,TRUE); /* Also, set up the four "special" keys that the CRTL defines, * whether or not underlying logical names exist. */ @@ -208,20 +220,39 @@ prime_env_iter(void) (void) hv_fetch(envhv,"USER",4,TRUE); /* Now, go get the logical names */ - if ((sholog = safe_popen("$ Show Logical *","r")) == Nullfp) { + create_mbx(&chan,&mbxdsc); + if ((sholog = PerlIO_open(mbxnam,"r")) != Nullfp) { + if ((retsts = sys$dassgn(chan)) & 1) { + /* Be certain that subprocess is using the CLI and command tables we + * expect, and don't pass symbols through so that we insure that + * "Show Logical" can't be subverted. + */ + do { + retsts = lib$spawn(&cmddsc,&nldsc,&mbxdsc,&flags,0,0,&substs, + 0,&riseandshine,0,0,&clidsc,&tabdsc); + flags &= ~CLI$M_TRUSTED; /* Just in case we hit a really old version */ + } while (retsts == LIB$_INVARG && (flags | CLI$M_TRUSTED)); + } + } + if (sholog == Nullfp || !(retsts & 1)) { + if (sholog != Nullfp) PerlIO_close(sholog); MUTEX_UNLOCK(&primenv_mutex); - _ckvmssts(vaxc$errno); + _ckvmssts(sholog == Nullfp ? vaxc$errno : retsts); } - /* We use Perl's sv_gets to read from the pipe, since safe_popen is + /* We use Perl's sv_gets to read from the pipe, since PerlIO_open is * tied to Perl's I/O layer, so it may not return a simple FILE * */ oldrs = rs; rs = newSVpv("\n",1); linesv = newSVpv("",0); while (1) { if ((start = sv_gets(linesv,sholog,0)) == Nullch) { - my_pclose(sholog); + PerlIO_close(sholog); SvREFCNT_dec(linesv); SvREFCNT_dec(rs); rs = oldrs; primed = 1; + /* Wait for subprocess to clean up (we know subproc won't return 0) */ + while (substs == 0) { sys$hiber(); wakect++;} + if (wakect > 1) sys$wake(0,0); /* Stole someone else's wake */ + _ckvmssts(substs); MUTEX_UNLOCK(&primenv_mutex); return; } @@ -578,7 +609,7 @@ popen_completion_ast(struct pipe_details *thispipe) } } -static FILE * +static PerlIO * safe_popen(char *cmd, char *mode) { static int handler_set_up = FALSE; @@ -841,12 +872,14 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) retsts = sys$parse(&myfab,0,0); if (!(retsts & 1)) { + mynam.nam$b_nop |= NAM$M_SYNCHK; if (retsts == RMS$_DNF || retsts == RMS$_DIR || retsts == RMS$_DEV || retsts == RMS$_DEV) { - mynam.nam$b_nop |= NAM$M_SYNCHK; retsts = sys$parse(&myfab,0,0); if (retsts & 1) goto expanded; } + mynam.nam$l_rlf = NULL; myfab.fab$b_dns = 0; + (void) sys$parse(&myfab,0,0); /* Free search context */ if (out) Safefree(out); set_vaxc_errno(retsts); if (retsts == RMS$_PRV) set_errno(EACCES); @@ -857,6 +890,8 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) } retsts = sys$search(&myfab,0,0); if (!(retsts & 1) && retsts != RMS$_FNF) { + mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL; + myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0); /* Free search context */ if (out) Safefree(out); set_vaxc_errno(retsts); if (retsts == RMS$_PRV) set_errno(EACCES); @@ -874,6 +909,10 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) if (!(mynam.nam$l_fnb & NAM$M_EXP_VER) && (!defspec || !*defspec || !strchr(myfab.fab$l_dna,';'))) speclen = mynam.nam$l_ver - out; + if (!(mynam.nam$l_fnb & NAM$M_EXP_TYPE) && + (!defspec || !*defspec || defspec[myfab.fab$b_dns-1] != '.' || + defspec[myfab.fab$b_dns-2] == '.')) + speclen = mynam.nam$l_type - out; /* If we just had a directory spec on input, $PARSE "helpfully" * adds an empty name and type for us */ if (mynam.nam$l_name == mynam.nam$l_type && @@ -895,6 +934,9 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) if (do_tounixspec(outbuf,tmpfspec,0) == NULL) return NULL; strcpy(outbuf,tmpfspec); } + mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL; + mynam.nam$l_rsa = NULL; mynam.nam$b_rss = 0; + myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0); /* Free search context */ return outbuf; } /*}}}*/ @@ -1032,6 +1074,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) } cp1++; } while ((cp1 = strstr(cp1,"/.")) != NULL); + lastdir = strrchr(dir,'/'); } else if (!strcmp(&dir[dirlen-7],"/000000")) { /* Ditto for specs that end in an MFD -- let the VMS code @@ -2441,7 +2484,7 @@ trim_unixpath(char *fspec, char *wildspec, int opts) for (front = end ; front >= base; front--) if (*front == '/' && !dirs--) { front++; break; } } - for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcend + sizeof lcend; + for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcres + sizeof lcres; cp1++,cp2++) *cp2 = _tolower(*cp1); /* Make lc copy for match */ if (cp1 != '\0') return 0; /* Path too long. */ lcend = cp2; @@ -4119,11 +4162,11 @@ my_binmode(FILE *fp, char iotype) if (iotype != '-'&& (ret = fgetpos(fp, &pos)) == -1 && dirend) return NULL; switch (iotype) { case '<': case 'r': acmode = "rb"; break; - case '>': case 'w': + case '>': case 'w': case '|': /* use 'a' instead of 'w' to avoid creating new file; fsetpos below will take care of restoring file position */ case 'a': acmode = "ab"; break; - case '+': case '|': case 's': acmode = "rb+"; break; + case '+': case 's': acmode = "rb+"; break; case '-': acmode = fileno(fp) ? "ab" : "rb"; break; default: warn("Unrecognized iotype %c in my_binmode",iotype); @@ -4538,6 +4581,11 @@ init_os_extras() newXSproto("VMS::Filespec::unixpath",unixpath_fromperl,file,"$"); newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$"); newXS("File::Copy::rmscopy",rmscopy_fromperl,file); + +#ifdef PRIME_ENV_AT_STARTUP + prime_env_iter(); +#endif + return; } diff --git a/vms/vmsish.h b/vms/vmsish.h index 31a42d997c..1cda1e29d0 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -16,12 +16,11 @@ #include <stsdef.h> /* bitmasks for exit status testing */ /* Suppress compiler warnings from DECC for VMS-specific extensions: - * GLOBALEXT, NOSHAREEXT, READONLYEXT: global[dr]ef declarations * ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values * (e.g. pointer fields of descriptors) */ #ifdef __DECC -# pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT,ADDRCONSTEXT,NEEDCONSTEXT) +# pragma message disable (ADDRCONSTEXT,NEEDCONSTEXT) #endif /* DEC's C compilers and gcc use incompatible definitions of _to(upp|low)er() */ @@ -75,11 +74,6 @@ /* DECC introduces this routine in the RTL as of VMS 7.0; for now, * we'll use ours, since it gives us the full VMS exit status. */ -#ifdef __PID_T -# define Pid_t pid_t -#else -# define Pid_t unsigned int -#endif #define waitpid my_waitpid /* Don't redeclare standard RTL routines in Perl's header files; |