From: Nick Ing-Simmons Date: Sat, 2 Jun 2001 07:38:33 +0000 (+0000) Subject: Integrate mainline X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=111cb5dec87a3a29d4527c0824eb994817f8d02f;p=p5sagit%2Fp5-mst-13.2.git Integrate mainline p4raw-id: //depot/perlio@10386 --- diff --git a/Changes b/Changes index 4148fb9..5517680 100644 --- a/Changes +++ b/Changes @@ -31,6 +31,169 @@ or any other branch. Version v5.7.1 Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 10380] By: jhi on 2001/06/01 16:19:18 + Log: Subject: [PATCH] Re: [ID 20010529.004] program doesn't work unless in debug mode + From: Mike Guy + Date: Fri, 01 Jun 2001 18:17:02 +0100 + Message-Id: + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 10379] By: jhi on 2001/06/01 16:13:28 + Log: Subject: Re: [ID 20010529.006] String plus zero inconsistent across platforms + From: Hugo + Date: Thu, 31 May 2001 20:49:48 +0100 + Message-Id: <200105311949.UAA02798@crypt.compulink.co.uk> + Branch: perl + ! embed.h embed.pl global.sym objXSUB.h perl.h perlapi.c proto.h + ! util.c +____________________________________________________________________________ +[ 10378] By: jhi on 2001/06/01 15:56:35 + Log: Zero() is not available in x2p (or, rather, some of its + implementations like memzero() might not be available.) + Branch: perl + ! x2p/hash.c +____________________________________________________________________________ +[ 10377] By: jhi on 2001/06/01 15:44:48 + Log: Subject: [PATCH x2p/hash.c] bzero -> memset + From: Michael G Schwern + Date: Fri, 1 Jun 2001 12:00:29 +0100 + Message-ID: <20010601120029.F29027@blackrider.blackstar.co.uk> + + (But use Zero() instead of memset.) + Branch: perl + ! x2p/hash.c +____________________________________________________________________________ +[ 10376] By: jhi on 2001/06/01 15:39:52 + Log: Subject: Re: [PATCHES] regcomp.c, pod/perldiag.pod, t/op/pat.t + From: Jeff Pinyan + Date: Fri, 1 Jun 2001 10:33:55 -0400 (EDT) + Message-ID: + Branch: perl + ! pod/perldiag.pod regcomp.c t/op/pat.t +____________________________________________________________________________ +[ 10375] By: jhi on 2001/06/01 15:36:35 + Log: Retract #10324 and #10333; not needed. + Branch: perl + ! hints/irix_6.sh hints/linux.sh +____________________________________________________________________________ +[ 10374] By: jhi on 2001/06/01 15:35:19 + Log: The #10370 wasn't quite right. + Branch: perl + ! ext/XS/Typemap/Typemap.xs +____________________________________________________________________________ +[ 10373] By: jhi on 2001/06/01 15:34:49 + Log: The metaconfig units changes for #10372. + Branch: metaconfig/U/perl + + d_realpath.U d_sresgproto.U d_sresuproto.U + ! gccvers.U i_db.U +____________________________________________________________________________ +[ 10372] By: jhi on 2001/06/01 15:34:24 + Log: Configure tweaks; record the Berkeley DB version, + probe for realpath(), for setresuid() and setresgid() + prototypes; use realpath() (try to be paranoid enough), + use the setres[ug]id prototypes because glibc has the functions + but not their prototypes; add -Wall -ansi to gcc ccflags; + regen toc. + Branch: perl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH configure.com epoc/config.sh + ! ext/DB_File/DB_File.xs perl.h pod/perlapi.pod pod/perltoc.pod + ! uconfig.h uconfig.sh util.c vos/config.alpha.def + ! vos/config.ga.def win32/config.bc win32/config.gc + ! win32/config.vc +____________________________________________________________________________ +[ 10371] By: jhi on 2001/06/01 12:50:05 + Log: Subject: Re: [PATCH xsutils.c] Quieting warnings + From: Michael G Schwern + Date: Fri, 1 Jun 2001 11:28:14 +0100 + Message-ID: <20010601112814.B29027@blackrider.blackstar.co.uk> + Branch: perl + ! lib/attributes.pm xsutils.c +____________________________________________________________________________ +[ 10370] By: jhi on 2001/06/01 12:48:55 + Log: Subject: [PATCH] Fix -Wall on XS::Typemap + From: Tim Jenness + Date: Thu, 31 May 2001 16:15:37 -1000 (HST) + Message-ID: + Branch: perl + ! ext/XS/Typemap/Typemap.xs +____________________________________________________________________________ +[ 10369] By: jhi on 2001/06/01 12:47:21 + Log: Subject: [patch] Cwd.xs optimizations/abstraction + From: Doug MacEachern + Date: Thu, 31 May 2001 17:37:37 -0700 (PDT) + Message-ID: + Branch: perl + ! embed.h embed.pl ext/Cwd/Cwd.xs global.sym lib/Cwd.pm + ! objXSUB.h perlapi.c pod/perlapi.pod proto.h util.c +____________________________________________________________________________ +[ 10368] By: jhi on 2001/06/01 12:32:00 + Log: Subject: Re: Why t/lib/extutils.t is failing (was Re: [PATCH] Re: [PATCH] Re: [SPAM] Re: [SPAM] Re: [EGGS] Re: [BACON] Re: [TOAST] Re: [PATCH] Re: [PATCH] Re: h2xs [was Re: HEAR YE, HEAR YE!]) + From: Nicholas Clark + Date: Thu, 31 May 2001 23:56:40 +0100 + Message-ID: <20010531235640.F12698@plum.flirble.org> + + Make the test work also under only static extensions + (sh Configure -Uusedl fakes this nicely) + Branch: perl + ! t/lib/extutils.t +____________________________________________________________________________ +[ 10367] By: jhi on 2001/06/01 12:27:53 + Log: Subject: [PATCH hv.c] Eliminating trigraph + From: Michael G Schwern + Message-ID: <20010601114955.E29027@blackrider.blackstar.co.uk> + Date: Fri, 1 Jun 2001 11:49:56 +0100 + Branch: perl + ! hv.c +____________________________________________________________________________ +[ 10366] By: jhi on 2001/06/01 12:14:57 + Log: Subject: Re: [PATCH] Tests for File::Compare + From: "Philip Newton" + Date: Thu, 31 May 2001 19:44:05 +0200 + Message-Id: <200105311748.f4VHmCt18269@chaos.wustl.edu> + + Unnecessary "quotation marks". + Branch: perl + ! t/lib/filecomp.t +____________________________________________________________________________ +[ 10365] By: jhi on 2001/06/01 12:13:26 + Log: Integrate perlio. + Branch: perl + !> lib/ExtUtils/MM_Win32.pm t/lib/filecomp.t +____________________________________________________________________________ +[ 10364] By: nick on 2001/06/01 10:13:31 + Log: Cleanup dll.base and dll.exp created by GCC builds. + Branch: perlio + ! lib/ExtUtils/MM_Win32.pm +____________________________________________________________________________ +[ 10363] By: nick on 2001/06/01 10:02:17 + Log: Make filecomp test work on CRLF platforms by adding binmode. + Branch: perlio + ! t/lib/filecomp.t +____________________________________________________________________________ +[ 10362] By: nick on 2001/06/01 08:37:17 + Log: Integrate mainline + Branch: perlio + !> Changes Configure patchlevel.h perlio.c +____________________________________________________________________________ +[ 10361] By: jhi on 2001/05/31 15:09:34 + Log: panic:claustrophobia. + Branch: perl + ! perlio.c +____________________________________________________________________________ +[ 10360] By: jhi on 2001/05/31 13:04:25 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 10359] By: nick on 2001/05/31 12:35:50 + Log: Integrate mainline. + Branch: perlio + +> t/lib/filecomp.t + !> AUTHORS MANIFEST ext/Storable/Storable.xs gv.c perl.c perl.h + !> pp_ctl.c sv.c t/lib/1_compile.t toke.c util.c +____________________________________________________________________________ [ 10358] By: jhi on 2001/05/31 12:35:05 Log: Integrate perlio. Branch: perl @@ -190,9 +353,10 @@ ____________________________________________________________________________ ! t/op/cmp.t ____________________________________________________________________________ [ 10336] By: jhi on 2001/05/30 23:18:48 - Log: It's is not, it isn't ain't, and it's it's, not its, if you mean it - is. If you don't, it's its. Then too, it's hers. It isn't her's. It - isn't our's either. It's ours, and likewise yours and theirs. + Log: It's is not, it isn't ain't, and it's it's, not its, + if you mean it is. If you don't, it's its. Then too, + it's hers. It isn't her's. It isn't our's either. + It's ours, and likewise yours and theirs. -- Oxford University Press, Edpress News Branch: perl ! lib/autouse.pm @@ -218,7 +382,9 @@ ____________________________________________________________________________ ! perl.c t/run/runenv.t ____________________________________________________________________________ [ 10333] By: jhi on 2001/05/30 22:25:02 - Log: IRIX hints patch from Merijn Broeren. + Log: (Retracted by #10375.) + + IRIX hints patch from Merijn Broeren. TODO: (this and the earlier Linux hints patch) should be solved at Configure level. Merijn: -ldb should not be used on any platform @@ -277,7 +443,9 @@ ____________________________________________________________________________ ! win32/config.gc win32/config.vc ____________________________________________________________________________ [ 10324] By: jhi on 2001/05/30 13:49:44 - Log: Linux DB tweak from Merijn Broeren . + Log: (Retracted by #10375.) + + Linux DB tweak from Merijn Broeren . Branch: perl ! hints/linux.sh ____________________________________________________________________________ @@ -505,12 +673,17 @@ ____________________________________________________________________________ ! ext/POSIX/Makefile.PL ____________________________________________________________________________ [ 10294] By: jhi on 2001/05/29 15:53:43 - Log: Syncing with Test::Harness 1.21, from Michael G Schwern + Log: Subject: [PATCH lib/Test/Harness.pm t/lib/test-harness.t] Syncing with 1.21 + From: Michael G Schwern + Date: Tue, 29 May 2001 09:53:29 +0100 + Message-ID: <20010529095329.T675@blackrider.blackstar.co.uk> + (#10280 retracted) Branch: perl ! lib/Test/Harness.pm t/lib/test-harness.t ____________________________________________________________________________ [ 10293] By: jhi on 2001/05/29 15:46:10 + Log: Subject: [PATCH t/TEST lib/Test.pm t/lib/Test/*.t] Syncing with Test-1.17 From: Michael G Schwern Date: Tue, 29 May 2001 09:19:52 +0100 diff --git a/Configure b/Configure index f31fb96..89c9ae5 100755 --- a/Configure +++ b/Configure @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Thu May 31 16:30:15 EET DST 2001 [metaconfig 3.0 PL70] +# Generated on Fri Jun 1 19:20:32 EET DST 2001 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.org) cat >c1$$ <&4 @@ -11049,6 +11063,10 @@ eval $inlibc set readv d_readv eval $inlibc +: see if realpath exists +set realpath d_realpath +eval $inlibc + : see if recvmsg exists set recvmsg d_recvmsg eval $inlibc @@ -11864,6 +11882,11 @@ eval $inlibc set socks5_init d_socks5_init eval $inlibc +: see if prototype for setresuid is available +echo " " +set d_sresuproto setresuid $i_unistd unistd.h +eval $hasproto + : see if sys/stat.h is available set sys/stat.h i_sysstat eval $inhdr @@ -13012,13 +13035,19 @@ $define) #include #include #include -int main() +int main(int argc, char *argv[]) { #ifdef DB_VERSION_MAJOR /* DB version >= 2 */ int Major, Minor, Patch ; unsigned long Version ; (void)db_version(&Major, &Minor, &Patch) ; - printf("You have Berkeley DB Version 2 or greater\n"); + if (argc == 2) { + printf("%d %d %d %d %d %d\n", + DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH, + Major, Minor, Patch); + exit(0); + } + printf("You have Berkeley DB Version 2 or greater.\n"); printf("db.h is from Berkeley DB Version %d.%d.%d\n", DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH); @@ -13027,11 +13056,11 @@ int main() /* check that db.h & libdb are compatible */ if (DB_VERSION_MAJOR != Major || DB_VERSION_MINOR != Minor || DB_VERSION_PATCH != Patch) { - printf("db.h and libdb are incompatible\n") ; + printf("db.h and libdb are incompatible.\n") ; exit(3); } - printf("db.h and libdb are compatible\n") ; + printf("db.h and libdb are compatible.\n") ; Version = DB_VERSION_MAJOR * 1000000 + DB_VERSION_MINOR * 1000 + DB_VERSION_PATCH ; @@ -13039,14 +13068,18 @@ int main() /* needs to be >= 2.3.4 */ if (Version < 2003004) { /* if (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && DB_VERSION_PATCH < 5) { */ - printf("but Perl needs Berkeley DB 2.3.4 or greater\n") ; + printf("Perl needs Berkeley DB 2.3.4 or greater.\n") ; exit(2); } exit(0); #else #if defined(_DB_H_) && defined(BTREEMAGIC) && defined(HASHMAGIC) - printf("You have Berkeley DB Version 1\n"); + if (argc == 2) { + printf("1 0 0\n"); + exit(0); + } + printf("You have Berkeley DB Version 1.\n"); exit(0); /* DB version < 2: the coast is clear. */ #else exit(1); /* not Berkeley DB? */ @@ -13057,6 +13090,10 @@ EOCP set try if eval $compile_ok && ./try; then echo 'Looks OK.' >&4 + set `./try 1` + db_version_major=$1 + db_version_minor=$2 + db_version_patch=$3 else echo "I can't use Berkeley DB with your . I'll disable Berkeley DB." >&4 i_db=$undef @@ -16360,6 +16397,7 @@ d_quad='$d_quad' d_readdir='$d_readdir' d_readlink='$d_readlink' d_readv='$d_readv' +d_realpath='$d_realpath' d_recvmsg='$d_recvmsg' d_rename='$d_rename' d_rewinddir='$d_rewinddir' @@ -16420,6 +16458,7 @@ d_socklen_t='$d_socklen_t' d_sockpair='$d_sockpair' d_socks5_init='$d_socks5_init' d_sqrtl='$d_sqrtl' +d_sresuproto='$d_sresuproto' d_statblks='$d_statblks' d_statfs_f_flags='$d_statfs_f_flags' d_statfs_s='$d_statfs_s' @@ -16486,6 +16525,9 @@ d_xenix='$d_xenix' date='$date' db_hashtype='$db_hashtype' db_prefixtype='$db_prefixtype' +db_version_major='$db_version_major' +db_version_minor='$db_version_minor' +db_version_patch='$db_version_patch' defvoidused='$defvoidused' direntrytype='$direntrytype' dlext='$dlext' diff --git a/Porting/Glossary b/Porting/Glossary index 4f7aa8e..d903a74 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -1244,6 +1244,10 @@ d_readv (d_readv.U): This variable conditionally defines the HAS_READV symbol, which indicates to the C program that the readv() routine is available. +d_realpath (d_realpath.U): + This variable conditionally defines the HAS_REALPATH symbol, which + indicates to the C program that the realpath() routine is available. + d_recvmsg (d_recvmsg.U): This variable conditionally defines the HAS_RECVMSG symbol, which indicates to the C program that the recvmsg() routine is available. @@ -1513,6 +1517,12 @@ d_sqrtl (d_sqrtl.U): This variable conditionally defines the HAS_SQRTL symbol, which indicates to the C program that the sqrtl() routine is available. +d_sresuproto (d_sresuproto.U): + This variable conditionally defines the HAS_SETRESUID_PROTO symbol, + which indicates to the C program that the system provides + a prototype for the setresuid() function. Otherwise, it is + up to the program to supply one. + d_statblks (d_statblks.U): This variable conditionally defines USE_STAT_BLOCKS if this system has a stat structure declaring @@ -1806,6 +1816,20 @@ db_prefixtype (i_db.U): in the header file. In older versions of DB, it was int, while in newer ones it is size_t. +db_version_major (i_db.U): + This variable contains the major version number of + Berkeley DB found in the header file. + +db_version_minor (i_db.U): + This variable contains the minor version number of + Berkeley DB found in the header file. + For DB version 1 this is always 0. + +db_version_patch (i_db.U): + This variable contains the patch version number of + Berkeley DB found in the header file. + For DB version 1 this is always 0. + defvoidused (voidflags.U): This variable contains the default value of the VOIDUSED symbol (15). diff --git a/Porting/config.sh b/Porting/config.sh index ca43a3c..69cb395 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -8,7 +8,7 @@ # Package name : perl5 # Source directory : . -# Configuration time: Wed May 30 17:57:39 EET DST 2001 +# Configuration time: Fri Jun 1 18:23:33 EET DST 2001 # Configured by : jhi # Target system : osf1 alpha.hut.fi v4.0 878 alpha @@ -63,7 +63,7 @@ ccsymbols='__alpha=1 __LANGUAGE_C__=1 __osf__=1 __unix__=1 _LONGLONG=1 _SYSTYPE_ ccversion='V5.6-082' cf_by='jhi' cf_email='yourname@yourhost.yourplace.com' -cf_time='Wed May 30 17:57:39 EET DST 2001' +cf_time='Fri Jun 1 18:23:33 EET DST 2001' charsize='1' chgrp='' chmod='' @@ -285,6 +285,7 @@ d_quad='define' d_readdir='define' d_readlink='define' d_readv='define' +d_realpath='define' d_recvmsg='define' d_rename='define' d_rewinddir='define' @@ -345,6 +346,7 @@ d_socklen_t='undef' d_sockpair='define' d_socks5_init='undef' d_sqrtl='define' +d_sresuproto='undef' d_statblks='define' d_statfs_f_flags='define' d_statfs_s='define' @@ -411,6 +413,9 @@ d_xenix='undef' date='date' db_hashtype='u_int32_t' db_prefixtype='size_t' +db_version_major='1' +db_version_minor='0' +db_version_patch='0' defvoidused='15' direntrytype='struct dirent' dlext='so' @@ -658,7 +663,7 @@ patchlevel='7' path_sep=':' perl5='/u/vieraat/vieraat/jhi/Perl/bin/perl' perl='' -perl_patchlevel='10297' +perl_patchlevel='10358' perladmin='yourname@yourhost.yourplace.com' perllibs='-lm -liconv -lutil -lpthread -lexc' perlpath='/opt/perl/bin/perl' @@ -853,7 +858,7 @@ PERL_SUBVERSION=1 PERL_API_REVISION=5 PERL_API_VERSION=5 PERL_API_SUBVERSION=0 -PERL_PATCHLEVEL=10297 +PERL_PATCHLEVEL=10358 PERL_CONFIG_SH=true # Variables propagated from previous config.sh file. pp_sys_cflags='ccflags="$ccflags -DNO_EFF_ONLY_OK"' diff --git a/Porting/config_H b/Porting/config_H index 6efeb63..da74ef0 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -17,7 +17,7 @@ /* * Package name : perl5 * Source directory : . - * Configuration time: Wed May 30 17:57:39 EET DST 2001 + * Configuration time: Fri Jun 1 18:23:33 EET DST 2001 * Configured by : jhi * Target system : osf1 alpha.hut.fi v4.0 878 alpha */ @@ -3319,6 +3319,12 @@ #define PERL_XS_APIVERSION "5.7.1" #define PERL_PM_APIVERSION "5.005" +/* HAS_REALPATH: + * This symbol, if defined, indicates that the realpath routine is + * available to do resolve paths. + */ +#define HAS_REALPATH /**/ + /* HAS_SIGPROCMASK: * This symbol, if defined, indicates that the sigprocmask * system call is available to examine or change the signal mask @@ -3332,6 +3338,14 @@ */ /*#define HAS_SOCKATMARK / **/ +/* HAS_SETRESUID_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the setresuid() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern int setresuid(uid_t ruid, uid_t euid, uid_t suid); + */ +/*#define HAS_SETRESUID_PROTO / **/ + /* HAS_STRFTIME: * This symbol, if defined, indicates that the strftime routine is * available to do time formatting. diff --git a/config_h.SH b/config_h.SH index c0a9146..328ad4b 100644 --- a/config_h.SH +++ b/config_h.SH @@ -2431,8 +2431,25 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un * in the header file. In older versions of DB, it was * int, while in newer ones it is size_t. */ +/* DB_VERSION_MAJOR_CFG: + * This symbol, if defined, defines the major version number of + * Berkeley DB found in the header when Perl was configured. + */ +/* DB_VERSION_MINOR_CFG: + * This symbol, if defined, defines the minor version number of + * Berkeley DB found in the header when Perl was configured. + * For DB version 1 this is always 0. + */ +/* DB_VERSION_PATCH_CFG: + * This symbol, if defined, defines the patch version number of + * Berkeley DB found in the header when Perl was configured. + * For DB version 1 this is always 0. + */ #define DB_Hash_t $db_hashtype /**/ #define DB_Prefix_t $db_prefixtype /**/ +#define DB_VERSION_MAJOR_CFG $db_version_major /**/ +#define DB_VERSION_MINOR_CFG $db_version_minor /**/ +#define DB_VERSION_PATCH_CFG $db_version_patch /**/ /* I_GRP: * This symbol, if defined, indicates to the C program that it should @@ -3339,6 +3356,12 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un #define PERL_XS_APIVERSION "$xs_apiversion" #define PERL_PM_APIVERSION "$pm_apiversion" +/* HAS_REALPATH: + * This symbol, if defined, indicates that the realpath routine is + * available to do resolve paths. + */ +#$d_realpath HAS_REALPATH /**/ + /* HAS_SIGPROCMASK: * This symbol, if defined, indicates that the sigprocmask * system call is available to examine or change the signal mask @@ -3352,6 +3375,14 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un */ #$d_sockatmark HAS_SOCKATMARK /**/ +/* HAS_SETRESUID_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the setresuid() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern int setresuid(uid_t ruid, uid_t euid, uid_t suid); + */ +#$d_sresuproto HAS_SETRESUID_PROTO /**/ + /* HAS_STRFTIME: * This symbol, if defined, indicates that the strftime routine is * available to do time formatting. diff --git a/configure.com b/configure.com index 3beba69..03a9465 100644 --- a/configure.com +++ b/configure.com @@ -5197,6 +5197,8 @@ $ WC "d_setproctitle='" + d_setproctitle + "'" $ WC "d_setpwent='define'" $ WC "d_setregid='undef'" $ WC "d_setresgid='undef'" +$ WC "d_sresproto='undef'" +$ WC "d_sresgproto='undef'" $ WC "d_setresuid='undef'" $ WC "d_setreuid='undef'" $ WC "d_setrgid='undef'" diff --git a/embed.h b/embed.h index 4acb7f3..dd0097c 100644 --- a/embed.h +++ b/embed.h @@ -668,6 +668,7 @@ #define sv_collxfrm Perl_sv_collxfrm #endif #define sv_compile_2op Perl_sv_compile_2op +#define sv_getcwd Perl_sv_getcwd #define sv_dec Perl_sv_dec #define sv_dump Perl_sv_dump #define sv_derived_from Perl_sv_derived_from @@ -691,6 +692,7 @@ #define sv_pos_b2u Perl_sv_pos_b2u #define sv_pvutf8n_force Perl_sv_pvutf8n_force #define sv_pvbyten_force Perl_sv_pvbyten_force +#define sv_realpath Perl_sv_realpath #define sv_reftype Perl_sv_reftype #define sv_replace Perl_sv_replace #define sv_report_used Perl_sv_report_used @@ -1176,6 +1178,7 @@ #define sv_utf8_upgrade_flags Perl_sv_utf8_upgrade_flags #define sv_pvn_force_flags Perl_sv_pvn_force_flags #define sv_2pv_flags Perl_sv_2pv_flags +#define my_atof2 Perl_my_atof2 #define ck_anoncode Perl_ck_anoncode #define ck_bitop Perl_ck_bitop #define ck_concat Perl_ck_concat @@ -2163,6 +2166,7 @@ #define sv_collxfrm(a,b) Perl_sv_collxfrm(aTHX_ a,b) #endif #define sv_compile_2op(a,b,c,d) Perl_sv_compile_2op(aTHX_ a,b,c,d) +#define sv_getcwd(a) Perl_sv_getcwd(aTHX_ a) #define sv_dec(a) Perl_sv_dec(aTHX_ a) #define sv_dump(a) Perl_sv_dump(aTHX_ a) #define sv_derived_from(a,b) Perl_sv_derived_from(aTHX_ a,b) @@ -2186,6 +2190,7 @@ #define sv_pos_b2u(a,b) Perl_sv_pos_b2u(aTHX_ a,b) #define sv_pvutf8n_force(a,b) Perl_sv_pvutf8n_force(aTHX_ a,b) #define sv_pvbyten_force(a,b) Perl_sv_pvbyten_force(aTHX_ a,b) +#define sv_realpath(a,b,c) Perl_sv_realpath(aTHX_ a,b,c) #define sv_reftype(a,b) Perl_sv_reftype(aTHX_ a,b) #define sv_replace(a,b) Perl_sv_replace(aTHX_ a,b) #define sv_report_used() Perl_sv_report_used(aTHX) @@ -2663,6 +2668,7 @@ #define sv_utf8_upgrade_flags(a,b) Perl_sv_utf8_upgrade_flags(aTHX_ a,b) #define sv_pvn_force_flags(a,b,c) Perl_sv_pvn_force_flags(aTHX_ a,b,c) #define sv_2pv_flags(a,b,c) Perl_sv_2pv_flags(aTHX_ a,b,c) +#define my_atof2(a,b) Perl_my_atof2(aTHX_ a,b) #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) @@ -4249,6 +4255,8 @@ #endif #define Perl_sv_compile_2op CPerlObj::Perl_sv_compile_2op #define sv_compile_2op Perl_sv_compile_2op +#define Perl_sv_getcwd CPerlObj::Perl_sv_getcwd +#define sv_getcwd Perl_sv_getcwd #define Perl_sv_dec CPerlObj::Perl_sv_dec #define sv_dec Perl_sv_dec #define Perl_sv_dump CPerlObj::Perl_sv_dump @@ -4297,6 +4305,8 @@ #define sv_pvutf8n_force Perl_sv_pvutf8n_force #define Perl_sv_pvbyten_force CPerlObj::Perl_sv_pvbyten_force #define sv_pvbyten_force Perl_sv_pvbyten_force +#define Perl_sv_realpath CPerlObj::Perl_sv_realpath +#define sv_realpath Perl_sv_realpath #define Perl_sv_reftype CPerlObj::Perl_sv_reftype #define sv_reftype Perl_sv_reftype #define Perl_sv_replace CPerlObj::Perl_sv_replace @@ -5178,6 +5188,8 @@ #define sv_pvn_force_flags Perl_sv_pvn_force_flags #define Perl_sv_2pv_flags CPerlObj::Perl_sv_2pv_flags #define sv_2pv_flags Perl_sv_2pv_flags +#define Perl_my_atof2 CPerlObj::Perl_my_atof2 +#define my_atof2 Perl_my_atof2 #define Perl_ck_anoncode CPerlObj::Perl_ck_anoncode #define ck_anoncode Perl_ck_anoncode #define Perl_ck_bitop CPerlObj::Perl_ck_bitop diff --git a/embed.pl b/embed.pl index 91165b3..7c251bb 100755 --- a/embed.pl +++ b/embed.pl @@ -1136,7 +1136,7 @@ DOC: redo FUNC; } } else { - warn "$file:$line:$in"; + warn "$file:$line:$in (=cut missing?)"; } } } @@ -2029,6 +2029,7 @@ Apd |I32 |sv_cmp_locale |SV* sv1|SV* sv2 Ap |char* |sv_collxfrm |SV* sv|STRLEN* nxp #endif Ap |OP* |sv_compile_2op |SV* sv|OP** startp|char* code|AV** avp +Apd |int |sv_getcwd |SV* sv Apd |void |sv_dec |SV* sv Ap |void |sv_dump |SV* sv Apd |bool |sv_derived_from|SV* sv|const char* name @@ -2055,6 +2056,7 @@ Ap |void |sv_pos_b2u |SV* sv|I32* offsetp Aopd |char* |sv_pvn_force |SV* sv|STRLEN* lp Apd |char* |sv_pvutf8n_force|SV* sv|STRLEN* lp Ap |char* |sv_pvbyten_force|SV* sv|STRLEN* lp +Apd |int |sv_realpath |SV* sv|char *path|STRLEN len Apd |char* |sv_reftype |SV* sv|int ob Apd |void |sv_replace |SV* sv|SV* nsv Ap |void |sv_report_used @@ -2592,3 +2594,4 @@ Apd |void |sv_catsv_flags |SV* dsv|SV* ssv|I32 flags Apd |STRLEN |sv_utf8_upgrade_flags|SV *sv|I32 flags Apd |char* |sv_pvn_force_flags|SV* sv|STRLEN* lp|I32 flags Ap |char* |sv_2pv_flags |SV* sv|STRLEN* lp|I32 flags +Ap |char* |my_atof2 |const char *s|NV* value diff --git a/epoc/config.sh b/epoc/config.sh index 28959ce..8b4399a 100644 --- a/epoc/config.sh +++ b/epoc/config.sh @@ -312,6 +312,8 @@ d_setpwent='undef' d_setregid='undef' d_setresgid='undef' d_setresuid='undef' +d_sresproto='undef' +d_sresuproto='undef' d_setreuid='undef' d_setrgid='undef' d_setruid='undef' diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs index 872591d..7b36716 100644 --- a/ext/Cwd/Cwd.xs +++ b/ext/Cwd/Cwd.xs @@ -2,250 +2,36 @@ #include "perl.h" #include "XSUB.h" -/* Originally written in Perl by John Bazik; rewritten in C by Ben Sugars. - * Comments from the orignal: - * This is a faster version of getcwd. It's also more dangerous - * because you might chdir out of a directory that you can't chdir - * back into. */ -char * -_cwdxs_fastcwd(void) -{ -/* XXX Should we just use getcwd(3) if available? */ - struct stat statbuf; - int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino; - int i = 0, j = 0, k = 0, ndirs = 16, pathlen = 0, namelen; - DIR *dir; - Direntry_t *dp; - char **names, *path; - - Newz(0, names, ndirs, char*); - - if (PerlLIO_lstat(".", &statbuf) < 0) { - Safefree(names); - return FALSE; - } - orig_cdev = statbuf.st_dev; - orig_cino = statbuf.st_ino; - cdev = orig_cdev; - cino = orig_cino; - for (;;) { - odev = cdev; - oino = cino; - - if (PerlDir_chdir("..") < 0) { - Safefree(names); - return FALSE; - } - if (PerlLIO_stat(".", &statbuf) < 0) { - Safefree(names); - return FALSE; - } - cdev = statbuf.st_dev; - cino = statbuf.st_ino; - if (odev == cdev && oino == cino) - break; - - if (!(dir = PerlDir_open("."))) { - Safefree(names); - return FALSE; - } - - while ((dp = PerlDir_read(dir)) != NULL) { - if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) { - Safefree(names); - return FALSE; - } - if (strEQ(dp->d_name, ".")) - continue; - if (strEQ(dp->d_name, "..")) - continue; - tdev = statbuf.st_dev; - tino = statbuf.st_ino; - if (tino == oino && tdev == odev) - break; - } - - if (!dp) { - Safefree(names); - return FALSE; - } - - if (i >= ndirs) { - ndirs += 16; - Renew(names, ndirs, char*); - } -#ifdef DIRNAMLEN - namelen = dp->d_namlen; -#else - namelen = strlen(dp->d_name); -#endif - Newz(0, *(names + i), namelen + 1, char); - Copy(dp->d_name, *(names + i), namelen, char); - *(names[i] + namelen) = '\0'; - pathlen += (namelen + 1); - ++i; - -#ifdef VOID_CLOSEDIR - PerlDir_close(dir); -#else - if (PerlDir_close(dir) < 0) { - Safefree(names); - return FALSE; - } -#endif - } - - Newz(0, path, pathlen + 1, char); - for (j = i - 1; j >= 0; j--) { - *(path + k) = '/'; - Copy(names[j], path + k + 1, strlen(names[j]) + 1, char); - k = k + strlen(names[j]) + 1; - Safefree(names[j]); - } +MODULE = Cwd PACKAGE = Cwd - if (PerlDir_chdir(path) < 0) { - Safefree(names); - Safefree(path); - return FALSE; - } - if (PerlLIO_stat(".", &statbuf) < 0) { - Safefree(names); - Safefree(path); - return FALSE; - } - cdev = statbuf.st_dev; - cino = statbuf.st_ino; - if (cdev != orig_cdev || cino != orig_cino) - Perl_croak(aTHX_ "Unstable directory path, current directory changed unexpectedly"); +PROTOTYPES: ENABLE - Safefree(names); - return(path); +void +fastcwd() +PPCODE: +{ + dXSTARG; + sv_getcwd(TARG); + XSprePUSH; PUSHTARG; } -char * -_cwdxs_abs_path(char *start) +void +abs_path(svpath=Nullsv) + SV *svpath +PPCODE: { - DIR *parent; - Direntry_t *dp; - char dotdots[MAXPATHLEN] = { 0 }; - char name[MAXPATHLEN] = { 0 }; - char *cwd; - int namelen = 0; - struct stat cst, pst, tst; - - if (PerlLIO_stat(start, &cst) < 0) { - warn("abs_path: stat(\"%s\"): %s", start, Strerror(errno)); - return FALSE; - } - - Newz(0, cwd, MAXPATHLEN, char); - Copy(start, dotdots, strlen(start), char); - - for (;;) { - strcat(dotdots, "/.."); - StructCopy(&cst, &pst, struct stat); + dXSTARG; + char *path; + STRLEN len; - if (PerlLIO_stat(dotdots, &cst) < 0) { - Safefree(cwd); - warn("abs_path: stat(\"%s\"): %s", dotdots, Strerror(errno)); - return FALSE; + if (svpath) { + path = SvPV(svpath, len); } - - if (pst.st_dev == cst.st_dev && pst.st_ino == cst.st_ino) { - /* We've reached the root: previous is same as current */ - break; - } else { - STRLEN dotdotslen = strlen(dotdots); - - /* Scan through the dir looking for name of previous */ - if (!(parent = PerlDir_open(dotdots))) { - Safefree(cwd); - warn("abs_path: opendir(\"%s\"): %s", dotdots, Strerror(errno)); - return FALSE; - } - - SETERRNO(0,SS$_NORMAL); /* for readdir() */ - while ((dp = PerlDir_read(parent)) != NULL) { - if (strEQ(dp->d_name, ".")) - continue; - if (strEQ(dp->d_name, "..")) - continue; - - Copy(dotdots, name, dotdotslen, char); - name[dotdotslen] = '/'; -#ifdef DIRNAMLEN - namelen = dp->d_namlen; -#else - namelen = strlen(dp->d_name); -#endif - Copy(dp->d_name, name + dotdotslen + 1, namelen, char); - name[dotdotslen + 1 + namelen] = 0; - - if (PerlLIO_lstat(name, &tst) < 0) { - Safefree(cwd); - PerlDir_close(parent); - warn("abs_path: lstat(\"%s\"): %s", name, Strerror(errno)); - return FALSE; - } - - if (tst.st_dev == pst.st_dev && tst.st_ino == pst.st_ino) - break; - - SETERRNO(0,SS$_NORMAL); /* for readdir() */ - } - - - if (!dp && errno) { - warn("abs_path: readdir(\"%s\"): %s", dotdots, Strerror(errno)); - Safefree(cwd); - return FALSE; - } - - Move(cwd, cwd + namelen + 1, strlen(cwd), char); - Copy(dp->d_name, cwd + 1, namelen, char); -#ifdef VOID_CLOSEDIR - PerlDir_close(parent); -#else - if (PerlDir_close(parent) < 0) { - warn("abs_path: closedir(\"%s\"): %s", dotdots, Strerror(errno)); - Safefree(cwd); - return FALSE; - } -#endif - *cwd = '/'; + else { + path = "."; + len = 1; } - } - return cwd; + sv_realpath(TARG, path, len); + XSprePUSH; PUSHTARG; } - - -MODULE = Cwd PACKAGE = Cwd - -PROTOTYPES: ENABLE - -char * -_fastcwd() -PPCODE: - char * buf; - buf = _cwdxs_fastcwd(); - if (buf) { - PUSHs(sv_2mortal(newSVpv(buf, 0))); - Safefree(buf); - } - else - XSRETURN_UNDEF; - -char * -_abs_path(start = ".") - char * start -PREINIT: - char * buf; -PPCODE: - buf = _cwdxs_abs_path(start); - if (buf) { - PUSHs(sv_2mortal(newSVpv(buf, 0))); - Safefree(buf); - } - else - XSRETURN_UNDEF; diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index f84f550..8a9ce8a 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -118,10 +118,15 @@ # define DEFSV GvSV(defgv) #endif +/* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and + DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */ + /* Being the Berkeley DB we prefer the (which will be * shortly #included by the ) __attribute__ to the possibly * already defined __attribute__, for example by GNUC or by Perl. */ +#if DB_VERSION_MAJOR_CFG < 2 + #undef __attribute__ /* Since we dropped the gccish definition of __attribute__ we will want @@ -131,6 +136,8 @@ #undef dNOOP #define dNOOP extern int Perl___notused +#endif + /* If Perl has been compiled with Threads support,the symbol op will be defined here. This clashes with a field name in db.h, so get rid of it. */ diff --git a/ext/XS/Typemap/Typemap.xs b/ext/XS/Typemap/Typemap.xs index 5b1ab84..1901549 100644 --- a/ext/XS/Typemap/Typemap.xs +++ b/ext/XS/Typemap/Typemap.xs @@ -764,11 +764,12 @@ the subtype. intArray * T_ARRAY( dummy, array, ... ) - int dummy = NO_INIT + int dummy = 0; intArray * array PREINIT: U32 size_RETVAL; CODE: + dummy += 0; /* Fix -Wall */ size_RETVAL = ix_array; RETVAL = array; OUTPUT: diff --git a/global.sym b/global.sym index 17e3df3..b8bfb2c 100644 --- a/global.sym +++ b/global.sym @@ -410,6 +410,7 @@ Perl_sv_cmp Perl_sv_cmp_locale Perl_sv_collxfrm Perl_sv_compile_2op +Perl_sv_getcwd Perl_sv_dec Perl_sv_dump Perl_sv_derived_from @@ -433,6 +434,7 @@ Perl_sv_pos_b2u Perl_sv_pvn_force Perl_sv_pvutf8n_force Perl_sv_pvbyten_force +Perl_sv_realpath Perl_sv_reftype Perl_sv_replace Perl_sv_report_used @@ -577,3 +579,4 @@ Perl_sv_catsv_flags Perl_sv_utf8_upgrade_flags Perl_sv_pvn_force_flags Perl_sv_2pv_flags +Perl_my_atof2 diff --git a/hints/irix_6.sh b/hints/irix_6.sh index bac68c3..6f4ca17 100644 --- a/hints/irix_6.sh +++ b/hints/irix_6.sh @@ -282,20 +282,6 @@ set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' shift libswanted="$*" -# -# XXX -- This isn't right, since you still don't want perl itself -# linked with -ldb, even if you *do* build the DB_File extension. -# Linking perl with -ldb will prevent you from building the -# Sybase::DBlib extension, due to a conflict between dbopen() in both -# libdb.so and libsybdb.so. -# -case "$i_db" in -undef) - set `echo X "$libswanted "|sed -e 's/ db / /'` - shift - libswanted="$*" ;; -esac - cat > UU/usethreads.cbu <<'EOCBU' # This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. diff --git a/hints/linux.sh b/hints/linux.sh index b8aafd2..a6b2bd9 100644 --- a/hints/linux.sh +++ b/hints/linux.sh @@ -289,45 +289,3 @@ ccflags_uselargefiles="-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" ;; esac EOCBU - -# Change by wpm 10 April 2001 -# -# XXX -- This isn't right, since you still don't want perl itself -# linked with -ldb, even if you *do* build the DB_File extension. -# Linking perl with -ldb will prevent you from building the -# Sybase::DBlib extension, due to a conflict between dbopen() in both -# libdb.so and libsybdb.so. -# -case "$i_db" in -undef) - set `echo X "$libswanted "|sed -e 's/ db / /'` - shift - libswanted="$*" ;; -esac - -# -# XXX -- Same is true for libgdbm. This makes it hard for us to build -# our own GDBM_File. -# -case "$i_gdbm" in -undef) - set `echo X "$libswanted "|sed -e 's/ gdbm / /'` - shift - libswanted="$*" ;; -esac - -# -# XXX -- damn. We also need to strip ndbm as well because: -# -# mglnxcs01$ ls -al /usr/lib/*ndbm* -# lrwxrwxrwx 1 root wheel 7 Oct 4 2000 /usr/lib/libndbm.a -> libdb.a -# lrwxrwxrwx 1 root wheel 8 Oct 4 2000 /usr/lib/libndbm.so -> libdb.so -# -case "$i_db" in -undef) - set `echo X "$libswanted "|sed -e 's/ ndbm / /'` - shift - libswanted="$*" ;; -esac - - diff --git a/hv.c b/hv.c index 7058116..14b9682 100644 --- a/hv.c +++ b/hv.c @@ -504,7 +504,7 @@ parameter is the precomputed hash value; if it is zero then Perl will compute it. The return value is the new hash entry so created. It will be NULL if the operation failed or if the value did not need to be actually stored within the hash (as in the case of tied hashes). Otherwise the -contents of the return value can be accessed using the C macros +contents of the return value can be accessed using the C macros described here. Note that the caller is responsible for suitably incrementing the reference count of C before the call, and decrementing it if the function returned NULL. diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 4e4d39c..27a3105 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -85,8 +85,10 @@ use base qw/ Exporter /; our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); -# Indicates if the XS portion has been loaded or not -my $Booted = 0; +eval { + require XSLoader; + XSLoader::load('Cwd'); +}; # The 'natural and safe form' for UNIX (pwd may be setuid root) @@ -123,19 +125,6 @@ sub getcwd abs_path('.'); } -# Now a callout to an XSUB. We have to delay booting of the XSUB -# until the first time fastcwd is called since Cwd::cwd is needed in the -# building of perl when dynamic loading may be unavailable -sub fastcwd { - unless ($Booted) { - require XSLoader; - XSLoader::load("Cwd"); - ++$Booted; - } - return &Cwd::_fastcwd; -} - - # Keeps track of current working directory in PWD environment var # Usage: # use Cwd 'chdir'; @@ -206,17 +195,6 @@ sub chdir { 1; } -# Now a callout to an XSUB -sub abs_path -{ - unless ($Booted) { - require XSLoader; - XSLoader::load("Cwd"); - ++$Booted; - } - return &Cwd::_abs_path(@_); -} - # added function alias for those of us more # used to the libc function. --tchrist 27-Jan-00 *realpath = \&abs_path; diff --git a/lib/attributes.pm b/lib/attributes.pm index 3c8923f..28f7eee 100644 --- a/lib/attributes.pm +++ b/lib/attributes.pm @@ -27,7 +27,7 @@ sub carp { # # The extra trips through newATTRSUB in the interpreter wipe out any savings # from avoiding the BEGIN block. Just do the bootstrap now. -BEGIN { bootstrap } +BEGIN { bootstrap attributes } sub import { @_ > 2 && ref $_[2] or do { diff --git a/lib/perl5db.pl b/lib/perl5db.pl index ef1f89b..15a4af6 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -540,15 +540,13 @@ if ($notty) { $OUT = \*OUT; } - select($OUT); + my $previous = select($OUT); $| = 1; # for DB::OUT - select(STDOUT); + select($previous); $LINEINFO = $OUT unless defined $LINEINFO; $lineinfo = $console unless defined $lineinfo; - $| = 1; # for real STDOUT - $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/; unless ($runnonstop) { if ($term_pid eq '-1') { diff --git a/objXSUB.h b/objXSUB.h index c830fe1..d3ca527 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -1645,6 +1645,10 @@ #define Perl_sv_compile_2op pPerl->Perl_sv_compile_2op #undef sv_compile_2op #define sv_compile_2op Perl_sv_compile_2op +#undef Perl_sv_getcwd +#define Perl_sv_getcwd pPerl->Perl_sv_getcwd +#undef sv_getcwd +#define sv_getcwd Perl_sv_getcwd #undef Perl_sv_dec #define Perl_sv_dec pPerl->Perl_sv_dec #undef sv_dec @@ -1737,6 +1741,10 @@ #define Perl_sv_pvbyten_force pPerl->Perl_sv_pvbyten_force #undef sv_pvbyten_force #define sv_pvbyten_force Perl_sv_pvbyten_force +#undef Perl_sv_realpath +#define Perl_sv_realpath pPerl->Perl_sv_realpath +#undef sv_realpath +#define sv_realpath Perl_sv_realpath #undef Perl_sv_reftype #define Perl_sv_reftype pPerl->Perl_sv_reftype #undef sv_reftype @@ -2406,6 +2414,10 @@ #define Perl_sv_2pv_flags pPerl->Perl_sv_2pv_flags #undef sv_2pv_flags #define sv_2pv_flags Perl_sv_2pv_flags +#undef Perl_my_atof2 +#define Perl_my_atof2 pPerl->Perl_my_atof2 +#undef my_atof2 +#define my_atof2 Perl_my_atof2 #endif /* PERL_CORE && PERL_OBJECT */ #endif /* __objXSUB_h__ */ diff --git a/patchlevel.h b/patchlevel.h index ba8dbfd..8efd2f5 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -70,7 +70,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL - ,"DEVEL10358" + ,"DEVEL10380" ,NULL }; diff --git a/perl.h b/perl.h index 1aee654..4561467 100644 --- a/perl.h +++ b/perl.h @@ -1311,24 +1311,8 @@ typedef NVTYPE NV; # endif #endif -#if !defined(Perl_atof) && defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) -# if !defined(Perl_atof) && defined(HAS_STRTOLD) -# define Perl_atof(s) (NV)strtold(s, (char**)NULL) -# endif -# if !defined(Perl_atof) && defined(HAS_ATOLF) -# define Perl_atof (NV)atolf -# endif -# if !defined(Perl_atof) && defined(PERL_SCNfldbl) -# define Perl_atof PERL_SCNfldbl -# define Perl_atof2(s,f) sscanf((s), "%"PERL_SCNfldbl, &(f)) -# endif -#endif -#if !defined(Perl_atof) -# define Perl_atof atof /* we assume atof being available anywhere */ -#endif -#if !defined(Perl_atof2) -# define Perl_atof2(s,f) ((f) = (NV)Perl_atof(s)) -#endif +#define Perl_atof(s) Perl_my_atof(s) +#define Perl_atof2(s, np) Perl_my_atof2(s, np) /* Previously these definitions used hardcoded figures. * It is hoped these formula are more portable, although @@ -2487,6 +2471,13 @@ I32 unlnk (char*); #define UNLINK PerlLIO_unlink #endif +#ifndef HAS_SETRESUID_PROTO /* some versions of glibc */ +int setresuid(uid_t ruid, uid_t euid, uid_t suid); +#endif +#ifndef HAS_SETRESUID_PROTO /* some versions of glibc */ +int setresgid(gid_t rgid, gid_t egid, gid_t sgid); +#endif + #ifndef HAS_SETREUID # ifdef HAS_SETRESUID # define setreuid(r,e) setresuid(r,e,(Uid_t)-1) diff --git a/perlapi.c b/perlapi.c index b839a35..a04ab22 100644 --- a/perlapi.c +++ b/perlapi.c @@ -2981,6 +2981,13 @@ Perl_sv_compile_2op(pTHXo_ SV* sv, OP** startp, char* code, AV** avp) return ((CPerlObj*)pPerl)->Perl_sv_compile_2op(sv, startp, code, avp); } +#undef Perl_sv_getcwd +int +Perl_sv_getcwd(pTHXo_ SV* sv) +{ + return ((CPerlObj*)pPerl)->Perl_sv_getcwd(sv); +} + #undef Perl_sv_dec void Perl_sv_dec(pTHXo_ SV* sv) @@ -3142,6 +3149,13 @@ Perl_sv_pvbyten_force(pTHXo_ SV* sv, STRLEN* lp) return ((CPerlObj*)pPerl)->Perl_sv_pvbyten_force(sv, lp); } +#undef Perl_sv_realpath +int +Perl_sv_realpath(pTHXo_ SV* sv, char *path, STRLEN len) +{ + return ((CPerlObj*)pPerl)->Perl_sv_realpath(sv, path, len); +} + #undef Perl_sv_reftype char* Perl_sv_reftype(pTHXo_ SV* sv, int ob) @@ -4275,6 +4289,13 @@ Perl_sv_2pv_flags(pTHXo_ SV* sv, STRLEN* lp, I32 flags) return ((CPerlObj*)pPerl)->Perl_sv_2pv_flags(sv, lp, flags); } +#undef Perl_my_atof2 +char* +Perl_my_atof2(pTHXo_ const char *s, NV* value) +{ + return ((CPerlObj*)pPerl)->Perl_my_atof2(s, value); +} + #undef Perl_fprintf_nocontext int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 824ec59..41283b8 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -952,7 +952,7 @@ parameter is the precomputed hash value; if it is zero then Perl will compute it. The return value is the new hash entry so created. It will be NULL if the operation failed or if the value did not need to be actually stored within the hash (as in the case of tied hashes). Otherwise the -contents of the return value can be accessed using the C macros +contents of the return value can be accessed using the C macros described here. Note that the caller is responsible for suitably incrementing the reference count of C before the call, and decrementing it if the function returned NULL. @@ -2754,6 +2754,15 @@ Free the memory used by an SV. =for hackers Found in file sv.c +=item sv_getcwd + +Fill the sv with current working directory + + int sv_getcwd(SV* sv) + +=for hackers +Found in file util.c + =item sv_gets Get a line from the filehandle and store it into the SV, optionally @@ -2894,6 +2903,15 @@ L. =for hackers Found in file sv.c +=item sv_realpath + +Wrap or emulate realpath(3). + + int sv_realpath(SV* sv, char *path, STRLEN len) + +=for hackers +Found in file util.c + =item sv_reftype Returns a string describing what the SV is a reference to. diff --git a/pod/perldiag.pod b/pod/perldiag.pod index afcc2cc..17b4b1b 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3706,6 +3706,34 @@ earlier in the line, and you really meant a "less than". (W untie) A copy of the object returned from C (or C) was still valid when C was called. +=item Useless (?%s) - use /%s modifier in regex; marked by <-- HERE in m/%s/ + +(W regexp) You have used an internal modifier such as (?o) that has no +meaning unless applied to the entire regexp: + + if ($string =~ /(?o)$pattern/) { ... } + +must be written as + + if ($string =~ /$pattern/o) { ... } + +The <-- HERE shows in the regular expression about +where the problem was discovered. See L. + +=item Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ + +(W regexp) You have used an internal modifier such as (?-o) that has no +meaning unless removed from the entire regexp: + + if ($string =~ /(?-o)$pattern/o) { ... } + +must be written as + + if ($string =~ /$pattern/) { ... } + +The <-- HERE shows in the regular expression about +where the problem was discovered. See L. + =item Useless use of %s in void context (W void) You did something without a side effect in a context that does diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 35e70e3..1240ef2 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -881,7 +881,7 @@ listing =item Predefined Names -$ARG, $_, $>, $MATCH, $&, $PREMATCH, $`, $POSTMATCH, $', +$ARG, $_, $a, $b, $>, $MATCH, $&, $PREMATCH, $`, $POSTMATCH, $', $LAST_PAREN_MATCH, $+, @LAST_MATCH_END, @+, $MULTILINE_MATCHING, $*, input_line_number HANDLE EXPR, $INPUT_LINE_NUMBER, $NR, $, input_record_separator HANDLE EXPR, $INPUT_RECORD_SEPARATOR, $RS, $/, @@ -908,8 +908,8 @@ $DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, %^H, $INPLACE_EDIT, $^I, $^M, $OSNAME, $^O, $PERLDB, $^P, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x100, 0x200, $LAST_REGEXP_CODE_RESULT, $^R, $EXCEPTIONS_BEING_CAUGHT, $^S, $BASETIME, $^T, $PERL_VERSION, $^V, $WARNING, $^W, ${^WARNING_BITS}, -${^WIDE_SYSTEM_CALLS}, $EXECUTABLE_NAME, $^X, $ARGV, @ARGV, @INC, @_, %INC, -%ENV, $ENV{expr}, %SIG, $SIG{expr} +${^WIDE_SYSTEM_CALLS}, $EXECUTABLE_NAME, $^X, $ARGV, @ARGV, @F, @INC, @_, +%INC, %ENV, $ENV{expr}, %SIG, $SIG{expr} =item Error Indicators @@ -2203,9 +2203,9 @@ CGI::Fast, CGI::Pretty, CGI::Push, CGI::Switch, CGI::Util, CPAN, CPAN::FirstTime, CPAN::Nox, Carp, Carp::Heavy, Class::ISA, Class::Struct, Cwd, DB, DB_File, Devel::SelfStubber, Digest, DirHandle, Dumpvalue, Encode, Encode::EncodeFormat, Encode::Tcl, English, Env, Exporter, Exporter::Heavy, -ExtUtils::Command, ExtUtils::Embed, ExtUtils::Install, ExtUtils::Installed, -ExtUtils::Liblist, ExtUtils::MM_Cygwin, ExtUtils::MM_OS2, -ExtUtils::MM_Unix, ExtUtils::MM_VMS, ExtUtils::MM_Win32, +ExtUtils::Command, ExtUtils::Constant, ExtUtils::Embed, ExtUtils::Install, +ExtUtils::Installed, ExtUtils::Liblist, ExtUtils::MM_Cygwin, +ExtUtils::MM_OS2, ExtUtils::MM_Unix, ExtUtils::MM_VMS, ExtUtils::MM_Win32, ExtUtils::MakeMaker, ExtUtils::Manifest, ExtUtils::Mkbootstrap, ExtUtils::Mksymlists, ExtUtils::Packlist, ExtUtils::testlib, Fatal, Fcntl, File::Basename, File::CheckTree, File::Compare, File::Copy, File::DosGlob, @@ -2213,11 +2213,12 @@ File::Find, File::Path, File::Spec, File::Spec::Epoc, File::Spec::Functions, File::Spec::Mac, File::Spec::OS2, File::Spec::Unix, File::Spec::VMS, File::Spec::Win32, File::Temp, File::stat, FileCache, FileHandle, Filter::Simple, FindBin, Getopt::Long, Getopt::Std, -I18N::Collate, IO, IPC::Open2, IPC::Open3, Locale::Constants, -Locale::Country, Locale::Currency, Locale::Language, Math::BigFloat, -Math::BigInt, Math::Complex, Math::Trig, NDBM_File, NEXT, Net::Ping, -Net::hostent, Net::netent, Net::protoent, Net::servent, O, ODBM_File, -Opcode, POSIX, PerlIO, Pod::Checker, Pod::Find, Pod::Html, +I18N::Collate, I18N::LangTags, I18N::LangTags::List, IO, IPC::Open2, +IPC::Open3, Locale::Constants, Locale::Country, Locale::Currency, +Locale::Language, Locale::Maketext, Locale::Maketext::TPJ13, +Math::BigFloat, Math::BigInt, Math::Complex, Math::Trig, NDBM_File, NEXT, +Net::Ping, Net::hostent, Net::netent, Net::protoent, Net::servent, O, +ODBM_File, Opcode, POSIX, PerlIO, Pod::Checker, Pod::Find, Pod::Html, Pod::InputObjects, Pod::LaTeX, Pod::Man, Pod::ParseUtils, Pod::Parser, Pod::Plainer, Pod::Select, Pod::Text, Pod::Text::Color, Pod::Text::Overstrike, Pod::Text::Termcap, Pod::Usage, SDBM_File, Safe, @@ -3900,28 +3901,29 @@ SvNOK_off, SvNOK_on, SvNOK_only, SvNV, SvNVX, SvOK, SvOOK, SvPOK, SvPOKp, SvPOK_off, SvPOK_on, SvPOK_only, SvPOK_only_UTF8, SvPV, SvPVX, SvPV_force, SvPV_nolen, SvREFCNT, SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off, SvROK_on, SvRV, SvSETMAGIC, SvSetSV, SvSetSV_nosteal, SvSTASH, SvTAINT, -SvTAINTED, SvTAINTED_off, SvTAINTED_on, SvTRUE, SvTYPE, svtype, SVt_IV, +SvTAINTED, SvTAINTED_off, SvTAINTED_on, SvTRUE, svtype, SvTYPE, SVt_IV, SVt_NV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SvUOK, SvUPGRADE, SvUTF8, SvUTF8_off, SvUTF8_on, SvUV, SvUVX, sv_2mortal, sv_bless, sv_catpv, sv_catpvf, sv_catpvf_mg, sv_catpvn, sv_catpvn_flags, sv_catpvn_mg, sv_catpv_mg, sv_catsv, sv_catsv_flags, sv_catsv_mg, sv_chop, sv_clear, -sv_cmp, sv_cmp_locale, sv_dec, sv_derived_from, sv_eq, sv_free, sv_gets, -sv_grow, sv_inc, sv_insert, sv_isa, sv_isobject, sv_len, sv_len_utf8, -sv_magic, sv_mortalcopy, sv_newmortal, sv_pvn_force, sv_pvn_force_flags, -sv_pvutf8n_force, sv_reftype, sv_replace, sv_rvweaken, sv_setiv, -sv_setiv_mg, sv_setnv, sv_setnv_mg, sv_setpv, sv_setpvf, sv_setpvf_mg, -sv_setpviv, sv_setpviv_mg, sv_setpvn, sv_setpvn_mg, sv_setpv_mg, -sv_setref_iv, sv_setref_nv, sv_setref_pv, sv_setref_pvn, sv_setref_uv, -sv_setsv, sv_setsv_flags, sv_setsv_mg, sv_setuv, sv_setuv_mg, sv_true, -sv_unmagic, sv_unref, sv_unref_flags, sv_upgrade, sv_usepvn, sv_usepvn_mg, -sv_utf8_decode, sv_utf8_downgrade, sv_utf8_encode, sv_utf8_upgrade, -sv_utf8_upgrade_flags, sv_vcatpvfn, sv_vsetpvfn, THIS, toLOWER, toUPPER, -utf8n_to_uvchr, utf8n_to_uvuni, utf8_distance, utf8_hop, utf8_length, -utf8_to_bytes, utf8_to_uvchr, utf8_to_uvuni, uvchr_to_utf8, uvuni_to_utf8, -warn, XPUSHi, XPUSHn, XPUSHp, XPUSHs, XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, -XSRETURN_IV, XSRETURN_NO, XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, -XSRETURN_YES, XST_mIV, XST_mNO, XST_mNV, XST_mPV, XST_mUNDEF, XST_mYES, -XS_VERSION, XS_VERSION_BOOTCHECK, Zero +sv_cmp, sv_cmp_locale, sv_dec, sv_derived_from, sv_eq, sv_free, sv_getcwd, +sv_gets, sv_grow, sv_inc, sv_insert, sv_isa, sv_isobject, sv_len, +sv_len_utf8, sv_magic, sv_mortalcopy, sv_newmortal, sv_pvn_force, +sv_pvn_force_flags, sv_pvutf8n_force, sv_realpath, sv_reftype, sv_replace, +sv_rvweaken, sv_setiv, sv_setiv_mg, sv_setnv, sv_setnv_mg, sv_setpv, +sv_setpvf, sv_setpvf_mg, sv_setpviv, sv_setpviv_mg, sv_setpvn, +sv_setpvn_mg, sv_setpv_mg, sv_setref_iv, sv_setref_nv, sv_setref_pv, +sv_setref_pvn, sv_setref_uv, sv_setsv, sv_setsv_flags, sv_setsv_mg, +sv_setuv, sv_setuv_mg, sv_true, sv_unmagic, sv_unref, sv_unref_flags, +sv_upgrade, sv_usepvn, sv_usepvn_mg, sv_utf8_decode, sv_utf8_downgrade, +sv_utf8_encode, sv_utf8_upgrade, sv_utf8_upgrade_flags, sv_vcatpvfn, +sv_vsetpvfn, THIS, toLOWER, toUPPER, utf8n_to_uvchr, utf8n_to_uvuni, +utf8_distance, utf8_hop, utf8_length, utf8_to_bytes, utf8_to_uvchr, +utf8_to_uvuni, uvchr_to_utf8, uvuni_to_utf8, warn, XPUSHi, XPUSHn, XPUSHp, +XPUSHs, XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, XSRETURN_NO, +XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES, XST_mIV, XST_mNO, +XST_mNV, XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION, XS_VERSION_BOOTCHECK, +Zero =item AUTHORS @@ -5869,50 +5871,6 @@ Source, Compiled Module Source, Perl Modules/Scripts =back -=head2 perldos - Perl under DOS, W31, W95. - -=over 4 - -=item SYNOPSIS - -=item DESCRIPTION - -=over 4 - -=item Prerequisites - -DJGPP, Pthreads - -=item Shortcomings of Perl under DOS - -=item Building - -=item Testing - -=item Installation - -=back - -=item BUILDING AND INSTALLING MODULES - -=over 4 - -=item Building Prerequisites - -=item Unpacking CPAN Modules - -=item Building Non-XS Modules - -=item Building XS Modules - -=back - -=item AUTHOR - -=item SEE ALSO - -=back - =head2 perlepoc, README.epoc - Perl for EPOC =over 4 @@ -6632,48 +6590,6 @@ LIST, waitpid PID,FLAGS =back -=head2 perlwin32 - Perl under Win32 - -=over 4 - -=item SYNOPSIS - -=item DESCRIPTION - -=over 4 - -=item Setting Up - -Make, Command Shell, Borland C++, Microsoft Visual C++, Mingw32 with GCC - -=item Building - -=item Testing - -=item Installation - -=item Usage Hints - -Environment Variables, File Globbing, Using perl from the command line, -Building Extensions, Command-line Wildcard Expansion, Win32 Specific -Extensions, Running Perl Scripts, Miscellaneous Things - -=back - -=item BUGS AND CAVEATS - -=item AUTHORS - -Gary Ng E71564.1743@CompuServe.COME, Gurusamy Sarathy -Egsar@activestate.comE, Nick Ing-Simmons -Enick@ing-simmons.netE - -=item SEE ALSO - -=item HISTORY - -=back - =head1 PRAGMA DOCUMENTATION =head2 attrs - set/get attributes of a subroutine (deprecated) @@ -8491,9 +8407,10 @@ C<_a>, C<_exe>, C<_o> =item a -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C +C, C, C, C, C, +C, C, C, C, +C, C, C, C, C, C, +C =item b @@ -8553,8 +8470,8 @@ C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, @@ -8566,9 +8483,9 @@ C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, -C, C, C, C, -C, C, C, C, -C, C, +C, C, C, C, +C, C, C, C, +C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, @@ -8581,8 +8498,9 @@ C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, -C, C, C, C, -C, C, C, C, C +C, C, C, C, +C, C, C, C, C, +C, C, C =item e @@ -8669,7 +8587,7 @@ C, C, C, C =item p C, C, C, C, C, C, -C +C, C =item P @@ -14151,14 +14069,32 @@ C, C, C =item DESCRIPTION +=over 4 + +=item Functions + +B + +=back + +=back + +B<_to_value> + +B + +=over 4 + =item TEST TYPES NORMAL TESTS, SKIPPED TESTS, TODO TESTS -=item RETURN VALUE - =item ONFAIL +=item BUGS and CAVEATS + +=item TODO + =item SEE ALSO =item AUTHOR @@ -14179,10 +14115,29 @@ NORMAL TESTS, SKIPPED TESTS, TODO TESTS B<'1..M'>, B<'ok', 'not ok'. Ok?>, B, B<$Test::Harness::verbose>, B<$Test::Harness::switches>, B, -B, B, B +B, B, B, B + +=item Failure + +B, B, B, B, B, B, B + +=item Functions + +B + +=back =back +B<_globdir> + +B<_run_all_tests> + +B<_mk_leader> + +=over 4 + =item EXPORT =item DIAGNOSTICS @@ -14198,10 +14153,14 @@ C, C, C, C, C, C, C +=item EXAMPLE + =item SEE ALSO =item AUTHORS +=item TODO + =item BUGS =back diff --git a/proto.h b/proto.h index c824a79..9a5cdfb 100644 --- a/proto.h +++ b/proto.h @@ -752,6 +752,7 @@ PERL_CALLCONV I32 Perl_sv_cmp_locale(pTHX_ SV* sv1, SV* sv2); PERL_CALLCONV char* Perl_sv_collxfrm(pTHX_ SV* sv, STRLEN* nxp); #endif PERL_CALLCONV OP* Perl_sv_compile_2op(pTHX_ SV* sv, OP** startp, char* code, AV** avp); +PERL_CALLCONV int Perl_sv_getcwd(pTHX_ SV* sv); PERL_CALLCONV void Perl_sv_dec(pTHX_ SV* sv); PERL_CALLCONV void Perl_sv_dump(pTHX_ SV* sv); PERL_CALLCONV bool Perl_sv_derived_from(pTHX_ SV* sv, const char* name); @@ -776,6 +777,7 @@ PERL_CALLCONV void Perl_sv_pos_b2u(pTHX_ SV* sv, I32* offsetp); PERL_CALLCONV char* Perl_sv_pvn_force(pTHX_ SV* sv, STRLEN* lp); PERL_CALLCONV char* Perl_sv_pvutf8n_force(pTHX_ SV* sv, STRLEN* lp); PERL_CALLCONV char* Perl_sv_pvbyten_force(pTHX_ SV* sv, STRLEN* lp); +PERL_CALLCONV int Perl_sv_realpath(pTHX_ SV* sv, char *path, STRLEN len); PERL_CALLCONV char* Perl_sv_reftype(pTHX_ SV* sv, int ob); PERL_CALLCONV void Perl_sv_replace(pTHX_ SV* sv, SV* nsv); PERL_CALLCONV void Perl_sv_report_used(pTHX); @@ -1312,3 +1314,4 @@ PERL_CALLCONV void Perl_sv_catsv_flags(pTHX_ SV* dsv, SV* ssv, I32 flags); PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade_flags(pTHX_ SV *sv, I32 flags); PERL_CALLCONV char* Perl_sv_pvn_force_flags(pTHX_ SV* sv, STRLEN* lp, I32 flags); PERL_CALLCONV char* Perl_sv_2pv_flags(pTHX_ SV* sv, STRLEN* lp, I32 flags); +PERL_CALLCONV char* Perl_my_atof2(pTHX_ const char *s, NV* value); diff --git a/regcomp.c b/regcomp.c index 98cf21b..7a713ae 100644 --- a/regcomp.c +++ b/regcomp.c @@ -418,6 +418,15 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END +/* used for the parse_flags section for (?c) -- japhy */ +#define vWARN5(loc, m, a1, a2, a3, a4) \ + STMT_START { \ + unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc)); \ + Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION, \ + a1, a2, a3, a4, \ + (int)offset, RExC_precomp, RExC_precomp + offset); \ + } STMT_END + /* Allow for side effects in s */ #define REGC(c,s) STMT_START { if (!SIZE_ONLY) *(s) = (c); else (s);} STMT_END @@ -2018,12 +2027,23 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) register regnode *ender = 0; register I32 parno = 0; I32 flags, oregflags = RExC_flags16, have_branch = 0, open = 0; + + /* for (?g), (?gc), and (?o) warnings; warning + about (?c) will warn about (?g) -- japhy */ + + I32 wastedflags = 0x00, + wasted_o = 0x01, + wasted_g = 0x02, + wasted_gc = 0x02 | 0x04, + wasted_c = 0x04; + char * parse_start = RExC_parse; /* MJD */ char *oregcomp_parse = RExC_parse; char c; *flagp = 0; /* Tentatively. */ + /* Make an OPEN node, if parenthesized. */ if (paren) { if (*RExC_parse == '?') { /* (?...) */ @@ -2202,12 +2222,45 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) --RExC_parse; parse_flags: /* (?i) */ while (*RExC_parse && strchr("iogcmsx", *RExC_parse)) { - if (*RExC_parse != 'o') - pmflag(flagsp, *RExC_parse); + /* (?g), (?gc) and (?o) are useless here + and must be globally applied -- japhy */ + + if (*RExC_parse == 'o' || *RExC_parse == 'g') { + if (SIZE_ONLY && ckWARN(WARN_REGEXP)) { + I32 wflagbit = *RExC_parse == 'o' ? wasted_o : wasted_g; + if (! (wastedflags & wflagbit) ) { + wastedflags |= wflagbit; + vWARN5( + RExC_parse + 1, + "Useless (%s%c) - %suse /%c modifier", + flagsp == &negflags ? "?-" : "?", + *RExC_parse, + flagsp == &negflags ? "don't " : "", + *RExC_parse + ); + } + } + } + else if (*RExC_parse == 'c') { + if (SIZE_ONLY && ckWARN(WARN_REGEXP)) { + if (! (wastedflags & wasted_c) ) { + wastedflags |= wasted_gc; + vWARN3( + RExC_parse + 1, + "Useless (%sc) - %suse /gc modifier", + flagsp == &negflags ? "?-" : "?", + flagsp == &negflags ? "don't " : "" + ); + } + } + } + else { pmflag(flagsp, *RExC_parse); } + ++RExC_parse; } if (*RExC_parse == '-') { flagsp = &negflags; + wastedflags = 0; /* reset so (?g-c) warns twice */ ++RExC_parse; goto parse_flags; } diff --git a/t/lib/extutils.t b/t/lib/extutils.t index 27512fe..759d761 100644 --- a/t/lib/extutils.t +++ b/t/lib/extutils.t @@ -1,6 +1,6 @@ #!./perl -w -print "1..10\n"; +print "1..12\n"; BEGIN { chdir 't' if -d 't'; @@ -12,8 +12,13 @@ use strict; use ExtUtils::MakeMaker; use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload); use Config; +use File::Spec::Functions; +use File::Spec; +# Because were are going to be changing directory before running Makefile.PL +my $perl = File::Spec->rel2abs( $^X ); -my $runperl = $^X; +print "# perl=$perl\n"; +my $runperl = "$perl \"-I../../lib\""; $| = 1; @@ -23,7 +28,6 @@ my @files; print "# $dir being created...\n"; mkdir $dir, 0777 or die "mkdir: $!\n"; -use File::Spec::Functions; END { use File::Path; @@ -31,9 +35,9 @@ END { rmtree($dir); } -my @names = ("THREE", {name=>"OK4", type=>"PV",}, - {name=>"OK5", type=>"PVN", - value=>['"not ok 5\\n\\0ok 5\\n"', 15]}, +my @names = ("FIVE", {name=>"OK6", type=>"PV",}, + {name=>"OK7", type=>"PVN", + value=>['"not ok 7\\n\\0ok 7\\n"', 15]}, {name => "FARTHING", type=>"NV"}, {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"}); @@ -45,9 +49,9 @@ my $header = catfile($dir, "test.h"); push @files, "test.h"; open FH, ">$header" or die "open >$header: $!\n"; print FH <<'EOT'; -#define THREE 3 -#define OK4 "ok 4\n" -#define OK5 1 +#define FIVE 5 +#define OK6 "ok 6\n" +#define OK7 1 #define FARTHING 0.25 #define NOT_ZERO 1 EOT @@ -112,31 +116,31 @@ open FH, ">$testpl" or die "open >$testpl: $!\n"; print FH "use $package qw(@names_only);\n"; print FH <<'EOT'; -my $three = THREE; -if ($three == 3) { - print "ok 3\n"; +my $five = FIVE; +if ($five == 5) { + print "ok 5\n"; } else { - print "not ok 3 # $three\n"; + print "not ok 5 # $five\n"; } -print OK4; +print OK6; -$_ = OK5; +$_ = OK7; s/.*\0//s; print; my $farthing = FARTHING; if ($farthing == 0.25) { - print "ok 6\n"; + print "ok 8\n"; } else { - print "not ok 6 # $farthing\n"; + print "not ok 8 # $farthing\n"; } my $not_zero = NOT_ZERO; if ($not_zero > 0 && $not_zero == ~0) { - print "ok 7\n"; + print "ok 9\n"; } else { - print "not ok 7 # \$not_zero=$not_zero ~0=" . (~0) . "\n"; + print "not ok 9 # \$not_zero=$not_zero ~0=" . (~0) . "\n"; } @@ -144,31 +148,43 @@ EOT close FH or die "close $testpl: $!\n"; -################ dummy Makefile.PL +################ Makefile.PL # Keep the dependancy in the Makefile happy my $makefilePL = catfile($dir, "Makefile.PL"); push @files, "Makefile.PL"; open FH, ">$makefilePL" or die "open >$makefilePL: $!\n"; +print FH <<"EOT"; +use ExtUtils::MakeMaker; +WriteMakefile( + 'NAME' => "$package", + 'VERSION_FROM' => "$package.pm", # finds \$VERSION + (\$] >= 5.005 ? + (#ABSTRACT_FROM => "$package.pm", # XXX add this + AUTHOR => "$0") : ()) + ); +EOT + close FH or die "close $makefilePL: $!\n"; chdir $dir or die $!; push @INC, '../../lib'; END {chdir ".." or warn $!}; -# Grr. MakeMaker hardwired to write its message to STDOUT. -print "# "; -WriteMakefile( - 'NAME' => $package, - 'VERSION_FROM' => "$package.pm", # finds $VERSION - ($] >= 5.005 ? - (#ABSTRACT_FROM => "$package.pm", # XXX add this - AUTHOR => $0) : ()) - ); +my @perlout = `$runperl Makefile.PL`; +if ($?) { + print "not ok 1 # $runperl Makefile.PL failed: $?\n"; + print "# $_" foreach @perlout; + exit($?); +} else { + print "ok 1\n"; +} + + my $makefile = ($^O eq 'VMS' ? 'descrip' : 'Makefile'); my $makefile_ext = ($^O eq 'VMS' ? '.mms' : ''); if (-f "$makefile$makefile_ext") { - print "ok 1\n"; + print "ok 2\n"; } else { - print "not ok 1\n"; + print "not ok 2\n"; } my $makefile_rename = ($^O eq 'VMS' ? '.mms' : '.old'); push @files, "$makefile$makefile_rename"; # Renamed by make clean @@ -182,17 +198,32 @@ my $makeout; print "# make = '$make'\n"; $makeout = `$make`; if ($?) { - print "not ok 2 # $make failed: $?\n"; + print "not ok 3 # $make failed: $?\n"; exit($?); } else { - print "ok 2\n"; + print "ok 3\n"; +} + +if ($Config{usedl}) { + print "ok 4\n"; +} else { + push @files, "perl$Config{exe_ext}"; + my $makeperl = "$make perl"; + print "# make = '$makeperl'\n"; + $makeout = `$makeperl`; + if ($?) { + print "not ok 4 # $makeperl failed: $?\n"; + exit($?); + } else { + print "ok 4\n"; + } } my $maketest = "$make test"; print "# make = '$maketest'\n"; $makeout = `$maketest`; if ($?) { - print "not ok 8 # $make failed: $?\n"; + print "not ok 10 # $maketest failed: $?\n"; } else { # Perl babblings $makeout =~ s/^\s*PERL_DL_NONLAZY=.+?\n//m; @@ -200,17 +231,23 @@ if ($?) { # GNU make babblings $makeout =~ s/^\w*?make.+?(?:entering|leaving) directory.+?\n//mig; + # Hopefully gets most make's babblings + # make -f Makefile.aperl perl + $makeout =~ s/^\w*?make.+\sperl[^A-Za-z0-9]*\n//mig; + # make[1]: `perl' is up to date. + $makeout =~ s/^\w*?make.+perl.+?is up to date.*?\n//mig; + print $makeout; - print "ok 8\n"; + print "ok 10\n"; } my $makeclean = "$make clean"; print "# make = '$makeclean'\n"; $makeout = `$makeclean`; if ($?) { - print "not ok 9 # $make failed: $?\n"; + print "not ok 11 # $make failed: $?\n"; } else { - print "ok 9\n"; + print "ok 11\n"; } foreach (@files) { @@ -226,7 +263,7 @@ while (defined (my $entry = readdir DIR)) { } closedir DIR or warn "closedir '.': $!"; if ($fail) { - print "not ok 10\n"; + print "not ok 12\n"; } else { - print "ok 10\n"; + print "ok 12\n"; } diff --git a/t/lib/filecomp.t b/t/lib/filecomp.t index 9e0751b..167a46a 100644 --- a/t/lib/filecomp.t +++ b/t/lib/filecomp.t @@ -88,8 +88,8 @@ eval { close($fh); } seek($tfh,0,0); - $donetests[0] = compare($tfh,'README'); - $donetests[1] = compare("$filename",'README'); + $donetests[0] = compare($tfh, 'README'); + $donetests[1] = compare($filename, 'README'); unlink0($tfh,$filename); }; print "# problems when testing with a tempory file\n" if $@; diff --git a/t/op/pat.t b/t/op/pat.t index 0df4d78..ab4226c 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -6,7 +6,7 @@ $| = 1; -print "1..615\n"; +print "1..625\n"; BEGIN { chdir 't' if -d 't'; @@ -1685,3 +1685,61 @@ EOT print "ok 615\n"; } +{ + # from japhy + my $w; + use warnings; + local $SIG{__WARN__} = sub { $w .= shift }; + + $w = ""; + eval 'qr/(?c)/'; + print "not " if $w !~ /^Useless \(\?c\)/; + print "ok 616\n"; + + $w = ""; + eval 'qr/(?-c)/'; + print "not " if $w !~ /^Useless \(\?-c\)/; + print "ok 617\n"; + + $w = ""; + eval 'qr/(?g)/'; + print "not " if $w !~ /^Useless \(\?g\)/; + print "ok 618\n"; + + $w = ""; + eval 'qr/(?-g)/'; + print "not " if $w !~ /^Useless \(\?-g\)/; + print "ok 619\n"; + + $w = ""; + eval 'qr/(?o)/'; + print "not " if $w !~ /^Useless \(\?o\)/; + print "ok 620\n"; + + $w = ""; + eval 'qr/(?-o)/'; + print "not " if $w !~ /^Useless \(\?-o\)/; + print "ok 621\n"; + + # now test multi-error regexes + + $w = ""; + eval 'qr/(?g-o)/'; + print "not " if $w !~ /^Useless \(\?g\).*\nUseless \(\?-o\)/; + print "ok 622\n"; + + $w = ""; + eval 'qr/(?g-c)/'; + print "not " if $w !~ /^Useless \(\?g\).*\nUseless \(\?-c\)/; + print "ok 623\n"; + + $w = ""; + eval 'qr/(?o-cg)/'; # (?c) means (?g) error won't be thrown + print "not " if $w !~ /^Useless \(\?o\).*\nUseless \(\?-c\)/; + print "ok 624\n"; + + $w = ""; + eval 'qr/(?ogc)/'; + print "not " if $w !~ /^Useless \(\?o\).*\nUseless \(\?g\).*\nUseless \(\?c\)/; + print "ok 625\n"; +} diff --git a/uconfig.h b/uconfig.h index 8766659..fa0d8b0 100644 --- a/uconfig.h +++ b/uconfig.h @@ -2407,8 +2407,25 @@ * in the header file. In older versions of DB, it was * int, while in newer ones it is size_t. */ +/* DB_VERSION_MAJOR_CFG: + * This symbol, if defined, defines the major version number of + * Berkeley DB found in the header when Perl was configured. + */ +/* DB_VERSION_MINOR_CFG: + * This symbol, if defined, defines the minor version number of + * Berkeley DB found in the header when Perl was configured. + * For DB version 1 this is always 0. + */ +/* DB_VERSION_PATCH_CFG: + * This symbol, if defined, defines the patch version number of + * Berkeley DB found in the header when Perl was configured. + * For DB version 1 this is always 0. + */ #define DB_Hash_t u_int32_t /**/ #define DB_Prefix_t size_t /**/ +#define DB_VERSION_MAJOR_CFG /**/ +#define DB_VERSION_MINOR_CFG /**/ +#define DB_VERSION_PATCH_CFG /**/ /* I_GRP: * This symbol, if defined, indicates to the C program that it should @@ -3315,6 +3332,12 @@ #define PERL_XS_APIVERSION "5.005" #define PERL_PM_APIVERSION "5.005" +/* HAS_REALPATH: + * This symbol, if defined, indicates that the realpath routine is + * available to do resolve paths. + */ +/*#define HAS_REALPATH / **/ + /* HAS_SIGPROCMASK: * This symbol, if defined, indicates that the sigprocmask * system call is available to examine or change the signal mask @@ -3328,6 +3351,14 @@ */ /*#define HAS_SOCKATMARK / **/ +/* HAS_SETRESUID_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the setresuid() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern int setresuid(uid_t ruid, uid_t euid, uid_t suid); + */ +/*#define HAS_SETRESUID_PROTO / **/ + /* HAS_STRFTIME: * This symbol, if defined, indicates that the strftime routine is * available to do time formatting. diff --git a/uconfig.sh b/uconfig.sh index 3a6bd04..4b6e2a6 100755 --- a/uconfig.sh +++ b/uconfig.sh @@ -52,8 +52,8 @@ d_chown='undef' d_chroot='undef' d_chsize='undef' d_closedir='undef' -d_const='undef' d_cmsghdr_s='undef' +d_const='undef' d_crypt='undef' d_csh='undef' d_cuserid='undef' @@ -216,6 +216,7 @@ d_quad='undef' d_readdir='undef' d_readlink='undef' d_readv='undef' +d_realpath='undef' d_recvmsg='undef' d_rename='undef' d_rewinddir='undef' @@ -276,6 +277,8 @@ d_socklen_t='undef' d_sockpair='undef' d_socks5_init='undef' d_sqrtl='undef' +d_sresgproto='undef' +d_sresuproto='undef' d_statblks='undef' d_statfs_f_flags='undef' d_statfs_s='undef' @@ -569,12 +572,12 @@ usesocks='undef' usethreads='undef' usevendorprefix='undef' usevfork='false' +uvXUformat='"lX"' uvoformat='"lo"' uvsize='4' uvtype='unsigned long' uvuformat='"lu"' uvxformat='"lx"' -uvXUformat='"lX"' versiononly='undef' voidflags=1 xs_apiversion='5.005' diff --git a/vos/config.alpha.def b/vos/config.alpha.def index a6f03b3..9c5554b 100644 --- a/vos/config.alpha.def +++ b/vos/config.alpha.def @@ -226,6 +226,8 @@ $d_setpwent='undef' $d_setregid='undef' $d_setresgid='undef' $d_setresuid='undef' +$d_sresgproto='undef' +$d_sresuproto='undef' $d_setreuid='undef' $d_setrgid='undef' $d_setruid='undef' diff --git a/win32/config.bc b/win32/config.bc index 4c69179..9511d19 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -306,6 +306,8 @@ d_setpwent='undef' d_setregid='undef' d_setresgid='undef' d_setresuid='undef' +d_sresgproto='undef' +d_sresuproto='undef' d_setreuid='undef' d_setrgid='undef' d_setruid='undef' diff --git a/win32/config.gc b/win32/config.gc index 4a86999..b0dd780 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -306,6 +306,8 @@ d_setpwent='undef' d_setregid='undef' d_setresgid='undef' d_setresuid='undef' +d_sresgproto='undef' +d_sresuproto='undef' d_setreuid='undef' d_setrgid='undef' d_setruid='undef' diff --git a/win32/config.vc b/win32/config.vc index 55edfbe..eab4380 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -306,6 +306,8 @@ d_setpwent='undef' d_setregid='undef' d_setresgid='undef' d_setresuid='undef' +d_sresgproto='undef' +d_sresuproto='undef' d_setreuid='undef' d_setrgid='undef' d_setruid='undef' diff --git a/x2p/hash.c b/x2p/hash.c index a266403..fa35ba6 100644 --- a/x2p/hash.c +++ b/x2p/hash.c @@ -137,7 +137,7 @@ hsplit(HASH *tb) register HENT **oentry; a = (HENT**) saferealloc((char*)tb->tbl_array, newsize * sizeof(HENT*)); - bzero((char*)&a[oldsize], oldsize * sizeof(HENT*)); /* zero second half */ + memset(&a[oldsize], 0, oldsize * sizeof(HENT*)); /* zero second half */ tb->tbl_max = --newsize; tb->tbl_array = a; @@ -171,7 +171,7 @@ hnew(void) tb->tbl_fill = 0; tb->tbl_max = 7; hiterinit(tb); /* so each() will start off right */ - bzero((char*)tb->tbl_array, 8 * sizeof(HENT*)); + memset(tb->tbl_array, 0, 8 * sizeof(HENT*)); return tb; } diff --git a/xsutils.c b/xsutils.c index d15de65..1a95191 100644 --- a/xsutils.c +++ b/xsutils.c @@ -127,8 +127,8 @@ XS(XS_attributes_bootstrap) dXSARGS; char *file = __FILE__; - if( items > 0 ) - Perl_croak(aTHX_ "Usage: bootstrap"); + if( items > 1 ) + Perl_croak(aTHX_ "Usage: attributes::bootstrap $module"); newXSproto("attributes::_warn_reserved", XS_attributes__warn_reserved, file, ""); newXS("attributes::_modify_attrs", XS_attributes__modify_attrs, file);