diff options
| author | Charles Bailey <bailey@newman.upenn.edu> | 2000-03-03 04:42:45 +0000 |
|---|---|---|
| committer | bailey <bailey@newman.upenn.edu> | 2000-03-03 04:42:45 +0000 |
| commit | d7f50f0c498d7fe25779a79348dab4af20b615d3 (patch) | |
| tree | 9c1592224deffc98a63ab82413d3792adbeec7be | |
| parent | 4466cc18e0cce2c475a3418e94d9c930d241d089 (diff) | |
| parent | 8c8ad484ae56ad5a81dc3b76a40859fc90c16a10 (diff) | |
| download | perl-d7f50f0c498d7fe25779a79348dab4af20b615d3.tar.gz | |
Once more unto resync
p4raw-id: //depot/vmsperl@5482
47 files changed, 854 insertions, 318 deletions
@@ -90,8 +90,325 @@ indicator: !> merged changes (from elsewhere) +-------------- +Version v5.6.0 +-------------- + +____________________________________________________________________________ +[ 5448] By: jhi on 2000/03/02 20:00:37 + Log: workaround for Tru64 compiler bug (cleaner fix will have + to wait until 5.6.1), from Spider Boardman + Branch: cfgperl + ! pp.c +____________________________________________________________________________ +[ 5447] By: jhi on 2000/03/02 19:52:34 + Log: Workaround for an optimizer bug. + Branch: cfgperl + ! hints/irix_6.sh +____________________________________________________________________________ +[ 5446] By: jhi on 2000/03/02 19:44:35 + Log: installation directory fix from Andy Dougherty + (installstyle was being clobbered, spotted by Spider Boardman) + Branch: cfgperl + ! Configure + Branch: metaconfig + ! U/installdirs/installstyle.U +____________________________________________________________________________ +[ 5445] By: gsar on 2000/03/02 19:40:44 + Log: patch to fix mingw32 build under USE_IMP_SYS (from Benjamin Stuhl); + some parts not applied + Branch: perl + ! win32/Makefile win32/makefile.mk win32/perllib.c win32/win32.c + ! win32/win32.h +____________________________________________________________________________ +[ 5444] By: gsar on 2000/03/02 19:26:08 + Log: avoid buffering issue in warn/8signal + Branch: perl + ! t/pragma/warn/8signal +____________________________________________________________________________ +[ 5443] By: gsar on 2000/03/02 18:13:28 + Log: integrate cfgperl changes into mainline + Branch: perl + !> Configure config_h.SH hints/aix.sh hints/hpux.sh + !> hints/solaris_2.sh makedepend.SH sv.c t/lib/syslfs.t + !> t/op/lfs.t t/op/pack.t +____________________________________________________________________________ +[ 5442] By: gsar on 2000/03/02 18:02:40 + Log: integrate vmsperl changes into mainline (denied their changes to + Glob.pm, t/pragma/warn/{8signal,pp_ctl}) + Branch: perl + !> configure.com ext/File/Glob/Glob.pm ext/File/Glob/bsd_glob.c + !> lib/ExtUtils/MM_VMS.pm lib/Test/Harness.pm t/lib/glob-basic.t + !> t/pragma/warn/8signal t/pragma/warn/pp_ctl + !> vms/descrip_mms.template vms/gen_shrfls.pl + !> vms/subconfigure.com vms/vms.c +____________________________________________________________________________ +[ 5441] By: jhi on 2000/03/02 17:56:20 + Log: nit from Spider Boardman + Branch: cfgperl + ! makedepend.SH +____________________________________________________________________________ +[ 5440] By: jhi on 2000/03/02 17:48:15 + Log: Confusion over uselargefiles.cbu and uselfs.cbu (the first one + is the correct one), spotted by Robin Parker. + Branch: cfgperl + ! Configure config_h.SH hints/aix.sh hints/hpux.sh + Branch: metaconfig/U/perl + ! uselfs.U +____________________________________________________________________________ +[ 5439] By: jhi on 2000/03/02 15:32:04 + Log: Remove the pack.t kludge introduced to fudge the test + to pass under long doubles: leave the similar kludge + to posix.t because POSIX::strtod() is still double, + not long double. + Branch: cfgperl + ! t/op/pack.t +____________________________________________________________________________ +[ 5438] By: jhi on 2000/03/02 04:58:48 + Log: Integrate with Sarathy. + Branch: cfgperl + !> lib/ExtUtils/Install.pm lib/ExtUtils/Installed.pm + !> lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm lib/FindBin.pm + !> lib/Pod/Html.pm op.c +____________________________________________________________________________ +[ 5437] By: jhi on 2000/03/02 04:51:46 + Log: A patch on #5407. + Branch: cfgperl + ! sv.c +____________________________________________________________________________ +[ 5436] By: gsar on 2000/03/02 04:45:37 + Log: avoid useless comparison + Branch: perl + ! op.c +____________________________________________________________________________ +[ 5435] By: bailey on 2000/03/02 04:43:11 + Log: YA sync with mainline + Branch: vmsperl + +> lib/open.pm pod/perlboot.pod pod/perlnumber.pod + +> t/lib/env-array.t + !> (integrate 150 files) +____________________________________________________________________________ +[ 5434] By: gsar on 2000/03/02 04:28:48 + Log: make the "back to top" links optional + Branch: perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 5433] By: bailey on 2000/03/02 04:26:58 + Log: Protect manipulation of open pipe list from concurrent ASTs (Charles Lane) + Branch: vmsperl + ! vms/vms.c +____________________________________________________________________________ +[ 5432] By: bailey on 2000/03/02 04:20:51 + Log: Update dependencies and remove obsolete VAXC support + Branch: vmsperl + ! vms/descrip_mms.template +____________________________________________________________________________ +[ 5431] By: bailey on 2000/03/02 04:19:42 + Log: Rmeove obsolete VAXC support + Branch: vmsperl + ! vms/gen_shrfls.pl +____________________________________________________________________________ +[ 5430] By: bailey on 2000/03/02 04:18:57 + Log: Minor updates to subconfigure.com: + - remove old VAXC support + - avoid echoing commands to tempfiles + - fix typos + - define 64bit symbols (as "undef") when not using 64 bit support + Branch: vmsperl + ! vms/subconfigure.com +____________________________________________________________________________ +[ 5429] By: bailey on 2000/03/02 04:16:11 + Log: Minor changes to Configure.Com: + - permit operation in batch mode (splits output) + - remove old VAXC support + - default to enabling secure internal lnm translation + Branch: vmsperl + ! configure.com +____________________________________________________________________________ +[ 5428] By: bailey on 2000/03/02 04:06:53 + Log: Optional warning for truncated logical name equivalence string (Dan Sugalski) + Branch: vmsperl + ! vms/vms.c +____________________________________________________________________________ +[ 5427] By: bailey on 2000/03/02 04:05:47 + Log: FIx no-op in vms.c + Branch: vmsperl + ! vms/vms.c +____________________________________________________________________________ +[ 5426] By: bailey on 2000/03/02 04:04:52 + Log: MIscellaneous tweaks to test and driver (Charles Lane) + Branch: vmsperl + ! t/pragma/warn/8signal t/pragma/warn/pp_sys t/pragma/warnings.t + ! vms/test.com +____________________________________________________________________________ +[ 5425] By: bailey on 2000/03/02 04:02:44 + Log: Take advantage of new subprocess invocation (Charles Lane) + Branch: vmsperl + ! t/op/runlevel.t t/pragma/strict.t t/pragma/subs.t + ! t/pragma/warnings.t +____________________________________________________________________________ +[ 5424] By: bailey on 2000/03/02 04:00:20 + Log: Increment counter for skipped tests (Charles Lane) + Branch: vmsperl + ! t/io/open.t +____________________________________________________________________________ +[ 5423] By: bailey on 2000/03/02 03:59:14 + Log: Remove redundant elements of @INC to cope with VMS' 255-char limit + on PERL5LIB logical (Dan Sugalski) + Branch: vmsperl + ! lib/Test/Harness.pm +____________________________________________________________________________ +[ 5422] By: bailey on 2000/03/02 03:57:40 + Log: Use temp to construct dirspec in File::Find (Charles Lane) + Branch: vmsperl + ! lib/File/Find.pm +____________________________________________________________________________ +[ 5421] By: bailey on 2000/03/02 03:56:13 + Log: Satisfy various Pod::* needs for Unix syntax (Charles Lane) + (Should move to File::Spec in long term) + Branch: vmsperl + ! lib/Pod/Checker.pm lib/Pod/Parser.pm t/pod/testp2pt.pl +____________________________________________________________________________ +[ 5420] By: bailey on 2000/03/02 03:52:45 + Log: Escape \n in commands written to Descrip.MMS (Charles Lane) + Branch: vmsperl + ! lib/ExtUtils/MM_VMS.pm +____________________________________________________________________________ +[ 5419] By: bailey on 2000/03/02 03:50:53 + Log: Make File::Glob more VMS-friendly (Charles Lane) + Branch: vmsperl + ! ext/File/Glob/Glob.pm ext/File/Glob/bsd_glob.c + ! t/lib/glob-basic.t +____________________________________________________________________________ +[ 5418] By: bailey on 2000/03/02 03:47:21 + Log: Miscellaneous fixes to build procedures (Peter Prymmer) + Branch: vmsperl + ! configure.com vms/subconfigure.com +____________________________________________________________________________ +[ 5417] By: bailey on 2000/03/02 03:42:49 + Log: Temrinate statements in pp_ctl warning test (Charles Lane) + Branch: vmsperl + ! t/pragma/warn/pp_ctl +____________________________________________________________________________ +[ 5416] By: bailey on 2000/03/02 03:39:46 + Log: Warn but continue installing when file missing (Dan Sugalski) + Branch: vmsperl + ! installperl +____________________________________________________________________________ +[ 5415] By: jhi on 2000/03/01 23:31:23 + Log: Make file sparseness detection more portable (Scott Henry) + Branch: cfgperl + ! t/lib/syslfs.t t/op/lfs.t +____________________________________________________________________________ +[ 5414] By: jhi on 2000/03/01 22:53:48 + Log: detypo #5411 continues: Sun grep doesn't have -e. + Branch: cfgperl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 5413] By: jhi on 2000/03/01 22:49:44 + Log: detypo #5411 + Branch: cfgperl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 5412] By: gsar on 2000/03/01 20:04:42 + Log: typo in change#5408 + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 5411] By: jhi on 2000/03/01 18:48:52 + Log: Better detection of the solaris workshop compiler. + Branch: cfgperl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 5410] By: jhi on 2000/03/01 18:18:04 + Log: From: Robin Barker <rmb1@cise.npl.co.uk> + To: perl5-porters@perl.org + Subject: solaris 64-bit and gcc + Date: Wed, 1 Mar 2000 17:59:36 GMT + Message-Id: <200003011759.RAA03938@tempest.npl.co.uk> + Branch: cfgperl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 5409] By: jhi on 2000/03/01 18:16:43 + Log: Integrate with Sarathy. + Branch: cfgperl + +> t/lib/env-array.t + !> MANIFEST README.cygwin ext/DynaLoader/DynaLoader_pm.PL + !> ext/DynaLoader/dlutils.c lib/AutoLoader.pm lib/AutoSplit.pm + !> lib/CGI/Carp.pm lib/CPAN.pm lib/Cwd.pm lib/Env.pm + !> lib/File/Find.pm lib/File/Spec/Mac.pm lib/File/Spec/VMS.pm + !> pod/perldebug.pod pod/perldelta.pod t/lib/env.t + !> t/lib/filefind.t t/lib/glob-basic.t +____________________________________________________________________________ +[ 5408] By: gsar on 2000/03/01 18:15:49 + Log: still more multiline match cleanups (from Greg Bacon) + Branch: perl + ! lib/ExtUtils/Install.pm lib/ExtUtils/Installed.pm + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm lib/FindBin.pm +____________________________________________________________________________ +[ 5407] By: jhi on 2000/03/01 18:11:09 + Log: A further patch from Spider Boardman for long doubleness. + Branch: cfgperl + ! sv.c +____________________________________________________________________________ +[ 5406] By: gsar on 2000/03/01 17:32:09 + Log: yet more multiline match cleanups (from Greg Bacon) + Branch: perl + ! lib/CPAN.pm lib/Cwd.pm +____________________________________________________________________________ +[ 5405] By: gsar on 2000/03/01 17:24:53 + Log: add support for Env arrays (from Gregor N. Purdy + <gregor@focusresearch.com>) + Branch: perl + + t/lib/env-array.t + ! MANIFEST lib/Env.pm pod/perldelta.pod t/lib/env.t +____________________________________________________________________________ +[ 5404] By: gsar on 2000/03/01 17:00:23 + Log: cygwin update (from Eric Fifer) + Branch: perl + ! README.cygwin t/lib/glob-basic.t +____________________________________________________________________________ +[ 5403] By: gsar on 2000/03/01 16:55:47 + Log: more multiline match cleanups (from Greg Bacon) + Branch: perl + ! lib/AutoLoader.pm lib/AutoSplit.pm lib/CGI/Carp.pm + ! lib/File/Spec/Mac.pm lib/File/Spec/VMS.pm +____________________________________________________________________________ +[ 5402] By: gsar on 2000/03/01 16:38:48 + Log: avoid DProf entering dl_unload_file() (from Alan Burlison) + Branch: perl + ! ext/DynaLoader/DynaLoader_pm.PL ext/DynaLoader/dlutils.c +____________________________________________________________________________ +[ 5401] By: gsar on 2000/03/01 16:35:28 + Log: fix minor compatibility issues with finddepth() (from Helmut Jarausch) + Branch: perl + ! lib/File/Find.pm t/lib/filefind.t +____________________________________________________________________________ +[ 5400] By: gsar on 2000/03/01 16:32:24 + Log: mention "r" debugger command (from Ilya Zakharevich) + Branch: perl + ! pod/perldebug.pod +____________________________________________________________________________ +[ 5399] By: jhi on 2000/03/01 14:58:33 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Changes configure.com ext/File/Glob/Glob.pm + !> ext/File/Glob/bsd_glob.c installperl lib/ExtUtils/MM_VMS.pm + !> lib/File/Find.pm lib/Pod/Checker.pm lib/Pod/Parser.pm + !> t/io/open.t t/io/openpid.t t/lib/glob-basic.t t/op/goto.t + !> t/op/runlevel.t t/op/split.t t/pod/testp2pt.pl + !> t/pragma/strict.t t/pragma/subs.t t/pragma/warn/8signal + !> t/pragma/warn/pp_sys t/pragma/warnings.t + !> vms/descrip_mms.template vms/subconfigure.com vms/test.com + !> vms/vms.c +____________________________________________________________________________ +[ 5398] By: gsar on 2000/03/01 07:03:13 + Log: fix testsuite issues in change#5397 + Branch: perl + ! Changes t/pragma/warn/8signal t/pragma/warn/pp_sys + ---------------- -Version v5.5.670 Development release working toward v5.6 +Version v5.5.670 ---------------- ____________________________________________________________________________ @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Wed Mar 1 01:33:58 EET 2000 [metaconfig 3.0 PL70] +# Generated on Thu Mar 2 21:42:14 EET 2000 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <<EOF @@ -4337,9 +4337,9 @@ case "$uselargefiles" in : Look for a hint-file generated 'call-back-unit'. If the : user has specified that a large files perl is to be built, : we may need to set or change some other defaults. - if $test -f uselfs.cbu; then + if $test -f uselargefiles.cbu; then echo "Your platform has some specific hints for large file builds, using them..." - . ./uselfs.cbu + . ./uselargefiles.cbu echo " " echo "Rechecking to see how big your file offsets are..." >&4 $cat >try.c <<EOCP @@ -4817,7 +4817,7 @@ case "$installstyle" in *) dflt='lib/perl5' ;; esac ;; -*) dflt='lib/perl5' ;; +*) dflt="$installstyle" ;; esac : Probably not worth prompting for this since we prompt for all : the directories individually, and the prompt would be too long and @@ -1594,10 +1594,8 @@ external program. On some systems, particularly those with smaller amounts of RAM, some of the tests in t/op/pat.t may fail with an "Out of memory" message. -Specifically, in perl5.004_64, tests 74 and 78 have been reported to -fail on some systems. On my SparcStation IPC with 8 MB of RAM, test 78 -will fail if the system is running any other significant tasks at the -same time. +For example, on my SparcStation IPC with 12 MB of RAM, in perl5.5.670, +test 85 will fail if run under either t/TEST or t/harness. Try stopping other jobs on the system and then running the test by itself: diff --git a/hints/aix.sh b/hints/aix.sh index 5a9482002c..d679ba9ee8 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -201,9 +201,9 @@ EOM esac EOCBU -# This script UU/uselfs.cbu will get 'called-back' by Configure +# This script UU/uselargefiles.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use large files. -cat > UU/uselfs.cbu <<'EOCBU' +cat > UU/uselargefiles.cbu <<'EOCBU' case "$uselargefiles" in ''|$define|true|[yY]*) lfcflags="`getconf XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`" @@ -311,7 +311,8 @@ EOM # do any harm, I didn't pursue it. -- sh lfldflags="`echo $lfldflags`" lflibs="`getconf XBS5_LP64_OFF64_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" - # -q32 and -b32 may have been set by uselfs or user. Remove them. + # -q32 and -b32 may have been set by uselargefiles or user. + # Remove them. ccflags="`echo $ccflags | sed -e 's@-q32@@'`" ldflags="`echo $ldflags | sed -e 's@-b32@@'`" # Tell archiver to use large format. Unless we remove 'ar' diff --git a/hints/hpux.sh b/hints/hpux.sh index faf5879ed9..bbb91f7894 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -378,8 +378,8 @@ EOM ;; esac -cat > UU/uselfs.cbu <<'EOCBU' -# This script UU/uselfs.cbu will get 'called-back' by Configure +cat > UU/uselargefiles.cbu <<'EOCBU' +# This script UU/uselargefiles.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use large files. case "$uselargefiles" in ''|$define|true|[yY]*) diff --git a/hints/irix_6.sh b/hints/irix_6.sh index d14ac93af6..09c5ee1d59 100644 --- a/hints/irix_6.sh +++ b/hints/irix_6.sh @@ -206,6 +206,10 @@ esac # Don't groan about unused libraries. ldflags="$ldflags -Wl,-woff,84" +case "`$cc -version 2>&1`" in +*7.2.*) op_cflags='optimize=-O1' ;; # workaround for an optimizer bug +esac + # We don't want these libraries. # Socket networking is in libc, these are not installed by default, # and just slow perl down. (scotth@sgi.com) diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh index 954af6a418..8ad616d6da 100644 --- a/hints/solaris_2.sh +++ b/hints/solaris_2.sh @@ -56,6 +56,20 @@ esac # Here's another draft of the perl5/solaris/gcc sanity-checker. +test -z "`{$cc:-cc} -V 2>/dev/null|grep -i workshop`" || ccisworkshop="$define" +test -z "`{$cc:-cc} -v 2>/dev/null|grep -i gcc`" || ccisgcc="$define" + +case "$ccisworkshop" in +"$define") + cat >try.c <<EOF +#include <sunmath.h> +int main() { return(0); } +EOF + workshoplibs=`cc -### try.c -lsunmath -o try 2>&1|grep " -Y "|sed 's%.* -Y "P,\(.*\)".*%\1%'|tr ':' '\n'|grep '/SUNWspro/'|sort -u` + loclibpth="$loclibpth $workshoplibs" + ;; +esac + case `type ${cc:-cc}` in */usr/ucb/cc*) cat <<END >&4 @@ -370,7 +384,7 @@ case "$use64bitall" in "$define"|true|[yY]*) libc='/usr/lib/sparcv9/libc.so' if test ! -f $libc; then - cat <<EOM + cat >&4 <<EOM I do not see the 64-bit libc, $libc. Cannot continue, aborting. @@ -381,17 +395,32 @@ EOM loclibpth="$loclibpth /usr/lib/sparcv9" case "$cc -v 2>/dev/null" in *gcc*) - # I don't know what are the flags to make gcc sparcv9-aware, - # I'm just guessing. --jhi - ccflags="$ccflags -mv9" - ldflags="$ldflags -mv9" - lddlflags="$lddlflags -G -mv9" + echo 'main() { return 0; }' > try.c + if ${cc:-cc} -mcpu=v9 -m64 -S try.c 2>&1 | grep -e \ + '-m64 is not supported by this configuration'; then + cat >&4 <<EOM + +Full 64-bit build not supported by this configuration. +Cannot continue, aborting. + +EOM + exit 1 + fi + ccflags="$ccflags -mcpu=v9 -m64" + if test X`getconf XBS5_LP64_OFF64_CFLAGS 2>/dev/null` != X; then + ccflags="$ccflags -Wa,`getconf XBS5_LP64_OFF64_CFLAGS 2>/dev/null`" + fi + # no changes to ld flags, as (according to man ld): + # + # There is no specific option that tells ld to link 64-bit + # objects; the class of the first object that gets processed + # by ld determines whether it is to perform a 32-bit or a + # 64-bit link edit. ;; *) ccflags="$ccflags `getconf XBS5_LP64_OFF64_CFLAGS 2>/dev/null`" ldflags="$ldflags `getconf XBS5_LP64_OFF64_LDFLAGS 2>/dev/null`" lddlflags="$lddlflags -G `getconf XBS5_LP64_OFF64_LDFLAGS 2>/dev/null`" - test -d /opt/SUNWspro/lib && loclibpth="$loclibpth /opt/SUNWspro/lib" ;; esac libscheck='case "`/usr/bin/file $xxx`" in @@ -415,21 +444,27 @@ cat > UU/uselongdouble.cbu <<'EOCBU' # after it has prompted the user for whether to use long doubles. case "$uselongdouble" in "$define"|true|[yY]*) - if test ! -f /opt/SUNWspro/lib/libsunmath.so; then + case "$ccisworkshop" in + '') cat <<EOM -I do not see the libsunmath.so in /opt/SUNWspro/lib; -therefore I cannot do long doubles, sorry. +I do not see the libsunmath.so; therefore I cannot do long doubles, sorry. EOM exit 1 - fi + ;; + esac libswanted="$libswanted sunmath" loclibpth="$loclibpth /opt/SUNWspro/lib" ;; esac EOCBU +rm -f try.c try.o try +# keep that leading tab + ccisworkshop='' + ccisgcc='' + # This is just a trick to include some useful notes. cat > /dev/null <<'End_of_Solaris_Notes' diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm index ecdb039987..0be3ae6765 100644 --- a/lib/AutoSplit.pm +++ b/lib/AutoSplit.pm @@ -148,7 +148,7 @@ my $Is_VMS = ($^O eq 'VMS'); # allow checking for valid ': attrlist' attachments my $nested; -$nested = qr{ \( (?: (?> [^()]+ ) | (?p{ $nested }) )* \) }x; +$nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x; my $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x; my $attr_list = qr{ \s* : \s* (?: $one_attr )* }x; diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 49d167dc0b..ff66b22a7d 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -249,9 +249,9 @@ foreach $key (keys %input_expr) { $input_expr{$key} =~ s/\n+$//; } -$bal = qr[(?:(?>[^()]+)|\((?p{ $bal })\))*]; # ()-balanced +$bal = qr[(?:(?>[^()]+)|\((??{ $bal })\))*]; # ()-balanced $cast = qr[(?:\(\s*SV\s*\*\s*\)\s*)?]; # Optional (SV*) cast -$size = qr[,\s* (?p{ $bal }) ]x; # Third arg (to setpvn) +$size = qr[,\s* (??{ $bal }) ]x; # Third arg (to setpvn) foreach $key (keys %output_expr) { use re 'eval'; @@ -260,8 +260,8 @@ foreach $key (keys %output_expr) { ($output_expr{$key} =~ m[^ \s+ sv_set ( [iunp] ) v (n)? # Type, is_setpvn \s* \( \s* $cast \$arg \s* , - \s* ( (?p{ $bal }) ) # Set from - ( (?p{ $size }) )? # Possible sizeof set-from + \s* ( (??{ $bal }) ) # Set from + ( (??{ $size }) )? # Possible sizeof set-from \) \s* ; \s* $ ]x); $targetable{$key} = [$t, $with_size, $arg, $sarg] if $t; @@ -287,11 +287,11 @@ sub check_keyword { my ($C_group_rex, $C_arg); # Group in C (no support for comments or literals) $C_group_rex = qr/ [({\[] - (?: (?> [^()\[\]{}]+ ) | (?p{ $C_group_rex }) )* + (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )* [)}\]] /x ; # Chunk in C without comma at toplevel (no comments): $C_arg = qr/ (?: (?> [^()\[\]{},"']+ ) - | (?p{ $C_group_rex }) + | (??{ $C_group_rex }) | " (?: (?> [^\\"]+ ) | \\. )* " # String literal @@ -1029,8 +1029,8 @@ while (fetch_para()) { my %out_vars; if ($process_argtypes and $orig_args =~ /\S/) { my $args = "$orig_args ,"; - if ($args =~ /^( (?p{ $C_arg }) , )* $ /x) { - @args = ($args =~ /\G ( (?p{ $C_arg }) ) , /xg); + if ($args =~ /^( (??{ $C_arg }) , )* $ /x) { + @args = ($args =~ /\G ( (??{ $C_arg }) ) , /xg); for ( @args ) { s/^\s+//; s/\s+$//; diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm index be9a43cb78..959e33d0cf 100644 --- a/lib/File/Spec/Mac.pm +++ b/lib/File/Spec/Mac.pm @@ -343,8 +343,8 @@ sub abs2rel { Converts a relative path to an absolute path. - $abs_path = $File::Spec->rel2abs( $destination ) ; - $abs_path = $File::Spec->rel2abs( $destination, $base ) ; + $abs_path = File::Spec->rel2abs( $destination ) ; + $abs_path = File::Spec->rel2abs( $destination, $base ) ; If $base is not present or '', then L<cwd()> is used. If $base is relative, then it is converted to absolute form using L</rel2abs()>. This means that it diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index f4e9f27bd1..0cbc8c7e57 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -383,8 +383,8 @@ sub abs2rel { Converts a relative path to an absolute path. - $abs_path = $File::Spec->rel2abs( $destination ) ; - $abs_path = $File::Spec->rel2abs( $destination, $base ) ; + $abs_path = File::Spec->rel2abs( $destination ) ; + $abs_path = File::Spec->rel2abs( $destination, $base ) ; If $base is not present or '', then L<cwd()> is used. If $base is relative, then it is converted to absolute form using L</rel2abs()>. This means that it diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index 52519b953f..9514dd74b5 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -485,12 +485,12 @@ sub abs2rel { } # Figure out the effective $base and clean it up. - if ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - elsif ( !defined( $base ) || $base eq '' ) { + if ( !defined( $base ) || $base eq '' ) { $base = cwd() ; } + elsif ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } else { $base = $self->canonpath( $base ) ; } diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index 85a71a23a3..aa95fbde36 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -341,8 +341,8 @@ sub abs2rel { Converts a relative path to an absolute path. - $abs_path = $File::Spec->rel2abs( $destination ) ; - $abs_path = $File::Spec->rel2abs( $destination, $base ) ; + $abs_path = File::Spec->rel2abs( $destination ) ; + $abs_path = File::Spec->rel2abs( $destination, $base ) ; If $base is not present or '', then L<cwd()> is used. If $base is relative, then it is converted to absolute form using L</rel2abs()>. This means that it @@ -368,12 +368,12 @@ sub rel2abs($;$;) { if ( ! $self->file_name_is_absolute( $path ) ) { - if ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - elsif ( !defined( $base ) || $base eq '' ) { + if ( !defined( $base ) || $base eq '' ) { $base = cwd() ; } + elsif ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } else { $base = $self->canonpath( $base ) ; } diff --git a/lib/Pod/Find.pm b/lib/Pod/Find.pm index 038b090b42..e29c908e16 100644 --- a/lib/Pod/Find.pm +++ b/lib/Pod/Find.pm @@ -148,7 +148,7 @@ sub pod_find # * remove e.g. 5.00503 # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod) $SIMPLIFY_RX = - qq!^(?i:site_perl/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\$))*!; + qq!^(?i:site_perl/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!; } @@ -158,11 +158,11 @@ sub pod_find my $pwd = cwd(); foreach my $try (@search) { - unless($try =~ m:^/:) { + unless($try =~ m:^/:s) { # make path absolute $try = join('/',$pwd,$try); } - $try =~ s:/\.?(?=/|$)::; # simplify path + $try =~ s:/\.?(?=/|\z)::; # simplify path my $name; if(-f $try) { if($name = _check_and_extract_name($try, $opts{-verbose})) { @@ -183,7 +183,7 @@ sub pod_find else { $dirs_visited{$item} = 1; } - if($opts{-perl} && /^(\d+\.[\d_]+)$/ && eval "$1" != $]) { + if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) { $File::Find::prune = 1; warn "Perl $] version mismatch on $_, skipping.\n" if($opts{-verbose}); @@ -216,7 +216,7 @@ sub _check_and_extract_name { my ($file, $verbose, $root_rx) = @_; # check extension or executable - unless($file =~ /\.(pod|pm|pl)$/i || (-f $file && -x _ && -T _)) { + unless($file =~ /\.(pod|pm|pl)\z/i || (-f $file && -x _ && -T _)) { return undef; } @@ -239,13 +239,13 @@ sub _check_and_extract_name { # _TODO_ what happens on e.g. Win32? my $name = $file; if(defined $root_rx) { - $name =~ s!$root_rx!!; - $name =~ s!$SIMPLIFY_RX!!o if(defined $SIMPLIFY_RX); + $name =~ s!$root_rx!!s; + $name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX); } else { - $name =~ s:^.*/::; + $name =~ s:^.*/::s; } - $name =~ s/\.(pod|pm|pl)$//i; + $name =~ s/\.(pod|pm|pl)\z//i; $name =~ s!/+!::!g; $name; } @@ -254,8 +254,8 @@ sub _check_and_extract_name { # basename & strip extension sub simplify_name { my ($str) = @_; - $str =~ s:^.*/::; - $str =~ s:\.p([lm]|od)$::i; + $str =~ s:^.*/::s; + $str =~ s:\.p([lm]|od)\z::i; $str; } diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm index 4df9599cf2..00b7e8993e 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -1,23 +1,21 @@ package Pod::Html; - -use Pod::Functions; -use Getopt::Long; # package for handling command-line parameters -use File::Spec::Unix; +use strict; require Exporter; -use vars qw($VERSION); + +use vars qw($VERSION @ISA @EXPORT); $VERSION = 1.03; -@ISA = Exporter; +@ISA = qw(Exporter); @EXPORT = qw(pod2html htmlify); -use Cwd; use Carp; +use Config; +use Cwd; +use File::Spec::Unix; +use Getopt::Long; +use Pod::Functions; use locale; # make \w work right in non-ASCII lands -use strict; - -use Config; - =head1 NAME Pod::Html - module to convert pod files to HTML @@ -39,6 +37,33 @@ Pod::Html takes the following arguments: =over 4 +=item backlink + + --backlink="Back to Top" + +Adds "Back to Top" links in front of every HEAD1 heading (except for +the first). By default, no backlink are being generated. + +=item css + + --css=stylesheet + +Specify the URL of a cascading style sheet. + +=item flush + + --flush + +Flushes the item and directory caches. + +=item header + + --header + --noheader + +Creates header and footer blocks containing the text of the NAME +section. By default, no headers are being generated. + =item help --help @@ -61,6 +86,14 @@ Pod::Html the root of the documentation tree. Sets the base URL for the HTML files. When cross-references are made, the HTML root is prepended to the URL. +=item index + + --index + --noindex + +Generate an index at the top of the HTML file. This is the default +behaviour. + =item infile --infile=name @@ -68,26 +101,6 @@ the HTML root is prepended to the URL. Specify the pod file to convert. Input is taken from STDIN if no infile is specified. -=item outfile - - --outfile=name - -Specify the HTML file to create. Output goes to STDOUT if no outfile -is specified. - -=item podroot - - --podroot=name - -Specify the base directory for finding library pods. - -=item podpath - - --podpath=name:...:name - -Specify which subdirectories of the podroot contain pod files whose -HTML converted forms can be linked-to in cross-references. - =item libpods --libpods=name:...:name @@ -97,39 +110,46 @@ List of page names (eg, "perlfunc") which contain linkable C<=item>s. =item netscape --netscape + --nonetscape -Use Netscape HTML directives when applicable. - -=item nonetscape +Use Netscape HTML directives when applicable. By default, they will +B<not> be used. - --nonetscape +=item outfile -Do not use Netscape HTML directives (default). + --outfile=name -=item index +Specify the HTML file to create. Output goes to STDOUT if no outfile +is specified. - --index +=item podpath -Generate an index at the top of the HTML file (default behaviour). + --podpath=name:...:name -=item noindex +Specify which subdirectories of the podroot contain pod files whose +HTML converted forms can be linked-to in cross-references. - --noindex +=item podroot -Do not generate an index at the top of the HTML file. + --podroot=name +Specify the base directory for finding library pods. -=item recurse +=item quiet - --recurse + --quiet + --noquiet -Recurse into subdirectories specified in podpath (default behaviour). +Don't display I<mostly harmless> warning messages. These messages +will be displayed by default. But this is not the same as C<verbose> +mode. -=item norecurse +=item recurse + --recurse --norecurse -Do not recurse into subdirectories specified in podpath. +Recurse into subdirectories specified in podpath (default behaviour). =item title @@ -137,23 +157,12 @@ Do not recurse into subdirectories specified in podpath. Specify the title of the resulting HTML file. -=item css - - --css=stylesheet - -Specify the URL of a cascading style sheet. - =item verbose --verbose + --noverbose -Display progress messages. - -=item quiet - - --quiet - -Don't display I<mostly harmless> warning messages. +Display progress messages. By default, they won't be displayed. =back @@ -211,6 +220,7 @@ my $recurse = 1; # recurse on subdirectories in $podpath. my $quiet = 0; # not quiet by default my $verbose = 0; # not verbose by default my $doindex = 1; # non-zero if we should generate an index +my $backlink = ''; # text for "back to top" links my $listlevel = 0; # current list depth my @listend = (); # the text to use to end the list. my $after_lpar = 0; # set to true after a par in an =item @@ -257,6 +267,7 @@ $recurse = 1; # recurse on subdirectories in $podpath. $quiet = 0; # not quiet by default $verbose = 0; # not verbose by default $doindex = 1; # non-zero if we should generate an index +$backlink = ''; # text for "back to top" links $listlevel = 0; # current list depth @listend = (); # the text to use to end the list. $after_lpar = 0; # set to true after a par in an =item @@ -331,7 +342,7 @@ sub pod2html { } $htmlfile = "-" unless $htmlfile; # stdout $htmlroot = "" if $htmlroot eq "/"; # so we don't get a // - $htmldir =~ s#/$## ; # so we don't get a // + $htmldir =~ s#/\z## ; # so we don't get a // if ( $htmlroot eq '' && defined( $htmldir ) && $htmldir ne '' @@ -377,7 +388,7 @@ sub pod2html { } } } - if (!$title and $podfile =~ /\.pod$/) { + if (!$title and $podfile =~ /\.pod\z/) { # probably a split pod so take first =head[12] as title for (my $i = 0; $i < @poddata; $i++) { last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/; @@ -389,7 +400,7 @@ sub pod2html { $title =~ s/\s*\(.*\)//; } else { warn "$0: no title for $podfile" unless $quiet; - $podfile =~ /^(.*)(\.[^.\/]+)?$/; + $podfile =~ /^(.*)(\.[^.\/]+)?\z/s; $title = ($podfile eq "-" ? 'No Title' : $1); warn "using $title" if $verbose; } @@ -526,8 +537,8 @@ END_OF_HEAD finish_list(); # link to page index - print HTML "<P><A HREF=\"#__index__\"><SMALL>page index</SMALL></A></P>\n" - if $doindex and $index; + print HTML "<P><A HREF=\"#__index__\"><SMALL>$backlink</SMALL></A></P>\n" + if $doindex and $index and $backlink; print HTML <<END_OF_TAIL; $block @@ -557,43 +568,50 @@ Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name> --libpods=<name>:...:<name> --recurse --verbose --index --netscape --norecurse --noindex - --flush - flushes the item and directory caches. - --help - prints this message. - --htmlroot - http-server base directory from which all relative paths - in podpath stem (default is /). - --index - generate an index at the top of the resulting html - (default). - --infile - filename for the pod to convert (input taken from stdin - by default). - --libpods - colon-separated list of pages to search for =item pod - directives in as targets of C<> and implicit links (empty - by default). note, these are not filenames, but rather - page names like those that appear in L<> links. - --netscape - will use netscape html directives when applicable. - --nonetscape - will not use netscape directives (default). - --outfile - filename for the resulting html file (output sent to - stdout by default). - --podpath - colon-separated list of directories containing library - pods. empty by default. - --podroot - filesystem base directory from which all relative paths - in podpath stem (default is .). - --noindex - don't generate an index at the top of the resulting html. - --norecurse - don't recurse on those subdirectories listed in podpath. - --recurse - recurse on those subdirectories listed in podpath - (default behavior). - --title - title that will appear in resulting html file. - --header - produce block header/footer - --css - stylesheet URL - --verbose - self-explanatory - --quiet - supress some benign warning messages + --backlink - set text for "back to top" links (default: none). + --css - stylesheet URL + --flush - flushes the item and directory caches. + --[no]header - produce block header/footer (default is no headers). + --help - prints this message. + --htmldir - directory for resulting HTML files. + --htmlroot - http-server base directory from which all relative paths + in podpath stem (default is /). + --[no]index - generate an index at the top of the resulting html + (default behaviour). + --infile - filename for the pod to convert (input taken from stdin + by default). + --libpods - colon-separated list of pages to search for =item pod + directives in as targets of C<> and implicit links (empty + by default). note, these are not filenames, but rather + page names like those that appear in L<> links. + --[no]netscape - will use netscape html directives when applicable. + (default is not to use them). + --outfile - filename for the resulting html file (output sent to + stdout by default). + --podpath - colon-separated list of directories containing library + pods (empty by default). + --podroot - filesystem base directory from which all relative paths + in podpath stem (default is .). + --[no]quiet - supress some benign warning messages (default is off). + --[no]recurse - recurse on those subdirectories listed in podpath + (default behaviour). + --title - title that will appear in resulting html file. + --[no]verbose - self-explanatory (off by default). END_OF_USAGE sub parse_command_line { - my ($opt_flush,$opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_recurse,$opt_title,$opt_verbose,$opt_css,$opt_header,$opt_quiet); + my ($opt_backlink,$opt_css,$opt_flush,$opt_header,$opt_help,$opt_htmldir, + $opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape, + $opt_outfile,$opt_podpath,$opt_podroot,$opt_quiet,$opt_recurse, + $opt_title,$opt_verbose); + unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html}; my $result = GetOptions( + 'backlink=s' => \$opt_backlink, + 'css=s' => \$opt_css, 'flush' => \$opt_flush, + 'header!' => \$opt_header, 'help' => \$opt_help, 'htmldir=s' => \$opt_htmldir, 'htmlroot=s' => \$opt_htmlroot, @@ -604,40 +622,37 @@ sub parse_command_line { 'outfile=s' => \$opt_outfile, 'podpath=s' => \$opt_podpath, 'podroot=s' => \$opt_podroot, + 'quiet!' => \$opt_quiet, 'recurse!' => \$opt_recurse, 'title=s' => \$opt_title, - 'header' => \$opt_header, - 'css=s' => \$opt_css, - 'verbose' => \$opt_verbose, - 'quiet' => \$opt_quiet, + 'verbose!' => \$opt_verbose, ); usage("-", "invalid parameters") if not $result; usage("-") if defined $opt_help; # see if the user asked for help $opt_help = ""; # just to make -w shut-up. - $podfile = $opt_infile if defined $opt_infile; - $htmlfile = $opt_outfile if defined $opt_outfile; - $htmldir = $opt_htmldir if defined $opt_htmldir; - @podpath = split(":", $opt_podpath) if defined $opt_podpath; @libpods = split(":", $opt_libpods) if defined $opt_libpods; + $backlink = $opt_backlink if defined $opt_backlink; + $css = $opt_css if defined $opt_css; + $header = $opt_header if defined $opt_header; + $htmldir = $opt_htmldir if defined $opt_htmldir; + $htmlroot = $opt_htmlroot if defined $opt_htmlroot; + $doindex = $opt_index if defined $opt_index; + $podfile = $opt_infile if defined $opt_infile; + $netscape = $opt_netscape if defined $opt_netscape; + $htmlfile = $opt_outfile if defined $opt_outfile; + $podroot = $opt_podroot if defined $opt_podroot; + $quiet = $opt_quiet if defined $opt_quiet; + $recurse = $opt_recurse if defined $opt_recurse; + $title = $opt_title if defined $opt_title; + $verbose = $opt_verbose if defined $opt_verbose; + warn "Flushing item and directory caches\n" if $opt_verbose && defined $opt_flush; unlink($dircache, $itemcache) if defined $opt_flush; - - $htmlroot = $opt_htmlroot if defined $opt_htmlroot; - $podroot = $opt_podroot if defined $opt_podroot; - - $doindex = $opt_index if defined $opt_index; - $recurse = $opt_recurse if defined $opt_recurse; - $title = $opt_title if defined $opt_title; - $header = defined $opt_header ? 1 : 0; - $css = $opt_css if defined $opt_css; - $verbose = defined $opt_verbose ? 1 : 0; - $quiet = defined $opt_quiet ? 1 : 0; - $netscape = $opt_netscape if defined $opt_netscape; } @@ -787,7 +802,7 @@ sub scan_podpath { $dirname = $1; opendir(DIR, $dirname) || die "$0: error opening directory $dirname: $!\n"; - @files = grep(/(\.pod|\.pm)$/ && ! -d $_, readdir(DIR)); + @files = grep(/(\.pod|\.pm)\z/ && ! -d $_, readdir(DIR)); closedir(DIR); # scan each .pod and .pm file for =item directives @@ -873,13 +888,13 @@ sub scan_dir { $pages{$_} = "" unless defined $pages{$_}; $pages{$_} .= "$dir/$_:"; push(@subdirs, $_); - } elsif (/\.pod$/) { # .pod - s/\.pod$//; + } elsif (/\.pod\z/) { # .pod + s/\.pod\z//; $pages{$_} = "" unless defined $pages{$_}; $pages{$_} .= "$dir/$_.pod:"; push(@pods, "$dir/$_.pod"); - } elsif (/\.pm$/) { # .pm - s/\.pm$//; + } elsif (/\.pm\z/) { # .pm + s/\.pm\z//; $pages{$_} = "" unless defined $pages{$_}; $pages{$_} .= "$dir/$_.pm:"; push(@pods, "$dir/$_.pm"); @@ -959,7 +974,7 @@ sub scan_items { my($i, $item); local $_; - $pod =~ s/\.pod$//; + $pod =~ s/\.pod\z//; $pod .= ".html" if $pod; foreach $i (0..$#poddata) { @@ -1001,8 +1016,8 @@ sub process_head { print HTML "<P>\n"; if( $level == 1 && ! $top ){ - print HTML "<A HREF=\"#__index__\"><SMALL>page index</SMALL></A>\n" - if $hasindex; + print HTML "<A HREF=\"#__index__\"><SMALL>$backlink</SMALL></A>\n" + if $hasindex and $backlink; print HTML "<HR>\n" } @@ -1678,7 +1693,7 @@ sub page_sect($$) { # this will only find one page. A better solution might be to produce # an intermediate page that is an index to all such pages. my $page_name = $page ; - $page_name =~ s,^.*/,, ; + $page_name =~ s,^.*/,,s ; if ( defined( $pages{ $page_name } ) && $pages{ $page_name } =~ /([^:]*$page)\.(?:pod|pm):/ ) { @@ -1737,7 +1752,7 @@ sub page_sect($$) { # for other kinds of links, like file:, ftp:, etc. my $url ; if ( $htmlfileurl ne '' ) { - $link = "$htmldir$link" if $link =~ m{^/}; + $link = "$htmldir$link" if $link =~ m{^/}s; $url = relativize_url( $link, $htmlfileurl ); # print( " b: [$link,$htmlfileurl,$url]\n" ); } diff --git a/lib/Pod/Man.pm b/lib/Pod/Man.pm index 9aadd42dea..f096c626c8 100644 --- a/lib/Pod/Man.pm +++ b/lib/Pod/Man.pm @@ -365,8 +365,8 @@ sub begin_pod { my $name = $$self{name}; if (!defined $name) { $name = $self->input_file; - $section = 3 if (!$$self{section} && $name =~ /\.pm$/i); - $name =~ s/\.p(od|[lm])$//i; + $section = 3 if (!$$self{section} && $name =~ /\.pm\z/i); + $name =~ s/\.p(od|[lm])\z//i; if ($section =~ /^1/) { require File::Basename; $name = uc File::Basename::basename ($name); @@ -378,11 +378,11 @@ sub begin_pod { # which works. Should be fixed to use File::Spec. for ($name) { s%//+%/%g; - if ( s%^.*?/lib/[^/]*perl[^/]*/%%i - or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%i) { - s%^site(_perl)?/%%; # site and site_perl - s%^(.*-$^O|$^O-.*)/%%o; # arch - s%^\d+\.\d+%%; # version + if ( s%^.*?/lib/[^/]*perl[^/]*/%%is + or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%is) { + s%^site(_perl)?/%%s; # site and site_perl + s%^(.*-$^O|$^O-.*)/%%os; # arch + s%^\d+\.\d+%%s; # version } s%/%::%g; } diff --git a/lib/SelfLoader.pm b/lib/SelfLoader.pm index 2aa29303fd..ff441c72dd 100644 --- a/lib/SelfLoader.pm +++ b/lib/SelfLoader.pm @@ -11,7 +11,7 @@ my %Cache; # private cache for all SelfLoader's client packages # allow checking for valid ': attrlist' attachments my $nested; -$nested = qr{ \( (?: (?> [^()]+ ) | (?p{ $nested }) )* \) }x; +$nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x; my $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x; my $attr_list = qr{ \s* : \s* (?: $one_attr )* }x; diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm index 1e95ec33b6..0954000e8d 100644 --- a/lib/Term/Cap.pm +++ b/lib/Term/Cap.pm @@ -107,8 +107,8 @@ sub termcap_path { ## private push(@termcap_path, $ENV{TERMCAP}) if ((exists $ENV{TERMCAP}) && (($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') - ? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/i - : $ENV{TERMCAP} =~ /^\//)); + ? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/is + : $ENV{TERMCAP} =~ /^\//s)); if ((exists $ENV{TERMPATH}) && ($ENV{TERMPATH})) { # Add the users $TERMPATH push(@termcap_path, split(/(:|\s+)/, $ENV{TERMPATH})) @@ -157,7 +157,7 @@ sub Tgetent { ## public -- static method my $foo = (exists $ENV{TERMCAP} ? $ENV{TERMCAP} : ''); # $entry is the extracted termcap entry - if (($foo !~ m:^/:) && ($foo =~ m/(^|\|)${termpat}[:|]/)) { + if (($foo !~ m:^/:s) && ($foo =~ m/(^|\|)${termpat}[:|]/s)) { $entry = $foo; } diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index e98a144cd0..f913478643 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -83,7 +83,7 @@ sub runtests { while ($test = shift(@tests)) { $te = $test; chop($te); - if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./; } + if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./s; } my $blank = (' ' x 77); my $leader = "$te" . '.' x (20 - length($te)); my $ml = ""; @@ -94,6 +94,8 @@ sub runtests { $fh->open($test) or print "can't open $test. $!\n"; my $first = <$fh>; my $s = $switches; + $s .= " $ENV{'HARNESS_PERL_SWITCHES'}" + if exists $ENV{'HARNESS_PERL_SWITCHES'}; $s .= join " ", q[ "-T"], map {qq["-I$_"]} @INC if $first =~ /^#!.*\bperl.*-\w*T/; $fh->close or print "can't close $test. $!\n"; @@ -508,6 +510,11 @@ If relative, directory name is with respect to the current directory at the moment runtests() was called. Putting absolute path into C<HARNESS_FILELEAK_IN_DIR> may give more predicatable results. +The value of C<HARNESS_PERL_SWITCHES> will be prepended to the +switches used to invoke perl on each test. For example, setting +C<HARNESS_PERL_SWITCHES> to "-W" will run all tests with all +warnings enabled. + Harness sets C<HARNESS_ACTIVE> before executing the individual tests. This allows the tests to determine if they are being executed through the harness or by any other means. diff --git a/lib/blib.pm b/lib/blib.pm index 1d56a58174..0916f797fd 100644 --- a/lib/blib.pm +++ b/lib/blib.pm @@ -45,12 +45,12 @@ sub import { my $package = shift; my $dir = getcwd; - if ($^O eq 'VMS') { ($dir = VMS::Filespec::unixify($dir)) =~ s-/$--; } + if ($^O eq 'VMS') { ($dir = VMS::Filespec::unixify($dir)) =~ s-/\z--; } if (@_) { $dir = shift; - $dir =~ s/blib$//; - $dir =~ s,/+$,,; + $dir =~ s/blib\z//; + $dir =~ s,/+\z,,; $dir = '.' unless ($dir); die "$dir is not a directory\n" unless (-d $dir); } diff --git a/lib/constant.pm b/lib/constant.pm index bbfdb78ec4..b4fcd421ac 100644 --- a/lib/constant.pm +++ b/lib/constant.pm @@ -35,7 +35,7 @@ sub import { my $pkg = caller; # Normal constant name - if ($name =~ /^(?:[A-Z]\w|_[A-Z])\w*\z/ and !$forbidden{$name}) { + if ($name =~ /^_?[^\W_0-9]\w*\z/ and !$forbidden{$name}) { # Everything is okay # Name forced into main, but we're not in main. Fatal. @@ -58,11 +58,6 @@ sub import { } elsif ($forced_into_main{$name}) { Carp::carp("Constant name '$name' is " . "forced into package main::"); - } elsif (1 == length $name) { - Carp::carp("Constant name '$name' is too short"); - } elsif ($name =~ /^_?[a-z\d]/) { - Carp::carp("Constant name '$name' should " . - "have an initial capital letter"); } else { # Catch-all - what did I miss? If you get this error, # please let me know what your constant's name was. diff --git a/makedepend.SH b/makedepend.SH index 994123ecd1..7129e08a84 100755 --- a/makedepend.SH +++ b/makedepend.SH @@ -135,6 +135,7 @@ for file in `$cat .clist`; do fi $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c | $sed \ + -e '1d' \ -e '/^#.*<stdin>/d' \ -e '/^#.*"-"/d' \ -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \ @@ -173,7 +173,7 @@ Perl_pad_allocmy(pTHX_ char *name) } } if (PL_in_my == KEY_our) { - while (off >= 0 && off <= top) { + while (off <= top) { if ((sv = svp[off]) && sv != &PL_sv_undef && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash) diff --git a/pod/perl.pod b/pod/perl.pod index 0414fa4f29..cb627cdb7a 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -35,6 +35,7 @@ sections: perlmodlib Perl modules: how to write and use perlmodinstall Perl modules: how to install from CPAN perlform Perl formats + perlunicode Perl unicode support perllocale Perl locale support perlreftut Perl references short introduction @@ -50,7 +51,8 @@ sections: perlipc Perl interprocess communication perlfork Perl fork() information perlthrtut Perl threads tutorial - perldbmfilter Perl DBM Filters + perllexwarn Perl warnings and their control + perldbmfilter Perl DBM filters perlcompile Perl compiler suite intro perldebug Perl debugging @@ -77,6 +79,15 @@ sections: perlhack Perl hackers guide perlhist Perl history records + perlamiga Perl notes for Amiga + perlcygwin Perl notes for Cygwin + perldos Perl notes for DOS + perlhpux Perl notes for HP-UX + perlos2 Perl notes for OS/2 + perlos390 Perl notes for OS/390 + perlvms Perl notes for VMS + perlwin32 Perl notes for Windows + (If you're intending to read these straight through for the first time, the suggested order will tend to reduce the number of forward references.) diff --git a/pod/perldata.pod b/pod/perldata.pod index a122d34c80..4dbc76564e 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -274,6 +274,7 @@ integer formats: 0xff # hex 0377 # octal 0b011011 # binary + v102.111.111 # string (made of characters "f", "o", "o") String literals are usually delimited by either single or double quotes. They work much like quotes in the standard Unix shells: @@ -323,6 +324,17 @@ C<$days{Feb}> and the quotes will be assumed automatically. But anything more complicated in the subscript will be interpreted as an expression. +A literal of the form C<v1.20.300.4000> is parsed as a string composed +of characters with the specified ordinals. This provides an alternative, +more readable way to construct strings, rather than use the somewhat less +readable interpolation form C<"\x{1}\x{14}\x{12c}\x{fa0}">. This is useful +for representing Unicode strings, and for comparing version "numbers" +using the string comparison operators, C<cmp>, C<gt>, C<lt> etc. +If there are two or more dots in the literal, the leading C<v> may be +omitted. Such literals are accepted by both C<require> and C<use> for +doing a version check. The C<$^V> special variable also contains the +running Perl interpreter's version in this form. See L<perlvar/$^V>. + The special literals __FILE__, __LINE__, and __PACKAGE__ represent the current filename, line number, and package name at that point in your program. They may be used only as separate tokens; they diff --git a/pod/perldelta.pod b/pod/perldelta.pod index ee42587b2c..964233c271 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -539,7 +539,7 @@ to print ordinals of characters in arbitrary strings: printf "%*vX", ":", $addr; # formats IPv6 address printf "%*vb", " ", $bits; # displays bitstring -See L<perlop/"Strings of Character"> for additional information. +See L<perldata/"Scalar value constructors"> for additional information. =head2 Weak references @@ -1653,6 +1653,15 @@ a connect attempt. This allows you to configure its options A bug that prevented the IO::Socket::protocol() accessor from ever returning the correct value has been corrected. +IO::Socket::connect now uses non-blocking IO instead of alarm() +to do connect timeouts. + +IO::Socket::accept now uses select() instead of alarm() for doing +timeouts. + +IO::Socket::INET->new now sets $! correctly on failure. $@ is +still set for backwards compatability. + =item JPL Java Perl Lingo is now distributed with Perl. See jpl/README diff --git a/pod/perlop.pod b/pod/perlop.pod index ac9d4b65da..9c8fa23f1d 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -1796,22 +1796,6 @@ operation you intend by using C<""> or C<0+>, as in the examples below. See L<perlfunc/vec> for information on how to manipulate individual bits in a bit vector. -=head2 Strings of Character - -A literal of the form C<v1.20.300.4000> is parsed as a string composed -of characters with the specified ordinals. This provides an alternative, -more readable way to construct strings, rather than use the somewhat less -readable interpolation form C<"\x{1}\x{14}\x{12c}\x{fa0}">. This is useful -for representing Unicode strings, and for comparing version "numbers" -using the string comparison operators, C<cmp>, C<gt>, C<lt> etc. - -If there are two or more dots in the literal, the leading C<v> may be -omitted. - -Such literals are accepted by both C<require> and C<use> for doing a version -check. The C<$^V> special variable also contains the running Perl -interpreter's version in this form. See L<perlvar/$^V>. - =head2 Integer Arithmetic By default, Perl assumes that it must do most of its arithmetic in diff --git a/pod/perlpod.pod b/pod/perlpod.pod index 0997c71738..49e0ffc767 100644 --- a/pod/perlpod.pod +++ b/pod/perlpod.pod @@ -289,9 +289,8 @@ B<pod2man> for details). Thus, you shouldn't write things like C<the LE<lt>fooE<gt> manpage>, if you want the translated document to read sensibly. -If you don need or want total control of the text used for a -link in the output use the form LE<lt>show this text|fooE<gt> -instead. +If you need total control of the text used for a link in the output +use the form LE<lt>show this text|fooE<gt> instead. =item * diff --git a/pod/perlre.pod b/pod/perlre.pod index d2f64d2eb6..52eac04a34 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -570,7 +570,7 @@ so you should only do so if you are also using taint checking. Better yet, use the carefully constrained evaluation within a Safe module. See L<perlsec> for details about both these mechanisms. -=item C<(?p{ code })> +=item C<(??{ code })> B<WARNING>: This extended regular expression feature is considered highly experimental, and may be changed or deleted without notice. @@ -592,7 +592,7 @@ The following pattern matches a parenthesized group: (?: (?> [^()]+ ) # Non-parens without backtracking | - (?p{ $re }) # Group with matching parens + (??{ $re }) # Group with matching parens )* \) }x; @@ -1175,7 +1175,7 @@ else in the whole regular expression.) For this grouping operator there is no need to describe the ordering, since only whether or not C<S> can match is important. -=item C<(?p{ EXPR })> +=item C<(??{ EXPR })> The ordering is the same as for the regular expression which is the result of EXPR. diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 83d40d4241..0a67fdc232 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -1648,7 +1648,7 @@ cntrl, graph, print, punct, xdigit C<(?#text)>, C<(?imsx-imsx)>, C<(?:pattern)>, C<(?imsx-imsx:pattern)>, C<(?=pattern)>, C<(?!pattern)>, C<(?E<lt>=pattern)>, C<(?<!pattern)>, C<(?{ -code })>, C<(?p{ code })>, C<(?E<gt>pattern)>, +code })>, C<(??{ code })>, C<(?E<gt>pattern)>, C<(?(condition)yes-pattern|no-pattern)>, C<(?(condition)yes-pattern)> =item Backtracking @@ -1663,7 +1663,7 @@ C<(?(condition)yes-pattern|no-pattern)>, C<(?(condition)yes-pattern)> C<ST>, C<S|T>, C<S{REPEAT_COUNT}>, C<S{min,max}>, C<S{min,max}?>, C<S?>, C<S*>, C<S+>, C<S??>, C<S*?>, C<S+?>, C<(?E<gt>S)>, C<(?=S)>, C<(?<=S)>, -C<(?!S)>, C<(?<!S)>, C<(?p{ EXPR })>, +C<(?!S)>, C<(?<!S)>, C<(??{ EXPR })>, C<(?(condition)yes-pattern|no-pattern)> =item Creating custom RE engines @@ -1199,7 +1199,21 @@ PP(pp_ncmp) { dPOPTOPnnrl; I32 value; +#ifdef __osf__ /* XXX fix in 5.6.1 --jhi */ +#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) +#define Perl_isnan isnanl +#else +#define Perl_isnan isnan +#endif +#endif +#ifdef __osf__ /* XXX fix in 5.6.1 --jhi */ + if (Perl_isnan(left) || Perl_isnan(right)) { + SETs(&PL_sv_undef); + RETURN; + } + value = (left > right) - (left < right); +#else if (left == right) value = 0; else if (left < right) @@ -1210,6 +1224,7 @@ PP(pp_ncmp) SETs(&PL_sv_undef); RETURN; } +#endif SETi(value); RETURN; } @@ -1735,6 +1735,9 @@ S_reg(pTHX_ I32 paren, I32 *flagp) *flagp = TRYAGAIN; return NULL; case 'p': + Perl_warner(aTHX_ WARN_REGEXP, "(?p{}) is deprecated - use (??{})"); + /* FALL THROUGH*/ + case '?': logical = 1; paren = *PL_regcomp_parse++; /* FALL THROUGH */ @@ -6230,8 +6230,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV *--eptr = c; #ifdef USE_LONG_DOUBLE { - char* p = PERL_PRIfldbl + sizeof(PERL_PRIfldbl) - 3; - while (p >= PERL_PRIfldbl) { *--eptr = *p--; } + static char const my_prifldbl[] = PERL_PRIfldbl; + char const *p = my_prifldbl + sizeof my_prifldbl - 3; + while (p >= my_prifldbl) { *--eptr = *p--; } } #endif if (has_precis) { diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t index 9efe5e9f3e..e38c7e7860 100755 --- a/t/lib/anydbm.t +++ b/t/lib/anydbm.t @@ -122,24 +122,24 @@ if ($h{''} eq 'bar') { print "ok 12\n" ; } else { - print "not ok 12\n" ; if ($AnyDBM_File::ISA[0] eq 'DB_File' && $DB_File::db_ver >= 2.004010) { ($major, $minor, $patch) = ($DB_File::db_ver =~ /^(\d+)\.(\d\d\d)(\d\d\d)/) ; $major =~ s/^0+// ; $minor =~ s/^0+// ; $patch =~ s/^0+// ; $compact = "$major.$minor.$patch" ; - - print STDERR <<EOM ; -# -# anydbm.t test 12 will fail when AnyDBM_File uses the combination of -# DB_File and Berkeley DB 2.4.10 (or greater). -# You are using DB_File $DB_File::VERSION and Berkeley DB $compact -# -# Berkeley DB 2 from version 2.4.10 onwards does not allow null keys. -# This feature will be reenabled in a future version of Berkeley DB. -# -EOM + # + # anydbm.t test 12 will fail when AnyDBM_File uses the combination of + # DB_File and Berkeley DB 2.4.10 (or greater). + # You are using DB_File $DB_File::VERSION and Berkeley DB $compact + # + # Berkeley DB 2 from version 2.4.10 onwards does not allow null keys. + # This feature will be reenabled in a future version of Berkeley DB. + # + print "ok 12 # skipped: db v$compact, no null key support\n" ; + } + else { + print "not ok 12\n" ; } } diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t index 3b040dc6ac..2857120942 100644 --- a/t/lib/syslfs.t +++ b/t/lib/syslfs.t @@ -1,5 +1,5 @@ # NOTE: this file tests how large files (>2GB) work with raw system IO. -# open(), tell(), seek(), print(), read() are tested in t/op/lfs.t. +# stdio: open(), tell(), seek(), print(), read() is tested in t/op/lfs.t. # If you modify/add tests here, remember to update also t/op/lfs.t. BEGIN { @@ -14,9 +14,15 @@ BEGIN { require Fcntl; import Fcntl qw(/^O_/ /^SEEK_/); } -sub bye { +sub zap { close(BIG); - unlink "big"; + unlink("big"); + unlink("big1"); + unlink("big2"); +} + +sub bye { + zap(); exit(0); } @@ -59,26 +65,38 @@ if ($^O eq 'unicos') { # consume less blocks than one megabyte (assuming nobody has # one megabyte blocks...) -sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or - do { warn "sysopen failed: $!\n"; bye }; -sysseek(BIG, 1_000_000, SEEK_SET); -syswrite(BIG, "big"); -close(BIG); +sysopen(BIG, "big1", O_WRONLY|O_CREAT|O_TRUNC) or + do { warn "sysopen big1 failed: $!\n"; bye }; +sysseek(BIG, 1_000_000, SEEK_SET) or + do { warn "sysseek big1 failed: $!\n"; bye }; +syswrite(BIG, "big") or + do { warn "syswrite big1 failed; $!\n"; bye }; +close(BIG) or + do { warn "close big1 failed: $!\n"; bye }; -my @s; +my @s1 = stat("big1"); -@s = stat("big"); +print "# s1 = @s1\n"; -print "# @s\n"; +sysopen(BIG, "big2", O_WRONLY|O_CREAT|O_TRUNC) or + do { warn "sysopen big2 failed: $!\n"; bye }; +sysseek(BIG, 2_000_000, SEEK_SET) or + do { warn "sysseek big2 failed: $!\n"; bye }; +syswrite(BIG, "big") or + do { warn "syswrite big2 failed; $!\n"; bye }; +close(BIG) or + do { warn "close big2 failed: $!\n"; bye }; -my $BLOCKSIZE = $s[11] || 512; +my @s2 = stat("big2"); -unless (@s == 13 && - $s[7] == 1_000_003 && - defined $s[12] && - $BLOCKSIZE * $s[12] < 1_000_003) { - print "1..0\n# no sparse files?\n"; - bye(); +print "# s2 = @s2\n"; + +zap(); + +unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 && + $s1[11] == $s2[11] && $s1[12] == $s2[12]) { + print "1..0\n#no sparse files?\n"; + bye; } print "# we seem to have sparse files...\n"; @@ -181,7 +199,7 @@ fail unless $big eq "big"; print "ok 14\n"; # 705_032_704 = (I32)5_000_000_000 -fail unless seek(BIG, 705_032_704, $SEEK_SET); +fail unless seek(BIG, 705_032_704, SEEK_SET); print "ok 15\n"; my $zero; diff --git a/t/op/lfs.t b/t/op/lfs.t index 0d6d027743..e704f6f57b 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -13,9 +13,15 @@ BEGIN { } } -sub bye { +sub zap { close(BIG); - unlink "big"; + unlink("big"); + unlink("big1"); + unlink("big2"); +} + +sub bye { + zap(); exit(0); } @@ -62,26 +68,42 @@ my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2); # consume less blocks than one megabyte (assuming nobody has # one megabyte blocks...) -open(BIG, ">big") or do { warn "open failed: $!\n"; bye }; -binmode BIG; -seek(BIG, 1_000_000, $SEEK_SET); -print BIG "big"; -close(BIG); - -my @s; - -@s = stat("big"); - -print "# @s\n"; - -my $BLOCKSIZE = $s[11] || 512; - -unless (@s == 13 && - $s[7] == 1_000_003 && - defined $s[12] && - $BLOCKSIZE * $s[12] < 1_000_003) { - print "1..0\n# no sparse files?\n"; - bye(); +open(BIG, ">big1") or + do { warn "open big1 failed: $!\n"; bye }; +binmode(BIG) or + do { warn "binmode big1 failed: $!\n"; bye }; +seek(BIG, 1_000_000, $SEEK_SET) or + do { warn "seek big1 failed: $!\n"; bye }; +print BIG "big" or + do { warn "print big1 failed: $!\n"; bye }; +close(BIG) or + do { warn "close big1 failed: $!\n"; bye }; + +my @s1 = stat("big1"); + +print "# s1 = @s1\n"; + +open(BIG, ">big2") or + do { warn "open big2 failed: $!\n"; bye }; +binmode(BIG) or + do { warn "binmode big2 failed: $!\n"; bye }; +seek(BIG, 2_000_000, $SEEK_SET) or + do { warn "seek big2 failed; $!\n"; bye }; +print BIG "big" or + do { warn "print big2 failed; $!\n"; bye }; +close(BIG) or + do { warn "close big2 failed; $!\n"; bye }; + +my @s2 = stat("big2"); + +print "# s2 = @s2\n"; + +zap(); + +unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 && + $s1[11] == $s2[11] && $s1[12] == $s2[12]) { + print "1..0\n#no sparse files?\n"; + bye; } print "# we seem to have sparse files...\n"; diff --git a/t/op/misc.t b/t/op/misc.t index b46c0ccb54..a595694e9b 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -482,7 +482,7 @@ new1new22DESTROY2new33DESTROY31DESTROY1 ######## re(); sub re { - my $re = join '', eval 'qr/(?p{ $obj->method })/'; + my $re = join '', eval 'qr/(??{ $obj->method })/'; $re; } EXPECT diff --git a/t/op/pack.t b/t/op/pack.t index 867da8dd14..e4c7a9c210 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -19,9 +19,6 @@ print ($#ary == $#ary2 ? "ok 1\n" : "not ok 1\n"); $out1=join(':',@ary); $out2=join(':',@ary2); -# Using long double NVs may introduce greater accuracy than wanted. -$out2 =~ s/:9\.87654321097999\d*:/:9.87654321098:/ - if $Config{uselongdouble} eq 'define'; print ($out1 eq $out2? "ok 2\n" : "not ok 2\n"); print ($foo =~ /def/ ? "ok 3\n" : "not ok 3\n"); diff --git a/t/op/pat.t b/t/op/pat.t index 142b82e2ad..103e6132b5 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -370,7 +370,7 @@ print "ok $test\n"; $test++; my $matched; -$matched = qr/\((?:(?>[^()]+)|(?p{$matched}))*\)/; +$matched = qr/\((?:(?>[^()]+)|(??{$matched}))*\)/; @ans = @ans1 = (); push(@ans, $res), push(@ans1, $&) while $res = m/$matched/g; @@ -866,7 +866,7 @@ print "ok $test\n"; $test++; $brackets = qr{ - { (?> [^{}]+ | (?p{ $brackets }) )* } + { (?> [^{}]+ | (??{ $brackets }) )* } }x; "{{}" =~ $brackets; @@ -877,7 +877,7 @@ $test++; print "ok $test\n"; # Did we survive? $test++; -"something { long { and } hairy" =~ m/((?p{ $brackets }))/; +"something { long { and } hairy" =~ m/((??{ $brackets }))/; print "not " unless $1 eq "{ and }"; print "ok $test\n"; $test++; diff --git a/t/pragma/warn/8signal b/t/pragma/warn/8signal index 80e60330a6..d480f1902a 100644 --- a/t/pragma/warn/8signal +++ b/t/pragma/warn/8signal @@ -4,7 +4,7 @@ TODO __END__ # 8signal -BEGIN { $SIG{__WARN__} = sub { print "WARN -- @_" } } +BEGIN { $| = 1; $SIG{__WARN__} = sub { print "WARN -- @_" } } BEGIN { $SIG{__DIE__} = sub { print "DIE -- @_" } } 1 if 1 EQ 2 ; use warnings qw(deprecated) ; @@ -1269,8 +1269,8 @@ S_scan_const(pTHX_ char *start) if (s[2] == '#') { while (s < send && *s != ')') *d++ = *s++; - } else if (s[2] == '{' - || s[2] == 'p' && s[3] == '{') { /* This should march regcomp.c */ + } else if (s[2] == '{' /* This should match regcomp.c */ + || (s[2] == 'p' || s[2] == '?') && s[3] == '{') { I32 count = 1; char *regparse = s + (s[2] == '{' ? 3 : 4); char c; diff --git a/utils/h2xs.PL b/utils/h2xs.PL index c47418e824..333e891060 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -100,6 +100,14 @@ Omit the autogenerated stub POD section. Omit the XS portion. Used to generate templates for a module which is not XS-based. C<-c> and C<-f> are implicitly enabled. +=item B<-a> + +Generate an accessor method for each element of structs and unions. The +generated methods are named after the element name; will return the current +value of the element if called without additional arguments; and will set +the element to the supplied value (and return the old value) if called with +an additional argument. + =item B<-c> Omit C<constant()> from the .xs file and corresponding specialised @@ -322,6 +330,7 @@ version: $H2XS_VERSION -O Allow overwriting of a pre-existing extension directory. -P Omit the stub POD section. -X Omit the XS portion (implies both -c and -f). + -a Generate get/set accessors for struct and union members (used with -x). -c Omit the constant() function and specialised AUTOLOAD from the XS file. -d Turn on debugging messages. -f Force creation of the extension even if the C header does not exist. @@ -339,8 +348,8 @@ extra_libraries } -getopts("ACF:M:OPXcdfhn:o:p:s:v:x") || usage; -use vars qw($opt_A $opt_C $opt_F $opt_M $opt_O $opt_P $opt_X $opt_c +getopts("ACF:M:OPXacdfhn:o:p:s:v:x") || usage; +use vars qw($opt_A $opt_C $opt_F $opt_M $opt_O $opt_P $opt_X $opt_a $opt_c $opt_d $opt_f $opt_h $opt_n $opt_o $opt_p $opt_s $opt_v $opt_x); usage if $opt_h; @@ -530,6 +539,7 @@ my $fdecls_parsed = []; my $typedef_rex; my %typedefs_pre; my %known_fnames; +my %structs; my @fnames; my @fnames_no_prefix; @@ -554,13 +564,17 @@ if( ! $opt_X ){ # use XS, unless it was disabled } warn "Scanning $filename for functions...\n"; $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter, - 'add_cppflags' => $addflags; + 'add_cppflags' => $addflags, 'c_styles' => [qw(C++ C9X)]; $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]); push @$fdecls_parsed, @{ $c->get('parsed_fdecls') }; push(@$fdecls, @{$c->get('fdecls')}); push @td, @{$c->get('typedefs_maybe')}; + if ($opt_a) { + my $structs = $c->get('typedef_structs'); + @structs{keys %$structs} = values %$structs; + } unless ($tmask_all) { warn "Scanning $filename for typedefs...\n"; @@ -1148,6 +1162,47 @@ EOP } } +sub print_accessors { + my($fh, $name, $struct) = @_; + return unless defined $struct && $name !~ /\s|_ANON/; + $name = normalize_type($name); + my $ptrname = normalize_type("$name *"); + printf $fh <<"EOF"; + +MODULE = $module PACKAGE = ${name}Ptr $prefix + +EOF + my @items = @$struct; + while (@items) { + my $item = shift @items; + if ($item->[0] =~ /_ANON/) { + if (defined $item->[1]) { + push @items, map [ + $_->[0], "$item->[1]_$_->[1]", "$item->[1].$_->[1]" + ], @{ $structs{$item->[0]} }; + } else { + push @items, @{ $structs{$item->[0]} }; + } + } else { + my $type = normalize_type($item->[0]); + print $fh <<"EOF"; +$type +$item->[1](THIS, __value = NO_INIT) + $ptrname THIS + $type __value + PROTOTYPE: \$;\$ + CODE: + RETVAL = THIS->$item->[-1]; + if (items > 1) + THIS->$item->[-1] = __value; + OUTPUT: + RETVAL + +EOF + } + } +} + # Should be called before any actual call to normalize_type(). sub get_typemap { # We do not want to read ./typemap by obvios reasons. @@ -1240,6 +1295,11 @@ sub assign_typemap_entry { if ($opt_x) { for my $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) } + if ($opt_a) { + while (my($name, $struct) = each %structs) { + print_accessors(\*XS, $name, $struct); + } + } } close XS; diff --git a/win32/Makefile b/win32/Makefile index 88e270d63a..3909230d4f 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -589,10 +589,7 @@ CORE_NOCFG_H = \ .\include\dirent.h \ .\include\netdb.h \ .\include\sys\socket.h \ - .\win32.h \ - .\perlhost.h \ - .\vdir.h \ - .\vmem.h + .\win32.h CORE_H = $(CORE_NOCFG_H) .\config.h @@ -798,8 +795,9 @@ $(MINIWIN32_OBJ) : $(CORE_NOCFG_H) $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*F).c # -DPERL_IMPLICIT_SYS needs C++ for perllib.c +# This is the only file that depends on perlhost.h, vmem.h, and vdir.h !IF "$(USE_IMP_SYS)$(USE_OBJECT)" == "defineundef" -perllib$(o) : perllib.c +perllib$(o) : perllib.c .\perlhost.h .\vdir.h .\vmem.h $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c !ENDIF @@ -1072,6 +1070,19 @@ test-notty : test-prep $(PERLEXE) -I..\lib harness cd ..\win32 +test-wide : test-prep + set HARNESS_PERL_SWITCHES=-C + cd ..\t + $(PERLEXE) -I..\lib harness + cd ..\win32 + +test-wide-notty : test-prep + set PERL_SKIP_TTY_TEST=1 + set HARNESS_PERL_SWITCHES=-C + cd ..\t + $(PERLEXE) -I..\lib harness + cd ..\win32 + clean : -@erase miniperlmain$(o) -@erase $(MINIPERL) diff --git a/win32/makefile.mk b/win32/makefile.mk index 724fb6304f..d727c9f13f 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -712,10 +712,7 @@ CORE_NOCFG_H = \ .\include\dirent.h \ .\include\netdb.h \ .\include\sys\socket.h \ - .\win32.h \ - .\perlhost.h \ - .\vdir.h \ - .\vmem.h + .\win32.h CORE_H = $(CORE_NOCFG_H) .\config.h @@ -1000,8 +997,10 @@ $(MINIWIN32_OBJ) : $(CORE_NOCFG_H) # -DPERL_IMPLICIT_SYS needs C++ for perllib.c # rules wrapped in .IFs break Win9X build (we end up with unbalanced []s unless -# unless the .IF is true), so instead we use a .ELSE with the default -perllib$(o) : perllib.c +# unless the .IF is true), so instead we use a .ELSE with the default. +# This is the only file that depends on perlhost.h, vmem.h, and vdir.h + +perllib$(o) : perllib.c .\perlhost.h .\vdir.h .\vmem.h .IF "$(USE_IMP_SYS)$(USE_OBJECT)" == "defineundef" $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c .ELSE @@ -1285,7 +1284,16 @@ test : $(RIGHTMAKE) test-prep test-notty : test-prep set PERL_SKIP_TTY_TEST=1 && \ - cd ..\t && $(PERLEXE) -I.\lib harness + cd ..\t && $(PERLEXE) -I.\lib harness + +test-wide : test-prep + set HARNESS_PERL_SWITCHES=-C && \ + cd ..\t && $(PERLEXE) -I..\lib harness + +test-wide-notty : test-prep + set PERL_SKIP_TTY_TEST=1 && \ + set HARNESS_PERL_SWITCHES=-C && \ + cd ..\t && $(PERLEXE) -I..\lib harness clean : -@erase miniperlmain$(o) diff --git a/win32/perllib.c b/win32/perllib.c index 2a0cb85c92..f240e2f0c0 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -337,6 +337,9 @@ RunPerl(int argc, char **argv, char **env) EXTERN_C void set_w32_module_name(void); +#ifdef __MINGW32__ +EXTERN_C /* GCC in C++ mode mangles the name, otherwise */ +#endif BOOL APIENTRY DllMain(HANDLE hModule, /* DLL module handle */ DWORD fdwReason, /* reason called */ diff --git a/win32/win32.c b/win32/win32.c index 5fb1f46545..4ccae52d84 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -15,7 +15,11 @@ #define Win32_Winsock #endif #include <windows.h> -#include <shellapi.h> +#ifndef __MINGW32__ /* GCC/Mingw32-2.95.2 forgot the WINAPI on CommandLineToArgvW() */ +# include <shellapi.h> +#else + LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs); +#endif #include <winnt.h> #include <io.h> @@ -58,7 +62,12 @@ int _CRT_glob = 0; #endif #if defined(__MINGW32__) -# define _stat stat +/* Mingw32 is missing some prototypes */ +FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode); +FILE * _wfdopen(int nFd, LPCWSTR wszMode); +FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream); +int _flushall(); +int _fcloseall(); #endif #if defined(__BORLANDC__) diff --git a/win32/win32.h b/win32/win32.h index b0ccd14d9f..a0d076109c 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -211,10 +211,6 @@ typedef long gid_t; #define flushall _flushall #define fcloseall _fcloseall -#ifndef CP_UTF8 -# define CP_UTF8 65001 -#endif - #ifdef PERL_OBJECT # define MEMBER_TO_FPTR(name) &(name) #endif @@ -228,6 +224,11 @@ typedef long gid_t; #endif /* __MINGW32__ */ +/* both GCC/Mingw32 and MSVC++ 4.0 are missing this, so we put it here */ +#ifndef CP_UTF8 +# define CP_UTF8 65001 +#endif + /* compatibility stuff for other compilers goes here */ |