diff options
| author | Gurusamy Sarathy <gsar@cpan.org> | 1998-05-29 07:22:51 +0000 |
|---|---|---|
| committer | Gurusamy Sarathy <gsar@cpan.org> | 1998-05-29 07:22:51 +0000 |
| commit | d0340efeaf607d2e70273b4fa22e5ee3b358abe8 (patch) | |
| tree | 8187e35c8e61d21279785c869e1a5d92009e8e57 | |
| parent | ab39fa9dbf3b1a1fb7beb555653d0558a089397f (diff) | |
| parent | a1737d5b9df80320e5be59ab8fa7c96455d6b5bf (diff) | |
| download | perl-d0340efeaf607d2e70273b4fa22e5ee3b358abe8.tar.gz | |
[asperl] integrate mainline changes
p4raw-id: //depot/asperl@1055
70 files changed, 1318 insertions, 817 deletions
@@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Wed May 13 13:35:54 EDT 1998 [metaconfig 3.0 PL70] +# Generated on Thu May 28 12:01:39 EDT 1998 [metaconfig 3.0 PL70] cat >/tmp/c1$$ <<EOF ARGGGHHHH!!!!! @@ -357,6 +357,7 @@ d_htonl='' d_inetaton='' d_isascii='' d_killpg='' +d_lchown='' d_link='' d_locconv='' d_lockf='' @@ -480,6 +481,9 @@ d_times='' d_truncate='' d_tzname='' d_umask='' +d_semctl_semid_ds='' +d_semctl_semun='' +d_union_semun='' d_vfork='' usevfork='' d_voidsig='' @@ -7190,6 +7194,38 @@ $rm -f isascii* set killpg d_killpg eval $inlibc +: see if lchown exists +echo " " +$cat > try.c <<'EOCP' +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char lchown(); below. */ +#include <assert.h> +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char lchown(); +int main() { + /* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_lchown) || defined (__stub___lchown) +choke me +#else +lchown(); +#endif +; return 0; } +EOCP +set try +if eval $compile; then + $echo "lchown() found." >&4 + val="$define" +else + $echo "lchown() NOT found." >&4 + val="$undef" +fi +set d_lchown +eval $setvar + : see if link exists set link d_link eval $inlibc @@ -7912,6 +7948,165 @@ fi set d_sem eval $setvar +: see whether sys/sem.h defines union semun +echo " " +$cat > try.c <<'END' +#include <sys/types.h> +#include <sys/ipc.h> +#include <sys/sem.h> +int main () { union semun semun; semun.buf = 0; } +END +set try +if eval $compile; then + echo "You have union semun in <sys/sem.h>." >&4 + val="$define" +else + echo "You do not have union semun in <sys/sem.h>." >&4 + val="$undef" +fi +$rm -f try try.c +set d_union_semun +eval $setvar + +: see how to do semctl IPC_STAT +case "$d_sem" in +$define) + : see whether semctl IPC_STAT can use union semun + echo " " + $cat > try.c <<END +#include <sys/types.h> +#include <sys/ipc.h> +#include <sys/sem.h> +#include <sys/stat.h> +#include <stdio.h> +#include <errno.h> +#ifndef errno +extern int errno; +#endif +#$d_union_semun HAS_UNION_SEMUN +int main() { + union semun +#ifndef HAS_UNION_SEMUN + { + int val; + struct semid_ds *buf; + unsigned short *array; + } +#endif + arg; + int sem, st; + +#if defined(IPC_PRIVATE) && defined(S_IRWXU) && defined(S_IRWXG) && defined(S_IRWXO) && defined(IPC_CREAT) + sem = semget(IPC_PRIVATE, 1, S_IRWXU|S_IRWXG|S_IRWXO|IPC_CREAT); + if (sem > -1) { + struct semid_ds argbuf; + arg.buf = &argbuf; +# ifdef IPC_STAT + st = semctl(sem, 0, IPC_STAT, arg); + if (st == 0) + printf("semun\n"); + else +# endif /* IPC_STAT */ + printf("semctl IPC_STAT failed: errno = %d\n", errno); +# ifdef IPC_RMID + if (semctl(sem, 0, IPC_RMID, arg) != 0) +# endif /* IPC_RMID */ + printf("semctl IPC_RMID failed: errno = %d\n", errno); + } else +#endif /* IPC_PRIVATE && ... */ + printf("semget failed: errno = %d\n", errno); + return 0; +} +END + val="$undef" + set try + if eval $compile; then + xxx=`./try` + case "$xxx" in + semun) val="$define" ;; + esac + fi + $rm -f try try.c + set d_semctl_semun + eval $setvar + case "$d_semctl_semun" in + $define) + echo "You can use union semun for semctl IPC_STAT." >&4 + also='also' + ;; + *) echo "You cannot use union semun for semctl IPC_STAT." >&4 + also='' + ;; + esac + + : see whether semctl IPC_STAT can use struct semid_ds pointer + $cat > try.c <<'END' +#include <sys/types.h> +#include <sys/ipc.h> +#include <sys/sem.h> +#include <sys/stat.h> +#include <stdio.h> +#include <errno.h> +#ifndef errno +extern int errno; +#endif +int main() { + struct semid_ds arg; + int sem, st; + +#if defined(IPC_PRIVATE) && defined(S_IRWXU) && defined(S_IRWXG) && defined(S_IRWXO) && defined(IPC_CREAT) + sem = semget(IPC_PRIVATE, 1, S_IRWXU|S_IRWXG|S_IRWXO|IPC_CREAT); + if (sem > -1) { +# ifdef IPC_STAT + st = semctl(sem, 0, IPC_STAT, &arg); + if (st == 0) + printf("semid_ds\n"); + else +# endif /* IPC_STAT */ + printf("semctl IPC_STAT failed: errno = %d\n", errno); +# ifdef IPC_RMID + if (semctl(sem, 0, IPC_RMID, &arg) != 0) +# endif /* IPC_RMID */ + printf("semctl IPC_RMID failed: errno = %d\n", errno); + } else +#endif /* IPC_PRIVATE && ... */ + printf("semget failed: errno = %d\n", errno); + + return 0; +} +END + val="$undef" + set try + if eval $compile; then + xxx=`./try` + case "$xxx" in + semid_ds) val="$define" ;; + esac + fi + $rm -f try try.c + set d_semctl_semid_ds + eval $setvar + case "$d_semctl_semid_ds" in + $define) + echo "You can $also use struct semid_ds * for semctl IPC_STAT." >&4 + ;; + *) echo "You cannot use struct semid_ds * for semctl IPC_STAT." >&4 + ;; + esac + ;; +*) val="$undef" + + # We do not have the full sem*(2) library, so assume we can not + # use either. + + set d_semctl_semun + eval $setvar + + set d_semctl_semid_ds + eval $setvar + ;; +esac + : see if setegid exists set setegid d_setegid eval $inlibc @@ -11043,6 +11238,7 @@ d_index='$d_index' d_inetaton='$d_inetaton' d_isascii='$d_isascii' d_killpg='$d_killpg' +d_lchown='$d_lchown' d_link='$d_link' d_locconv='$d_locconv' d_lockf='$d_lockf' @@ -11098,6 +11294,8 @@ d_seekdir='$d_seekdir' d_select='$d_select' d_sem='$d_sem' d_semctl='$d_semctl' +d_semctl_semid_ds='$d_semctl_semid_ds' +d_semctl_semun='$d_semctl_semun' d_semget='$d_semget' d_semop='$d_semop' d_setegid='$d_setegid' @@ -11162,6 +11360,7 @@ d_truncate='$d_truncate' d_tzname='$d_tzname' d_umask='$d_umask' d_uname='$d_uname' +d_union_semun='$d_union_semun' d_vfork='$d_vfork' d_void_closedir='$d_void_closedir' d_voidsig='$d_voidsig' @@ -163,18 +163,11 @@ your perl source directory. If you do, installperl will attempt infinite recursion. It may seem obvious to say, but Perl is useful only when users can -easily find it. When possible, it's good for both /usr/bin/perl and -/usr/local/bin/perl to be symlinks to the actual binary. If that can't -be done, system administrators are strongly encouraged to put -(symlinks to) perl and its accompanying utilities, such as perldoc, -into a directory typically found along a user's PATH, or in another -obvious and convenient place. - -It may seem obvious to say, but Perl is useful only when users can -easily find it. When possible, it's good for both /usr/bin/perl and -/usr/local/bin/perl to be symlinks to the actual binary. If that can't -be done, system administrators are strongly encouraged to put -(symlinks to) perl and its accompanying utilities, such as perldoc, +easily find it. It's often a good idea to have both /usr/bin/perl and +/usr/local/bin/perl be symlinks to the actual binary. Be especially +careful, however, of overwriting a version of perl supplied by your +vendor. In any case, system administrators are strongly encouraged to +put (symlinks to) perl and its accompanying utilities, such as perldoc, into a directory typically found along a user's PATH, or in another obvious and convenient place. @@ -515,14 +508,6 @@ system. For most users, the defaults are sensible and will work. Some users, however, may wish to further customize perl. Here are some of the main things you can change. -=head2 Installing perl under different names - -If you want to install perl under a name other than "perl" (for example, -when installing perl with special features enabled, such as debugging), -indicate the alternate name on the "make install" line, such as: - - make install PERLNAME=myperl - =head2 Threads On some platforms, perl5.005 can be compiled to use threads. To @@ -1319,6 +1304,16 @@ pages, however. You may need to be root to run B<make install>. If you are not root, you must own the directories in question and you should ignore any messages about chown not working. +=head2 Installing perl under different names + +If you want to install perl under a name other than "perl" (for example, +when installing perl with special features enabled, such as debugging), +indicate the alternate name on the "make install" line, such as: + + make install PERLNAME=myperl + +=head2 Installed files + If you want to see exactly what will happen without installing anything, you can run @@ -1588,4 +1583,4 @@ above. =head1 LAST MODIFIED -$Id: INSTALL,v 1.34 1998/04/23 18:19:41 doughera Released $ +$Id: INSTALL,v 1.35 1998/05/18 19:06:26 doughera Released $ @@ -791,6 +791,9 @@ t/lib/filepath.t See if File::Path works t/lib/findbin.t See if FindBin works t/lib/gdbm.t See if GDBM_File works t/lib/getopt.t See if Getopt::Std and Getopt::Long works +t/lib/h2ph.h Test header file for h2ph +t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison +t/lib/h2ph.t See if h2ph works like it should t/lib/hostname.t See if Sys::Hostname works t/lib/io_dup.t See if dup()-related methods from IO work t/lib/io_pipe.t See if pipe()-related methods from IO work @@ -927,10 +930,10 @@ utils/c2ph.PL program to translate dbx stabs to perl utils/h2ph.PL A thing to turn C .h files into perl .ph files utils/h2xs.PL Program to make .xs files from C header files utils/perlbug.PL A simple tool to submit a bug report +utils/perlcc.PL Front-end for compiler utils/perldoc.PL A simple tool to find & display perl's documentation utils/pl2pm.PL A pl to pm translator utils/splain.PL Stand-alone version of diagnostics.pm -utils/perlcc.PL Front-end for compiler vms/config.vms default config.h for VMS vms/descrip.mms MM[SK] description file for build vms/ext/DCLsym/0README.txt ReadMe file for VMS::DCLsym diff --git a/Makefile.SH b/Makefile.SH index a70b53e4fe..4f78f57d74 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -552,7 +552,7 @@ depend: makedepend makedepend: makedepend.SH config.sh sh ./makedepend.SH -test-prep: miniperl perl preplibrary $(dynamic_ext) +test-prep: miniperl perl preplibrary utilities $(dynamic_ext) cd t && (rm -f perl$(EXE_EXT); $(LNS) ../perl$(EXE_EXT) perl$(EXE_EXT)) test check: test-prep @@ -573,10 +573,13 @@ minitest: miniperl # Handy way to run perlbug -ok without having to install and run the # installed perlbug. We don't re-run the tests here - we trust the user. # Please *don't* use this unless all tests pass. -# If you want to report test failures, just use "perlbug -Ilib". +# If you want to report test failures, use "make nok" instead. ok: utilities $(LBLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' +nok: utilities + $(LBLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)' + clist: $(c) echo $(c) | tr ' ' '\012' >.clist diff --git a/Porting/Glossary b/Porting/Glossary index 15ca4f9050..8e7514e10a 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -540,6 +540,11 @@ d_killpg (d_killpg.U): indicates to the C program that the killpg() routine is available to kill process groups. +d_lchown (d_lchown.U): + This variable conditionally defines the HAS_LCHOWN symbol, which + indicates to the C program that the lchown() routine is available + to operate on a symbolic link (instead of following the link). + d_link (d_link.U): This variable conditionally defines HAS_LINK if link() is available to create hard links. @@ -787,6 +792,14 @@ d_semctl (d_semctl.U): This variable conditionally defines the HAS_SEMCTL symbol, which indicates to the C program that the semctl() routine is available. +d_semctl_semid_ds (d_union_senum.U): + This variable conditionally defines USE_SEMCTL_SEMID_DS, which + indicates that struct semid_ds * is to be used for semctl IPC_STAT. + +d_semctl_semun (d_union_senum.U): + This variable conditionally defines USE_SEMCTL_SEMUN, which + indicates that union semun is to be used for semctl IPC_STAT. + d_semget (d_semget.U): This variable conditionally defines the HAS_SEMGET symbol, which indicates to the C program that the semget() routine is available. @@ -1074,6 +1087,10 @@ d_uname (d_gethname.U): indicates to the C program that the uname() routine may be used to derive the host name. +d_union_semun (d_union_senum.U): + This variable conditionally defines HAS_UNION_SEMUN if the + union semun is defined by including <sys/sem.h>. + d_vfork (d_vfork.U): This variable conditionally defines the HAS_VFORK symbol, which indicates the vfork() routine is available. diff --git a/Porting/config.sh b/Porting/config.sh index 69da4a96b0..5a417ae2f0 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -8,7 +8,7 @@ # Package name : perl5 # Source directory : . -# Configuration time: Wed May 13 13:36:52 EDT 1998 +# Configuration time: Thu May 28 12:44:36 EDT 1998 # Configured by : doughera # Target system : linux fractal 2.0.33 #1 tue feb 3 10:11:46 est 1998 i686 unknown @@ -31,8 +31,8 @@ alignbytes='4' ansi2knr='' aphostname='' ar='ar' -archlib='/opt/perl/lib/i686-linux-thread/5.00464' -archlibexp='/opt/perl/lib/i686-linux-thread/5.00464' +archlib='/opt/perl/lib/i686-linux-thread/5.00465' +archlibexp='/opt/perl/lib/i686-linux-thread/5.00465' archname='i686-linux-thread' archobjs='' awk='awk' @@ -52,7 +52,7 @@ ccdlflags='-rdynamic' ccflags='-D_REENTRANT -Dbool=char -DHAS_BOOL -I/usr/local/include' cf_by='doughera' cf_email='yourname@yourhost.yourplace.com' -cf_time='Wed May 13 13:36:52 EDT 1998' +cf_time='Thu May 28 12:44:36 EDT 1998' chgrp='' chmod='' chown='' @@ -151,6 +151,7 @@ d_index='undef' d_inetaton='define' d_isascii='define' d_killpg='define' +d_lchown='undef' d_link='define' d_locconv='define' d_lockf='define' @@ -206,6 +207,8 @@ d_seekdir='define' d_select='define' d_sem='define' d_semctl='define' +d_semctl_semid_ds='define' +d_semctl_semun='define' d_semget='define' d_semop='define' d_setegid='define' @@ -270,6 +273,7 @@ d_truncate='define' d_tzname='define' d_umask='define' d_uname='define' +d_union_semun='define' d_vfork='undef' d_void_closedir='undef' d_voidsig='define' @@ -372,7 +376,7 @@ i_varhdr='stdarg.h' i_vfork='undef' incpath='' inews='' -installarchlib='/opt/perl/lib/i686-linux-thread/5.00464' +installarchlib='/opt/perl/lib/i686-linux-thread/5.00465' installbin='/opt/perl/bin' installman1dir='/opt/perl/man/man1' installman3dir='/opt/perl/man/man3' @@ -392,7 +396,7 @@ lib_ext='.a' libc='' libperl='libperl.a' libpth='/usr/local/lib /lib /usr/lib' -libs='-lnsl -lndbm -lgdbm -ldbm -ldb -ldl -lm -lpthread -lc -lposix -lcrypt' +libs='-lnsl -lgdbm -ldbm -ldb -ldl -lm -lpthread -lc -lposix -lcrypt' libswanted='sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun m pthread c cposix posix ndir dir crypt ucb BSD PW x' line='line' lint='' @@ -518,7 +522,7 @@ stdio_filbuf='' stdio_ptr='((fp)->_IO_read_ptr)' strings='/usr/include/string.h' submit='' -subversion='64' +subversion='65' sysman='/usr/man/man1' tail='' tar='' @@ -551,5 +555,5 @@ xlibpth='/usr/lib/386 /lib/386' zcat='' zip='zip' PATCHLEVEL=4 -SUBVERSION=64 +SUBVERSION=65 CONFIG=true diff --git a/Porting/config_H b/Porting/config_H index de0cfd6684..0b1de0855f 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -17,7 +17,7 @@ /* * Package name : perl5 * Source directory : . - * Configuration time: Wed May 13 13:36:52 EDT 1998 + * Configuration time: Thu May 28 12:44:36 EDT 1998 * Configured by : doughera * Target system : linux fractal 2.0.33 #1 tue feb 3 10:11:46 est 1998 i686 unknown */ @@ -982,6 +982,12 @@ */ #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. @@ -1213,6 +1219,13 @@ */ #define HAS_ISASCII /**/ +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN / **/ + /* HAS_OPEN3: * This manifest constant lets the C program know that the three * argument form of open(2) is available. @@ -1454,8 +1467,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.00464" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/i686-linux-thread/5.00464" /**/ +#define ARCHLIB "/opt/perl/lib/i686-linux-thread/5.00465" /**/ +#define ARCHLIB_EXP "/opt/perl/lib/i686-linux-thread/5.00465" /**/ /* CAT2: * This macro catenates 2 tokens together. @@ -1662,6 +1675,28 @@ #define HAS_SOCKET /**/ #define HAS_SOCKETPAIR /**/ +/* HAS_UNION_SEMUN: + * This symbol, if defined, indicates that the union semun is + * defined by including <sys/sem.h>. If not, the user code + * probably needs to define it as: + * union semun { + * int val; + * struct semid_ds *buf; + * unsigned short *array; + * } + */ +/* USE_SEMCTL_SEMUN: + * This symbol, if defined, indicates that union semun is + * used for semctl IPC_STAT. + */ +/* USE_SEMCTL_SEMID_DS: + * This symbol, if defined, indicates that struct semid_ds * is + * used for semctl IPC_STAT. + */ +#define HAS_UNION_SEMUN /**/ +#define USE_SEMCTL_SEMUN /**/ +#define USE_SEMCTL_SEMID_DS /**/ + /* 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 @@ -1730,12 +1765,6 @@ /*#define PWCOMMENT / **/ #define PWGECOS /**/ -/* 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 diff --git a/Porting/patching.pod b/Porting/patching.pod index b2a86b6f34..b528ad7080 100644 --- a/Porting/patching.pod +++ b/Porting/patching.pod @@ -2,10 +2,10 @@ patching.pod - Appropriate format for patches to the perl source tree -=head2re to get this document +=head2 Where to get this document The latest version of this document is available from - http://www.tdrenterprises.com/perl/perlpatch.html + http://perrin.dimensional.com/perl/perlpatch.html =head2 How to contribute to this document @@ -130,8 +130,33 @@ block of code that you are patching. =item Testsuite -Also please include an addition to the regression tests to properly -exercise your patch. +When submitting a patch you should make every effort to also include +an addition to perl's regression tests to properly exercise your +patch. Your testsuite additions should generally follow these +guidelines (courtesy of Gurusamy Sarathy (gsar@engin.umich.edu))- + + Know what you're testing. Read the docs, and the source. + Tend to fail, not succeed. + Interpret results strictly. + Use unrelated features (this will flush out bizarre interactions). + Use non-standard idioms (otherwise you are not testing TIMTOWTDI). + Avoid using hardcoded test umbers whenever possible (the EXPECTED/GOT style + found in t/op/tie.t is much more maintainable, and gives better failure + reports). + Give meaningful error messages when a test fails. + Avoid using qx// and system() unless you are testing for them. If you + do use them, make sure that you cover _all_ perl platforms. + Unlink any temporary files you create. + Promote unforeseen warnings to errors with $SIG{__WARN__}. + Be sure to use the libraries and modules shipped with version being tested, + not those that were already installed. + Add comments to the code explaining what you are testing for. + Make updating the '1..42' string unnecessary. Or make sure that you update it. + Test _all_ behaviors of a given operator, library, or function- + All optional arguments + Return values in various contexts (boolean, scalar, list, lvalue) + Use both global and lexical variables + Don't forget the exceptional, pathological cases. =back @@ -261,7 +286,7 @@ mind. 8-) =head1 Last Modified -Last modified 1 May 1998 by Daniel Grisinger <dgris@tdrenterprises.com> +Last modified 21 May 1998 by Daniel Grisinger <dgris@perrin.dimensional.com> =head1 Author and Copyright Information diff --git a/config_h.SH b/config_h.SH index 5d4cffccf6..6b01b975e6 100644 --- a/config_h.SH +++ b/config_h.SH @@ -996,6 +996,12 @@ 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. @@ -1227,6 +1233,13 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_isascii HAS_ISASCII /**/ +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +#$d_lchown HAS_LCHOWN /**/ + /* HAS_OPEN3: * This manifest constant lets the C program know that the three * argument form of open(2) is available. @@ -1676,6 +1689,28 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_socket HAS_SOCKET /**/ #$d_sockpair HAS_SOCKETPAIR /**/ +/* HAS_UNION_SEMUN: + * This symbol, if defined, indicates that the union semun is + * defined by including <sys/sem.h>. If not, the user code + * probably needs to define it as: + * union semun { + * int val; + * struct semid_ds *buf; + * unsigned short *array; + * } + */ +/* USE_SEMCTL_SEMUN: + * This symbol, if defined, indicates that union semun is + * used for semctl IPC_STAT. + */ +/* USE_SEMCTL_SEMID_DS: + * This symbol, if defined, indicates that struct semid_ds * is + * used for semctl IPC_STAT. + */ +#$d_union_semun HAS_UNION_SEMUN /**/ +#$d_semctl_semun USE_SEMCTL_SEMUN /**/ +#$d_semctl_semid_ds USE_SEMCTL_SEMID_DS /**/ + /* 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 @@ -1744,12 +1779,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_pwcomment PWCOMMENT /**/ #$d_pwgecos PWGECOS /**/ -/* 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 @@ -15,50 +15,8 @@ #include "EXTERN.h" #include "perl.h" -#if !defined(I_STDARG) && !defined(I_VARARGS) - -/* - * Fallback on the old hackers way of doing varargs - */ - -/*VARARGS1*/ -void -deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) - char *pat; -{ -#ifdef DEBUGGING - dTHR; - register I32 i; - GV* gv = curcop->cop_filegv; - -#ifdef USE_THREADS - PerlIO_printf(Perl_debug_log,"0x%lx (%s:%ld)\t", - (unsigned long) thr, - SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", - (long)curcop->cop_line); -#else - PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", - SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", - (long)curcop->cop_line); -#endif /* USE_THREADS */ - for (i=0; i<dlevel; i++) - PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]); - PerlIO_printf(Perl_debug_log, pat,a1,a2,a3,a4,a5,a6,a7,a8); -#endif /* DEBUGGING */ -} - -#else /* !defined(I_STDARG) && !defined(I_VARARGS) */ - -# ifdef I_STDARG void deb(const char *pat, ...) -# else -/*VARARGS1*/ -void -deb(pat, va_alist) - const char *pat; - va_dcl -# endif { #ifdef DEBUGGING dTHR; @@ -79,16 +37,11 @@ deb(pat, va_alist) for (i=0; i<dlevel; i++) PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]); -# ifdef I_STDARG va_start(args, pat); -# else - va_start(args); -# endif (void) PerlIO_vprintf(Perl_debug_log,pat,args); va_end( args ); #endif /* DEBUGGING */ } -#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */ void deb_growlevel(void) @@ -579,14 +579,17 @@ do_close(GV *gv, bool not_implicit) if (!gv) gv = argvgv; if (!gv || SvTYPE(gv) != SVt_PVGV) { - SETERRNO(EBADF,SS$_IVCHAN); + if (not_implicit) + SETERRNO(EBADF,SS$_IVCHAN); return FALSE; } io = GvIO(gv); if (!io) { /* never opened */ - if (dowarn && not_implicit) - warn("Close on unopened file <%s>",GvENAME(gv)); - SETERRNO(EBADF,SS$_IVCHAN); + if (not_implicit) { + if (dowarn) + warn("Close on unopened file <%s>",GvENAME(gv)); + SETERRNO(EBADF,SS$_IVCHAN); + } return FALSE; } retval = io_close(io); @@ -1133,6 +1136,12 @@ apply(I32 type, register SV **mark, register SV **sp) } break; #endif +/* +XXX Should we make lchown() directly available from perl? +For now, we'll let Configure test for HAS_LCHOWN, but do +nothing in the core. + --AD 5/1998 +*/ #ifdef HAS_KILL case OP_KILL: what = "kill"; @@ -1385,21 +1394,6 @@ do_ipcget(I32 optype, SV **mark, SV **sp) return -1; /* should never happen */ } -#if defined(__sun) && defined(__svr4__) /* XXX Need metaconfig test */ -/* Solaris manpage says that it uses (like linux) - int semctl (int semid, int semnum, int cmd, union semun arg) - but the system include files do not define union semun !!!! - Note: Linux/glibc *does* declare union semun in <sys/sem_buf.h> - but, unlike the older Linux libc and Solaris, it has an extra - struct seminfo * on the end. -*/ -union semun { - int val; - struct semid_ds *buf; - ushort *array; -}; -#endif - I32 do_ipcctl(I32 optype, SV **mark, SV **sp) { @@ -1408,26 +1402,6 @@ do_ipcctl(I32 optype, SV **mark, SV **sp) char *a; I32 id, n, cmd, infosize, getinfo; I32 ret = -1; -/* XXX REALLY need metaconfig test */ -/* linux and Solaris2 use: - int semctl (int semid, int semnum, int cmd, union semun arg) - instead of: - int semctl (int semid, int semnum, int cmd, struct semid_ds *arg); - Solaris and Linux (pre-glibc) use - union semun { - int val; - struct semid_ds *buf; - ushort *array; - }; - but Solaris doesn't declare it in a header file (we declared it - explicitly earlier). Linux/glibc declares a *different* union semun - so we just refer to "union semun" here. - -*/ -#if defined(__linux__) || (defined(__sun__) && defined(__svr4__)) -# define SEMCTL_SEMUN - union semun unsemds, semun; -#endif id = SvIVx(*++mark); n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; @@ -1457,13 +1431,9 @@ do_ipcctl(I32 optype, SV **mark, SV **sp) else if (cmd == GETALL || cmd == SETALL) { struct semid_ds semds; -#ifdef SEMCTL_SEMUN + union semun semun; + semun.buf = &semds; - if (semctl(id, 0, IPC_STAT, semun) == -1) -#else - if (semctl(id, 0, IPC_STAT, &semds) == -1) -#endif - return -1; getinfo = (cmd == GETALL); infosize = semds.sem_nsems * sizeof(short); /* "short" is technically wrong but much more portable @@ -1507,14 +1477,12 @@ do_ipcctl(I32 optype, SV **mark, SV **sp) break; #endif #ifdef HAS_SEM - case OP_SEMCTL: -#ifdef SEMCTL_SEMUN - /* XXX Need metaconfig test */ - unsemds.buf = (struct semid_ds *)a; - ret = semctl(id, n, cmd, unsemds); -#else - ret = semctl(id, n, cmd, (struct semid_ds *)a); -#endif + case OP_SEMCTL: { + union semun unsemds; + + unsemds.buf = (struct semid_ds *)a; + ret = Semctl(id, n, cmd, unsemds); + } break; #endif #ifdef HAS_SHM @@ -16,11 +16,7 @@ #include "perl.h" #ifndef PERL_OBJECT -#ifdef I_STDARG static void dump(char *pat, ...); -#else -static void dump(); -#endif #endif /* PERL_OBJECT */ void @@ -32,7 +28,7 @@ dump_all(void) if (main_root) dump_op(main_root); dump_packsubs(defstash); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } void @@ -58,7 +54,7 @@ dump_packsubs(HV *stash) dump_packsubs(hv); /* nested package */ } } -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } void @@ -77,7 +73,7 @@ dump_sub(GV *gv) dump_op(CvROOT(GvCV(gv))); else dump("<undef>\n"); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } void @@ -92,7 +88,7 @@ dump_form(GV *gv) dump_op(CvROOT(GvFORM(gv))); else dump("<undef>\n"); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } void @@ -100,7 +96,7 @@ dump_eval(void) { #ifdef DEBUGGING dump_op(eval_root); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } void @@ -315,7 +311,7 @@ dump_op(OP *o) } dumplvl--; dump("}\n"); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } void @@ -340,7 +336,7 @@ dump_gv(GV *gv) dump("\n"); dumplvl--; dump("}\n"); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } void @@ -401,51 +397,21 @@ dump_pm(PMOP *pm) dumplvl--; dump("}\n"); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } -#if !defined(I_STDARG) && !defined(I_VARARGS) -/* VARARGS1 */ -static void dump(arg1,arg2,arg3,arg4,arg5) -char *arg1; -long arg2, arg3, arg4, arg5; -{ -#ifdef DEBUGGING - I32 i; - - for (i = dumplvl*4; i; i--) - (void)PerlIO_putc(Perl_debug_log,' '); - PerlIO_printf(Perl_debug_log, arg1, arg2, arg3, arg4, arg5); -#endif /* DEBUGGING */ -} - -#else - -#ifdef I_STDARG STATIC void dump(char *pat,...) -#else -/*VARARGS0*/ -static void -dump(pat,va_alist) - char *pat; - va_dcl -#endif { #ifdef DEBUGGING I32 i; va_list args; -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif for (i = dumplvl*4; i; i--) (void)PerlIO_putc(Perl_debug_log,' '); PerlIO_vprintf(Perl_debug_log,pat,args); va_end(args); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } -#endif @@ -440,6 +440,7 @@ #define oopsAV Perl_oopsAV #define oopsCV Perl_oopsCV #define oopsHV Perl_oopsHV +#define op_const_sv Perl_op_const_sv #define op_desc Perl_op_desc #define op_free Perl_op_free #define op_name Perl_op_name diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index f7c630aacf..bfa1f78ac0 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -53,11 +53,7 @@ SaveError(CPERLarg_ char* pat, ...) /* This code is based on croak/warn, see mess() in util.c */ -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif message = mess(pat, &args); va_end(args); diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index c3bacb4e29..fd27b11623 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -30,9 +30,8 @@ #endif #include <setjmp.h> #include <signal.h> -#ifdef I_STDARG #include <stdarg.h> -#endif + #ifdef I_STDDEF #include <stddef.h> #endif @@ -51,7 +50,7 @@ #include <sys/types.h> #include <time.h> #ifdef I_UNISTD -#include <unistd.h> /* see hints/sunos_4_1.sh */ +#include <unistd.h> #endif #include <fcntl.h> @@ -115,6 +114,15 @@ # ifdef _MSC_VER # define mode_t short # endif +# ifdef __MINGW32__ +# define mode_t short +# ifndef tzset +# define tzset() not_here("tzset") +# endif +# ifndef _POSIX_OPEN_MAX +# define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */ +# endif +# endif # define sigaction(a,b,c) not_here("sigaction") # define sigpending(a) not_here("sigpending") # define sigprocmask(a,b,c) not_here("sigprocmask") @@ -262,13 +270,13 @@ unsigned long strtoul _((const char *, char **, int)); #define localeconv() not_here("localeconv") #endif -#ifndef WIN32 #ifdef HAS_TZNAME +# ifndef WIN32 extern char *tzname[]; +# endif #else char *tzname[] = { "" , "" }; #endif -#endif /* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX) * fields for which we don't have Configure support yet: diff --git a/ext/POSIX/hints/sunos_4.pl b/ext/POSIX/hints/sunos_4.pl index 59b45bc4f2..32b3558a5e 100644 --- a/ext/POSIX/hints/sunos_4.pl +++ b/ext/POSIX/hints/sunos_4.pl @@ -3,4 +3,8 @@ # This state of affairs also persists in glibc2, found # on linux systems running libc6. # XXX A Configure test is needed. -$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; + +# Although <unistd.h> is inappropriate in general for SunOS, we need it +# in POSIX.xs to get the correct prototype for ttyname(). + +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE -DI_UNISTD' ; diff --git a/global.sym b/global.sym index 1ce7a688d3..ea9a875465 100644 --- a/global.sym +++ b/global.sym @@ -75,6 +75,7 @@ nomem nomethod_amg not_amg numer_amg +op_const_sv op_desc op_name opargs @@ -111,6 +111,7 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi) if (multi) GvMULTI_on(gv); if (doproto) { /* Replicate part of newSUB here. */ + SvIOK_off(gv); ENTER; start_subparse(0,0); /* Create CV in compcv. */ GvCV(gv) = compcv; @@ -721,7 +722,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type) SPAGAIN; stash = gv_stashpvn("Errno",5,FALSE); if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) - croak("Can't use %%! because Errno.pm is not avaliable"); + croak("Can't use %%! because Errno.pm is not available"); } } goto magicalize; diff --git a/hints/bsdos.sh b/hints/bsdos.sh index 0896e264ba..c54a0c1606 100644 --- a/hints/bsdos.sh +++ b/hints/bsdos.sh @@ -33,9 +33,6 @@ libswanted="$*" glibpth="$glibpth /usr/X11/lib" ldflags="$ldflags -L/usr/X11/lib" -# Avoid telldir prototype conflict in pp_sys.c -pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' - case "$optimize" in '') optimize='-O2' ;; esac diff --git a/hints/openbsd.sh b/hints/openbsd.sh index 633ac35d54..4c98ec8587 100644 --- a/hints/openbsd.sh +++ b/hints/openbsd.sh @@ -41,9 +41,6 @@ esac # around for old NetBSD binaries. libswanted=`echo $libswanted | sed 's/ crypt / /'` -# Avoid telldir prototype conflict in pp_sys.c (OpenBSD uses const DIR *) -pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' - # Configure can't figure this out non-interactively d_suidsafe='define' diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh index 744b131fad..9a1ccb9027 100644 --- a/hints/solaris_2.sh +++ b/hints/solaris_2.sh @@ -1,5 +1,5 @@ # hints/solaris_2.sh -# Last modified: Thu Feb 8 11:38:12 EST 1996 +# Last modified: Wed May 27 13:04:45 EDT 1998 # Andy Dougherty <doughera@lafcol.lafayette.edu> # Based on input from lots of folks, especially # Dean Roehrich <roehrich@ironwood-fddi.cray.com> @@ -53,11 +53,12 @@ esac # Here's another draft of the perl5/solaris/gcc sanity-checker. -case $PATH in -*/usr/ucb*:/usr/bin:*|*/usr/ucb*:/usr/bin) cat <<END >&4 +case `type ${cc:-cc}` in +*/usr/ucb/cc*) cat <<END >&4 NOTE: Some people have reported problems with /usr/ucb/cc. -Remove /usr/ucb from your PATH if you have difficulties. +If you have difficulties, please make sure the directory +containing your C compiler is before /usr/ucb in your PATH. END ;; @@ -95,13 +96,22 @@ END ;; esac +# Use shell built-in 'type' command instead of /usr/bin/which to +# avoid possible csh start-up problems and also to use the same shell +# we'll be using to Configure and make perl. +# The path name is the last field in the output, but the type command +# has an annoying array of possible outputs, e.g.: +# make is hashed (/opt/gnu/bin/make) +# cc is /usr/ucb/cc +# foo not found +# use a command like type make | awk '{print $NF}' | sed 's/[()]//g' # See if make(1) is GNU make(1). # If it is, make sure the setgid bit is not set. make -v > make.vers 2>&1 if grep GNU make.vers > /dev/null 2>&1; then - tmp=`/usr/bin/which make` - case "`/usr/bin/ls -l $tmp`" in + tmp=`type make | awk '{print $NF}' | sed 's/[()]//g'` + case "`/usr/bin/ls -lL $tmp`" in ??????s*) cat <<END >&2 @@ -123,17 +133,17 @@ cat > UU/cc.cbu <<'EOSH' # If the C compiler is gcc: # - check the fixed-includes # - check as(1) and ld(1), they should not be GNU -# (GNU ad and ld 2.8.1 and later are reportedly ok, however.) +# (GNU as and ld 2.8.1 and later are reportedly ok, however.) # If the C compiler is not gcc: # - check as(1) and ld(1), they should not be GNU -# (GNU ad and ld 2.8.1 and later are reportedly ok, however.) +# (GNU as and ld 2.8.1 and later are reportedly ok, however.) # # Watch out in case they have not set $cc. # Get gcc to share its secrets. echo 'main() { return 0; }' > try.c -verbose=`${cc:-cc} -v -o try try.c 2>&1` -rm -f try try.c + # Indent to avoid propagation to config.sh + verbose=`${cc:-cc} -v -o try try.c 2>&1` if echo "$verbose" | grep '^Reading specs from' >/dev/null 2>&1; then # @@ -154,24 +164,24 @@ if echo "$verbose" | grep '^Reading specs from' >/dev/null 2>&1; then cat <<END >&2 NOTE: You are using GNU as(1). GNU as(1) will not build Perl. -I'm arranging to use /usr/ccs/bin/as by setting including --B/usr/ccs/bin/ in your ${cc:-cc} command. -(Note that the trailing "/" is required.) +I'm arranging to use /usr/ccs/bin/as by including -B/usr/ccs/bin/ +in your ${cc:-cc} command. (Note that the trailing "/" is required.) END cc="${cc:-cc} -B/usr/ccs/bin/" fi # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. - if echo "$verbose" | grep ' /usr/ccs/bin/as ' >/dev/null 2>&1; then + # Recompute $verbose since we may have just changed $cc. + verbose=`${cc:-cc} -v -o try try.c 2>&1` + if echo "$verbose" | grep ' /usr/ccs/bin/ld ' >/dev/null 2>&1; then : else cat <<END >&2 -NOTE: You are using GNU as(1). GNU as(1) will not build Perl. -I'm arranging to use /usr/ccs/bin/as by setting including --B/usr/ccs/bin/ in your ${cc:-cc} command. -(Note that the trailing "/" is required.) +NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. +I'm arranging to use /usr/ccs/bin/ld by including -B/usr/ccs/bin/ +in your ${cc:-cc} command. (Note that the trailing "/" is required.) END cc="${cc:-cc} -B/usr/ccs/bin/" @@ -189,8 +199,8 @@ else cat <<END >&2 NOTE: You are using GNU as(1). GNU as(1) will not build Perl. -You must arrange to use /usr/ccs/bin, perhaps by adding it to the -beginning of your PATH. +You must arrange to use /usr/ccs/bin/as, perhaps by adding /usr/ccs/bin +to the beginning of your PATH. END ;; @@ -207,19 +217,18 @@ END esac if $gnu_ld ; then : else - case `which ld` in - no\ ld\ in*|[Cc]ommand\ not\ found*) - ;; - /*gnu*/ld|/*GNU*/ld) + # Try to guess from path + case `type ld | awk '{print $NF}'` in + *gnu*|*GNU*|*FSF*) gnu_ld=true ;; esac fi if $gnu_ld ; then cat <<END >&2 -NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. -You must arrange to use /usr/ccs/bin, perhaps by adding it to the -beginning of your PATH. +NOTE: You are apparently using GNU ld(1). GNU ld(1) will not build Perl. +You must arrange to use /usr/ccs/bin/ld, perhaps by adding /usr/ccs/bin +to the beginning of your PATH. END fi @@ -227,6 +236,7 @@ END fi # as --version or ld --version might dump core. +rm -f try try.c rm -f core # XXX diff --git a/hints/sunos_4_1.sh b/hints/sunos_4_1.sh index 9f342d100b..4585d793d7 100644 --- a/hints/sunos_4_1.sh +++ b/hints/sunos_4_1.sh @@ -1,5 +1,5 @@ # hints/sunos_4_1.sh -# Last modified: Thu Feb 8 11:46:05 EST 1996 +# Last modified: Wed May 27 11:00:02 EDT 1998 # Andy Dougherty <doughera@lafcol.lafayette.edu> case "$cc" in @@ -25,9 +25,7 @@ d_tzname='undef' # The gcc fix-includes script exposes those incorrect prototypes. # There may be other examples as well. Volunteers are welcome to # track them all down :-). In the meantime, we'll just skip unistd.h -# for SunOS in most of the code. The POSIX extension is built with -# unistd.h because, even though unistd.h has problems, if used with -# care, it helps create a better POSIX extension. +# for SunOS in most of the code. (However, see ext/POSIX/hints/sunos_4.pl.) i_unistd='undef' cat << 'EOM' >&4 diff --git a/hints/svr4.sh b/hints/svr4.sh index 2939e4ec1f..ed1640b1ad 100644 --- a/hints/svr4.sh +++ b/hints/svr4.sh @@ -66,12 +66,17 @@ if [ "$sh_cnt" -ne "$csh_cnt" ]; then d_csh='undef' fi -# UnixWare has a broken csh. The undocumented -X argument to uname is probably -# a reasonable way of detecting UnixWare. Also in 2.1.1 the fields in -# FILE* got renamed! Plus 1.1 can't cast large floats to 32-bit ints. -# Leave leading tabs so Configure doesn't propagate these variables +# Unixware-specific problems. The undocumented -X argument to uname +# is probably a reasonable way of detecting UnixWare. +# UnixWare has a broken csh. (This might already be detected above). +# In Unixware 2.1.1 the fields in FILE* got renamed! +$ Unixware 1.1 can't cast large floats to 32-bit ints. +# +# Leave leading tabs on the next two lines so Configure doesn't +# propagate these variables to config.sh uw_ver=`uname -v` uw_isuw=`uname -X 2>&1 | grep Release` + if [ "$uw_isuw" = "Release = 4.2" ]; then case $uw_ver in 1.1) @@ -93,6 +98,7 @@ if [ "$uw_isuw" = "Release = 4.2MP" ]; then ;; esac fi +# End of Unixware-specific tests. # DDE SMES Supermax Enterprise Server case "`uname -sm`" in diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm index fe77dd0a61..f490998039 100644 --- a/lib/Benchmark.pm +++ b/lib/Benchmark.pm @@ -115,7 +115,9 @@ call timethis(COUNT, VALUE, KEY, STYLE) -The Count can be zero or negative, see timethis(). +The routines are called in string comparison order of KEY. + +The COUNT can be zero or negative, see timethis(). =item timediff ( T1, T2 ) @@ -295,12 +297,12 @@ sub timestr { $style ||= $defaultstyle; $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto'; my $s = "@t $style"; # default for unknown style - $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU secs)", + $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)", @t,$t) if $style eq 'all'; - $s=sprintf("%$f CPU secs (%$f usr + %$f sys)", - $pt,$pu,$ps) if $style eq 'noc'; - $s=sprintf("%$f CPU secs (%$f cusr %$f csys)", - $ct,$cu,$cs) if $style eq 'nop'; + $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)", + $r,$pu,$ps,$pt) if $style eq 'noc'; + $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)", + $r,$cu,$cs,$ct) if $style eq 'nop'; $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n; $s; } diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index f1102aa44e..729906dd80 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -1015,8 +1015,8 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists if ($^O eq 'solaris'); # The IRIX linker also doesn't use LD_RUN_PATH - $ldrun = "-rpath $self->{LD_RUN_PATH}" - if ($^O eq 'irix'); + $ldrun = qq{-rpath "$self->{LD_RUN_PATH}"} + if ($^O eq 'irix' && $self->{LD_RUN_PATH}); push(@m,' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ '.$ldrun.' $(LDDLFLAGS) '.$ldfrom. ' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)'); diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm index 72ecdac1b6..eec9b61f31 100644 --- a/lib/FileHandle.pm +++ b/lib/FileHandle.pm @@ -112,7 +112,7 @@ FileHandle - supply object methods for filehandles use FileHandle; $fh = new FileHandle; - if ($fh->open "< file") { + if ($fh->open("< file")) { print <$fh>; $fh->close; } @@ -3322,16 +3322,27 @@ cv_ckproto(CV *cv, GV *gv, char *p) SV * cv_const_sv(CV *cv) { - OP *o; - SV *sv; - if (!cv || !SvPOK(cv) || SvCUR(cv)) return Nullsv; + return op_const_sv(CvSTART(cv), cv); +} + +SV * +op_const_sv(OP *o, CV *cv) +{ + SV *sv = Nullsv; + + if(!o) + return Nullsv; + + if(o->op_type == OP_LINESEQ && cLISTOPo->op_first) + o = cLISTOPo->op_first->op_sibling; - sv = Nullsv; - for (o = CvSTART(cv); o; o = o->op_next) { + for (; o; o = o->op_next) { OPCODE type = o->op_type; - + + if(sv && o->op_next == o) + return sv; if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) continue; if (type == OP_LEAVESUB || type == OP_RETURN) @@ -3340,7 +3351,7 @@ cv_const_sv(CV *cv) return Nullsv; if (type == OP_CONST) sv = cSVOPo->op_sv; - else if (type == OP_PADSV) { + else if (type == OP_PADSV && cv) { AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]); sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv; if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1)) @@ -3382,7 +3393,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) else sv_setiv((SV*)gv, -1); SvREFCNT_dec(compcv); - compcv = NULL; + cv = compcv = NULL; sub_generation++; goto noblock; } @@ -3394,6 +3405,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) /* already defined (or promised)? */ if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { SV* const_sv; + bool const_changed = TRUE; if (!block) { /* just a "sub foo;" when &foo is already defined */ SAVEFREESV(compcv); @@ -3402,8 +3414,9 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) /* ahem, death to those who redefine active sort subs */ if (curstackinfo->si_type == SI_SORT && sortcop == CvSTART(cv)) croak("Can't redefine active sort subroutine %s", name); - const_sv = cv_const_sv(cv); - if (const_sv || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv)) + if(const_sv = cv_const_sv(cv)) + const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv)); + if ((const_sv && const_changed) || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv)) && HvNAME(GvSTASH(CvGV(cv))) && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) { diff --git a/patchlevel.h b/patchlevel.h index 292d76f308..611d625862 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,6 +1,6 @@ #ifndef __PATCHLEVEL_H_INCLUDED__ #define PATCHLEVEL 4 -#define SUBVERSION 65 +#define SUBVERSION 66 /* local_patches -- list of locally applied less-than-subversion patches. @@ -2474,7 +2474,7 @@ init_postdump_symbols(register int argc, register char **argv, register char **e if (!(s = strchr(*env,'='))) continue; *s++ = '\0'; -#if defined(WIN32) || defined(MSDOS) +#if defined(MSDOS) (void)strupr(*env); #endif sv = newSVpv(s--,0); @@ -2878,7 +2878,6 @@ read_e_script(int idx, SV *buf_sv, int maxlen) #endif { char *p, *nl; - FILTER_READ(idx+1, buf_sv, maxlen); p = SvPVX(e_script); nl = strchr(p, '\n'); nl = (nl) ? nl+1 : SvEND(e_script); @@ -2295,6 +2295,26 @@ enum { UNLOCK_SV_MUTEX; \ } while (0) +#ifdef HAS_SEM +# include <sys/ipc.h> +# include <sys/sem.h> +# ifndef HAS_UNION_SEMUN /* Provide the union semun. */ + union semun { + int val; + struct semid_ds *buf; + unsigned short *array; + }; +# endif +# ifdef USE_SEMCTL_SEMUN +# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) +# else +# ifdef USE_SEMCTL_SEMID_DS +# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf) +# endif +# endif +# ifndef Semctl /* Place our bets on the semun horse. */ +# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) +# endif +#endif #endif /* Include guard */ - @@ -76,7 +76,7 @@ PerlIO_init() sfset(sfstdout,SF_SHARE,0); } -#else +#else /* USE_SFIO */ /* Implement all the PerlIO interface using stdio. - this should be only file to include <stdio.h> @@ -445,22 +445,11 @@ PerlIO *f; #undef PerlIO_printf int -#ifdef I_STDARG PerlIO_printf(PerlIO *f,const char *fmt,...) -#else -PerlIO_printf(f,fmt,va_alist) -PerlIO *f; -const char *fmt; -va_dcl -#endif { va_list ap; int result; -#ifdef I_STDARG va_start(ap,fmt); -#else - va_start(ap); -#endif result = vfprintf(f,fmt,ap); va_end(ap); return result; @@ -468,21 +457,11 @@ va_dcl #undef PerlIO_stdoutf int -#ifdef I_STDARG PerlIO_stdoutf(const char *fmt,...) -#else -PerlIO_stdoutf(fmt, va_alist) -const char *fmt; -va_dcl -#endif { va_list ap; int result; -#ifdef I_STDARG va_start(ap,fmt); -#else - va_start(ap); -#endif result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap); va_end(ap); return result; @@ -627,23 +606,11 @@ PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap) #ifndef PerlIO_sprintf int -#ifdef I_STDARG PerlIO_sprintf(char *s, int n, const char *fmt,...) -#else -PerlIO_sprintf(s, n, fmt, va_alist) -char *s; -int n; -const char *fmt; -va_dcl -#endif { va_list ap; int result; -#ifdef I_STDARG va_start(ap,fmt); -#else - va_start(ap); -#endif result = PerlIO_vsprintf(s, n, fmt, ap); va_end(ap); return result; diff --git a/plan9/config.plan9 b/plan9/config.plan9 index 6916622bf3..b35f60a93a 100644 --- a/plan9/config.plan9 +++ b/plan9/config.plan9 @@ -365,6 +365,13 @@ */ #undef HAS_ISASCII /**/ +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN / **/ + /* HAS_KILLPG: * This symbol, if defined, indicates that the killpg routine is available * to kill process groups. If unavailable, you probably should use kill diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 8f49541b40..cb042e9752 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -1083,7 +1083,7 @@ file. Some functions are provided to simplify customization. See L<"Debugger Customization"> for description of C<DB::parse_options(string)>. The function C<DB::dump_trace(skip[, count])> skips the specified number -of frames, and returns an array containing info about the caller +of frames, and returns a list containing info about the caller frames (all if C<count> is missing). Each entry is a hash with keys C<context> (C<$> or C<@>), C<sub> (subroutine name, or info about eval), C<args> (C<undef> or a reference to an array), C<file>, and diff --git a/pod/perldiag.pod b/pod/perldiag.pod index d51551756a..8dd2f823a0 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -823,6 +823,12 @@ message indicates that such a conversion was attempted. of upgradability. Upgrading to undef indicates an error in the code calling sv_upgrade. +=item Can't use %%! because Errno.pm is not available + +(F) The first time the %! hash is used, perl automatically loads the +Errno.pm module. The Errno module is expected to tie the %! hash to +provide symbolic names for C<$!> errno values. + =item Can't use "my %s" in sort comparison (F) The global variables $a and $b are reserved for sort comparisons. @@ -878,34 +884,17 @@ weren't. subscript. But to the left of the brackets was an expression that didn't look like an array reference, or anything else subscriptable. -=item Can't write to temp file for B<-e>: %s - -(F) The write routine failed for some reason while trying to process -a B<-e> switch. Maybe your /tmp partition is full, or clobbered. - =item Can't x= to read-only value (F) You tried to repeat a constant value (often the undefined value) with 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 generate temporary filename - -(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' (F|P) Error resolving overloading specified by a method name (as @@ -2087,18 +2076,6 @@ to use parens. In any case, a hash requires key/value B<pairs>. %hash = ( one => 1, two => 2, ); # right %hash = qw( one 1 two 2 ); # also fine -=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/perlfunc.pod b/pod/perlfunc.pod index 28a3ba152d..e867a0c65d 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -603,6 +603,25 @@ it can be used to increment a loop variable, even when the loop has been continued via the C<next> statement (which is similar to the C C<continue> statement). +C<last>, C<next>, or C<redo> may appear within a C<continue> +block. C<last> and C<redo> will behave as if they had been executed within +the main block. So will C<next>, but since it will execute a C<continue> +block, it may be more entertaining. + + while (EXPR) { + ### redo always comes here + do_something; + } continue { + ### next always comes here + do_something_else; + # then back the top to re-check EXPR + } + ### last always comes here + +Omitting the C<continue> section is semantically equivalent to using an +empty one, logically enough. In that case, C<next> goes directly back +to check the condition at the top of the loop. + =item cos EXPR Returns the cosine of EXPR (expressed in radians). If EXPR is omitted @@ -673,8 +692,8 @@ variables, not set them. If you want to test whether you can write, either use file tests or try setting a dummy hash entry inside an eval(), which will trap the error. -Note that functions such as keys() and values() may return huge array -values when used on large DBM files. You may prefer to use the each() +Note that functions such as keys() and values() may return huge lists +when used on large DBM files. You may prefer to use the each() function to iterate over large DBM files. Example: # print out history file offsets @@ -908,7 +927,7 @@ Example: =item each HASH -When called in a list context, returns a 2-element array consisting of the +When called in a list context, returns a 2-element list consisting of the key and value for the next element of a hash, so that you can iterate over it. When called in a scalar context, returns the key for only the next element in the hash. (Note: Keys may be "0" or "", which are logically @@ -1707,8 +1726,8 @@ See L<perlfunc/split>. =item keys HASH -Returns a normal array consisting of all the keys of the named hash. (In -a scalar context, returns the number of keys.) The keys are returned in +Returns a list consisting of all the keys of the named hash. (In a +scalar context, returns the number of keys.) The keys are returned in an apparently random order, but it is the same order as either the values() or each() function produces (given that the hash has not been modified). As a side effect, it resets HASH's iterator. @@ -1777,6 +1796,9 @@ C<continue> block, if any, is not executed: ... } +See also L</continue> for an illustration of how C<last>, C<next>, and +C<redo> work. + =item lc EXPR =item lc @@ -1967,6 +1989,9 @@ Note that if there were a C<continue> block on the above, it would get executed even on discarded lines. If the LABEL is omitted, the command refers to the innermost enclosing loop. +See also L</continue> for an illustration of how C<last>, C<next>, and +C<redo> work. + =item no Module LIST See the "use" function, which "no" is the opposite of. @@ -2567,6 +2592,9 @@ themselves about what was just input: print; } +See also L</continue> for an illustration of how C<last>, C<next>, and +C<redo> work. + =item ref EXPR =item ref @@ -3196,7 +3224,7 @@ Splits a string into an array of strings, and returns it. If not in a list context, returns the number of fields found and splits into the @_ array. (In a list context, you can force the split into @_ by -using C<??> as the pattern delimiters, but it still returns the array +using C<??> as the pattern delimiters, but it still returns the list value.) The use of implicit split to @_ is deprecated, however. If EXPR is omitted, splits the $_ string. If PATTERN is also omitted, @@ -3395,11 +3423,10 @@ one-third of the time. So don't do that. =item stat -Returns a 13-element array giving the status info for a file, either the -file opened via FILEHANDLE, or named by EXPR. If EXPR is omitted, it -stats $_. Returns a null list if the stat fails. Typically used as -follows: - +Returns a 13-element list giving the status info for a file, either +the file opened via FILEHANDLE, or named by EXPR. If EXPR is omitted, +it stats $_. Returns a null list if the stat fails. Typically used +as follows: ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) @@ -3434,6 +3461,10 @@ last stat or filetest are returned. Example: (This works on machines only for which the device number is negative under NFS.) +In scalar context, C<stat> returns a boolean value indicating success +or failure, and, if successful, sets the information associated with +the special filehandle C<_>. + =item study SCALAR =item study @@ -3741,9 +3772,9 @@ function of C. The object returned by the "new" method is also returned by the tie() function, which would be useful if you want to access other methods in CLASSNAME. -Note that functions such as keys() and values() may return huge array -values when used on large objects, like DBM files. You may prefer to -use the each() function to iterate over such. Example: +Note that functions such as keys() and values() may return huge lists +when used on large objects, like DBM files. You may prefer to use the +each() function to iterate over such. Example: # print out history file offsets use NDBM_File; @@ -3801,7 +3832,7 @@ Suitable for feeding to gmtime() and localtime(). =item times -Returns a four-element array giving the user and system times, in +Returns a four-element list giving the user and system times, in seconds, for this process and the children of this process. ($user,$system,$cuser,$csystem) = times; @@ -4026,11 +4057,12 @@ command if the files already exist: =item values HASH -Returns a normal array consisting of all the values of the named hash. -(In a scalar context, returns the number of values.) The values are -returned in an apparently random order, but it is the same order as either -the keys() or each() function would produce on the same hash. As a side -effect, it resets HASH's iterator. See also keys(), each(), and sort(). +Returns a list consisting of all the values of the named hash. (In a +scalar context, returns the number of values.) The values are +returned in an apparently random order, but it is the same order as +either the keys() or each() function would produce on the same hash. +As a side effect, it resets HASH's iterator. See also keys(), each(), +and sort(). =item vec EXPR,OFFSET,BITS @@ -4047,6 +4079,22 @@ Vectors created with vec() can also be manipulated with the logical operators |, &, and ^, which will assume a bit vector operation is desired when both operands are strings. +The following code will build up an ASCII string saying 'PerlPerlPerl'. +The comments show the string after each step. Note that this code works +in the same way on big-endian or little-endian machines. + + my $foo = ''; + vec($foo, 0, 32) = 0x5065726C; # 'Perl' + vec($foo, 2, 16) = 0x5065; # 'PerlPe' + vec($foo, 3, 16) = 0x726C; # 'PerlPerl' + vec($foo, 8, 8) = 0x50; # 'PerlPerlP' + vec($foo, 9, 8) = 0x65; # 'PerlPerlPe' + vec($foo, 20, 4) = 2; # 'PerlPerlPe' . "\x02" + vec($foo, 21, 4) = 7; # 'PerlPerlPer' # 'r' is "\x72" + vec($foo, 45, 2) = 3; # 'PerlPerlPer' . "\x0c" + vec($foo, 93, 1) = 1; # 'PerlPerlPer' . "\x2c" + vec($foo, 94, 1) = 1; # 'PerlPerlPerl' # 'l' is "\x6c" + To transform a bit vector into a string or array of 0's and 1's, use these: $bits = unpack("b*", $vector); diff --git a/pod/perlop.pod b/pod/perlop.pod index 538745dd6a..cae38ebf55 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -601,11 +601,16 @@ a transliteration, the first ten of these sequences may be used. \L lowercase till \E \U uppercase till \E \E end case modification - \Q quote regexp metacharacters till \E + \Q quote non-word characters till \E If C<use locale> is in effect, the case map used by C<\l>, C<\L>, C<\u> and C<\U> is taken from the current locale. See L<perllocale>. +You cannot include a literal C<$> or C<@> within a C<\Q> sequence. +An unescaped C<$> or C<@> interpolates the corresponding variable, +while escaping will cause the literal string C<\$> to be inserted. +You'll need to write something like C<m/\Quser\E\@\Qhost/>. + Patterns are subject to an additional level of interpretation as a regular expression. This is done as a second pass, after variables are interpolated, so that regular expressions may be incorporated into the @@ -681,9 +686,9 @@ successfully matched regular expression is used instead. If used in a context that requires a list value, a pattern match returns a list consisting of the subexpressions matched by the parentheses in the pattern, i.e., (C<$1>, $2, $3...). (Note that here $1 etc. are also set, and -that this differs from Perl 4's behavior.) If the match fails, a null -array is returned. If the match succeeds, but there were no parentheses, -a list value of (1) is returned. +that this differs from Perl 4's behavior.) If there are no parentheses, +the return value is the list C<(1)> for success or C<('')> upon failure. +With parentheses, C<()> is returned upon failure. Examples: diff --git a/pod/perlre.pod b/pod/perlre.pod index 68ce4b9bf7..8fb582074c 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -148,6 +148,11 @@ also work: If C<use locale> is in effect, the case map used by C<\l>, C<\L>, C<\u> and C<\U> is taken from the current locale. See L<perllocale>. +You cannot include a literal C<$> or C<@> within a C<\Q> sequence. +An unescaped C<$> or C<@> interpolates the corresponding variable, +while escaping will cause the literal string C<\$> to be matched. +You'll need to write something like C<m/\Quser\E\@\Qhost/>. + In addition, Perl defines the following: \w Match a "word" character (alphanumeric plus "_") diff --git a/pod/perltie.pod b/pod/perltie.pod index 398c3a0d29..da4fbe99cf 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -603,9 +603,9 @@ or have auxiliary state to clean up. Here's a very simple function: =back -Note that functions such as keys() and values() may return huge array -values when used on large objects, like DBM files. You may prefer to -use the each() function to iterate over such. Example: +Note that functions such as keys() and values() may return huge lists +when used on large objects, like DBM files. You may prefer to use the +each() function to iterate over such. Example: # print out history file offsets use NDBM_File; diff --git a/pod/perltrap.pod b/pod/perltrap.pod index 9d861e3ae5..4159777146 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -451,8 +451,8 @@ Also see precedence traps, for parsing C<$:>. The second and third arguments of C<splice()> are now evaluated in scalar context (as the Camel says) rather than list context. - sub sub1{return(0,2) } # return a 2-elem array - sub sub2{ return(1,2,3)} # return a 3-elem array + sub sub1{return(0,2) } # return a 2-element list + sub sub2{ return(1,2,3)} # return a 3-element list @a1 = ("a","b","c","d","e"); @a2 = splice(@a1,&sub1,&sub2); print join(' ',@a2),"\n"; @@ -775,7 +775,7 @@ PP(pp_undef) hv_undef((HV*)sv); break; case SVt_PVCV: - if (cv_const_sv((CV*)sv)) + if (dowarn && cv_const_sv((CV*)sv)) warn("Constant subroutine %s undefined", CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv))); /* FALL THROUGH */ @@ -2466,7 +2466,7 @@ PP(pp_require) SvREFCNT_dec(namesv); if (!tryrsfp) { if (op->op_type == OP_REQUIRE) { - SV *msg = sv_2mortal(newSVpvf("Can't locate '%s' in @INC", name)); + SV *msg = sv_2mortal(newSVpvf("Can't locate %s in @INC", name)); SV *dirmsgsv = NEWSV(0, 0); AV *ar = GvAVn(incgv); I32 i; @@ -324,6 +324,23 @@ PP(pp_die) if(tmpsv ? SvROK(tmpsv) : SvROK(error)) { if(tmpsv) SvSetSV(error,tmpsv); + else if(sv_isobject(error)) { + HV *stash = SvSTASH(SvRV(error)); + GV *gv = gv_fetchmethod(stash, "PROPAGATE"); + if (gv) { + SV *file = sv_2mortal(newSVsv(GvSV(curcop->cop_filegv))); + SV *line = sv_2mortal(newSViv(curcop->cop_line)); + EXTEND(SP, 3); + PUSHMARK(SP); + PUSHs(error); + PUSHs(file); + PUSHs(line); + PUTBACK; + perl_call_sv((SV*)GvCV(gv), + G_SCALAR|G_EVAL|G_KEEPERR); + sv_setsv(error,*stack_sp--); + } + } pat = Nullch; } else { @@ -2292,7 +2292,7 @@ dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l) else if (op == WHILEM) l--; } -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ return node; } @@ -2355,7 +2355,7 @@ regdump(regexp *r) PerlIO_printf(Perl_debug_log, "implicit "); PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen); PerlIO_printf(Perl_debug_log, "\n"); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } /* @@ -2562,7 +2562,7 @@ regprop(SV *sv, regnode *o) } if (p) sv_catpv(sv, p); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } void @@ -2633,17 +2633,8 @@ regnext(register regnode *p) #endif } -#ifdef I_STDARG STATIC void re_croak2(const char* pat1,const char* pat2,...) -#else -/*VARARGS0*/ -static void -re_croak2(const char* pat1,const char* pat2, va_alist) - const char* pat1; - const char* pat2; - va_dcl -#endif { va_list args; STRLEN l1 = strlen(pat1); @@ -2659,11 +2650,7 @@ re_croak2(const char* pat1,const char* pat2, va_alist) Copy(pat2, buf + l1, l2 , char); buf[l1 + l2 + 1] = '\n'; buf[l1 + l2 + 2] = '\0'; -#ifdef I_STDARG va_start(args, pat2); -#else - va_start(args); -#endif message = mess(buf, &args); va_end(args); l1 = strlen(message); @@ -23,7 +23,8 @@ #endif int -runops_standard(void) { +runops_standard(void) +{ dTHR; while ( op = (CALLOP->op_ppaddr)(ARGS) ) ; @@ -32,6 +33,8 @@ runops_standard(void) { return 0; } +#ifdef DEBUGGING + dEXT char **watchaddr = 0; dEXT char *watchok; @@ -39,6 +42,8 @@ dEXT char *watchok; static void debprof _((OP*o)); #endif +#endif /* DEBUGGING */ + int runops_debug(void) { @@ -64,7 +69,7 @@ runops_debug(void) return 0; #else return runops_standard(); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } I32 @@ -92,7 +97,7 @@ debop(OP *o) break; } PerlIO_printf(Perl_debug_log, "\n"); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ return 0; } @@ -104,7 +109,7 @@ watch(char **addr) watchok = *addr; PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n", (long)watchaddr, (long)watchok); -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } STATIC void @@ -129,5 +134,5 @@ debprofdump(void) PerlIO_printf(Perl_debug_log, "%u\t%lu\n", i, (unsigned long)profiledata[i]); } -#endif /* DEBUGGING */ +#endif /* DEBUGGING */ } @@ -899,5 +899,5 @@ cx_dump(PERL_CONTEXT *cx) (long)cx->sb_rxres); break; } -#endif +#endif /* DEBUGGING */ } @@ -1711,7 +1711,7 @@ sv_2pv(register SV *sv, STRLEN *lp) case SVt_PVHV: s = "HASH"; break; case SVt_PVCV: s = "CODE"; break; case SVt_PVGV: s = "GLOB"; break; - case SVt_PVFM: s = "FORMLINE"; break; + case SVt_PVFM: s = "FORMAT"; break; case SVt_PVIO: s = "IO"; break; default: s = "UNKNOWN"; break; } @@ -2079,6 +2079,12 @@ sv_setsv(SV *dstr, register SV *sstr) if (!GvCVGEN((GV*)dstr) && (CvROOT(cv) || CvXSUB(cv))) { + SV *const_sv = cv_const_sv(cv); + bool const_changed = TRUE; + if(const_sv) + const_changed = sv_cmp(const_sv, + op_const_sv(CvSTART((CV*)sref), + Nullcv)); /* ahem, death to those who redefine * active sort subs */ if (curstackinfo->si_type == SI_SORT && @@ -2086,15 +2092,14 @@ sv_setsv(SV *dstr, register SV *sstr) croak( "Can't redefine active sort subroutine %s", GvENAME((GV*)dstr)); - if (cv_const_sv(cv)) - warn("Constant subroutine %s redefined", - GvENAME((GV*)dstr)); - else if (dowarn) { + if (dowarn || (const_changed && const_sv)) { if (!(CvGV(cv) && GvSTASH(CvGV(cv)) && HvNAME(GvSTASH(CvGV(cv))) && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) - warn("Subroutine %s redefined", + warn(const_sv ? + "Constant subroutine %s redefined" + : "Subroutine %s redefined", GvENAME((GV*)dstr)); } } @@ -3589,16 +3594,8 @@ newSVpvn(char *s, STRLEN len) return sv; } -#ifdef I_STDARG SV * newSVpvf(const char* pat, ...) -#else -/*VARARGS0*/ -SV * -newSVpvf(pat, va_alist) -const char *pat; -va_dcl -#endif { register SV *sv; va_list args; @@ -3607,11 +3604,7 @@ va_dcl SvANY(sv) = 0; SvREFCNT(sv) = 1; SvFLAGS(sv) = 0; -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); va_end(args); return sv; @@ -3996,7 +3989,7 @@ sv_reftype(SV *sv, int ob) case SVt_PVHV: return "HASH"; case SVt_PVCV: return "CODE"; case SVt_PVGV: return "GLOB"; - case SVt_PVFM: return "FORMLINE"; + case SVt_PVFM: return "FORMAT"; default: return "UNKNOWN"; } } @@ -4228,92 +4221,40 @@ sv_setpviv_mg(SV *sv, IV iv) SvSETMAGIC(sv); } -#ifdef I_STDARG void sv_setpvf(SV *sv, const char* pat, ...) -#else -/*VARARGS0*/ -void -sv_setpvf(sv, pat, va_alist) - SV *sv; - const char *pat; - va_dcl -#endif { va_list args; -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); va_end(args); } -#ifdef I_STDARG void sv_setpvf_mg(SV *sv, const char* pat, ...) -#else -/*VARARGS0*/ -void -sv_setpvf_mg(sv, pat, va_alist) - SV *sv; - const char *pat; - va_dcl -#endif { va_list args; -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); va_end(args); SvSETMAGIC(sv); } -#ifdef I_STDARG void sv_catpvf(SV *sv, const char* pat, ...) -#else -/*VARARGS0*/ -void -sv_catpvf(sv, pat, va_alist) - SV *sv; - const char *pat; - va_dcl -#endif { va_list args; -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); va_end(args); } -#ifdef I_STDARG void sv_catpvf_mg(SV *sv, const char* pat, ...) -#else -/*VARARGS0*/ -void -sv_catpvf_mg(sv, pat, va_alist) - SV *sv; - const char *pat; - va_dcl -#endif { va_list args; -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); va_end(args); SvSETMAGIC(sv); diff --git a/t/comp/proto.t b/t/comp/proto.t index 2a4c9ccce5..6a59107ce7 100755 --- a/t/comp/proto.t +++ b/t/comp/proto.t @@ -16,7 +16,7 @@ BEGIN { use strict; -print "1..80\n"; +print "1..82\n"; my $i = 1; @@ -403,3 +403,13 @@ sub foo2 ($\%); eval q{ foo2 "s" }; print "not " unless $@ =~ /^Not enough/; print "ok ", $i++, "\n"; + +sub X::foo3; +*X::foo3 = sub {'ok'}; +print "# $@not " unless eval {X->foo3} eq 'ok'; +print "ok ", $i++, "\n"; + +sub X::foo4 ($); +*X::foo4 = sub ($) {'ok'}; +print "not " unless X->foo4 eq 'ok'; +print "ok ", $i++, "\n"; diff --git a/t/io/pipe.t b/t/io/pipe.t index 4a7cb7a423..63614f5f4f 100755 --- a/t/io/pipe.t +++ b/t/io/pipe.t @@ -59,6 +59,7 @@ close READER; $SIG{'PIPE'} = 'broken_pipe'; sub broken_pipe { + $SIG{'PIPE'} = 'IGNORE'; # loop preventer print "ok 7\n"; } diff --git a/t/lib/h2ph.h b/t/lib/h2ph.h new file mode 100644 index 0000000000..cddf0a7d94 --- /dev/null +++ b/t/lib/h2ph.h @@ -0,0 +1,85 @@ +/* + * Test header file for h2ph + * + * Try to test as many constructs as possible + * For example, the multi-line comment :) + */ + +/* And here's a single line comment :) */ + +/* Test #define with no indenting, over multiple lines */ +#define SQUARE(x) \ +((x)*(x)) + +/* Test #ifndef and parameter interpretation*/ +#ifndef ERROR +#define ERROR(x) fprintf(stderr, "%s\n", x[2][3][0]) +#endif /* ERROR */ + +#ifndef _H2PH_H_ +#define _H2PH_H_ + +/* #ident - doesn't really do anything, but I think it always gets included anyway */ +#ident "$Revision h2ph.h,v 1.0 98/05/04 20:42:14 billy $" + +/* Test #undef */ +#undef MAX +#define MAX(a,b) ((a) > (b) ? (a) : (b)) + +/* Test #ifdef */ +#ifdef __SOME_UNIMPORTANT_PROPERTY +#define MIN(a,b) ((a) < (b) ? (a) : (b)) +#endif /* __SOME_UNIMPORTANT_PROPERTY */ + +/* + * Test #if, #elif, #else, #endif, #warn and #error, and `!' + * Also test whitespace between the `#' and the command + */ +#if !(defined __SOMETHING_MORE_IMPORTANT) +# warn Be careful... +#elif !(defined __SOMETHING_REALLY_REALLY_IMPORTANT) +# error Nup, can't go on /* ' /* stupid font-lock-mode */ +#else /* defined __SOMETHING_MORE_IMPORTANT && defined __SOMETHING_REALLY_REALLY_IMPORTANT */ +# define EVERYTHING_IS_OK +#endif + +/* Test && and || */ +#undef WHATEVER +#if (!((defined __SOMETHING_TRIVIAL && defined __SOMETHING_LESS_SO)) \ + || defined __SOMETHING_OVERPOWERING) +# define WHATEVER 6 +#elif !(defined __SOMETHING_TRIVIAL) /* defined __SOMETHING_LESS_SO */ +# define WHATEVER 7 +#elif !(defined __SOMETHING_LESS_SO) /* defined __SOMETHING_TRIVIAL */ +# define WHATEVER 8 +#else /* defined __SOMETHING_TRIVIAL && defined __SOMETHING_LESS_SO */ +# define WHATEVER 1000 +#endif + +/* + * Test #include, #import and #include_next + * #include_next is difficult to test, it really depends on the actual + * circumstances - for example, `#include_next <limits.h>' on a Linux system + * with `use lib qw(/opt/perl5/lib/site_perl/i586-linux/linux);' or whatever + * your equivalent is... + */ +#include <sys/socket.h> +#import "sys/ioctl.h" +#include_next <sys/fcntl.h> + +/* typedefs should be ignored */ +typedef struct a_struct { + int typedefs_should; + char be_ignored; + long as_well; +} a_typedef; + +/* + * however, typedefs of enums and just plain enums should end up being treated + * like a bunch of #defines... + */ + +typedef enum _days_of_week { sun, mon, tue, wed, thu, fri, sat, Sun=0, Mon, + Tue, Wed, Thu, Fri, Sat } days_of_week; + +#endif /* _H2PH_H_ */ diff --git a/t/lib/h2ph.pht b/t/lib/h2ph.pht new file mode 100644 index 0000000000..80867a6113 --- /dev/null +++ b/t/lib/h2ph.pht @@ -0,0 +1,69 @@ +unless(defined(&SQUARE)) { + sub SQUARE { + local($x) = @_; + eval q((($x)*($x))); + } +} +unless(defined(&ERROR)) { + eval 'sub ERROR { + local($x) = @_; + eval q( &fprintf( &stderr, \\"%s\\\\n\\", $x->[2][3][0])); + }' unless defined(&ERROR); +} +unless(defined(&_H2PH_H_)) { + eval 'sub _H2PH_H_ () {1;}' unless defined(&_H2PH_H_); + # "$Revision h2ph.h,v 1.0 98/05/04 20:42:14 billy $" + undef(&MAX) if defined(&MAX); + eval 'sub MAX { + local($a,$b) = @_; + eval q((($a) > ($b) ? ($a) : ($b))); + }' unless defined(&MAX); + if(defined(&__SOME_UNIMPORTANT_PROPERTY)) { + eval 'sub MIN { + local($a,$b) = @_; + eval q((($a) < ($b) ? ($a) : ($b))); + }' unless defined(&MIN); + } + if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) { + } + elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) { + die("Nup, can't go on "); + } else { + eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK); + } + undef(&WHATEVER) if defined(&WHATEVER); + if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0) && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : 0))) { + eval 'sub WHATEVER () {6;}' unless defined(&WHATEVER); + } + elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0)) ) { + eval 'sub WHATEVER () {7;}' unless defined(&WHATEVER); + } + elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0)) ) { + eval 'sub WHATEVER () {8;}' unless defined(&WHATEVER); + } else { + eval 'sub WHATEVER () {1000;}' unless defined(&WHATEVER); + } + require 'sys/socket.ph'; + require 'sys/ioctl.ph'; + eval { + my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC)); + my(@REM) = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"})and -f "$_/sys/fcntl.ph" } @INC); + require "$REM[0]" if @REM; + }; + warn($@) if $@; + eval("sub sun () { 0; }") unless defined(&sun); + eval("sub mon () { 1; }") unless defined(&mon); + eval("sub tue () { 2; }") unless defined(&tue); + eval("sub wed () { 3; }") unless defined(&wed); + eval("sub thu () { 4; }") unless defined(&thu); + eval("sub fri () { 5; }") unless defined(&fri); + eval("sub sat () { 6; }") unless defined(&sat); + eval("sub Sun () { 0; }") unless defined(&Sun); + eval("sub Mon () { 1; }") unless defined(&Mon); + eval("sub Tue () { 2; }") unless defined(&Tue); + eval("sub Wed () { 3; }") unless defined(&Wed); + eval("sub Thu () { 4; }") unless defined(&Thu); + eval("sub Fri () { 5; }") unless defined(&Fri); + eval("sub Sat () { 6; }") unless defined(&Sat); +} +1; diff --git a/t/lib/h2ph.t b/t/lib/h2ph.t new file mode 100755 index 0000000000..17d5509085 --- /dev/null +++ b/t/lib/h2ph.t @@ -0,0 +1,34 @@ +#!./perl + +# quickie tests to see if h2ph actually runs and does more or less what is +# expected + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +print "1..2\n"; + +# quickly compare two text files +sub txt_compare { + local ($/, $A, $B); + for (($A,$B) = @_) { open(_,"<$_") ? $_ = <_> : die "$_ : $!"; close _ } + $A cmp $B; +} + +unless(-e '../utils/h2ph') { + print("ok 1\nok 2\n"); + # i'll probably get in trouble for this :) +} else { + # does it run? + $ok = system("./perl -I../lib ../utils/h2ph -d. lib/h2ph.h"); + print(($ok == 0 ? "" : "not "), "ok 1\n"); + + # does it work? well, does it do what we expect? :-) + $ok = txt_compare("lib/h2ph.ph", "lib/h2ph.pht"); + print(($ok == 0 ? "" : "not "), "ok 2\n"); + + # cleanup - should this be in an END block? + unlink("lib/h2ph.ph"); +} diff --git a/t/op/die.t b/t/op/die.t index 795d856564..d473ed6b7f 100755 --- a/t/op/die.t +++ b/t/op/die.t @@ -1,6 +1,6 @@ #!./perl -print "1..6\n"; +print "1..10\n"; $SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ; @@ -24,3 +24,20 @@ eval { }; die if $@; }; + +eval { + eval { + die bless [ 7 ], "Error"; + }; + die if $@; +}; + +print "not " unless ref($@) eq "Out"; +print "ok 10\n"; + +package Error; + +sub PROPAGATE { + print "ok ",$_[0]->[0]++,"\n"; + bless [$_[0]->[0]], "Out"; +} diff --git a/t/op/ipcmsg.t b/t/op/ipcmsg.t index ab2b0737e9..72e345c90a 100755 --- a/t/op/ipcmsg.t +++ b/t/op/ipcmsg.t @@ -110,8 +110,9 @@ use strict; print "1..6\n"; -my $msg = msgget($IPC_PRIVATE, $S_IRWXU | $S_IRWXG | $S_IRWXO) - || die "msgget failed: $!\n"; +my $msg = msgget($IPC_PRIVATE, $S_IRWXU | $S_IRWXG | $S_IRWXO); +# Very first time called after machine is booted value may be 0 +die "msgget failed: $!\n" unless defined($msg) && $msg >= 0; print "ok 1\n"; diff --git a/t/op/ipcsem.t b/t/op/ipcsem.t index f71f810570..a1450ffd42 100755 --- a/t/op/ipcsem.t +++ b/t/op/ipcsem.t @@ -115,8 +115,9 @@ exit; print "1..10\n"; -my $sem = semget($IPC_PRIVATE, 10, $S_IRWXU | $S_IRWXG | $S_IRWXO | $IPC_CREAT) - || die "semget: $!\n"; +my $sem = semget($IPC_PRIVATE, 10, $S_IRWXU | $S_IRWXG | $S_IRWXO | $IPC_CREAT); +# Very first time called after machine is booted value may be 0 +die "semget: $!\n" unless defined($sem) && $sem >= 0; print "ok 1\n"; diff --git a/t/pragma/locale.t b/t/pragma/locale.t index bd5267d720..00baa6645e 100755 --- a/t/pragma/locale.t +++ b/t/pragma/locale.t @@ -20,7 +20,8 @@ eval { }; # Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1" -$have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^cl/i; +# and mingw32 uses said silly CRT +$have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i; print "1..", ($have_setlocale ? 102 : 98), "\n"; @@ -2221,13 +2221,8 @@ yylex(void) else lex_brackstack[lex_brackets++] = XOPERATOR; s = skipspace(s); - if (*s == '}') { - if (expect == XSTATE) { - lex_brackstack[lex_brackets-1] = XSTATE; - break; - } + if (*s == '}') OPERATOR(HASHBRACK); - } /* This hack serves to disambiguate a pair of curlies * as being a block or an anon hash. Normally, expectation * determines that, but in cases where we're not in a @@ -1193,23 +1193,11 @@ mess_alloc(void) return sv; } -#ifdef I_STDARG char * form(const char* pat, ...) -#else -/*VARARGS0*/ -char * -form(pat, va_alist) - const char *pat; - va_dcl -#endif { va_list args; -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif if (!mess_sv) mess_sv = mess_alloc(); sv_vsetpvfn(mess_sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); @@ -1249,16 +1237,8 @@ mess(const char *pat, va_list *args) return SvPVX(sv); } -#ifdef I_STDARG OP * die(const char* pat, ...) -#else -/*VARARGS0*/ -OP * -die(pat, va_alist) - const char *pat; - va_dcl -#endif { dTHR; va_list args; @@ -1274,11 +1254,7 @@ die(pat, va_alist) thr, curstack, mainstack)); #endif /* USE_THREADS */ -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif message = pat ? mess(pat, &args) : Nullch; va_end(args); @@ -1330,16 +1306,8 @@ die(pat, va_alist) return restartop; } -#ifdef I_STDARG void croak(const char* pat, ...) -#else -/*VARARGS0*/ -void -croak(pat, va_alist) - char *pat; - va_dcl -#endif { dTHR; va_list args; @@ -1348,11 +1316,7 @@ croak(pat, va_alist) GV *gv; CV *cv; -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif message = mess(pat, &args); va_end(args); #ifdef USE_THREADS @@ -1394,14 +1358,7 @@ croak(pat, va_alist) } void -#ifdef I_STDARG warn(const char* pat,...) -#else -/*VARARGS0*/ -warn(pat,va_alist) - const char *pat; - va_dcl -#endif { va_list args; char *message; @@ -1409,11 +1366,7 @@ warn(pat,va_alist) GV *gv; CV *cv; -#ifdef I_STDARG va_start(args, pat); -#else - va_start(args); -#endif message = mess(pat, &args); va_end(args); @@ -1672,7 +1625,6 @@ register I32 len; } #endif /* !HAS_MEMCMP || !HAS_SANE_MEMCMP */ -#if defined(I_STDARG) || defined(I_VARARGS) #ifndef HAS_VPRINTF #ifdef USE_CHAR_VSPRINTF @@ -1703,7 +1655,6 @@ char *args; } #endif /* HAS_VPRINTF */ -#endif /* I_VARARGS || I_STDARGS */ #ifdef MYSWAP #if BYTEORDER != 0x4321 diff --git a/utils/h2ph.PL b/utils/h2ph.PL index 730c2259e7..da7bb64843 100644 --- a/utils/h2ph.PL +++ b/utils/h2ph.PL @@ -112,7 +112,7 @@ while (defined ($file = next_file())) { redo; } } - if (s/^\s*#\s*//) { + if (s/^\s*\#\s*//) { if (s/^define\s+(\w+)//) { $name = $1; $new = ''; @@ -171,37 +171,25 @@ while (defined ($file = next_file())) { print OUT $t,"require '$incl';\n"; } elsif(/^include_next\s*[<"](.*)[>"]/) { ($incl = $1) =~ s/\.h$/.ph/; - # should've read up on #include_next properly before attempting - # to implement it... - # - #print OUT $t, "{\n"; - #$tab += 4; - #$t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - #print OUT $t, "my(\$INC) = shift(\@INC);\n"; - #print OUT $t, "require '$incl';\n"; - #print OUT $t, "unshift(\@INC, \$INC);}\n"; - #$tab -= 4; - #$t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - #print OUT $t, "}\n"; - # - # try this instead: - print OUT ($t, "my(\$i) = 0;\n"); - print OUT ($t, "if(exists(\$INC{$incl})) {\n"); - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT ($t, "++\$i while (\$i <= \$#INC", - " and \$INC[\$i].'/$incl' ne \$INC{'$incl'});\n"); - print OUT ($t, "\$i = 0 if \$INC[\$i].'/$incl' ne", - " \$INC{'$incl'};\n"); - $tab -= 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT ($t, "}\n"); print OUT ($t, - "eval(\"require '\" . ", - "(\$i ? \$INC[\$i].'/' : '') . \"\$incl';\");"); - # any better? require is smart enough not to try and include a - # file twice, i believe, so require-ing the same actual file - # should end up just being a null operation... + "eval {\n"); + $tab += 4; + $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); + print OUT ($t, + "my(\%INCD) = map { \$INC{\$_} => 1 } ", + "(grep { \$_ eq \"$incl\" } keys(\%INC));\n"); + print OUT ($t, + "my(\@REM) = map { \"\$_/$incl\" } ", + "(grep { not exists(\$INCD{\"\$_/$incl\"})", + "and -f \"\$_/$incl\" } \@INC);\n"); + print OUT ($t, + "require \"\$REM[0]\" if \@REM;\n"); + $tab -= 4; + $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); + print OUT ($t, + "};\n"); + print OUT ($t, + "warn(\$\@) if \$\@;\n"); } elsif (/^ifdef\s+(\w+)/) { print OUT $t,"if(defined(&$1)) {\n"; $tab += 4; @@ -247,6 +235,34 @@ while (defined ($file = next_file())) { } elsif(/^ident\s+(.*)/) { print OUT $t, "# $1\n"; } + } elsif(/^\s*(typedef\s*)?enum\b/) { + until(/\}.*?;/) { + chomp($next = <IN>); + $_ .= $next; + print OUT "# $next\n" if $opt_D; + } + s@/\*.*?\*/@@g; + s/\s+/ /g; + /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/; + ($enum_subs = $3) =~ s/\s//g; + @enum_subs = split(/,/, $enum_subs); + $enum_val = -1; + for $enum (@enum_subs) { + ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/; + $enum_value =~ s/^=//; + $enum_val = (length($enum_value) ? $enum_value : $enum_val + 1); + if ($opt_h) { + print OUT ($t, + "eval(\"\\n#line $eval_index $outfile\\n", + "sub $enum_name () \{ $enum_val; \}\") ", + "unless defined(\&$enum_name);\n"); + ++ $eval_index; + } else { + print OUT ($t, + "eval(\"sub $enum_name () \{ $enum_val; \}\") ", + "unless defined(\&$enum_name);\n"); + } + } } } print OUT "1;\n"; diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 68ff2901d5..4685e42af2 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -84,7 +84,7 @@ BEGIN { $::HaveUtil = ($@ eq ""); }; -my $Version = "1.22"; +my $Version = "1.23"; # Changed in 1.06 to skip Mail::Send and Mail::Util if not available. # Changed in 1.07 to see more sendmail execs, and added pipe output. @@ -111,6 +111,7 @@ my $Version = "1.22"; # Changed in 1.20 Added patchlevel.h reading and version/config checks # Changed in 1.21 Added '-nok' for reporting build failure DFD 98-05-05 # Changed in 1.22 Heavy reformatting & minor bugfixes HVDS 98-05-10 +# Changed in 1.23 Restore -ok(ay): say 'success'; don't prompt # TODO: - Allow the user to re-name the file on mail failure, and # make sure failure (transmission-wise) of Mail::Send is @@ -137,7 +138,7 @@ EOF if (!-t STDOUT) { Dump(*STDOUT); exit; } Query(); -Edit() unless $usefile; +Edit() unless $usefile || ($ok and not $::opt_n); NowWhat(); Send(); @@ -435,7 +436,7 @@ EOF # Generate report open(REP,">$filename"); - my $reptype = $ok ? "build failure" : "bug"; + my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success"; print REP <<EOF; This is a $reptype report for perl from $from, diff --git a/vms/config.vms b/vms/config.vms index 9614ea60c3..839c7ee00f 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -691,6 +691,28 @@ */ #define HAS_VFORK /**/ +/* HAS_UNION_SEMUN: + * This symbol, if defined, indicates that the union semun is + * defined by including <sys/sem.h>. If not, the user code + * probably needs to define it as: + * union semun { + * int val; + * struct semid_ds *buf; + * unsigned short *array; + * } + */ +/* USE_SEMCTL_SEMUN: + * This symbol, if defined, indicates that union semun is + * used for semctl IPC_STAT. + */ +/* USE_SEMCTL_SEMID_DS: + * This symbol, if defined, indicates that struct semid_ds * is + * used for semctl IPC_STAT. + */ +#undef HAS_UNION_SEMUN /**/ +#undef USE_SEMCTL_SEMUN /**/ +#undef USE_SEMCTL_SEMID_DS /**/ + /* 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 @@ -1652,6 +1674,13 @@ */ #define HAS_ISASCII /**/ +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN / **/ + /* HAS_SETLOCALE: * This symbol, if defined, indicates that the setlocale routine is * available to handle locale-specific ctype implementations. diff --git a/win32/config.bc b/win32/config.bc index fe9f297b4b..3923cf6208 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -141,6 +141,7 @@ d_index='undef' d_inetaton='undef' d_isascii='define' d_killpg='undef' +d_lchown='undef' d_link='undef' d_locconv='define' d_lockf='undef' @@ -196,6 +197,8 @@ d_seekdir='define' d_select='define' d_sem='undef' d_semctl='undef' +d_semctl_semid_ds='undef' +d_semctl_semun='undef' d_semget='undef' d_semop='undef' d_setegid='undef' @@ -260,6 +263,7 @@ d_truncate='undef' d_tzname='define' d_umask='define' d_uname='undef' +d_union_semun='define' d_vfork='undef' d_void_closedir='undef' d_voidsig='define' diff --git a/win32/config.gc b/win32/config.gc index 5e732ab3f2..c469fa8cde 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -141,6 +141,7 @@ d_index='undef' d_inetaton='undef' d_isascii='define' d_killpg='undef' +d_lchown='undef' d_link='undef' d_locconv='define' d_lockf='undef' @@ -196,6 +197,8 @@ d_seekdir='define' d_select='define' d_sem='undef' d_semctl='undef' +d_semctl_semid_ds='undef' +d_semctl_semun='undef' d_semget='undef' d_semop='undef' d_setegid='undef' @@ -257,9 +260,10 @@ d_telldir='define' d_time='define' d_times='define' d_truncate='undef' -d_tzname='define' +d_tzname='undef' d_umask='define' d_uname='undef' +d_union_semun='define' d_vfork='undef' d_void_closedir='undef' d_voidsig='define' diff --git a/win32/config.vc b/win32/config.vc index 1fdbcbfbc2..ab4d24a7c4 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -141,6 +141,7 @@ d_index='undef' d_inetaton='undef' d_isascii='define' d_killpg='undef' +d_lchown='undef' d_link='undef' d_locconv='define' d_lockf='undef' @@ -196,6 +197,8 @@ d_seekdir='define' d_select='define' d_sem='undef' d_semctl='undef' +d_semctl_semid_ds='undef' +d_semctl_semun='undef' d_semget='undef' d_semop='undef' d_setegid='undef' @@ -260,6 +263,7 @@ d_truncate='undef' d_tzname='define' d_umask='define' d_uname='undef' +d_union_semun='define' d_vfork='undef' d_void_closedir='undef' d_voidsig='define' diff --git a/win32/config_H.bc b/win32/config_H.bc index 2e645a8e99..43755ff6e2 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -900,47 +900,6 @@ */ /*#define I_NETINET_IN /**/ -/* I_PWD: - * This symbol, if defined, indicates to the C program that it should - * include <pwd.h>. - */ -/* PWQUOTA: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_quota. - */ -/* PWAGE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_age. - */ -/* PWCHANGE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_change. - */ -/* PWCLASS: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_class. - */ -/* PWEXPIRE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_expire. - */ -/* PWGECOS: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_gecos. - */ -/* PWCOMMENT: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_comment. - */ -/*#define I_PWD /**/ -/*#define PWQUOTA /**/ -/*#define PWAGE /**/ -/*#define PWCHANGE /**/ -/*#define PWCLASS /**/ -/*#define PWEXPIRE /**/ -/*#define PWGECOS /**/ -/*#define PWCOMMENT /**/ - /* I_SFIO: * This symbol, if defined, indicates to the C program that it should * include <sfio.h>. @@ -1019,6 +978,12 @@ */ /*#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. @@ -1250,6 +1215,13 @@ */ #define HAS_ISASCII /**/ +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN /**/ + /* HAS_OPEN3: * This manifest constant lets the C program know that the three * argument form of open(2) is available. @@ -1699,6 +1671,28 @@ #define HAS_SOCKET /**/ /*#define HAS_SOCKETPAIR /**/ +/* HAS_UNION_SEMUN: + * This symbol, if defined, indicates that the union semun is + * defined by including <sys/sem.h>. If not, the user code + * probably needs to define it as: + * union semun { + * int val; + * struct semid_ds *buf; + * unsigned short *array; + * } + */ +/* USE_SEMCTL_SEMUN: + * This symbol, if defined, indicates that union semun is + * used for semctl IPC_STAT. + */ +/* USE_SEMCTL_SEMID_DS: + * This symbol, if defined, indicates that struct semid_ds * is + * used for semctl IPC_STAT. + */ +#define HAS_UNION_SEMUN /**/ +/*#define USE_SEMCTL_SEMUN /**/ +/*#define USE_SEMCTL_SEMID_DS /**/ + /* 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 @@ -1726,11 +1720,46 @@ */ /*#define I_NETDB /**/ -/* I_SYS_TYPES: +/* I_PWD: * This symbol, if defined, indicates to the C program that it should - * include <sys/types.h>. + * include <pwd.h>. */ -#define I_SYS_TYPES /**/ +/* PWQUOTA: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_quota. + */ +/* PWAGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_age. + */ +/* PWCHANGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_change. + */ +/* PWCLASS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_class. + */ +/* PWEXPIRE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_expire. + */ +/* PWCOMMENT: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_comment. + */ +/* PWGECOS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_gecos. + */ +/*#define I_PWD /**/ +/*#define PWQUOTA /**/ +/*#define PWAGE /**/ +/*#define PWCHANGE /**/ +/*#define PWCLASS /**/ +/*#define PWEXPIRE /**/ +/*#define PWCOMMENT /**/ +/*#define PWGECOS /**/ /* PRIVLIB: * This symbol contains the name of the private library for this package. @@ -1745,6 +1774,37 @@ #define PRIVLIB "c:\\perl5004.5x\\lib" /**/ #define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/ +/* 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", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "USR3", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/ +#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 16, 17, 18, 20, 21, 22, 23, 25, 18, 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 @@ -1885,37 +1945,6 @@ */ #define Select_fd_set_t Perl_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", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "USR3", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/ -#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 16, 17, 18, 20, 21, 22, 23, 25, 18, 0 /**/ - /* ARCHNAME: * This symbol holds a string representing the architecture name. * It may be used to construct an architecture-dependant pathname @@ -1929,7 +1958,13 @@ * routine is available to yield the execution of the current * thread. */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. + */ /*#define HAS_PTHREAD_YIELD /**/ +/*#define HAS_SCHED_YIELD /**/ /* PTHREADS_CREATED_JOINABLE: * This symbol, if defined, indicates that pthreads are created diff --git a/win32/config_H.gc b/win32/config_H.gc index 44aafe7c4c..369ac61c10 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -757,7 +757,7 @@ * This symbol, if defined, indicates that the tzname[] array is * available to access timezone names. */ -#define HAS_TZNAME /**/ +/*#define HAS_TZNAME /**/ /* HAS_UMASK: * This symbol, if defined, indicates that the umask routine is @@ -900,47 +900,6 @@ */ /*#define I_NETINET_IN /**/ -/* I_PWD: - * This symbol, if defined, indicates to the C program that it should - * include <pwd.h>. - */ -/* PWQUOTA: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_quota. - */ -/* PWAGE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_age. - */ -/* PWCHANGE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_change. - */ -/* PWCLASS: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_class. - */ -/* PWEXPIRE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_expire. - */ -/* PWGECOS: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_gecos. - */ -/* PWCOMMENT: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_comment. - */ -/*#define I_PWD /**/ -/*#define PWQUOTA /**/ -/*#define PWAGE /**/ -/*#define PWCHANGE /**/ -/*#define PWCLASS /**/ -/*#define PWEXPIRE /**/ -/*#define PWGECOS /**/ -/*#define PWCOMMENT /**/ - /* I_SFIO: * This symbol, if defined, indicates to the C program that it should * include <sfio.h>. @@ -1019,6 +978,12 @@ */ /*#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. @@ -1250,6 +1215,13 @@ */ #define HAS_ISASCII /**/ +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN /**/ + /* HAS_OPEN3: * This manifest constant lets the C program know that the three * argument form of open(2) is available. @@ -1699,6 +1671,28 @@ #define HAS_SOCKET /**/ /*#define HAS_SOCKETPAIR /**/ +/* HAS_UNION_SEMUN: + * This symbol, if defined, indicates that the union semun is + * defined by including <sys/sem.h>. If not, the user code + * probably needs to define it as: + * union semun { + * int val; + * struct semid_ds *buf; + * unsigned short *array; + * } + */ +/* USE_SEMCTL_SEMUN: + * This symbol, if defined, indicates that union semun is + * used for semctl IPC_STAT. + */ +/* USE_SEMCTL_SEMID_DS: + * This symbol, if defined, indicates that struct semid_ds * is + * used for semctl IPC_STAT. + */ +#define HAS_UNION_SEMUN /**/ +/*#define USE_SEMCTL_SEMUN /**/ +/*#define USE_SEMCTL_SEMID_DS /**/ + /* 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 @@ -1726,11 +1720,46 @@ */ /*#define I_NETDB /**/ -/* I_SYS_TYPES: +/* I_PWD: * This symbol, if defined, indicates to the C program that it should - * include <sys/types.h>. + * include <pwd.h>. */ -#define I_SYS_TYPES /**/ +/* PWQUOTA: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_quota. + */ +/* PWAGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_age. + */ +/* PWCHANGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_change. + */ +/* PWCLASS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_class. + */ +/* PWEXPIRE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_expire. + */ +/* PWCOMMENT: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_comment. + */ +/* PWGECOS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_gecos. + */ +/*#define I_PWD /**/ +/*#define PWQUOTA /**/ +/*#define PWAGE /**/ +/*#define PWCHANGE /**/ +/*#define PWCLASS /**/ +/*#define PWEXPIRE /**/ +/*#define PWCOMMENT /**/ +/*#define PWGECOS /**/ /* PRIVLIB: * This symbol contains the name of the private library for this package. @@ -1745,6 +1774,37 @@ #define PRIVLIB "c:\\perl5004.5x\\lib" /**/ #define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/ +/* 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", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/ +#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 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 @@ -1885,37 +1945,6 @@ */ #define Select_fd_set_t Perl_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", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/ -#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0 /**/ - /* ARCHNAME: * This symbol holds a string representing the architecture name. * It may be used to construct an architecture-dependant pathname @@ -1929,7 +1958,13 @@ * routine is available to yield the execution of the current * thread. */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. + */ /*#define HAS_PTHREAD_YIELD /**/ +/*#define HAS_SCHED_YIELD /**/ /* PTHREADS_CREATED_JOINABLE: * This symbol, if defined, indicates that pthreads are created diff --git a/win32/config_H.vc b/win32/config_H.vc index 07e6e235c5..4d49a5512b 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -900,47 +900,6 @@ */ /*#define I_NETINET_IN /**/ -/* I_PWD: - * This symbol, if defined, indicates to the C program that it should - * include <pwd.h>. - */ -/* PWQUOTA: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_quota. - */ -/* PWAGE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_age. - */ -/* PWCHANGE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_change. - */ -/* PWCLASS: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_class. - */ -/* PWEXPIRE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_expire. - */ -/* PWGECOS: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_gecos. - */ -/* PWCOMMENT: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_comment. - */ -/*#define I_PWD /**/ -/*#define PWQUOTA /**/ -/*#define PWAGE /**/ -/*#define PWCHANGE /**/ -/*#define PWCLASS /**/ -/*#define PWEXPIRE /**/ -/*#define PWGECOS /**/ -/*#define PWCOMMENT /**/ - /* I_SFIO: * This symbol, if defined, indicates to the C program that it should * include <sfio.h>. @@ -1019,6 +978,12 @@ */ /*#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. @@ -1250,6 +1215,13 @@ */ #define HAS_ISASCII /**/ +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN /**/ + /* HAS_OPEN3: * This manifest constant lets the C program know that the three * argument form of open(2) is available. @@ -1699,6 +1671,28 @@ #define HAS_SOCKET /**/ /*#define HAS_SOCKETPAIR /**/ +/* HAS_UNION_SEMUN: + * This symbol, if defined, indicates that the union semun is + * defined by including <sys/sem.h>. If not, the user code + * probably needs to define it as: + * union semun { + * int val; + * struct semid_ds *buf; + * unsigned short *array; + * } + */ +/* USE_SEMCTL_SEMUN: + * This symbol, if defined, indicates that union semun is + * used for semctl IPC_STAT. + */ +/* USE_SEMCTL_SEMID_DS: + * This symbol, if defined, indicates that struct semid_ds * is + * used for semctl IPC_STAT. + */ +#define HAS_UNION_SEMUN /**/ +/*#define USE_SEMCTL_SEMUN /**/ +/*#define USE_SEMCTL_SEMID_DS /**/ + /* 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 @@ -1726,11 +1720,46 @@ */ /*#define I_NETDB /**/ -/* I_SYS_TYPES: +/* I_PWD: * This symbol, if defined, indicates to the C program that it should - * include <sys/types.h>. + * include <pwd.h>. */ -#define I_SYS_TYPES /**/ +/* PWQUOTA: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_quota. + */ +/* PWAGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_age. + */ +/* PWCHANGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_change. + */ +/* PWCLASS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_class. + */ +/* PWEXPIRE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_expire. + */ +/* PWCOMMENT: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_comment. + */ +/* PWGECOS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_gecos. + */ +/*#define I_PWD /**/ +/*#define PWQUOTA /**/ +/*#define PWAGE /**/ +/*#define PWCHANGE /**/ +/*#define PWCLASS /**/ +/*#define PWEXPIRE /**/ +/*#define PWCOMMENT /**/ +/*#define PWGECOS /**/ /* PRIVLIB: * This symbol contains the name of the private library for this package. @@ -1745,6 +1774,37 @@ #define PRIVLIB "c:\\perl5004.5x\\lib" /**/ #define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/ +/* 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", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/ +#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 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 @@ -1885,37 +1945,6 @@ */ #define Select_fd_set_t Perl_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", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/ -#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0 /**/ - /* ARCHNAME: * This symbol holds a string representing the architecture name. * It may be used to construct an architecture-dependant pathname @@ -1929,7 +1958,13 @@ * routine is available to yield the execution of the current * thread. */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. + */ /*#define HAS_PTHREAD_YIELD /**/ +/*#define HAS_SCHED_YIELD /**/ /* PTHREADS_CREATED_JOINABLE: * This symbol, if defined, indicates that pthreads are created diff --git a/win32/makefile.mk b/win32/makefile.mk index 872ab835d3..8dad7063cd 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -712,7 +712,7 @@ $(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) $(LINK32) -Tpe -ap $(LINK_FLAGS) \ @$(mktmp c0x32$(o) $(PERLEXE_OBJ:s,\,\\)\n \ $(@:s,\,\\),\n \ - $(LIBFILES) $(PERLIMPLIB)\n) + $(PERLIMPLIB) $(LIBFILES)\n) .ELIF "$(CCTYPE)" == "GCC" $(LINK32) -o $@ $(LINK_FLAGS) \ $(PERLEXE_OBJ) $(PERLIMPLIB) $(LIBFILES) diff --git a/win32/win32.h b/win32/win32.h index ceee4fe8b6..032b196698 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -57,7 +57,6 @@ typedef long long __int64; #ifdef WIN32_LEAN_AND_MEAN /* C file is NOT a Perl5 original. */ #define CONTEXT PERL_CONTEXT /* Avoid conflict of CONTEXT defs. */ -#define index strchr /* Why 'index'? */ #endif /*WIN32_LEAN_AND_MEAN */ #include <dirent.h> diff --git a/x2p/util.c b/x2p/util.c index 0c6f99f795..364dfe94fa 100644 --- a/x2p/util.c +++ b/x2p/util.c @@ -13,9 +13,7 @@ #include "INTERN.h" #include "util.h" -#ifdef I_STDARG -# include <stdarg.h> -#endif +#include <stdarg.h> #define FLUSH static char nomem[] = "Out of memory!\n"; @@ -178,16 +176,9 @@ growstr(char **strptr, int *curlen, int newlen) } void -#if defined(I_STDARG) && defined(HAS_VPRINTF) croak(char *pat,...) -#else /* I_STDARG */ -/*VARARGS1*/ -croak(pat,a1,a2,a3,a4) - char *pat; - int a1,a2,a3,a4; -#endif /* I_STDARG */ { -#if defined(I_STDARG) && defined(HAS_VPRINTF) +#if defined(HAS_VPRINTF) va_list args; va_start(args, pat); @@ -199,16 +190,9 @@ croak(pat,a1,a2,a3,a4) } void -#if defined(I_STDARG) && defined(HAS_VPRINTF) fatal(char *pat,...) -#else /* I_STDARG */ -/*VARARGS1*/ -fatal(pat,a1,a2,a3,a4) - char *pat; - int a1,a2,a3,a4; -#endif /* I_STDARG */ { -#if defined(I_STDARG) && defined(HAS_VPRINTF) +#if defined(HAS_VPRINTF) va_list args; va_start(args, pat); @@ -220,16 +204,9 @@ fatal(pat,a1,a2,a3,a4) } void -#if defined(I_STDARG) && defined(HAS_VPRINTF) warn(char *pat,...) -#else /* I_STDARG */ -/*VARARGS1*/ -warn(pat,a1,a2,a3,a4) - char *pat; - int a1,a2,a3,a4; -#endif /* I_STDARG */ { -#if defined(I_STDARG) && defined(HAS_VPRINTF) +#if defined(HAS_VPRINTF) va_list args; va_start(args, pat); diff --git a/x2p/util.h b/x2p/util.h index ff93e8ac7a..aa31bea217 100644 --- a/x2p/util.h +++ b/x2p/util.h @@ -28,15 +28,9 @@ void growstr _(( char **strptr, int *curlen, int newlen )); char * instr _(( char *big, char *little )); char * safecpy _(( char *to, char *from, int len )); char * savestr _(( char *str )); -#if defined(I_STDARG) && defined(HAS_VPRINTF) void croak _(( char *pat, ... )); void fatal _(( char *pat, ... )); void warn _(( char *pat, ... )); -#else /* defined(I_STDARG) && defined(HAS_VPRINTF) */ -void croak _(( char *pat, int a1, int a2, int a3, int a4 )); -void Myfatal (); -void warn (); -#endif /* defined(I_STDARG) && defined(HAS_VPRINTF) */ int prewalk _(( int numit, int level, int node, int *numericptr )); Malloc_t safemalloc _((MEM_SIZE nbytes)); |