diff options
63 files changed, 937 insertions, 1183 deletions
@@ -46,7 +46,7 @@ neale Neale Ferguson neale@VMA.TABNSW.COM.AU nik Nick Ing-Simmons nik@tiuk.ti.com okamoto Jeff Okamoto okamoto@corp.hp.com paul_green Paul Green Paul_Green@stratus.com -pmarquess Paul Marquess pmarquess@bfsec.bt.co.uk +pmarquess Paul Marquess Paul.Marquess@btinternet.com pomeranz Hal Pomeranz pomeranz@netcom.com pudge Chris Nandor pudge@pobox.com pueschel Norbert Pueschel pueschel@imsdd.meb.uni-bonn.de @@ -29,7 +29,7 @@ current addresses (as of July 1998): Nick Ing-Simmons <nik@tiuk.ti.com> Andreas Koenig <a.koenig@mind.de> Doug MacEachern <dougm@opengroup.org> - Paul Marquess <pmarquess@bfsec.bt.co.uk> + Paul Marquess <Paul.Marquess@btinternet.com> Stephen McCamant <alias@mcs.com> Laszlo Molnar <laszlo.molnar@eth.ericsson.se> Hans Mulder <hansmu@xs4all.nl> @@ -75,7 +75,278 @@ indicator: ---------------- -Version 5.005_63 Development release working toward 5.6 +Version v5.5.640 Development release working toward 5.6 +---------------- + +____________________________________________________________________________ +[ 4722] By: gsar on 1999/12/28 03:14:48 + Log: avoid "used once" warning + Branch: perl + ! lib/diagnostics.pm +____________________________________________________________________________ +[ 4721] By: gsar on 1999/12/28 03:10:32 + Log: ebcdic tweaks for tests from Peter Prymmer + Branch: perl + ! t/pragma/warn/doop t/pragma/warn/pp t/pragma/warn/regcomp + ! t/pragma/warn/sv t/pragma/warn/toke t/pragma/warn/utf8 +____________________________________________________________________________ +[ 4720] By: gsar on 1999/12/28 03:08:39 + Log: pod nits from Simon Cozens <simon@brecon.co.uk> and others + Branch: perl + ! README.os2 lib/ExtUtils/Embed.pm lib/ExtUtils/Install.pm + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MakeMaker.pm + ! lib/ExtUtils/Mkbootstrap.pm pod/perlop.pod +____________________________________________________________________________ +[ 4719] By: gsar on 1999/12/28 03:01:04 + Log: perlport v1.45 from Chris Nandor + Branch: perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 4718] By: gsar on 1999/12/28 02:59:16 + Log: newer version of constant.pm from Tom Phoenix; added Tom's notes to + perldelta; added STOP, DESTROY and AUTOLOAD to specials list + Branch: perl + ! lib/constant.pm pod/perldelta.pod pod/perlvar.pod + ! t/pragma/constant.t +____________________________________________________________________________ +[ 4717] By: gsar on 1999/12/28 02:47:04 + Log: cygwin update from Eric Fifer <EFifer@sanwaint.com> + Branch: perl + - ext/DynaLoader/dl_cygwin.xs + ! MAINTAIN MANIFEST ext/POSIX/POSIX.xs ext/SDBM_File/sdbm/pair.c + ! hints/cygwin.sh installperl mg.c pod/perlfaq3.pod t/op/stat.t + ! util.c +____________________________________________________________________________ +[ 4716] By: gsar on 1999/12/28 02:40:51 + Log: tweak to show up db-linked-with-libpthread-but-not-perl problem + (from Andy Dougherty) + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4715] By: gsar on 1999/12/28 02:38:44 + Log: better variant of change#4644 (from Andy Dougherty) + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4714] By: gsar on 1999/12/28 02:36:40 + Log: be defensive about setting {host,group,pass}cat (from Andy Dougherty) + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4713] By: gsar on 1999/12/28 02:35:15 + Log: $sitelib should be $prefix/lib/perl5/site_perl, as documented in + INSTALL (from Andy Dougherty) + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4712] By: gsar on 1999/12/28 02:30:55 + Log: avoid creating new files during make install + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 4711] By: gsar on 1999/12/28 02:24:44 + Log: pod edits from Paul Marquess and Mark-Jason Dominus + Branch: perl + ! AUTHORS Changes ext/DynaLoader/dl_aix.xs + ! ext/DynaLoader/dl_dlopen.xs lib/Net/Ping.pm pod/perlcall.pod + ! pod/perldelta.pod +____________________________________________________________________________ +[ 4710] By: gsar on 1999/12/28 02:05:23 + Log: miniperl build fixes for os2 (from Yitzchak Scott-Thoennes + <sthoenna@efn.org>); add explicit target for opmini.o + Branch: perl + ! Makefile.SH cygwin/Makefile.SHs os2/Makefile.SHs +____________________________________________________________________________ +[ 4709] By: gsar on 1999/12/28 01:20:39 + Log: partly fix perldiag regressions identified by Tom Christiansen + Branch: perl + ! doio.c lib/diagnostics.pm pod/perldiag.pod pp_hot.c pp_sys.c + ! t/pragma/warn/4lint t/pragma/warn/doio t/pragma/warn/pp_hot + ! t/pragma/warn/pp_sys +____________________________________________________________________________ +[ 4708] By: gsar on 1999/12/27 23:33:24 + Log: update perldiag for change#4707 + Branch: perl + ! perl.c pod/perldiag.pod +____________________________________________________________________________ +[ 4707] By: gsar on 1999/12/27 23:23:39 + Log: allow spaces in -I switch argument + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 4706] By: gsar on 1999/12/26 23:44:53 + Log: fix typos + Branch: utfperl + ! sv.h toke.c +____________________________________________________________________________ +[ 4705] By: gsar on 1999/12/24 04:02:35 + Log: support for v5.5.640 style version numbers + Branch: utfperl + ! configpm embedvar.h gv.c intrpvar.h objXSUB.h patchlevel.h + ! perl.c perl.h pp_ctl.c sv.c sv.h t/comp/require.t toke.c +____________________________________________________________________________ +[ 4704] By: gsar on 1999/12/23 08:54:27 + Log: bring in basic threads stuff under USE_ITHREADS + Branch: perl + ! makedef.pl op.c perl.c perl.h perlvars.h pp_sys.c thread.h + ! util.c +____________________________________________________________________________ +[ 4703] By: gsar on 1999/12/23 00:10:06 + Log: integrate mainline contents into utfperl + Branch: utfperl + !> (integrate 33 files) +____________________________________________________________________________ +[ 4702] By: gsar on 1999/12/20 17:18:23 + Log: virtual directory handling broken on paths with trailing slash + Branch: perl + ! win32/Makefile win32/makefile.mk win32/vdir.h +____________________________________________________________________________ +[ 4701] By: gsar on 1999/12/20 17:09:55 + Log: revert optimization in change#4700 (it appears OPpRUNTIME flag + isn't set for all m/$foo/o) + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 4700] By: gsar on 1999/12/20 16:28:51 + Log: avoid pp_regcomp() changing optree at run time under USE_*THREADS (or + we have a race on our hands) + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 4699] By: gsar on 1999/12/20 16:19:00 + Log: pod tweaks + Branch: perl + ! pod/perldelta.pod pod/perlfilter.pod pod/perlopentut.pod +____________________________________________________________________________ +[ 4698] By: gsar on 1999/12/20 07:55:07 + Log: uv_to_utf8() could lose 37th bit on HAS_QUAD platforms + Branch: perl + ! utf8.c +____________________________________________________________________________ +[ 4697] By: gsar on 1999/12/18 01:35:50 + Log: fix from Larry for parsing C<{ 0x1 => 'foo'}> as an + anon hash rather than a block; test case for the same + Branch: perl + ! t/comp/term.t toke.c +____________________________________________________________________________ +[ 4696] By: gsar on 1999/12/17 19:55:03 + Log: leak in change#4694 spotted by Larry + Branch: perl + ! hv.c +____________________________________________________________________________ +[ 4695] By: gsar on 1999/12/17 18:14:11 + Log: test case for change#4694 + Branch: perl + ! t/op/delete.t +____________________________________________________________________________ +[ 4694] By: gsar on 1999/12/17 18:09:08 + Log: delete() should return the value as is, not a copy thereof + Branch: perl + ! hv.c pod/perldelta.pod +____________________________________________________________________________ +[ 4693] By: gsar on 1999/12/17 17:45:58 + Log: fix for C<"\nx\taa\n" =~ /^\S\s+aa$/m> (from Ilya Zakharevich) + Branch: perl + ! regexec.c t/op/re_tests +____________________________________________________________________________ +[ 4692] By: gsar on 1999/12/17 17:41:10 + Log: credits tweak + Branch: perl + ! lib/File/Spec.pm +____________________________________________________________________________ +[ 4691] By: gsar on 1999/12/17 07:12:53 + Log: DynaLoader doesn't build properly when $(DLSRC) changes + (fix suggested by Hans Mulder) + Branch: perl + ! ext/DynaLoader/Makefile.PL +____________________________________________________________________________ +[ 4690] By: gsar on 1999/12/17 06:26:34 + Log: add missing new ops + Branch: perl + ! ext/B/ramblings/runtime.porting +____________________________________________________________________________ +[ 4689] By: gsar on 1999/12/17 06:16:49 + Log: test harness tweak from Hans Mulder + Branch: perl + ! t/TEST +____________________________________________________________________________ +[ 4688] By: gsar on 1999/12/17 06:14:23 + Log: miniperl build fixes for NeXTstep and cygwin (from Hans Mulder + and Lucian CIONCA <Lucian.Cionca@algoritma.ro>) + Branch: perl + ! Makefile.SH cygwin/Makefile.SHs +____________________________________________________________________________ +[ 4687] By: gsar on 1999/12/17 06:06:46 + Log: applied suggested patch with whitespace adjustments + From: Helmut Jarausch <jarausch@numa1.igpm.rwth-aachen.de> + Date: Thu, 16 Dec 1999 08:57:55 +0100 + Message-id: <38589B82.C4668E10@numa1.igpm.rwth-aachen.de> + Subject: Re: [ID 19991215.001] patch 5.005_63: Find::Fill cannot handle / + Branch: perl + ! lib/File/Find.pm +____________________________________________________________________________ +[ 4686] By: gsar on 1999/12/17 05:48:53 + Log: avoid warnings due to symbols unintroduced by XSLoader (spotted + by Hans Mulder) + Branch: perl + ! ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_hpux.xs + ! ext/DynaLoader/dl_mpeix.xs ext/DynaLoader/dl_next.xs + ! ext/DynaLoader/dl_rhapsody.xs +____________________________________________________________________________ +[ 4685] By: gsar on 1999/12/17 05:37:51 + Log: fix bug when one of the operands is +0E+0 (from Ronald J Kimball + <rjk@linguist.dartmouth.edu>) + Branch: perl + ! lib/Math/BigFloat.pm t/lib/bigfltpm.t +____________________________________________________________________________ +[ 4684] By: gsar on 1999/12/16 09:32:48 + Log: spell out how to get 4-digit year (from Micheal G Schwern + <schwern@pobox.com>) + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4683] By: gsar on 1999/12/16 09:26:53 + Log: type mismatch for %c format argument (spotted by Robin Barker + <rmb1@cise.npl.co.uk>) + Branch: perl + ! regcomp.c +____________________________________________________________________________ +[ 4682] By: gsar on 1999/12/16 08:33:28 + Log: mingw32 doesn't have anonymous union (from Benjamin Stuhl + <sho_pi@hotmail.com>) + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 4681] By: gsar on 1999/12/16 08:31:15 + Log: missing backslash (spotted by Johan Vromans) + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 4680] By: gsar on 1999/12/16 08:26:00 + Log: avoid coredump on diagnostics when STDERR is closed + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 4679] By: gsar on 1999/12/12 18:09:41 + Log: integrate mainline changes + Branch: utfperl + +> (branch 39 files) + - lib/unicode/Jamo-2.txt lib/unicode/Unicode.html + - lib/unicode/UnicodeData-Latest.txt + !> (integrate 447 files) +____________________________________________________________________________ +[ 4678] By: gsar on 1999/12/10 01:39:13 + Log: interpreter structure should be nulled under -DMULTIPLICITY + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 4677] By: gsar on 1999/12/09 11:10:27 + Log: update Changes + Branch: perl + ! Changes + +---------------- +Version 5.005_63 ---------------- ____________________________________________________________________________ @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Tue Nov 16 23:04:27 EET 1999 [metaconfig 3.0 PL70] +# Generated on Wed Dec 22 14:18:58 EST 1999 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <<EOF @@ -6378,13 +6378,13 @@ if $test -d /usr/etc/yp || $test -d /etc/yp; then esac fi case "$hostcat" in -'') hostcat='cat /etc/hosts';; +'') test -f /etc/hosts && hostcat='cat /etc/hosts';; esac case "$groupcat" in -'') groupcat='cat /etc/group';; +'') test -f /etc/group && groupcat='cat /etc/group';; esac case "$passcat" in -'') passcat='cat /etc/passwd';; +'') test -f /etc/passwd && passcat='cat /etc/passwd';; esac : now get the host name @@ -6486,6 +6486,7 @@ case "$myhostname" in $sed -e 's/[ ]*#.*//; s/$/ /' > hosts && \ $test -s hosts } || { + test "X$hostcat" != "X" && $hostcat | $sed -n -e "s/[ ]*#.*//; s/\$/ / /[ ]$myhostname[ . ]/p" > hosts } @@ -6778,7 +6779,7 @@ siteprefixexp="$ansexp" : XXX No longer works with Prefixit stuff. prog=`echo $package | $sed 's/-*[0-9.]*$//'` case "$installstyle" in -*lib/perl5*) dflt=$siteprefix/lib/site_$prog ;; +*lib/perl5*) dflt=$siteprefix/lib/$package/site_$prog ;; *) dflt=$siteprefix/lib/site_$prog ;; esac $cat <<EOM @@ -11262,7 +11263,7 @@ int main() } EOCP set try - if eval $compile && ./try; then + if eval $compile_ok && ./try; then echo 'Looks OK.' >&4 else echo "I can't use Berkeley DB with your <db.h>. I'll disable Berkeley DB." >&4 @@ -12856,13 +12857,12 @@ esac : Remove SIGSTKSIZE used by Linux. : Remove SIGSTKSZ used by Posix. : Remove SIGTYP void lines used by OS2. +: Some cpps, like os390, dont give the file name anywhere if [ "X$fieldn" = X ]; then - xxx=`echo '#include <signal.h>' | - $cppstdin $cppminus $cppflags 2>/dev/null | - $grep '^[ ]*#.*include' | - $sed 's!"!!g' | $sort | $uniq` + : Just make some guesses. We check them later. + xxx='/usr/include/signal.h /usr/include/sys/signal.h' else - xxx=`echo '#include <signal.h>' | + xxx=`echo '#include <signal.h>' | $cppstdin $cppminus $cppflags 2>/dev/null | $grep '^[ ]*#.*include' | $awk "{print \\$$fieldn}" | $sed 's!"!!g' | $sort | $uniq` @@ -12886,10 +12886,12 @@ $1 == "#" && $2 ~ /^define$/ && $3 ~ /^SIG[A-Z0-9]*$/ && $3 !~ /SIGARRAYSIZE/ && print substr($3, 4, 20) }' $xxxfiles` : Append some common names just in case the awk scan failed. -xxx="$xxx ABRT ALRM BUS CHLD CLD CONT DIL EMT FPE HUP ILL INT IO IOT KILL" -xxx="$xxx LOST PHONE PIPE POLL PROF PWR QUIT SEGV STKFLT STOP SYS TERM TRAP" -xxx="$xxx TSTP TTIN TTOU URG USR1 USR2 USR3 USR4 VTALRM" -xxx="$xxx WINCH WIND WINDOW XCPU XFSZ" +xxx="$xxx ABRT ALRM BUS CANCEL CHLD CLD CONT DIL EMT FPE" +xxx="$xxx FREEZE HUP ILL INT IO IOT KILL LOST LWP PHONE" +xxx="$xxx PIPE POLL PROF PWR QUIT RTMAX RTMIN SEGV STKFLT STOP" +xxx="$xxx SYS TERM THAW TRAP TSTP TTIN TTOU URG USR1 USR2" +xxx="$xxx USR3 USR4 VTALRM WAITING WINCH WIND WINDOW XCPU XFSZ" + : generate a few handy files for later $cat > signal.c <<'EOCP' #include <sys/types.h> @@ -154,7 +154,6 @@ ext/DynaLoader/DynaLoader_pm.PL ext/DynaLoader/Makefile.PL ext/DynaLoader/README ext/DynaLoader/dl_aix.xs aix -ext/DynaLoader/dl_cygwin.xs cygwin ext/DynaLoader/dl_dld.xs rsanders ext/DynaLoader/dl_dlopen.xs timb ext/DynaLoader/dl_hpux.xs hpux @@ -234,7 +234,6 @@ ext/DynaLoader/README Dynamic Loader notes and intro ext/DynaLoader/XSLoader_pm.PL Simple XS Loader perl module ext/DynaLoader/dl_aix.xs AIX implementation ext/DynaLoader/dl_beos.xs BeOS implementation -ext/DynaLoader/dl_cygwin.xs Cygwin implementation ext/DynaLoader/dl_dld.xs GNU dld style implementation ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation ext/DynaLoader/dl_hpux.xs HP-UX implementation diff --git a/Makefile.SH b/Makefile.SH index ce438a6876..ea75eac556 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -261,7 +261,7 @@ lintflags = -hbvxac .c$(OBJ_EXT): $(CCCMD) $(PLDLFLAGS) $*.c -all: $(FIRSTMAKEFILE) miniperl $(private) $(public) $(dynamic_ext) $(nonxs_ext) +all: $(FIRSTMAKEFILE) miniperl extra.pods $(private) $(public) $(dynamic_ext) $(nonxs_ext) @echo " "; @echo " Everything is up to date. 'make test' to run test suite." @@ -286,6 +286,9 @@ utilities: miniperl lib/Config.pm $(plextract) FORCE FORCE: @sh -c true +opmini$(OBJ_EXT): op.c + $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c + miniperlmain$(OBJ_EXT): miniperlmain.c $(CCCMD) $(PLDLFLAGS) $*.c @@ -336,8 +339,7 @@ $(LIBPERL_NONSHR): perl$(OBJ_EXT) $(obj) $(RMS) $(LIBPERL_NONSHR) $(AR) rcu $(LIBPERL_NONSHR) perl$(OBJ_EXT) $(obj) -$(MINIPERL_NONSHR): $(LIBPERL_NONSHR) miniperlmain$(OBJ_EXT) - $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c +$(MINIPERL_NONSHR): $(LIBPERL_NONSHR) miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(CC) $(LDFLAGS) -o $(MINIPERL_NONSHR) miniperlmain$(OBJ_EXT) \ opmini$(OBJ_EXT) $(LIBPERL_NONSHR) $(LIBS) @@ -426,20 +428,18 @@ $(LIBPERL): $& perl$(OBJ_EXT) $(obj) $(LIBPERLEXPORT) case "${osname}${osvers}" in next4*) $spitshell >>Makefile <<'!NO!SUBS!' -miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) - $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c +miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT) $(CC) -o miniperl `echo $(obj) | sed 's/ op$(OBJ_EXT) / /'` \ miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) perl$(OBJ_EXT) $(libs) - $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest + $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '<?>' || $(MAKE) minitest !NO!SUBS! ;; *) $spitshell >>Makefile <<'!NO!SUBS!' -miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) - $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c +miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl \ miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL) $(libs) - $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest + $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '<?>' || $(MAKE) minitest !NO!SUBS! ;; esac @@ -505,7 +505,7 @@ lib/re.pm: ext/re/re.pm $(plextract): miniperl lib/Config.pm lib/re.pm $(LDLIBPTH) ./miniperl -Ilib $@.PL -extra.pods: perl +extra.pods: miniperl -@test -f extra.pods && rm -f `cat extra.pods` -@rm -f extra.pods -@for x in `grep -l '^=[a-z]' README.*` ; do \ @@ -516,7 +516,7 @@ extra.pods: perl install: all install.perl install.man -install.perl: all extra.pods installperl +install.perl: all installperl if [ -n "$(COMPILE)" ]; \ then \ cd utils; $(MAKE) compile; \ @@ -526,7 +526,7 @@ install.perl: all extra.pods installperl fi $(LDLIBPTH) ./perl installperl -install.man: all extra.pods installman +install.man: all installman $(LDLIBPTH) ./perl installman # XXX Experimental. Hardwired values, but useful for testing. diff --git a/README.os2 b/README.os2 index 409c774591..10e54cde90 100644 --- a/README.os2 +++ b/README.os2 @@ -939,6 +939,8 @@ The reasons for most important skipped tests are: =item F<op/fs.t> +=over 4 + =item 18 Checks C<atime> and C<mtime> of C<stat()> - unfortunately, HPFS diff --git a/cygwin/Makefile.SHs b/cygwin/Makefile.SHs index 466afdabf3..d466bdea52 100644 --- a/cygwin/Makefile.SHs +++ b/cygwin/Makefile.SHs @@ -124,10 +124,9 @@ $(LIBPERL)$(LIB_EXT): $& perl$(OBJ_EXT) $(cwobj) ld2 # build problems but that's not obvious to the novice. # The Module used here must not depend on Config or any extensions. -miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)s$(LIB_EXT) - $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c +miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)s$(LIB_EXT) opmini$(OBJ_EXT) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL)s $(libs) - $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest + $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '<?>' || $(MAKE) minitest !NO!SUBS! ;; @@ -147,10 +146,9 @@ $(LIBPERL)$(LIB_EXT): $& perl$(OBJ_EXT) $(cwobj) # build problems but that's not obvious to the novice. # The Module used here must not depend on Config or any extensions. -miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) - $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c +miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) opmini$(OBJ_EXT) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL) $(libs) - $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest + $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '<?>' || $(MAKE) minitest !NO!SUBS! ;; @@ -161,6 +159,9 @@ esac # $spitshell >>Makefile <<'!NO!SUBS!' +opmini$(OBJ_EXT) : op.c + $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c + perl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) @@ -236,7 +236,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, dTHR; name[strlen(name)-1] = '\0' ; if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ WARN_PIPE, "Can't do bidirectional pipe"); + Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe"); } fp = PerlProc_popen(name,"w"); writing = 1; @@ -660,9 +660,9 @@ Perl_nextargv(pTHX_ register GV *gv) if (!S_ISREG(PL_statbuf.st_mode)) Perl_warner(aTHX_ WARN_INPLACE, "Can't do inplace edit: %s is not a regular file", - PL_oldname ); + PL_oldname); else - Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s\n", + Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s", PL_oldname, Strerror(errno)); } } diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index 798ed58d31..f845681ae1 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -558,7 +558,7 @@ static int readExports(ModulePtr mp) /* dl_dlopen.xs * * Platform: SunOS/Solaris, possibly others which use dlopen. - * Author: Paul Marquess (pmarquess@bfsec.bt.co.uk) + * Author: Paul Marquess (Paul.Marquess@btinternet.com) * Created: 10th July 1994 * * Modified: diff --git a/ext/DynaLoader/dl_cygwin.xs b/ext/DynaLoader/dl_cygwin.xs deleted file mode 100644 index 4055b058ef..0000000000 --- a/ext/DynaLoader/dl_cygwin.xs +++ /dev/null @@ -1,148 +0,0 @@ -/* dl_cygwin.xs - * - * Platform: Win32 (Windows NT/Windows 95) - * Author: Wei-Yuen Tan (wyt@hip.com) - * Created: A warm day in June, 1995 - * - * Modified: - * August 23rd 1995 - rewritten after losing everything when I - * wiped off my NT partition (eek!) - */ -/* Modified from the original dl_win32.xs to work with cygwin - -John Cerney 3/26/97 -*/ -/* Porting notes: - -I merely took Paul's dl_dlopen.xs, took out extraneous stuff and -replaced the appropriate SunOS calls with the corresponding Win32 -calls. - -*/ - -#define WIN32_LEAN_AND_MEAN -// Defines from windows needed for this function only. Can't include full -// Cygwin windows headers because of problems with CONTEXT redefinition -// Removed logic to tell not dynamically load static modules. It is assumed that all -// modules are dynamically built. This should be similar to the behavoir on sunOS. -// Leaving in the logic would have required changes to the standard perlmain.c code -// -#include <stdio.h> - -//#include <windows.h> -#define LOAD_WITH_ALTERED_SEARCH_PATH (8) -typedef void *HANDLE; -typedef HANDLE HINSTANCE; -#define STDCALL __attribute__ ((stdcall)) -typedef int STDCALL (*FARPROC)(); -#define MAX_PATH 260 - -HINSTANCE -STDCALL -LoadLibraryExA( - char* lpLibFileName, - HANDLE hFile, - unsigned int dwFlags - ); -unsigned int -STDCALL -GetLastError( - void - ); -FARPROC -STDCALL -GetProcAddress( - HINSTANCE hModule, - char* lpProcName - ); - -#include <string.h> - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include "dlutils.c" /* SaveError() etc */ - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); -} - - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - -void * -dl_load_file(filename,flags=0) - char * filename - int flags - PREINIT: - CODE: - { - char win32_path[MAX_PATH]; - cygwin_conv_to_full_win32_path(filename, win32_path); - filename = win32_path; - - DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename)); - - RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; - - DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL){ - SaveError(aTHX_ "%d",GetLastError()) ; - } else { - sv_setiv( ST(0), PTR2IV(RETVAL) ); - } - } - - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); - RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); - DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref = %x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%d",GetLastError()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL)); - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index 94cd0173a1..0746bc5ea5 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -1,7 +1,7 @@ /* dl_dlopen.xs * * Platform: SunOS/Solaris, possibly others which use dlopen. - * Author: Paul Marquess (pmarquess@bfsec.bt.co.uk) + * Author: Paul Marquess (Paul.Marquess@btinternet.com) * Created: 10th July 1994 * * Modified: diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 6fc32b1bd5..4c96f12e4f 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -108,7 +108,6 @@ #else #if defined (CYGWIN) # define tzname _tzname -# undef MB_CUR_MAX /* XXX: bug in b20.1 */ #endif #if defined (WIN32) # undef mkfifo @@ -290,7 +289,7 @@ unsigned long strtoul (const char *, char **, int); #endif #ifdef HAS_TZNAME -# ifndef WIN32 +# if !defined(WIN32) && !defined(CYGWIN) extern char *tzname[]; # endif #else diff --git a/ext/SDBM_File/sdbm/pair.c b/ext/SDBM_File/sdbm/pair.c index a30894b780..c2ed213036 100644 --- a/ext/SDBM_File/sdbm/pair.c +++ b/ext/SDBM_File/sdbm/pair.c @@ -9,7 +9,6 @@ #include "config.h" #ifdef CYGWIN -# define EXT extern # define EXTCONST extern const #else # include "EXTERN.h" diff --git a/hints/cygwin.sh b/hints/cygwin.sh index de48cdfeb2..ba84df49d5 100644 --- a/hints/cygwin.sh +++ b/hints/cygwin.sh @@ -1,46 +1,37 @@ #! /bin/sh # cygwin.sh - hints for building perl using the Cygwin environment for Win32 # -# Many of these inflexible settings should be changed to allow command- -# line overrides and allow for variations in local set-ups. -# I have made first guesses at some of these, but would welcome -# corrections from someone actually using Cygwin. -# Andy Dougherty <doughera@lafayette.edu> Tue Sep 28 12:39:38 EDT 1999 -_exe='.exe' +# not otherwise settable exe_ext='.exe' -# work around case-insensitive file names firstmakefile='GNUmakefile' -sharpbang='#!' -startsh='#!/bin/sh' +case "$ldlibpthname" in +'') ldlibpthname=PATH ;; +esac -archname='cygwin' +# mandatory (overrides defaults) test -z "$cc" && cc='gcc' -libpth='/usr/i586-cygwin32/lib /usr/lib /usr/local/lib' +if test -z "$libpth" +then + libpth=`gcc -print-file-name=libc.a` + libpth=`dirname $libpth` + libpth=`cd $libpth && pwd` +fi so='dll' libs='-lcygwin -lm -lkernel32' -#optimize='-g' -# Is -I/usr/include *really* needed? -# Is -I/usr/local/include *really* needed? I thought gcc always looked there. -ccflags="$ccflags -DCYGWIN -I/usr/include -I/usr/local/include" -# Is -L/usr/lib *really* needed? -ldflags="$ldflags -L/usr/i586-cygwin32/lib -L/usr/lib -L/usr/local/lib" -test -z "$usemymalloc" && usemymalloc='n' -dlsrc='dl_cygwin.xs' +ccflags="$ccflags -DCYGWIN" +archname='cygwin' cccdlflags=' ' ld='ld2' -# Is -L/usr/local/lib *really* needed? -lddlflags="$lddlflags -L/usr/local/lib" + +# optional(ish) +# - perl malloc needs to be unpolluted +bincompat5005='undef' +# - build shared libperl.dll useshrplib='true' libperl='libperl.a' -dlext='dll' -dynamic_ext=' ' - -# What if they aren't using $prefix=/usr/local ?? -# Why is this needed at all? Doesn't Configure suggest this? -test -z "$man1dir" && man1dir=/usr/local/man/man1 -test -z "$man3dir" && man3dir=/usr/local/man/man3 -case "$ldlibpthname" in -'') ldlibpthname=PATH ;; -esac +# strip exe's and dll's +#ldflags="$ldflags -s" +#ccdlflags="$ccdlflags -s" +#lddlflags="$lddlflags -s" diff --git a/installperl b/installperl index fd1314fe2c..d1d299559c 100755 --- a/installperl +++ b/installperl @@ -162,13 +162,13 @@ if ($Is_Cygwin) { if ($dlsrc ne "dl_none.xs") { -f $perldll || die "No perl DLL built\n"; - + } # Install the DLL - safe_unlink("$installbin/$perldll"); - copy("$perldll", "$installbin/$perldll"); - chmod(0755, "$installbin/$perldll"); - } + safe_unlink("$installbin/$perldll"); + copy("$perldll", "$installbin/$perldll"); + chmod(0755, "$installbin/$perldll"); + } # if ($Is_W32 or $Is_Cygwin) # This will be used to store the packlist diff --git a/lib/ExtUtils/Embed.pm b/lib/ExtUtils/Embed.pm index e0ea0685f0..b649b6b77b 100644 --- a/lib/ExtUtils/Embed.pm +++ b/lib/ExtUtils/Embed.pm @@ -332,7 +332,7 @@ B<[@modules]> is an array ref, same as additional arguments mentioned above. This will generate code with an B<xs_init> function that glues the perl B<Socket::bootstrap> function -to the C B<boot_Socket> function and writes it to a file named "xsinit.c". +to the C B<boot_Socket> function and writes it to a file named F<xsinit.c>. Note that B<DynaLoader> is a special case where it must call B<boot_DynaLoader> directly. @@ -378,7 +378,7 @@ we should find B<auto/Socket/Socket.a> When looking for B<DBD::Oracle> relative to a search path, we should find B<auto/DBD/Oracle/Oracle.a> -Keep in mind, you can always supply B</my/own/path/ModuleName.a> +Keep in mind that you can always supply B</my/own/path/ModuleName.a> as an additional linker argument. B<--> E<lt>list of linker argsE<gt> @@ -392,7 +392,7 @@ When invoked with parameters the following are accepted and optional: C<ldopts($std,[@modules],[@link_args],$path)> -Where, +Where: B<$std> is boolean, equivalent to the B<-std> option. diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index a2d7d6bebd..38377101cc 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -339,7 +339,7 @@ There are two keys with a special meaning in the hash: "read" and target files to the file named by C<$hashref-E<gt>{write}>. If there is another file named by C<$hashref-E<gt>{read}>, the contents of this file will be merged into the written file. The read and the written file may be -identical, but on AFS it is quite likely, people are installing to a +identical, but on AFS it is quite likely that people are installing to a different directory than the one where the files later appear. install_default() takes one or less arguments. If no arguments are @@ -352,7 +352,7 @@ The argument-less form is convenient for install scripts like perl -MExtUtils::Install -e install_default Tk/Canvas -Assuming this command is executed in a directory with populated F<blib> +Assuming this command is executed in a directory with a populated F<blib> directory, it will proceed as if the F<blib> was build by MakeMaker on this machine. This is useful for binary distributions. diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm index 13e4e29e88..b992ec0116 100644 --- a/lib/ExtUtils/Liblist.pm +++ b/lib/ExtUtils/Liblist.pm @@ -540,7 +540,7 @@ below. =head2 EXTRALIBS List of libraries that need to be linked with when linking a perl -binary which includes this extension Only those libraries that +binary which includes this extension. Only those libraries that actually exist are included. These are written to a file and used when linking perl. @@ -562,7 +562,7 @@ object file. This list is used to create a .bs (bootstrap) file. =head1 PORTABILITY This module deals with a lot of system dependencies and has quite a -few architecture specific B<if>s in the code. +few architecture specific C<if>s in the code. =head2 VMS implementation @@ -682,7 +682,7 @@ enable searching for default libraries specified by C<$Config{libs}>. The libraries specified may be a mixture of static libraries and import libraries (to link with DLLs). Since both kinds are used -pretty transparently on the win32 platform, we do not attempt to +pretty transparently on the Win32 platform, we do not attempt to distinguish between them. =item * diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index 0f00e39afc..f323d2722e 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -1183,7 +1183,7 @@ MakeMaker gives you much more freedom than needed to configure internal variables and get different results. It is worth to mention, that make(1) also lets you configure most of the variables that are used in the Makefile. But in the majority of situations this will not -be necessary, and should only be done, if the author of a package +be necessary, and should only be done if the author of a package recommends it (or you know what you're doing). =head2 Using Attributes and Parameters @@ -1598,9 +1598,9 @@ Makefile.PL. =item NEEDS_LINKING -MakeMaker will figure out, if an extension contains linkable code +MakeMaker will figure out if an extension contains linkable code anywhere down the directory tree, and will set this variable -accordingly, but you can speed it up a very little bit, if you define +accordingly, but you can speed it up a very little bit if you define this boolean variable yourself. =item NOECHO @@ -1615,7 +1615,7 @@ Boolean. Attribute to inhibit descending into subdirectories. =item NO_VC -In general any generated Makefile checks for the current version of +In general, any generated Makefile checks for the current version of MakeMaker and the version the Makefile was built under. If NO_VC is set, the version check is neglected. Do not write this into your Makefile.PL, use it interactively instead. @@ -1642,7 +1642,7 @@ to $(CC). =item PERL_ARCHLIB -Same as above for architecture dependent files +Same as above for architecture dependent files. =item PERL_LIB @@ -1699,14 +1699,14 @@ Defining PM in the Makefile.PL will override PMLIBDIRS. =item POLLUTE Release 5.005 grandfathered old global symbol names by providing preprocessor -macros for extension source compatibility. As of release 5.006, these +macros for extension source compatibility. As of release 5.6, these preprocessor definitions are not available by default. The POLLUTE flag specifies that the old names should still be defined: perl Makefile.PL POLLUTE=1 Please inform the module author if this is necessary to successfully install -a module under 5.006 or later. +a module under 5.6 or later. =item PPM_INSTALL_EXEC @@ -1736,8 +1736,8 @@ only check if any version is installed already. =item SKIP Arryref. E.g. [qw(name1 name2)] skip (do not write) sections of the -Makefile. Caution! Do not use the SKIP attribute for the neglectible -speedup. It may seriously damage the resulting Makefile. Only use it, +Makefile. Caution! Do not use the SKIP attribute for the negligible +speedup. It may seriously damage the resulting Makefile. Only use it if you really need it. =item TYPEMAPS @@ -1860,7 +1860,7 @@ NB: Extensions that have nothing but *.pm files had to say {LINKTYPE => ''} with Pre-5.0 MakeMakers. Since version 5.00 of MakeMaker such a line -can be deleted safely. MakeMaker recognizes, when there's nothing to +can be deleted safely. MakeMaker recognizes when there's nothing to be linked. =item macro @@ -1963,7 +1963,7 @@ details) =item make distclean does a realclean first and then the distcheck. Note that this is not -needed to build a new distribution as long as you are sure, that the +needed to build a new distribution as long as you are sure that the MANIFEST file is ok. =item make manifest diff --git a/lib/ExtUtils/Mkbootstrap.pm b/lib/ExtUtils/Mkbootstrap.pm index 25c374c153..323c3ab6ba 100644 --- a/lib/ExtUtils/Mkbootstrap.pm +++ b/lib/ExtUtils/Mkbootstrap.pm @@ -81,8 +81,8 @@ C<mkbootstrap> Mkbootstrap typically gets called from an extension Makefile. -There is no C<*.bs> file supplied with the extension. Instead a -C<*_BS> file which has code for the special cases, like posix for +There is no C<*.bs> file supplied with the extension. Instead, there may +be a C<*_BS> file which has code for the special cases, like posix for berkeley db on the NeXT. This file will get parsed, and produce a maybe empty diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm index 495b82f95b..54540601d3 100644 --- a/lib/Net/Ping.pm +++ b/lib/Net/Ping.pm @@ -4,7 +4,7 @@ package Net::Ping; # # Authors of the original pingecho(): # karrer@bernina.ethz.ch (Andreas Karrer) -# pmarquess@bfsec.bt.co.uk (Paul Marquess) +# Paul.Marquess@btinternet.com (Paul Marquess) # # Copyright (c) 1996 Russell Mosemann. All rights reserved. This # program is free software; you may redistribute it and/or modify it diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl index 6af5f17303..8c28abdcd1 100644 --- a/lib/bigfloat.pl +++ b/lib/bigfloat.pl @@ -79,7 +79,12 @@ sub norm { #(mantissa, exponent) return fnum_str sub main'fneg { #(fnum_str) return fnum_str local($_) = &'fnorm($_[$[]); vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign - s/^H/N/; + if ( ord("\t") == 9 ) { # ascii + s/^H/N/; + } + else { # ebcdic character set + s/\373/N/; + } $_; } diff --git a/lib/constant.pm b/lib/constant.pm index 5d3dd91b46..31f47fbf54 100644 --- a/lib/constant.pm +++ b/lib/constant.pm @@ -1,6 +1,112 @@ package constant; -$VERSION = '1.00'; +use strict; +use vars qw( $VERSION %declared ); +$VERSION = '1.01'; + +#======================================================================= + +require 5.005_62; + +# Some names are evil choices. +my %keywords = map +($_, 1), qw{ BEGIN INIT STOP END DESTROY AUTOLOAD }; + +my %forced_into_main = map +($_, 1), + qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; + +my %forbidden = (%keywords, %forced_into_main); + +#======================================================================= +# import() - import symbols into user's namespace +# +# What we actually do is define a function in the caller's namespace +# which returns the value. The function we create will normally +# be inlined as a constant, thereby avoiding further sub calling +# overhead. +#======================================================================= +sub import { + my $class = shift; + return unless @_; # Ignore 'use constant;' + my $name = shift; + unless (defined $name) { + require Carp; + Carp::croak("Can't use undef as constant name"); + } + my $pkg = caller; + + # Normal constant name + if ($name =~ /^(?:[A-Z]\w|_[A-Z])\w*\z/ and !$forbidden{$name}) { + # Everything is okay + + # Name forced into main, but we're not in main. Fatal. + } elsif ($forced_into_main{$name} and $pkg ne 'main') { + require Carp; + Carp::croak("Constant name '$name' is forced into main::"); + + # Starts with double underscore. Fatal. + } elsif ($name =~ /^__/) { + require Carp; + Carp::croak("Constant name '$name' begins with '__'"); + + # Maybe the name is tolerable + } elsif ($name =~ /^[A-Za-z_]\w*\z/) { + # Then we'll warn only if you've asked for warnings + if ($^W) { + require Carp; + if ($keywords{$name}) { + Carp::carp("Constant name '$name' is a Perl keyword"); + } 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. + # Write to <rootbeer@redcat.com>. Thanks! + Carp::carp("Constant name '$name' has unknown problems"); + } + } + + # Looks like a boolean + # use constant FRED == fred; + } elsif ($name =~ /^[01]?\z/) { + require Carp; + if (@_) { + Carp::croak("Constant name '$name' is invalid"); + } else { + Carp::croak("Constant name looks like boolean value"); + } + + } else { + # Must have bad characters + require Carp; + Carp::croak("Constant name '$name' has invalid characters"); + } + + { + no strict 'refs'; + my $full_name = "${pkg}::$name"; + $declared{$full_name}++; + if (@_ == 1) { + my $scalar = $_[0]; + *$full_name = sub () { $scalar }; + } elsif (@_) { + my @list = @_; + *$full_name = sub () { @list }; + } else { + *$full_name = sub () { }; + } + } + +} + +1; + +__END__ =head1 NAME @@ -20,7 +126,7 @@ constant - Perl pragma to declare constants print "This line does nothing" unless DEBUGGING; - # references can be declared constant + # references can be constants use constant CHASH => { foo => 42 }; use constant CARRAY => [ 1,2,3,4 ]; use constant CPSEUDOHASH => [ { foo => 1}, 42 ]; @@ -30,7 +136,7 @@ constant - Perl pragma to declare constants print CARRAY->[$i]; print CPSEUDOHASH->{foo}; print CCODE->("me"); - print CHASH->[10]; # compile-time error + print CHASH->[10]; # compile-time error =head1 DESCRIPTION @@ -63,7 +169,10 @@ List constants are returned as lists, not as arrays. The use of all caps for constant names is merely a convention, although it is recommended in order to make constants stand out and to help avoid collisions with other barewords, keywords, and -subroutine names. Constant names must begin with a letter. +subroutine names. Constant names must begin with a letter or +underscore. Names beginning with a double underscore are reserved. Some +poor choices for names will generate warnings, if warnings are enabled at +compile time. Constant symbols are package scoped (rather than block scoped, as C<use strict> is). That is, you can refer to a constant from package @@ -98,7 +207,24 @@ constants at compile time, allowing for way cool stuff like this. print E2BIG, "\n"; # something like "Arg list too long" print 0+E2BIG, "\n"; # "7" -Errors in dereferencing constant references are trapped at compile-time. +Dereferencing constant references incorrectly (such as using an array +subscript on a constant hash reference, or vice versa) will be trapped at +compile time. + +In the rare case in which you need to discover at run time whether a +particular constant has been declared via this module, you may use +this function to examine the hash C<%constant::declared>. If the given +constant name does not include a package name, the current package is +used. + + sub declared ($) { + use constant 1.01; # don't omit this! + my $name = shift; + $name =~ s/^::/main::/; + my $pkg = caller; + my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; + $constant::declared{$full_name}; + } =head1 TECHNICAL NOTE @@ -115,7 +241,19 @@ In the current version of Perl, list constants are not inlined and some symbols may be redefined without generating a warning. It is not possible to have a subroutine or keyword with the same -name as a constant. This is probably a Good Thing. +name as a constant in the same package. This is probably a Good Thing. + +A constant with a name in the list C<STDIN STDOUT STDERR ARGV ARGVOUT +ENV INC SIG> is not allowed anywhere but in package C<main::>, for +technical reasons. + +Even though a reference may be declared as a constant, the reference may +point to data which may be changed, as this code shows. + + use constant CARRAY => [ 1,2,3,4 ]; + print CARRAY->[1]; + CARRAY->[1] = " be changed"; + print CARRAY->[1]; Unlike constants in some languages, these cannot be overridden on the command line or via environment variables. @@ -126,61 +264,20 @@ For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will be interpreted as a string. Use C<$hash{CONSTANT()}> or C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from kicking in. Similarly, since the C<=E<gt>> operator quotes a bareword -immediately to its left you have to say C<CONSTANT() =E<gt> 'value'> -instead of C<CONSTANT =E<gt> 'value'>. +immediately to its left, you have to say C<CONSTANT() =E<gt> 'value'> +(or simply use a comma in place of the big arrow) instead of +C<CONSTANT =E<gt> 'value'>. =head1 AUTHOR -Tom Phoenix, E<lt>F<rootbeer@teleport.com>E<gt>, with help from +Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from many other folks. =head1 COPYRIGHT -Copyright (C) 1997, Tom Phoenix +Copyright (C) 1997, 1999 Tom Phoenix This module is free software; you can redistribute it or modify it under the same terms as Perl itself. =cut - -use strict; -use Carp; -use vars qw($VERSION); - -#======================================================================= - -# Some of this stuff didn't work in version 5.003, alas. -require 5.003_96; - -#======================================================================= -# import() - import symbols into user's namespace -# -# What we actually do is define a function in the caller's namespace -# which returns the value. The function we create will normally -# be inlined as a constant, thereby avoiding further sub calling -# overhead. -#======================================================================= -sub import { - my $class = shift; - my $name = shift or return; # Ignore 'use constant;' - croak qq{Can't define "$name" as constant} . - qq{ (name contains invalid characters or is empty)} - unless $name =~ /^[^\W_0-9]\w*$/; - - my $pkg = caller; - { - no strict 'refs'; - if (@_ == 1) { - my $scalar = $_[0]; - *{"${pkg}::$name"} = sub () { $scalar }; - } elsif (@_) { - my @list = @_; - *{"${pkg}::$name"} = sub () { @list }; - } else { - *{"${pkg}::$name"} = sub () { }; - } - } - -} - -1; diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index d405e3673e..532505e5d1 100755 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -167,9 +167,11 @@ Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995. =cut -require 5.001; +require 5.005_64; use Carp; +$VERSION = v1.0; + use Config; ($privlib, $archlib) = @Config{qw(privlibexp archlibexp)}; if ($^O eq 'VMS') { @@ -333,7 +335,7 @@ EOFUNC # strip formatting directives in =item line ($header = $1) =~ s/[A-Z]<(.*?)>/$1/g; - if ($header =~ /%[sd]/) { + if ($header =~ /%[csd]/) { $rhs = $lhs = $header; #if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E\$/g) { if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E/g) { @@ -346,6 +348,7 @@ EOFUNC $lhs =~ s/\377//g; $lhs =~ s/\.\*\?$/.*/; # Allow %s at the end to eat it all } + $lhs =~ s/\\%c/./g; $transmo .= " s{^$lhs}\n {\Q$rhs\E}s\n\t&& return 1;\n"; } else { $transmo .= " m{^\Q$header\E} && return 1;\n"; @@ -376,7 +379,8 @@ if ($standalone) { } exit; } else { - $old_w = 0; $oldwarn = ''; $olddie = ''; + #$old_w = 0; + $oldwarn = ''; $olddie = ''; } sub import { diff --git a/lib/unicode/Eq/Latin1 b/lib/unicode/Eq/Latin1 deleted file mode 100644 index 89ecd763ad..0000000000 --- a/lib/unicode/Eq/Latin1 +++ /dev/null @@ -1,16 +0,0 @@ -0041 00C0 00C1 00C2 00C3 00C4 00C5 -0043 00C7 -0045 00C8 00C9 00CA 00CB -0049 00CC 00CD 00CE 00CF -004E 00D1 -004F 00D2 00D3 00D4 00D5 00D6 00D8 -0055 00D9 00DA 00DB 00DC -0059 00DD -0061 00AA 00E0 00E1 00E2 00E3 00E4 00E5 -0063 00E7 -0065 00E8 00E9 00EA 00EB -0069 00EC 00ED 00EE 00EF -006E 00F1 -006F 00BA 00F2 00F3 00F4 00F5 00F6 00F8 -0075 00F9 00FA 00FB 00FC -0079 00FD 00FF diff --git a/lib/unicode/Eq/Unicode b/lib/unicode/Eq/Unicode deleted file mode 100644 index 29b2a1c044..0000000000 --- a/lib/unicode/Eq/Unicode +++ /dev/null @@ -1,661 +0,0 @@ -0041 00C0 00C1 00C2 00C3 00C4 00C5 0100 0102 0104 01CD 0200 0202 0226 1E00 1EA0 1EA2 FF21 -0042 0181 0182 1E02 1E04 1E06 212C FF22 -0043 00C7 0106 0108 010A 010C 0187 2102 212D FF23 -0044 010E 0110 018A 018B 01C4 01C5 01F1 01F2 1E0A 1E0C 1E0E 1E10 1E12 FF24 -0045 00C8 00C9 00CA 00CB 0112 0114 0116 0118 011A 0204 0206 0228 1E18 1E1A 1EB8 1EBA 1EBC 2130 FF25 -0046 0191 1E1E 2131 FF26 -0047 011C 011E 0120 0122 0193 01E4 01E6 01F4 1E20 FF27 -0048 0124 0126 021E 1E22 1E24 1E26 1E28 1E2A 210B 210C 210D FF28 -0049 00CC 00CD 00CE 00CF 0128 012A 012C 012E 0130 0132 0197 01CF 0208 020A 1E2C 1EC8 1ECA 2110 2111 FF29 -004A 0134 FF2A -004B 0136 0198 01E8 1E30 1E32 1E34 212A FF2B -004C 0139 013B 013D 013F 0141 01C7 01C8 1E36 1E3A 1E3C 2112 FF2C -004D 1E3E 1E40 1E42 2133 FF2D -004E 00D1 0143 0145 0147 019D 01CA 01CB 01F8 1E44 1E46 1E48 1E4A 2115 FF2E -004F 00D2 00D3 00D4 00D5 00D6 00D8 014C 014E 0150 019F 01A0 01D1 01EA 020C 020E 022E 1ECC 1ECE FF2F -0050 01A4 1E54 1E56 2119 FF30 -0051 211A FF31 -0052 0154 0156 0158 0210 0212 1E58 1E5A 1E5E 211B 211C 211D FF32 -0053 015A 015C 015E 0160 0218 1E60 1E62 FF33 -0054 0162 0164 0166 01AC 01AE 021A 1E6A 1E6C 1E6E 1E70 FF34 -0055 00D9 00DA 00DB 00DC 0168 016A 016C 016E 0170 0172 01AF 01D3 0214 0216 1E72 1E74 1E76 1EE4 1EE6 FF35 -0056 01B2 1E7C 1E7E FF36 -0057 0174 1E80 1E82 1E84 1E86 1E88 FF37 -0058 1E8A 1E8C FF38 -0059 00DD 0176 0178 01B3 0232 1E8E 1EF2 1EF4 1EF6 1EF8 FF39 -005A 0179 017B 017D 01B5 0224 1E90 1E92 1E94 2124 2128 FF3A -0061 00AA 00E0 00E1 00E2 00E3 00E4 00E5 0101 0103 0105 01CE 0201 0203 0227 1E01 1E9A 1EA1 1EA3 FF41 -0062 0180 0183 0253 1E03 1E05 1E07 FF42 -0063 00E7 0107 0109 010B 010D 0188 0255 FF43 -0064 010F 0111 018C 01C6 01F3 0256 0257 1E0B 1E0D 1E0F 1E11 1E13 FF44 -0065 00E8 00E9 00EA 00EB 0113 0115 0117 0119 011B 0205 0207 0229 1E19 1E1B 1EB9 1EBB 1EBD 212F FF45 -0066 0192 1E1F FB00 FB01 FB02 FB03 FB04 FF46 -0067 011D 011F 0121 0123 01E5 01E7 01F5 0260 1E21 210A FF47 -0068 0125 0127 021F 0266 02B0 1E23 1E25 1E27 1E29 1E2B 1E96 210E FF48 -0069 00EC 00ED 00EE 00EF 0129 012B 012D 012F 0133 01D0 0209 020B 0268 1E2D 1EC9 1ECB 2139 FF49 -006A 0135 01F0 029D 02B2 FF4A -006B 0137 0199 01E9 1E31 1E33 1E35 FF4B -006C 013A 013C 013E 0140 0142 019A 01C9 026B 026C 026D 02E1 1E37 1E3B 1E3D 2113 FF4C -006D 0271 1E3F 1E41 1E43 FF4D -006E 00F1 0144 0146 0148 019E 01CC 01F9 0272 0273 1E45 1E47 1E49 1E4B 207F FF4E -006F 00BA 00F2 00F3 00F4 00F5 00F6 00F8 014D 014F 0151 01A1 01D2 01EB 020D 020F 022F 1ECD 1ECF 2134 FF4F -0070 01A5 1E55 1E57 FF50 -0071 02A0 FF51 -0072 0155 0157 0159 0211 0213 027C 027D 027E 02B3 1E59 1E5B 1E5F FF52 -0073 015B 015D 015F 0161 017F 0219 0282 02E2 1E61 1E63 FB06 FF53 -0074 0163 0165 0167 01AB 01AD 021B 0288 1E6B 1E6D 1E6F 1E71 1E97 FF54 -0075 00F9 00FA 00FB 00FC 0169 016B 016D 016F 0171 0173 01B0 01D4 0215 0217 1E73 1E75 1E77 1EE5 1EE7 FF55 -0076 028B 1E7D 1E7F FF56 -0077 0175 02B7 1E81 1E83 1E85 1E87 1E89 1E98 FF57 -0078 02E3 1E8B 1E8D FF58 -0079 00FD 00FF 0177 01B4 0233 02B8 1E8F 1E99 1EF3 1EF5 1EF7 1EF9 FF59 -007A 017A 017C 017E 01B6 0225 0290 0291 1E91 1E93 1E95 FF5A -00C2 1EA4 1EA6 1EA8 1EAA -00C4 01DE -00C5 01FA 212B -00C6 01E2 01FC -00C7 1E08 -00CA 1EBE 1EC0 1EC2 1EC4 -00CF 1E2E -00D4 1ED0 1ED2 1ED4 1ED6 -00D5 022C 1E4C 1E4E -00D6 022A -00D8 01FE -00DC 01D5 01D7 01D9 01DB -00E2 1EA5 1EA7 1EA9 1EAB -00E4 01DF -00E5 01FB -00E6 01E3 01FD -00E7 1E09 -00EA 1EBF 1EC1 1EC3 1EC5 -00EF 1E2F -00F4 1ED1 1ED3 1ED5 1ED7 -00F5 022D 1E4D 1E4F -00F6 022B -00F8 01FF -00FC 01D6 01D8 01DA 01DC -0102 1EAE 1EB0 1EB2 1EB4 -0103 1EAF 1EB1 1EB3 1EB5 -0112 1E14 1E16 -0113 1E15 1E17 -0127 210F -014C 1E50 1E52 -014D 1E51 1E53 -015A 1E64 -015B 1E65 -0160 1E66 -0161 1E67 -0168 1E78 -0169 1E79 -016A 1E7A -016B 1E7B -017F 1E9B FB05 -0190 2107 -01A0 1EDA 1EDC 1EDE 1EE0 1EE2 -01A1 1EDB 1EDD 1EDF 1EE1 1EE3 -01AF 1EE8 1EEA 1EEC 1EEE 1EF0 -01B0 1EE9 1EEB 1EED 1EEF 1EF1 -01B7 01EE -01EA 01EC -01EB 01ED -0226 01E0 -0227 01E1 -0228 1E1C -0229 1E1D -022E 0230 -022F 0231 -0259 025A -025C 025D -0262 029B -0263 02E0 -0266 02B1 -026F 0270 -0279 027A 027B 02B4 -027B 02B5 -0281 02B6 -0283 0286 -0292 01BA 01EF 0293 -0294 02A1 -0295 02E4 -0296 01BE -02A3 02A5 -02BC 0149 -0386 1FBB -0388 1FC9 -0389 1FCB -038A 1FDB -038C 1FF9 -038E 1FEB -038F 1FFB -0390 1FD3 -0391 0386 1F08 1F09 1FB8 1FB9 1FBA 1FBC -0395 0388 1F18 1F19 1FC8 -0397 0389 1F28 1F29 1FCA 1FCC -0399 038A 03AA 1F38 1F39 1FD8 1FD9 1FDA -039F 038C 1F48 1F49 1FF8 -03A1 1FEC -03A5 038E 03AB 03D2 1F59 1FE8 1FE9 1FEA -03A9 038F 1F68 1F69 1FFA 1FFC 2126 -03AC 1F71 1FB4 -03AD 1F73 -03AE 1F75 1FC4 -03AF 1F77 -03B0 1FE3 -03B1 03AC 1F00 1F01 1F70 1FB0 1FB1 1FB3 1FB6 -03B2 03D0 -03B5 03AD 1F10 1F11 1F72 -03B7 03AE 1F20 1F21 1F74 1FC3 1FC6 -03B8 03D1 -03B9 03AF 03CA 1F30 1F31 1F76 1FBE 1FD0 1FD1 1FD6 -03BA 03F0 -03BC 00B5 -03BF 03CC 1F40 1F41 1F78 -03C0 03D6 -03C1 03F1 1FE4 1FE5 -03C2 03F2 -03C5 03CB 03CD 1F50 1F51 1F7A 1FE0 1FE1 1FE6 -03C6 03D5 -03C9 03CE 1F60 1F61 1F7C 1FF3 1FF6 -03CA 0390 1FD2 1FD7 -03CB 03B0 1FE2 1FE7 -03CC 1F79 -03CD 1F7B -03CE 1F7D 1FF4 -03D2 03D3 03D4 -0406 0407 -0410 04D0 04D2 -0413 0403 0490 0492 0494 -0415 0400 0401 04D6 -0416 0496 04C1 04DC -0417 0498 04DE -0418 040D 0419 04E2 04E4 -041A 040C 049A 049C 049E 04C3 -041D 04A2 04C7 -041E 04E6 -041F 04A6 -0420 048E -0421 04AA -0422 04AC -0423 040E 04EE 04F0 04F2 -0425 04B2 -0427 04B6 04B8 04F4 -042B 04F8 -042D 04EC -0430 04D1 04D3 -0433 0453 0491 0493 0495 -0435 0450 0451 04D7 -0436 0497 04C2 04DD -0437 0499 04DF -0438 0439 045D 04E3 04E5 -043A 045C 049B 049D 049F 04C4 -043D 04A3 04C8 -043E 04E7 -043F 04A7 -0440 048F -0441 04AB -0442 04AD -0443 045E 04EF 04F1 04F3 -0445 04B3 -0447 04B7 04B9 04F5 -044B 04F9 -044D 04ED -0456 0457 -0460 047C -0461 047D -0474 0476 -0475 0477 -04AE 04B0 -04AF 04B1 -04BC 04BE -04BD 04BF -04D8 04DA -04D9 04DB -04E8 04EA -04E9 04EB -0565 0587 -0574 FB13 FB14 FB15 FB17 -057E FB16 -05D0 2135 FB21 FB2E FB2F FB30 FB4F -05D1 2136 FB31 FB4C -05D2 2137 FB32 -05D3 2138 FB22 FB33 -05D4 FB23 FB34 -05D5 FB35 FB4B -05D6 FB36 -05D8 FB38 -05D9 FB1D FB39 -05DA FB3A -05DB FB24 FB3B FB4D -05DC FB25 FB3C -05DD FB26 -05DE FB3E -05E0 FB40 -05E1 FB41 -05E2 FB20 -05E3 FB43 -05E4 FB44 FB4E -05E6 FB46 -05E7 FB47 -05E8 FB27 FB48 -05E9 FB2A FB2B FB49 -05EA FB28 FB4A -05F2 FB1F -0621 FE80 -0622 FE81 FE82 -0623 FE83 FE84 -0624 FE85 FE86 -0625 FE87 FE88 -0626 FBEA FBEB FBEC FBED FBEE FBEF FBF0 FBF1 FBF2 FBF3 FBF4 FBF5 FBF6 FBF7 FBF8 FBF9 FBFA FBFB FC00 FC01 FC02 FC03 FC04 FC64 FC65 FC66 FC67 FC68 FC69 FC97 FC98 FC99 FC9A FC9B FCDF FCE0 FE89 FE8A FE8B FE8C -0627 0622 0623 0625 0672 0673 0675 FD3C FD3D FDF2 FDF3 FE8D FE8E -0628 FC05 FC06 FC07 FC08 FC09 FC0A FC6A FC6B FC6C FC6D FC6E FC6F FC9C FC9D FC9E FC9F FCA0 FCE1 FCE2 FD9E FDC2 FE8F FE90 FE91 FE92 -0629 FE93 FE94 -062A 067C 067D FC0B FC0C FC0D FC0E FC0F FC10 FC70 FC71 FC72 FC73 FC74 FC75 FCA1 FCA2 FCA3 FCA4 FCA5 FCE3 FCE4 FD50 FD51 FD52 FD53 FD54 FD55 FD56 FD57 FD9F FDA0 FDA1 FDA2 FDA3 FDA4 FE95 FE96 FE97 FE98 -062B FC11 FC12 FC13 FC14 FC76 FC77 FC78 FC79 FC7A FC7B FCA6 FCE5 FCE6 FE99 FE9A FE9B FE9C -062C FC15 FC16 FCA7 FCA8 FD01 FD02 FD1D FD1E FD58 FD59 FDA5 FDA6 FDA7 FDBE FDFB FE9D FE9E FE9F FEA0 -062D 0681 0682 0685 FC17 FC18 FCA9 FCAA FCFF FD00 FD1B FD1C FD5A FD5B FDBF FEA1 FEA2 FEA3 FEA4 -062E FC19 FC1A FC1B FCAB FCAC FD03 FD04 FD1F FD20 FEA5 FEA6 FEA7 FEA8 -062F 0689 068A 068B 068F 0690 FEA9 FEAA -0630 FC5B FEAB FEAC -0631 0692 0693 0694 0695 0696 0697 0699 FC5C FDF6 FEAD FEAE -0632 FEAF FEB0 -0633 069A 069B 069C FC1C FC1D FC1E FC1F FCAD FCAE FCAF FCB0 FCE7 FCE8 FCFB FCFC FD0E FD17 FD18 FD2A FD31 FD34 FD35 FD36 FD5C FD5D FD5E FD5F FD60 FD61 FD62 FD63 FDA8 FDC6 FEB1 FEB2 FEB3 FEB4 -0634 06FA FCE9 FCEA FCFD FCFE FD09 FD0A FD0B FD0C FD0D FD19 FD1A FD25 FD26 FD27 FD28 FD29 FD2D FD2E FD2F FD30 FD32 FD37 FD38 FD39 FD67 FD68 FD69 FD6A FD6B FD6C FD6D FDAA FEB5 FEB6 FEB7 FEB8 -0635 069D 069E FC20 FC21 FCB1 FCB2 FCB3 FD05 FD06 FD0F FD21 FD22 FD2B FD64 FD65 FD66 FDA9 FDC5 FDF0 FDF5 FDF9 FDFA FEB9 FEBA FEBB FEBC -0636 06FB FC22 FC23 FC24 FC25 FCB4 FCB5 FCB6 FCB7 FD07 FD08 FD10 FD23 FD24 FD2C FD6E FD6F FD70 FDAB FEBD FEBE FEBF FEC0 -0637 069F FC26 FC27 FCB8 FCF5 FCF6 FD11 FD12 FD33 FD3A FD71 FD72 FD73 FD74 FEC1 FEC2 FEC3 FEC4 -0638 FC28 FCB9 FD3B FEC5 FEC6 FEC7 FEC8 -0639 06A0 FC29 FC2A FCBA FCBB FCF7 FCF8 FD13 FD14 FD75 FD76 FD77 FD78 FDB6 FDC4 FDF7 FEC9 FECA FECB FECC -063A 06FC FC2B FC2C FCBC FCBD FCF9 FCFA FD15 FD16 FD79 FD7A FD7B FECD FECE FECF FED0 -0640 FCF2 FCF3 FCF4 FE71 FE77 FE79 FE7B FE7D FE7F -0641 06A2 06A3 06A5 FC2D FC2E FC2F FC30 FC31 FC32 FC7C FC7D FCBE FCBF FCC0 FCC1 FD7C FD7D FDC1 FED1 FED2 FED3 FED4 -0642 06A7 06A8 FC33 FC34 FC35 FC36 FC7E FC7F FCC2 FCC3 FD7E FD7F FDB2 FDB4 FDF1 FED5 FED6 FED7 FED8 -0643 06AB 06AC 06AE FC37 FC38 FC39 FC3A FC3B FC3C FC3D FC3E FC80 FC81 FC82 FC83 FC84 FCC4 FCC5 FCC6 FCC7 FCC8 FCEB FCEC FDB7 FDBB FDC3 FED9 FEDA FEDB FEDC -0644 06B5 06B6 06B7 06B8 FC3F FC40 FC41 FC42 FC43 FC44 FC85 FC86 FC87 FCC9 FCCA FCCB FCCC FCCD FCED FD80 FD81 FD82 FD83 FD84 FD85 FD86 FD87 FD88 FDAC FDAD FDB5 FDBA FDBC FEDD FEDE FEDF FEE0 FEF5 FEF6 FEF7 FEF8 FEF9 FEFA FEFB FEFC -0645 FC45 FC46 FC47 FC48 FC49 FC4A FC88 FC89 FCCE FCCF FCD0 FCD1 FD89 FD8A FD8B FD8C FD8D FD8E FD8F FD92 FDB1 FDB9 FDC0 FDF4 FEE1 FEE2 FEE3 FEE4 -0646 06B9 06BC 06BD FC4B FC4C FC4D FC4E FC4F FC50 FC8A FC8B FC8C FC8D FC8E FC8F FCD2 FCD3 FCD4 FCD5 FCD6 FCEE FCEF FD95 FD96 FD97 FD98 FD99 FD9A FD9B FDB3 FDB8 FDBD FDC7 FEE5 FEE6 FEE7 FEE8 -0647 FC51 FC52 FC53 FC54 FCD7 FCD8 FCD9 FD93 FD94 FEE9 FEEA FEEB FEEC -0648 0624 0676 06C4 06CA 06CF FDF8 FEED FEEE -0649 FBE8 FBE9 FC5D FC90 FEEF FEF0 -064A 0626 0678 06CD 06CE 06D1 FC55 FC56 FC57 FC58 FC59 FC5A FC91 FC92 FC93 FC94 FC95 FC96 FCDA FCDB FCDC FCDD FCDE FCF0 FCF1 FD9C FD9D FDAE FDAF FDB0 FEF1 FEF2 FEF3 FEF4 -0671 FB50 FB51 -0677 FBDD -0679 FB66 FB67 FB68 FB69 -067A FB5E FB5F FB60 FB61 -067B FB52 FB53 FB54 FB55 -067E FB56 FB57 FB58 FB59 -067F FB62 FB63 FB64 FB65 -0680 FB5A FB5B FB5C FB5D -0683 FB76 FB77 FB78 FB79 -0684 FB72 FB73 FB74 FB75 -0686 06BF FB7A FB7B FB7C FB7D -0687 FB7E FB7F FB80 FB81 -0688 FB88 FB89 -068C FB84 FB85 -068D FB82 FB83 -068E FB86 FB87 -0691 FB8C FB8D -0698 FB8A FB8B -06A4 FB6A FB6B FB6C FB6D -06A6 FB6E FB6F FB70 FB71 -06A9 FB8E FB8F FB90 FB91 -06AD FBD3 FBD4 FBD5 FBD6 -06AF 06B0 06B2 06B4 FB92 FB93 FB94 FB95 -06B1 FB9A FB9B FB9C FB9D -06B3 FB96 FB97 FB98 FB99 -06BA FB9E FB9F -06BB FBA0 FBA1 FBA2 FBA3 -06BE FBAA FBAB FBAC FBAD -06C0 FBA4 FBA5 -06C1 06C2 FBA6 FBA7 FBA8 FBA9 -06C5 FBE0 FBE1 -06C6 FBD9 FBDA -06C7 0677 FBD7 FBD8 -06C8 FBDB FBDC -06C9 FBE2 FBE3 -06CB FBDE FBDF -06CC FBFC FBFD FBFE FBFF -06D0 FBE4 FBE5 FBE6 FBE7 -06D2 06D3 FBAE FBAF -06D3 FBB0 FBB1 -06D5 06C0 -0915 0958 -0916 0959 -0917 095A -091C 095B -0921 095C -0922 095D -0928 0929 -092B 095E -092F 095F -0930 0931 -0933 0934 -09A1 09DC -09A2 09DD -09AF 09DF -09B0 09F0 09F1 -0A16 0A59 -0A17 0A5A -0A1C 0A5B -0A2B 0A5E -0A32 0A33 -0A38 0A36 -0B21 0B5C -0B22 0B5D -0B92 0B94 -0EAB 0EDC 0EDD -0F40 0F69 -0F42 0F43 -0F4C 0F4D -0F51 0F52 -0F56 0F57 -0F5B 0F5C -1025 1026 -1100 3131 -1101 3132 -1102 3134 -1103 3137 -1104 3138 -1105 3139 -1106 3141 -1107 3142 -1108 3143 -1109 3145 -110A 3146 -110B 3147 -110C 3148 -110D 3149 -110E 314A -110F 314B -1110 314C -1111 314D -1112 314E -1114 3165 -1115 3166 -111A 3140 -111C 316E -111D 3171 -111E 3172 -1120 3173 -1121 3144 -1122 3174 -1123 3175 -1127 3176 -1129 3177 -112B 3178 -112C 3179 -112D 317A -112E 317B -112F 317C -1132 317D -1136 317E -1140 317F -1147 3180 -114C 3181 -1157 3184 -1158 3185 -1159 3186 -1160 3164 -1161 314F -1162 3150 -1163 3151 -1164 3152 -1165 3153 -1166 3154 -1167 3155 -1168 3156 -1169 3157 -116A 3158 -116B 3159 -116C 315A -116D 315B -116E 315C -116F 315D -1170 315E -1171 315F -1172 3160 -1173 3161 -1174 3162 -1175 3163 -1184 3187 -1185 3188 -1188 3189 -1191 318A -1192 318B -1194 318C -119E 318D -11A1 318E -11AA 3133 -11AC 3135 -11AD 3136 -11B0 313A -11B1 313B -11B2 313C -11B3 313D -11B4 313E -11B5 313F -11C7 3167 -11C8 3168 -11CC 3169 -11CE 316A -11D3 316B -11D7 316C -11D9 316D -11DD 316F -11DF 3170 -11F1 3182 -11F2 3183 -1E36 1E38 -1E37 1E39 -1E5A 1E5C -1E5B 1E5D -1E62 1E68 -1E63 1E69 -1EA0 1EAC 1EB6 -1EA1 1EAD 1EB7 -1EB8 1EC6 -1EB9 1EC7 -1ECC 1ED8 -1ECD 1ED9 -1F00 1F02 1F04 1F06 1F80 -1F01 1F03 1F05 1F07 1F81 -1F02 1F82 -1F03 1F83 -1F04 1F84 -1F05 1F85 -1F06 1F86 -1F07 1F87 -1F08 1F0A 1F0C 1F0E 1F88 -1F09 1F0B 1F0D 1F0F 1F89 -1F0A 1F8A -1F0B 1F8B -1F0C 1F8C -1F0D 1F8D -1F0E 1F8E -1F0F 1F8F -1F10 1F12 1F14 -1F11 1F13 1F15 -1F18 1F1A 1F1C -1F19 1F1B 1F1D -1F20 1F22 1F24 1F26 1F90 -1F21 1F23 1F25 1F27 1F91 -1F22 1F92 -1F23 1F93 -1F24 1F94 -1F25 1F95 -1F26 1F96 -1F27 1F97 -1F28 1F2A 1F2C 1F2E 1F98 -1F29 1F2B 1F2D 1F2F 1F99 -1F2A 1F9A -1F2B 1F9B -1F2C 1F9C -1F2D 1F9D -1F2E 1F9E -1F2F 1F9F -1F30 1F32 1F34 1F36 -1F31 1F33 1F35 1F37 -1F38 1F3A 1F3C 1F3E -1F39 1F3B 1F3D 1F3F -1F40 1F42 1F44 -1F41 1F43 1F45 -1F48 1F4A 1F4C -1F49 1F4B 1F4D -1F50 1F52 1F54 1F56 -1F51 1F53 1F55 1F57 -1F59 1F5B 1F5D 1F5F -1F60 1F62 1F64 1F66 1FA0 -1F61 1F63 1F65 1F67 1FA1 -1F62 1FA2 -1F63 1FA3 -1F64 1FA4 -1F65 1FA5 -1F66 1FA6 -1F67 1FA7 -1F68 1F6A 1F6C 1F6E 1FA8 -1F69 1F6B 1F6D 1F6F 1FA9 -1F6A 1FAA -1F6B 1FAB -1F6C 1FAC -1F6D 1FAD -1F6E 1FAE -1F6F 1FAF -1F70 1FB2 -1F74 1FC2 -1F7C 1FF2 -1FB6 1FB7 -1FC6 1FC7 -1FF6 1FF7 -3046 3094 -304B 304C -304D 304E -304F 3050 -3051 3052 -3053 3054 -3055 3056 -3057 3058 -3059 305A -305B 305C -305D 305E -305F 3060 -3061 3062 -3064 3065 -3066 3067 -3068 3069 -306F 3070 3071 -3072 3073 3074 -3075 3076 3077 -3078 3079 307A -307B 307C 307D -309D 309E -30A1 FF67 -30A2 FF71 -30A3 FF68 -30A4 FF72 -30A5 FF69 -30A6 30F4 FF73 -30A7 FF6A -30A8 FF74 -30A9 FF6B -30AA FF75 -30AB 30AC FF76 -30AD 30AE FF77 -30AF 30B0 FF78 -30B1 30B2 FF79 -30B3 30B4 FF7A -30B5 30B6 FF7B -30B7 30B8 FF7C -30B9 30BA FF7D -30BB 30BC FF7E -30BD 30BE FF7F -30BF 30C0 FF80 -30C1 30C2 FF81 -30C3 FF6F -30C4 30C5 FF82 -30C6 30C7 FF83 -30C8 30C9 FF84 -30CA FF85 -30CB FF86 -30CC FF87 -30CD FF88 -30CE FF89 -30CF 30D0 30D1 FF8A -30D2 30D3 30D4 FF8B -30D5 30D6 30D7 FF8C -30D8 30D9 30DA FF8D -30DB 30DC 30DD FF8E -30DE FF8F -30DF FF90 -30E0 FF91 -30E1 FF92 -30E2 FF93 -30E3 FF6C -30E4 FF94 -30E5 FF6D -30E6 FF95 -30E7 FF6E -30E8 FF96 -30E9 FF97 -30EA FF98 -30EB FF99 -30EC FF9A -30ED FF9B -30EF 30F7 FF9C -30F0 30F8 -30F1 30F9 -30F2 30FA FF66 -30F3 FF9D -30FC FF70 -30FD 30FE -3131 FFA1 -3132 FFA2 -3133 FFA3 -3134 FFA4 -3135 FFA5 -3136 FFA6 -3137 FFA7 -3138 FFA8 -3139 FFA9 -313A FFAA -313B FFAB -313C FFAC -313D FFAD -313E FFAE -313F FFAF -3140 FFB0 -3141 FFB1 -3142 FFB2 -3143 FFB3 -3144 FFB4 -3145 FFB5 -3146 FFB6 -3147 FFB7 -3148 FFB8 -3149 FFB9 -314A FFBA -314B FFBB -314C FFBC -314D FFBD -314E FFBE -314F FFC2 -3150 FFC3 -3151 FFC4 -3152 FFC5 -3153 FFC6 -3154 FFC7 -3155 FFCA -3156 FFCB -3157 FFCC -3158 FFCD -3159 FFCE -315A FFCF -315B FFD2 -315C FFD3 -315D FFD4 -315E FFD5 -315F FFD6 -3160 FFD7 -3161 FFDA -3162 FFDB -3163 FFDC -3164 FFA0 -FB49 FB2C FB2D diff --git a/makedef.pl b/makedef.pl index 1d585a2e31..eb599c9ae5 100644 --- a/makedef.pl +++ b/makedef.pl @@ -338,6 +338,11 @@ if ($define{'MYMALLOC'}) { Perl_realloc Perl_calloc )]; + if ($define{'USE_THREADS'} || $define{'USE_ITHREADS'}) { + emit_symbols [qw( + PL_malloc_mutex + )]; + } } else { skip_symbols [qw( @@ -357,7 +362,6 @@ unless ($define{'USE_THREADS'}) { PL_sv_mutex PL_strtab_mutex PL_svref_mutex - PL_malloc_mutex PL_cred_mutex PL_eval_mutex PL_eval_cond @@ -848,7 +848,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) # ifdef CYGWIN I32 i; for (i = 0; environ[i]; i++) - Safefree(environ[i]); + safesysfree(environ[i]); # else # ifndef PERL_USE_SAFE_PUTENV I32 i; @@ -4133,9 +4133,9 @@ CV * Perl_cv_clone(pTHX_ CV *proto) { CV *cv; - MUTEX_LOCK(&PL_cred_mutex); /* XXX create separate mutex */ + LOCK_CRED_MUTEX; /* XXX create separate mutex */ cv = cv_clone2(proto, CvOUTSIDE(proto)); - MUTEX_UNLOCK(&PL_cred_mutex); /* XXX create separate mutex */ + UNLOCK_CRED_MUTEX; /* XXX create separate mutex */ return cv; } diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index ba503ffbb3..005d7a92b6 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -96,9 +96,12 @@ perl.linkexp: perl.exports perl.map os2/os2.sym # We link miniperl statically, since .DLL depends on $(DYNALOADER) -miniperl.map miniperl: $(obj) perl$(OBJ_EXT) miniperlmain$(OBJ_EXT) - $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) perl$(OBJ_EXT) $(obj) $(libs) -Zmap -Zlinker /map - @./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest +opmini$(OBJ_EXT) : op.c + $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c + +miniperl.map miniperl: $(obj) perl$(OBJ_EXT) miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) + $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) perl$(OBJ_EXT) `echo $(obj)|sed -e 's/\bop\./opmini./g'` $(libs) -Zmap -Zlinker /map/PM:VIO + @./miniperl -w -Ilib -MExporter -e '<?>' || $(MAKE) minitest depend: os2ish.h dlfcn.h os2thread.h os2.c @@ -162,6 +165,9 @@ $(AOUT_LIBPERL) : $(aout_obj) perl$(AOUT_OBJ_EXT) .c$(AOUT_OBJ_EXT): $(AOUT_CCCMD) $(PLDLFLAGS) -c $*.c +opmini$(AOUT_OBJ_EXT): op.c + $(AOUT_CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(AOUT_OBJ_EXT) -c op.c + perlmain(AOUT_OBJ_EXT): perlmain.c $(AOUT_CCCMD_DLL) $(PLDLFLAGS) -c perlmain.c @@ -169,8 +175,8 @@ aout_perlmain.c: miniperlmain.c config.sh makefile $(static_ext_autoinit) sh writemain $(DYNALOADER) $(aout_static_lib) > tmp sh mv-if-diff tmp aout_perlmain.c -miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) - $(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o miniperl_ miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(libs) +miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) opmini$(AOUT_OBJ_EXT) + $(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o miniperl_ miniperlmain$(AOUT_OBJ_EXT) opmini$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(libs) perl_: $& aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs $(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER) $(aout_static_ext) $(AOUT_LIBPERL) `cat ext.libs` $(libs) @@ -119,9 +119,8 @@ perl_construct(pTHXx) /* Init the real globals (and main thread)? */ if (!PL_linestr) { -#ifdef USE_THREADS - INIT_THREADS; +#ifdef USE_THREADS #ifdef ALLOC_THREAD_KEY ALLOC_THREAD_KEY; #else @@ -856,18 +855,18 @@ S_parse_body(pTHX_ va_list args) if (!*++s && (s=argv[1]) != Nullch) { argc--,argv++; } - while (s && isSPACE(*s)) - ++s; if (s && *s) { - char *e, *p; - for (e = s; *e && !isSPACE(*e); e++) ; - p = savepvn(s, e-s); + char *p; + STRLEN len = strlen(s); + p = savepvn(s, len); incpush(p, TRUE); - sv_catpv(sv,"-I"); - sv_catpv(sv,p); - sv_catpv(sv," "); + sv_catpvn(sv, "-I", 2); + sv_catpvn(sv, p, len); + sv_catpvn(sv, " ", 1); Safefree(p); - } /* XXX else croak? */ + } + else + Perl_croak(aTHX_ "No directory specified for -I"); break; case 'P': forbid_setid("-P"); @@ -978,7 +977,8 @@ print \" \\@INC:\\n @INC\\n\";"); #ifndef SECURE_INTERNAL_GETENV !PL_tainting && #endif - (s = PerlEnv_getenv("PERL5OPT"))) { + (s = PerlEnv_getenv("PERL5OPT"))) + { while (isSPACE(*s)) s++; if (*s == '-' && *(s+1) == 'T') @@ -1762,14 +1762,23 @@ Perl_moreswitches(pTHX_ char *s) ++s; if (*s) { char *e, *p; - for (e = s; *e && !isSPACE(*e); e++) ; - p = savepvn(s, e-s); - incpush(p, TRUE); - Safefree(p); - s = e; + p = s; + /* ignore trailing spaces (possibly followed by other switches) */ + do { + for (e = p; *e && !isSPACE(*e); e++) ; + p = e; + while (isSPACE(*p)) + p++; + } while (*p && *p != '-'); + e = savepvn(s, e-s); + incpush(e, TRUE); + Safefree(e); + s = p; + if (*s == '-') + s++; } else - Perl_croak(aTHX_ "No space allowed after -I"); + Perl_croak(aTHX_ "No directory specified for -I"); return s; case 'l': PL_minus_l = TRUE; @@ -2154,7 +2163,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP); sv_catpv(cpp, cpp_cfg); - sv_catpv(sv,"-I"); + sv_catpvn(sv, "-I", 2); sv_catpv(sv,PRIVLIB_EXP); #ifdef MSDOS @@ -383,7 +383,8 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); /* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that pthread.h must be included before all other header files. */ -#if defined(USE_THREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) +#if (defined(USE_THREADS) || defined(USE_ITHREADS)) \ + && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) # include <pthread.h> #endif @@ -1502,11 +1503,12 @@ typedef struct ptr_tbl PTR_TBL_t; * May make sense to have threads after "*ish.h" anyway */ -#ifdef USE_THREADS +#if defined(USE_THREADS) || defined(USE_ITHREADS) +# if defined(USE_THREADS) /* pending resolution of licensing issues, we avoid the erstwhile * atomic.h everywhere */ # define EMULATE_ATOMIC_REFCOUNTS - +# endif # ifdef FAKE_THREADS # include "fakethr.h" # else @@ -1537,10 +1539,10 @@ typedef pthread_key_t perl_key; # endif /* OS2 */ # endif /* WIN32 */ # endif /* FAKE_THREADS */ -#endif /* USE_THREADS */ +#endif /* USE_THREADS || USE_ITHREADS */ #ifdef WIN32 -#include "win32.h" +# include "win32.h" #endif #ifdef VMS diff --git a/perlvars.h b/perlvars.h index 85ff7515bd..55769d55ca 100644 --- a/perlvars.h +++ b/perlvars.h @@ -31,6 +31,6 @@ PERLVARIC(Gpatleave, char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}") /* XXX does anyone even use this? */ PERLVARI(Gdo_undump, bool, FALSE) /* -u or dump seen? */ -#if defined(MYMALLOC) && defined(USE_THREADS) +#if defined(MYMALLOC) && (defined(USE_THREADS) || defined(USE_ITHREADS)) PERLVAR(Gmalloc_mutex, perl_mutex) /* Mutex for malloc */ #endif diff --git a/pod/perlcall.pod b/pod/perlcall.pod index 35c0f051d5..e691e759a1 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -1948,7 +1948,7 @@ L<perlxs>, L<perlguts>, L<perlembed> =head1 AUTHOR -Paul Marquess <F<pmarquess@bfsec.bt.co.uk>> +Paul Marquess Special thanks to the following people who assisted in the creation of the document. diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 3a48ef4672..c5f3a30edd 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -27,8 +27,10 @@ responsibility to ensure that warnings are enabled judiciously. =item STOP is a new keyword In addition to C<BEGIN>, C<INIT>, C<END>, C<DESTROY> and C<AUTOLOAD>, -subroutines named C<STOP> are now special. They are queued up for -execution at the end of compilation, and cannot be called directly. +subroutines named C<STOP> are now special. These are queued up during +compilation and behave similar to END blocks, except they are called at +the end of compilation rather than at the end of execution. They cannot +be called directly. =item Treatment of list slices of undef has changed @@ -691,13 +693,6 @@ BEGIN blocks are executed under such conditions, this variable enables perl code to determine whether actions that make sense only during normal running are warranted. See L<perlvar>. -=head2 STOP blocks - -Arbitrary code can be queued for execution when Perl has finished -parsing the program (i.e. when the compile phase ends) using STOP -blocks. These behave similar to END blocks, except for being -called at the end of compilation rather than at the end of execution. - =head2 Optional Y2K warnings If Perl is built with the cpp macro C<PERL_Y2KWARN> defined, @@ -1113,7 +1108,17 @@ Perl bytecode. See L<ByteLoader>. =item constant -References can now be used. See L<constant>. +References can now be used. + +The new version also allows a leading underscore in constant names, but +disallows a double leading underscore (as in "__LINE__"). Some other names +are disallowed or warned against, including BEGIN, END, etc. Some names +which were forced into main:: used to fail silently in some cases; now they're +fatal (outside of main::) and an optional warning (inside of main::). +The ability to detect whether a constant had been set with a given name has +been added. + +See L<constant>. =item charnames @@ -1134,7 +1139,8 @@ to Perl's debugging API. =item DB_File -[TODO - Paul Marquess <paul.marquess@bt.com>] +DB_File can now be built with Berkeley DB versions 1, 2 or 3. +See C<ext/DB_File/Changes>. =item Devel::DProf diff --git a/pod/perldiag.pod b/pod/perldiag.pod index a76d8f008b..20ab4d9155 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -280,7 +280,7 @@ the string being unpacked. See L<perlfunc/pack>. (F) You wrote C<require E<lt>fileE<gt>> when you should have written C<require 'file'>. -=item accept() on closed fd +=item accept() on closed socket (W) You tried to do an accept on a closed socket. Did you forget to check the return value of your socket() call? See L<perlfunc/accept>. @@ -518,7 +518,7 @@ likely depends on its correct operation, Perl just gave up. (4294967295) and therefore non-portable between systems. See L<perlport> for more on portability concerns. -=item bind() on closed fd +=item bind() on closed socket (W) You tried to do a bind on a closed socket. Did you forget to check the return value of your socket() call? See L<perlfunc/bind>. @@ -1068,7 +1068,7 @@ most likely an unexpected right brace '}'. reference of the type needed. You can use the ref() function to test the type of the reference, if need be. -=item Can't use \1 to mean $1 in expression +=item Can't use \%c to mean $%c in expression (W) In an ordinary expression, backslash is a unary operator that creates a reference to its argument. The use of backslash to indicate a backreference @@ -1076,7 +1076,7 @@ to a matched substring is valid only as part of a regular expression pattern. Trying to do this in ordinary Perl code produces a value that prints out looking like SCALAR(0xdecaf). Use the $1 form instead. -=item Can't use bareword ("%s") as %s ref while \"strict refs\" in use +=item Can't use bareword ("%s") as %s ref while "strict refs" in use (F) Only hard references are allowed by "strict refs". Symbolic references are disallowed. See L<perlref>. @@ -1187,7 +1187,7 @@ than in the regular expression engine; or rewriting the regular expression so that it is simpler or backtracks less. (See L<perlbook> for information on I<Mastering Regular Expressions>.) -=item connect() on closed fd +=item connect() on closed socket (W) You tried to do a connect on a closed socket. Did you forget to check the return value of your socket() call? See L<perlfunc/connect>. @@ -1489,7 +1489,7 @@ when you meant because if it did, it'd feel morally obligated to return every hostname on the Internet. -=item get{sock,peer}name() on closed fd +=item get%sname() on closed socket (W) You tried to get a socket or peer socket name on a closed socket. Did you forget to check the return value of your socket() call? @@ -1766,7 +1766,7 @@ L<perlfunc/last>. (F) While under the C<use filetest> pragma, switching the real and effective uids or gids failed. -=item listen() on closed fd +=item listen() on closed socket (W) You tried to do a listen on a closed socket. Did you forget to check the return value of your socket() call? See L<perlfunc/listen>. @@ -1904,6 +1904,11 @@ See L<perlsec>. (F) A setuid script can't be specified by the user. +=item No %s specified for -%c + +(F) The indicated command line switch needs a mandatory argument, but +you haven't specified one. + =item No comma allowed after %s (F) A list operator that has a filehandle or "indirect object" is not @@ -1988,10 +1993,10 @@ your system. (F) Configure didn't find anything resembling the setreuid() call for your system. -=item No space allowed after B<-I> +=item No space allowed after -%c -(F) The argument to B<-I> must follow the B<-I> immediately with no -intervening space. +(F) The argument to the indicated command line switch must follow immediately +after the switch, without intervening spaces. =item No such pseudo-hash field "%s" @@ -2478,12 +2483,12 @@ instead of "||". See Server error. -=item print on closed filehandle %s +=item print() on closed filehandle %s (W) The filehandle you're printing on got itself closed sometime before now. Check your logic flow. -=item printf on closed filehandle %s +=item printf() on closed filehandle %s (W) The filehandle you're writing to got itself closed sometime before now. Check your logic flow. @@ -2508,7 +2513,7 @@ are outside the range which can be represented by integers internally. One possible workaround is to force Perl to use magical string increment by prepending "0" to your numbers. -=item Read on closed filehandle %s +=item readline() on closed filehandle %s (W) The filehandle you're reading from got itself closed sometime before now. Check your logic flow. @@ -2649,9 +2654,9 @@ that had previously been marked as free. (W) A nearby syntax error was probably caused by a missing semicolon, or possibly some other missing operator, such as a comma. -=item Send on closed socket +=item send() on closed socket -(W) The filehandle you're sending to got itself closed sometime before now. +(W) The socket you're sending to got itself closed sometime before now. Check your logic flow. =item Sequence (? incomplete @@ -2738,7 +2743,7 @@ because the world might have written on it already. (F) You don't have System V shared memory IPC on your system. -=item shutdown() on closed fd +=item shutdown() on closed socket (W) You tried to do a shutdown on a closed socket. Seems a bit superfluous. @@ -2876,7 +2881,7 @@ into Perl yourself. machine. In some machines the functionality can exist but be unconfigured. Consult your system support. -=item Syswrite on closed filehandle +=item syswrite() on closed filehandle (W) The filehandle you're writing to got itself closed sometime before now. Check your logic flow. @@ -3444,7 +3449,7 @@ but in actual fact, you got So put in parentheses to say what you really mean. -=item Write on closed filehandle %s +=item write() on closed filehandle %s (W) The filehandle you're writing to got itself closed sometime before now. Check your logic flow. @@ -3487,11 +3492,11 @@ already have a subroutine of that name declared, which means that Perl 5 will try to call the subroutine when the assignment is executed, which is probably not what you want. (If it IS what you want, put an & in front.) -=item [gs]etsockopt() on closed fd +=item %cetsockopt() on closed fd (W) You tried to get or set a socket option on a closed socket. Did you forget to check the return value of your socket() call? -See L<perlfunc/getsockopt>. +See L<perlfunc/getsockopt> and L<perlfunc/setsockopt>. =item \1 better written as $1 diff --git a/pod/perlfaq3.pod b/pod/perlfaq3.pod index 26f7a693f3..18c436bdc4 100644 --- a/pod/perlfaq3.pod +++ b/pod/perlfaq3.pod @@ -483,7 +483,7 @@ The Win95/NT installation, when using the ActiveState port of Perl, will modify the Registry to associate the C<.pl> extension with the perl interpreter. If you install another port, perhaps even building your own Win95/NT Perl from the standard sources by using a Windows port -of gcc (e.g., with cygwin32 or mingw32), then you'll have to modify +of gcc (e.g., with cygwin or mingw32), then you'll have to modify the Registry yourself. In addition to associating C<.pl> with the interpreter, NT people can use: C<SET PATHEXT=%PATHEXT%;.PL> to let them run the program C<install-linux.pl> merely by typing C<install-linux>. diff --git a/pod/perlop.pod b/pod/perlop.pod index c430dbc48d..547ee5328e 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -963,7 +963,7 @@ notably if the result of qr() is used standalone: my @compiled = map qr/$_/i, @$patterns; grep { my $success = 0; - foreach my $pat @compiled { + foreach my $pat (@compiled) { $success = 1, last if /$pat/; } $success; diff --git a/pod/perlport.pod b/pod/perlport.pod index 25736960da..21f144c237 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -925,10 +925,10 @@ the message body to majordomo@list.stratagy.com. Recent versions of Perl have been ported to platforms such as OS/400 on AS/400 minicomputers as well as OS/390, VM/ESA, and BS2000 for S/390 Mainframes. Such computers use EBCDIC character sets internally (usually -Character Code Set ID 00819 for OS/400 and 1047 for S/390 systems). -On the mainframe perl currently works under the "Unix system services -for OS/390" (formerly known as OpenEdition), VM/ESA OpenEdition, or -the BS200 POSIX system (BS2000 is supported in perl 5.006 and greater). +Character Code Set ID 0037 for OS/400 and either 1047 or POSIX-BC for S/390 +systems). On the mainframe perl currently works under the "Unix system +services for OS/390" (formerly known as OpenEdition), VM/ESA OpenEdition, or +the BS200 POSIX-BC system (BS2000 is supported in perl 5.6 and greater). As of R2.5 of USS for OS/390 and Version 2.3 of VM/ESA these Unix sub-systems do not support the C<#!> shebang trick for script invocation. @@ -1663,6 +1663,10 @@ Not useful. (S<RISC OS>) =over 4 +=item v1.45, 20 December 1999 + +Small changes from 5.005_63 distribution, more changes to EBCDIC info. + =item v1.44, 19 July 1999 A bunch of updates from Peter Prymmer for C<$^O> values, @@ -1756,6 +1760,7 @@ Chris Nandor E<lt>pudge@pobox.comE<gt>, Matthias Neeracher E<lt>neeri@iis.ee.ethz.chE<gt>, Gary Ng E<lt>71564.1743@CompuServe.COME<gt>, Tom Phoenix E<lt>rootbeer@teleport.comE<gt>, +AndrE<eacute> Pirard E<lt>A.Pirard@ulg.ac.beE<gt>, Peter Prymmer E<lt>pvhp@forte.comE<gt>, Hugo van der Sanden E<lt>hv@crypt0.demon.co.ukE<gt>, Gurusamy Sarathy E<lt>gsar@activestate.comE<gt>, @@ -1769,4 +1774,4 @@ E<lt>pudge@pobox.comE<gt>. =head1 VERSION -Version 1.44, last modified 22 July 1999 +Version 1.45, last modified 20 December 1999 diff --git a/pod/perlvar.pod b/pod/perlvar.pod index d38bc4937d..5e705313d5 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -270,7 +270,7 @@ set, you'll get the record back in pieces. On VMS, record reads are done with the equivalent of C<sysread>, so it's best not to mix record and non-record reads on the same file. (This is unlikely to be a problem, because any file you'd -want to read in record mode is probably usable in line mode.) +want to read in record mode is probably unusable in line mode.) Non-VMS systems do normal I/O, so it's safe to mix record and non-record reads of a file. @@ -367,7 +367,7 @@ PP(pp_print) SvPV(sv,n_a)); else if (ckWARN(WARN_CLOSED)) Perl_warner(aTHX_ WARN_CLOSED, - "print on closed filehandle %s", SvPV(sv,n_a)); + "print() on closed filehandle %s", SvPV(sv,n_a)); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); goto just_say_no; @@ -1254,7 +1254,7 @@ Perl_do_readline(pTHX) SV* sv = sv_newmortal(); gv_efullname3(sv, PL_last_in_gv, Nullch); Perl_warner(aTHX_ WARN_CLOSED, - "Read on closed filehandle %s", + "readline() on closed filehandle %s", SvPV_nolen(sv)); } } @@ -247,7 +247,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) Gid_t egid = getegid(); int res; - MUTEX_LOCK(&PL_cred_mutex); + LOCK_CRED_MUTEX; #if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID) Perl_croak(aTHX_ "switching effective uid is not implemented"); #else @@ -293,7 +293,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) #endif #endif Perl_croak(aTHX_ "leaving effective gid failed"); - MUTEX_UNLOCK(&PL_cred_mutex); + UNLOCK_CRED_MUTEX; return res; } @@ -1281,7 +1281,7 @@ PP(pp_leavewrite) SvPV_nolen(sv)); else if (ckWARN(WARN_CLOSED)) Perl_warner(aTHX_ WARN_CLOSED, - "Write on closed filehandle %s", SvPV_nolen(sv)); + "write() on closed filehandle %s", SvPV_nolen(sv)); } PUSHs(&PL_sv_no); } @@ -1361,7 +1361,7 @@ PP(pp_prtf) SvPV(sv,n_a)); else if (ckWARN(WARN_CLOSED)) Perl_warner(aTHX_ WARN_CLOSED, - "printf on closed filehandle %s", SvPV(sv,n_a)); + "printf() on closed filehandle %s", SvPV(sv,n_a)); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); goto just_say_no; @@ -1631,9 +1631,9 @@ PP(pp_send) length = -1; if (ckWARN(WARN_CLOSED)) { if (PL_op->op_type == OP_SYSWRITE) - Perl_warner(aTHX_ WARN_CLOSED, "Syswrite on closed filehandle"); + Perl_warner(aTHX_ WARN_CLOSED, "syswrite() on closed filehandle"); else - Perl_warner(aTHX_ WARN_CLOSED, "Send on closed socket"); + Perl_warner(aTHX_ WARN_CLOSED, "send() on closed socket"); } } else if (PL_op->op_type == OP_SYSWRITE) { @@ -2140,7 +2140,7 @@ PP(pp_bind) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2170,7 +2170,7 @@ PP(pp_connect) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2196,7 +2196,7 @@ PP(pp_listen) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2250,7 +2250,7 @@ PP(pp_accept) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed socket"); SETERRNO(EBADF,SS$_IVCHAN); badexit: @@ -2277,7 +2277,7 @@ PP(pp_shutdown) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2356,7 +2356,8 @@ PP(pp_ssockopt) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "[gs]etsockopt() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "%cetsockopt() on closed socket", + optype == OP_GSOCKOPT ? 'g' : 's'); SETERRNO(EBADF,SS$_IVCHAN); nuts2: RETPUSHUNDEF; @@ -2429,7 +2430,8 @@ PP(pp_getpeername) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "get{sock, peer}name() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "get%sname() on closed socket", + optype == OP_GETSOCKNAME ? "sock" : "peer"); SETERRNO(EBADF,SS$_IVCHAN); nuts2: RETPUSHUNDEF; @@ -545,9 +545,21 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da } } else if (flags & SCF_DO_STCLASS_AND) { - cl_and(data->start_class, &accum); - if (min1) + if (min1) { + cl_and(data->start_class, &accum); flags &= ~SCF_DO_STCLASS; + } + else { + /* Switch to OR mode: cache the old value of + * data->start_class */ + StructCopy(data->start_class, &and_with, + struct regnode_charclass_class); + flags &= ~SCF_DO_STCLASS_AND; + StructCopy(&accum, data->start_class, + struct regnode_charclass_class); + flags |= SCF_DO_STCLASS_OR; + data->start_class->flags |= ANYOF_EOS; + } } } else if (code == BRANCHJ) /* single branch is optimized. */ diff --git a/t/lib/charnames.t b/t/lib/charnames.t index b03083e6d1..9775b141b2 100644 --- a/t/lib/charnames.t +++ b/t/lib/charnames.t @@ -12,7 +12,7 @@ print "1..5\n"; use charnames ':full'; -print "not " unless "Here\N{EXCLAMATION MARK}?" eq 'Here!?'; +print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here\041?"; print "ok 1\n"; { diff --git a/t/lib/dumper.t b/t/lib/dumper.t index 9130d1c690..0ac269620d 100755 --- a/t/lib/dumper.t +++ b/t/lib/dumper.t @@ -9,6 +9,8 @@ BEGIN { } use Data::Dumper; +use Config; +my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define'; $Data::Dumper::Pad = "#"; my $TMAX; @@ -22,6 +24,14 @@ sub TEST { ++$TNUM; $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g if ($WANT =~ /deadbeef/); + if ($Is_ebcdic) { + # these data need massaging with non ascii character sets + # because of hashing order differences + $WANT = join("\n",sort(split(/\n/,$WANT))); + $WANT =~ s/\,$//mg; + $t = join("\n",sort(split(/\n/,$t))); + $t =~ s/\,$//mg; + } print( ($t eq $WANT and not $@) ? "ok $TNUM\n" : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n"); @@ -33,6 +43,13 @@ sub TEST { ++$TNUM; $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g if ($WANT =~ /deadbeef/); + if ($Is_ebcdic) { + # here too there are hashing order differences + $WANT = join("\n",sort(split(/\n/,$WANT))); + $WANT =~ s/\,$//mg; + $t = join("\n",sort(split(/\n/,$t))); + $t =~ s/\,$//mg; + } print( ($t eq $WANT and not $@) ? "ok $TNUM\n" : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n"); } diff --git a/t/op/re_tests b/t/op/re_tests index e957609071..d506e6e07f 100644 --- a/t/op/re_tests +++ b/t/op/re_tests @@ -749,3 +749,4 @@ tt+$ xxxtt y - - '(\.c(pp|xx|c)?$)'i IO.c y $1 .c ^([a-z]:) C:/ n - - '^\S\s+aa$'m \nx aa y - - +(^|a)b ab y - - diff --git a/t/op/stat.t b/t/op/stat.t index 0af55bbaab..b44617d2b6 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -14,9 +14,10 @@ print "1..58\n"; $Is_MSWin32 = $^O eq 'MSWin32'; $Is_Dos = $^O eq 'dos'; $Is_Dosish = $Is_Dos || $^O eq 'os2' || $Is_MSWin32; +$Is_Cygwin = $^O =~ /cygwin/; chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`)); -$DEV = `ls -l /dev` unless $Is_Dosish; +$DEV = `ls -l /dev` unless $Is_Dosish or $Is_Cygwin; unlink "Op.stat.tmp"; if (open(FOO, ">Op.stat.tmp")) { @@ -163,7 +164,7 @@ else {print "not ok 33\n";} if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";} -if ($^O eq 'amigaos' or $Is_Dosish) { +if ($^O eq 'amigaos' or $Is_Dosish or $Is_Cygwin) { print "ok 35 # skipped: no -u\n"; goto tty_test; } diff --git a/t/pragma/constant.t b/t/pragma/constant.t index a56e081083..5904a4f2b6 100755 --- a/t/pragma/constant.t +++ b/t/pragma/constant.t @@ -14,9 +14,9 @@ END { print @warnings } ######################### We start with some black magic to print on failure. -BEGIN { $| = 1; print "1..46\n"; } +BEGIN { $| = 1; print "1..58\n"; } END {print "not ok 1\n" unless $loaded;} -use constant; +use constant 1.01; $loaded = 1; #print "# Version: $constant::VERSION\n"; print "ok 1\n"; @@ -155,3 +155,42 @@ test 44, scalar($@ =~ /^No such pseudo-hash field/); print CCODE->(45); eval q{ CCODE->{foo} }; test 46, scalar($@ =~ /^Constant is not a HASH/); + +# Allow leading underscore +use constant _PRIVATE => 47; +test 47, _PRIVATE == 47; + +# Disallow doubled leading underscore +eval q{ + use constant __DISALLOWED => "Oops"; +}; +test 48, $@ =~ /begins with '__'/; + +# Check on declared() and %declared. This sub should be EXACTLY the +# same as the one quoted in the docs! +sub declared ($) { + use constant 1.01; # don't omit this! + my $name = shift; + $name =~ s/^::/main::/; + my $pkg = caller; + my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; + $constant::declared{$full_name}; +} + +test 49, declared 'PI'; +test 50, $constant::declared{'main::PI'}; + +test 51, !declared 'PIE'; +test 52, !$constant::declared{'main::PIE'}; + +{ + package Other; + use constant IN_OTHER_PACK => 42; + ::test 53, ::declared 'IN_OTHER_PACK'; + ::test 54, $constant::declared{'Other::IN_OTHER_PACK'}; + ::test 55, ::declared 'main::PI'; + ::test 56, $constant::declared{'main::PI'}; +} + +test 57, declared 'Other::IN_OTHER_PACK'; +test 58, $constant::declared{'Other::IN_OTHER_PACK'}; diff --git a/t/pragma/overload.t b/t/pragma/overload.t index f673dce028..f9a9c59c87 100755 --- a/t/pragma/overload.t +++ b/t/pragma/overload.t @@ -759,7 +759,12 @@ else { }, 'deref'; # Hash: my @cont = sort %$deref; - test "@cont", '23 5 fake foo'; # 178 + if ("\t" eq "\011") { # ascii + test "@cont", '23 5 fake foo'; # 178 + } + else { # ebcdic alpha-numeric sort order + test "@cont", 'fake foo 23 5'; # 178 + } my @keys = sort keys %$deref; test "@keys", 'fake foo'; # 179 my @val = sort values %$deref; diff --git a/t/pragma/utf8.t b/t/pragma/utf8.t index 01b0f0529c..2ae8d9c784 100755 --- a/t/pragma/utf8.t +++ b/t/pragma/utf8.t @@ -4,6 +4,10 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; $ENV{PERL5LIB} = '../lib'; + if ( ord("\t") != 9 ) { # skip on ebcdic platforms + print "1..0 # Skip utf8 tests on ebcdic platform.\n"; + exit; + } } print "1..12\n"; diff --git a/t/pragma/warn/4lint b/t/pragma/warn/4lint index b7c64c31ac..db54f31c7b 100644 --- a/t/pragma/warn/4lint +++ b/t/pragma/warn/4lint @@ -9,14 +9,14 @@ $a = 1 if $a EQ $b ; close STDIN ; print STDIN "abc" ; EXPECT Use of EQ is deprecated at - line 5. -print on closed filehandle main::STDIN at - line 6. +print() on closed filehandle main::STDIN at - line 6. ######## -W # lint: check runtime $^W is zapped $^W = 0 ; close STDIN ; print STDIN "abc" ; EXPECT -print on closed filehandle main::STDIN at - line 4. +print() on closed filehandle main::STDIN at - line 4. ######## -W # lint: check runtime $^W is zapped @@ -25,7 +25,7 @@ print on closed filehandle main::STDIN at - line 4. close STDIN ; print STDIN "abc" ; } EXPECT -print on closed filehandle main::STDIN at - line 5. +print() on closed filehandle main::STDIN at - line 5. ######## -W # lint: check "no warnings" is zapped @@ -35,7 +35,7 @@ $a = 1 if $a EQ $b ; close STDIN ; print STDIN "abc" ; EXPECT Use of EQ is deprecated at - line 5. -print on closed filehandle main::STDIN at - line 6. +print() on closed filehandle main::STDIN at - line 6. ######## -W # lint: check "no warnings" is zapped @@ -44,7 +44,7 @@ print on closed filehandle main::STDIN at - line 6. close STDIN ; print STDIN "abc" ; } EXPECT -print on closed filehandle main::STDIN at - line 5. +print() on closed filehandle main::STDIN at - line 5. ######## -Ww # lint: check combination of -w and -W @@ -53,7 +53,7 @@ print on closed filehandle main::STDIN at - line 5. close STDIN ; print STDIN "abc" ; } EXPECT -print on closed filehandle main::STDIN at - line 5. +print() on closed filehandle main::STDIN at - line 5. ######## -W --FILE-- abc.pm diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio index 4706aebfdc..57dd993a2b 100644 --- a/t/pragma/warn/doio +++ b/t/pragma/warn/doio @@ -1,6 +1,6 @@ doio.c - Can't do bidirectional pipe [Perl_do_open9] + Can't open bidirectional pipe [Perl_do_open9] open(F, "| true |"); Missing command in piped open [Perl_do_open9] @@ -64,7 +64,7 @@ no warnings 'io' ; open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); close(G); EXPECT -Can't do bidirectional pipe at - line 3. +Can't open bidirectional pipe at - line 3. ######## # doio.c [Perl_do_open9] use warnings 'io' ; diff --git a/t/pragma/warn/doop b/t/pragma/warn/doop index 961d157502..d666950495 100644 --- a/t/pragma/warn/doop +++ b/t/pragma/warn/doop @@ -12,6 +12,12 @@ EXPECT Malformed UTF-8 character at - line 4. ######## # doop.c +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# Character codes differ on ebcdic machines."; + exit 0; + } +} use warnings 'utf8' ; use utf8 ; $_ = "\x80 \xff" ; diff --git a/t/pragma/warn/pp b/t/pragma/warn/pp index ea85912475..227c97c664 100644 --- a/t/pragma/warn/pp +++ b/t/pragma/warn/pp @@ -112,6 +112,12 @@ EXPECT Malformed UTF-8 character at - line 4. ######## # pp.c +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# Character codes differ on ebcdic machines."; + exit 0; + } +} use warnings 'utf8' ; use utf8 ; $_ = "\x80 \xff" ; diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 379918b6b8..7e19dc5c94 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -9,7 +9,7 @@ Filehandle %s opened only for output [pp_print] print <STDOUT> ; - print on closed filehandle %s [pp_print] + print() on closed filehandle %s [pp_print] close STDIN ; print STDIN "abc" ; uninitialized [pp_rv2av] @@ -30,7 +30,7 @@ glob failed (can't start child: %s) [Perl_do_readline] <<TODO - Read on closed filehandle %s [Perl_do_readline] + readline() on closed filehandle %s [Perl_do_readline] close STDIN ; $a = <STDIN>; glob failed (child exited with status %d%s) [Perl_do_readline] <<TODO @@ -86,7 +86,7 @@ print STDIN "anc"; no warnings 'closed' ; print STDIN "anc"; EXPECT -print on closed filehandle main::STDIN at - line 4. +print() on closed filehandle main::STDIN at - line 4. ######## # pp_hot.c [pp_rv2av] use warnings 'uninitialized' ; @@ -128,7 +128,7 @@ close STDIN ; $a = <STDIN> ; no warnings 'closed' ; $a = <STDIN> ; EXPECT -Read on closed filehandle main::STDIN at - line 3. +readline() on closed filehandle main::STDIN at - line 3. ######## # pp_hot.c [Perl_do_readline] use warnings 'io' ; diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys index 651cdf9515..ea4b536842 100644 --- a/t/pragma/warn/pp_sys +++ b/t/pragma/warn/pp_sys @@ -8,7 +8,7 @@ . write STDIN; - Write on closed filehandle %s [pp_leavewrite] + write() on closed filehandle %s [pp_leavewrite] format STDIN = . close STDIN; @@ -23,45 +23,47 @@ $a = "abc"; printf $a "fred" - printf on closed filehandle %s [pp_prtf] + printf() on closed filehandle %s [pp_prtf] close STDIN ; printf STDIN "fred" - Syswrite on closed filehandle [pp_send] + syswrite() on closed filehandle [pp_send] close STDIN; syswrite STDIN, "fred", 1; - Send on closed socket [pp_send] + send() on closed socket [pp_send] close STDIN; send STDIN, "fred", 1 - bind() on closed fd [pp_bind] + bind() on closed socket [pp_bind] close STDIN; bind STDIN, "fred" ; - connect() on closed fd [pp_connect] + connect() on closed socket [pp_connect] close STDIN; connect STDIN, "fred" ; - listen() on closed fd [pp_listen] + listen() on closed socket [pp_listen] close STDIN; listen STDIN, 2; - accept() on closed fd [pp_accept] + accept() on closed socket [pp_accept] close STDIN; accept STDIN, "fred" ; - shutdown() on closed fd [pp_shutdown] + shutdown() on closed socket [pp_shutdown] close STDIN; shutdown STDIN, 0; - [gs]etsockopt() on closed fd [pp_ssockopt] + setsockopt() on closed socket [pp_ssockopt] + getsockopt() on closed socket [pp_ssockopt] close STDIN; setsockopt STDIN, 1,2,3; getsockopt STDIN, 1,2; - get{sock, peer}name() on closed fd [pp_getpeername] + getsockname() on closed socket [pp_getpeername] + getpeername() on closed socket [pp_getpeername] close STDIN; getsockname STDIN; getpeername STDIN; @@ -112,7 +114,7 @@ write STDIN; no warnings 'closed' ; write STDIN; EXPECT -Write on closed filehandle main::STDIN at - line 6. +write() on closed filehandle main::STDIN at - line 6. ######## # pp_sys.c [pp_leavewrite] use warnings 'io' ; @@ -148,7 +150,7 @@ printf STDIN "fred"; no warnings 'closed' ; printf STDIN "fred"; EXPECT -printf on closed filehandle main::STDIN at - line 4. +printf() on closed filehandle main::STDIN at - line 4. ######## # pp_sys.c [pp_prtf] use warnings 'io' ; @@ -165,7 +167,7 @@ syswrite STDIN, "fred", 1; no warnings 'closed' ; syswrite STDIN, "fred", 1; EXPECT -Syswrite on closed filehandle at - line 4. +syswrite() on closed filehandle at - line 4. ######## # pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername] use warnings 'io' ; @@ -210,16 +212,16 @@ getsockopt STDIN, 1,2; getsockname STDIN; getpeername STDIN; EXPECT -Send on closed socket at - line 22. -bind() on closed fd at - line 23. -connect() on closed fd at - line 24. -listen() on closed fd at - line 25. -accept() on closed fd at - line 26. -shutdown() on closed fd at - line 27. -[gs]etsockopt() on closed fd at - line 28. -[gs]etsockopt() on closed fd at - line 29. -get{sock, peer}name() on closed fd at - line 30. -get{sock, peer}name() on closed fd at - line 31. +send() on closed socket at - line 22. +bind() on closed socket at - line 23. +connect() on closed socket at - line 24. +listen() on closed socket at - line 25. +accept() on closed socket at - line 26. +shutdown() on closed socket at - line 27. +setsockopt() on closed socket at - line 28. +getsockopt() on closed socket at - line 29. +getsockname() on closed socket at - line 30. +getpeername() on closed socket at - line 31. ######## # pp_sys.c [pp_stat] use warnings 'newline' ; diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp index 1bdc4a9382..581b84a026 100644 --- a/t/pragma/warn/regcomp +++ b/t/pragma/warn/regcomp @@ -114,6 +114,12 @@ EXPECT /[[:digit:]-[:alpha:]]/: false [] range "[:digit:]-" in regexp at - line 12. ######## # regcomp.c [S_regclassutf8] +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# ebcdic regular expression ranges differ."; + exit 0; + } +} use utf8; $_ = ""; use warnings 'unsafe' ; diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv index d9de3b622f..82080308f2 100644 --- a/t/pragma/warn/sv +++ b/t/pragma/warn/sv @@ -269,6 +269,12 @@ EXPECT Undefined value assigned to typeglob at - line 3. ######## # sv.c +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# ebcdic \\x characters differ."; + exit 0; + } +} use utf8 ; $^W =0 ; { diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke index ee02efa813..cfffa370e6 100644 --- a/t/pragma/warn/toke +++ b/t/pragma/warn/toke @@ -462,6 +462,12 @@ EXPECT ######## # toke.c +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# Ebcdic platforms have different \\x constructs."; + exit 0; + } +} use warnings 'utf8' ; use utf8 ; $_ = " \xffe " ; diff --git a/t/pragma/warn/utf8 b/t/pragma/warn/utf8 index b11514d826..1faa80c16a 100644 --- a/t/pragma/warn/utf8 +++ b/t/pragma/warn/utf8 @@ -22,6 +22,12 @@ EXPECT Malformed UTF-8 character at - line 3. ######## # utf8.c [utf8_to_uv] +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# Ebcdic platforms have different \\x constructs."; + exit 0; + } +} use utf8 ; my $a = ord "\x80" ; { @@ -42,6 +48,12 @@ EXPECT Malformed UTF-8 character at - line 3. ######## # utf8.c [utf8_to_uv] +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# Ebcdic platforms have different \\x constructs."; + exit 0; + } +} use utf8 ; my $a = ord "\xf080" ; { @@ -1,4 +1,4 @@ -#ifdef USE_THREADS +#if defined(USE_THREADS) || defined(USE_ITHREADS) #ifdef WIN32 # include <win32thread.h> @@ -236,10 +236,19 @@ struct perl_thread *getTHR (void); } STMT_END #endif /* SET_THR */ -#ifndef THR -#define THR ((struct perl_thread *) pthread_getspecific(PL_thr_key)) +#ifndef INIT_THREADS +# ifdef NEED_PTHREAD_INIT +# define INIT_THREADS pthread_init() +# endif #endif +#ifndef THREAD_RET_TYPE +# define THREAD_RET_TYPE void * +# define THREAD_RET_CAST(p) ((void *)(p)) +#endif /* THREAD_RET */ + +#if defined(USE_THREADS) + /* * dTHR is performance-critical. Here, we only do the pthread_get_specific * if there may be more than one thread in existence, otherwise we get thr @@ -249,21 +258,18 @@ struct perl_thread *getTHR (void); * * The use of PL_threadnum should be safe here. */ -#ifndef dTHR -# define dTHR \ - struct perl_thread *thr = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv) -#endif /* dTHR */ +# if !defined(dTHR) +# define dTHR \ + struct perl_thread *thr = PL_threadnum ? THR : (struct perl_thread*)SvPVX(PL_thrsv) +# endif /* dTHR */ -#ifndef INIT_THREADS -# ifdef NEED_PTHREAD_INIT -# define INIT_THREADS pthread_init() -# else -# define INIT_THREADS NOOP +# if !defined(THR) +# define THR ((struct perl_thread *) pthread_getspecific(PL_thr_key)) # endif -#endif + /* Accessor for per-thread SVs */ -#define THREADSV(i) (thr->threadsvp[i]) +# define THREADSV(i) (thr->threadsvp[i]) /* * LOCK_SV_MUTEX and UNLOCK_SV_MUTEX are performance-critical. Here, we @@ -272,31 +278,12 @@ struct perl_thread *getTHR (void); * remove the "if (threadnum) ..." test. * XXX do NOT use C<if (PL_threadnum) ...> -- it sets up race conditions! */ -#define LOCK_SV_MUTEX \ - STMT_START { \ - MUTEX_LOCK(&PL_sv_mutex); \ - } STMT_END - -#define UNLOCK_SV_MUTEX \ - STMT_START { \ - MUTEX_UNLOCK(&PL_sv_mutex); \ - } STMT_END - -/* Likewise for strtab_mutex */ -#define LOCK_STRTAB_MUTEX \ - STMT_START { \ - MUTEX_LOCK(&PL_strtab_mutex); \ - } STMT_END - -#define UNLOCK_STRTAB_MUTEX \ - STMT_START { \ - MUTEX_UNLOCK(&PL_strtab_mutex); \ - } STMT_END - -#ifndef THREAD_RET_TYPE -# define THREAD_RET_TYPE void * -# define THREAD_RET_CAST(p) ((void *)(p)) -#endif /* THREAD_RET */ +# define LOCK_SV_MUTEX MUTEX_LOCK(&PL_sv_mutex) +# define UNLOCK_SV_MUTEX MUTEX_UNLOCK(&PL_sv_mutex) +# define LOCK_STRTAB_MUTEX MUTEX_LOCK(&PL_strtab_mutex) +# define UNLOCK_STRTAB_MUTEX MUTEX_UNLOCK(&PL_strtab_mutex) +# define LOCK_CRED_MUTEX MUTEX_LOCK(&PL_cred_mutex) +# define UNLOCK_CRED_MUTEX MUTEX_UNLOCK(&PL_cred_mutex) /* Values and macros for thr->flags */ @@ -330,24 +317,85 @@ typedef struct condpair { #define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond) #define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner -#else -/* USE_THREADS is not defined */ -#define MUTEX_LOCK(m) -#define MUTEX_LOCK_NOCONTEXT(m) -#define MUTEX_UNLOCK(m) -#define MUTEX_UNLOCK_NOCONTEXT(m) -#define MUTEX_INIT(m) -#define MUTEX_DESTROY(m) -#define COND_INIT(c) -#define COND_SIGNAL(c) -#define COND_BROADCAST(c) -#define COND_WAIT(c, m) -#define COND_DESTROY(c) -#define LOCK_SV_MUTEX -#define UNLOCK_SV_MUTEX -#define LOCK_STRTAB_MUTEX -#define UNLOCK_STRTAB_MUTEX - -#define THR -#define dTHR dNOOP #endif /* USE_THREADS */ +#endif /* USE_THREADS || USE_ITHREADS */ + +#ifndef MUTEX_LOCK +# define MUTEX_LOCK(m) +#endif + +#ifndef MUTEX_LOCK_NOCONTEXT +# define MUTEX_LOCK_NOCONTEXT(m) +#endif + +#ifndef MUTEX_UNLOCK +# define MUTEX_UNLOCK(m) +#endif + +#ifndef MUTEX_UNLOCK_NOCONTEXT +# define MUTEX_UNLOCK_NOCONTEXT(m) +#endif + +#ifndef MUTEX_INIT +# define MUTEX_INIT(m) +#endif + +#ifndef MUTEX_DESTROY +# define MUTEX_DESTROY(m) +#endif + +#ifndef COND_INIT +# define COND_INIT(c) +#endif + +#ifndef COND_SIGNAL +# define COND_SIGNAL(c) +#endif + +#ifndef COND_BROADCAST +# define COND_BROADCAST(c) +#endif + +#ifndef COND_WAIT +# define COND_WAIT(c, m) +#endif + +#ifndef COND_DESTROY +# define COND_DESTROY(c) +#endif + +#ifndef LOCK_SV_MUTEX +# define LOCK_SV_MUTEX +#endif + +#ifndef UNLOCK_SV_MUTEX +# define UNLOCK_SV_MUTEX +#endif + +#ifndef LOCK_STRTAB_MUTEX +# define LOCK_STRTAB_MUTEX +#endif + +#ifndef UNLOCK_STRTAB_MUTEX +# define UNLOCK_STRTAB_MUTEX +#endif + +#ifndef LOCK_CRED_MUTEX +# define LOCK_CRED_MUTEX +#endif + +#ifndef UNLOCK_CRED_MUTEX +# define UNLOCK_CRED_MUTEX +#endif + +#ifndef THR +# define THR +#endif + +#ifndef dTHR +# define dTHR dNOOP +#endif + +#ifndef INIT_THREADS +# define INIT_THREADS NOOP +#endif @@ -1889,7 +1889,7 @@ Perl_my_setenv_init(char ***penviron) } void -my_setenv(char *nam, char *val) +Perl_my_setenv(char *nam, char *val) { /* You can not directly manipulate the environ[] array because * the routines do some additional work that syncs the Cygwin @@ -1901,13 +1901,13 @@ my_setenv(char *nam, char *val) if (!oldstr) return; unsetenv(nam); - Safefree(oldstr); + safesysfree(oldstr); return; } setenv(nam, val, 1); environ = *Perl_main_environ; /* environ realloc can occur in setenv */ if(oldstr && environ[setenv_getix(nam)] != oldstr) - Safefree(oldstr); + safesysfree(oldstr); } #else /* if WIN32 */ @@ -3339,11 +3339,11 @@ Perl_condpair_magic(pTHX_ SV *sv) COND_INIT(&cp->owner_cond); COND_INIT(&cp->cond); cp->owner = 0; - MUTEX_LOCK(&PL_cred_mutex); /* XXX need separate mutex? */ + LOCK_CRED_MUTEX; /* XXX need separate mutex? */ mg = mg_find(sv, 'm'); if (mg) { /* someone else beat us to initialising it */ - MUTEX_UNLOCK(&PL_cred_mutex); /* XXX need separate mutex? */ + UNLOCK_CRED_MUTEX; /* XXX need separate mutex? */ MUTEX_DESTROY(&cp->mutex); COND_DESTROY(&cp->owner_cond); COND_DESTROY(&cp->cond); @@ -3354,7 +3354,7 @@ Perl_condpair_magic(pTHX_ SV *sv) mg = SvMAGIC(sv); mg->mg_ptr = (char *)cp; mg->mg_len = sizeof(cp); - MUTEX_UNLOCK(&PL_cred_mutex); /* XXX need separate mutex? */ + UNLOCK_CRED_MUTEX; /* XXX need separate mutex? */ DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log, "%p: condpair_magic %p\n", thr, sv));) } |