diff options
105 files changed, 3543 insertions, 1848 deletions
@@ -28,6 +28,489 @@ example from http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/ Version v5.7.X Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 15172] By: jhi on 2002/03/11 13:54:49 + Log: Regen toc. + Branch: perl + ! pod/perltoc.pod +____________________________________________________________________________ +[ 15171] By: jhi on 2002/03/11 13:48:09 + Log: Add t/CN.t and t/TW.t; re-sort. + Branch: perl + ! ext/Encode/MANIFEST +____________________________________________________________________________ +[ 15170] By: jhi on 2002/03/11 13:04:25 + Log: Document what to do if one yearns back to + the old legacy encoding. + Branch: perl + ! lib/encoding.pm +____________________________________________________________________________ +[ 15169] By: jhi on 2002/03/11 12:57:45 + Log: Undocument the use of .*utf8.*{upgrade,downgrade,encode,decode} + as general purpose encoding transformation interfaces + since that's not what they are. + Branch: perl + ! lib/utf8.pm pod/perlunicode.pod sv.c +____________________________________________________________________________ +[ 15168] By: ams on 2002/03/11 12:54:16 + Log: Subject: [PATCH] Re: Smoke 15089 Tru64/OSF Problems: numconvert, lstat + warnings + From: Rafael Garcia-Suarez <rgarciasuarez@free.fr> + Date: Mon, 11 Mar 2002 14:35:22 +0100 + Message-Id: <20020311143522.A7431@rafael> + Branch: perl + ! t/lib/warnings/pp_sys +____________________________________________________________________________ +[ 15167] By: ams on 2002/03/11 04:57:20 + Log: A little commonsense is better than 1_compile. + Branch: perl + ! lib/File/Find/t/find.t lib/File/Find/t/taint.t +____________________________________________________________________________ +[ 15166] By: ams on 2002/03/11 04:53:50 + Log: Subject: [PATCH] Hash::Util & restricted hash touch up, part 1 + From: Michael G Schwern <schwern@pobox.com> + Date: Sun, 10 Mar 2002 13:27:12 -0500 + Message-Id: <20020310182712.GC693@blackrider> + + Subject: [PATCH] Hash::Util part 2 + From: Michael G Schwern <schwern@pobox.com> + Date: Sun, 10 Mar 2002 15:09:34 -0500 + Message-Id: <20020310200934.GB27112@blackrider> + + Subject: [PATCH] Hash::Util MANIFEST correction + From: Michael G Schwern <schwern@pobox.com> + Date: Sun, 10 Mar 2002 16:27:07 -0500 + Message-Id: <20020310212707.GF27112@blackrider> + + (Also changes find.t and taint.t, which were looking for access.t) + Branch: perl + + ext/Data/Util/Changes ext/Data/Util/Makefile.PL + + ext/Data/Util/Util.xs ext/Data/Util/lib/Data/Util.pm + + ext/Data/Util/lib/Hash/Util.pm ext/Data/Util/t/Data.t + + ext/Data/Util/t/Hash.t + - t/lib/access.t + ! MANIFEST hv.c lib/File/Find/t/find.t lib/File/Find/t/taint.t + ! pod/perldiag.pod pod/perltodo.pod universal.c +____________________________________________________________________________ +[ 15165] By: jhi on 2002/03/11 04:52:56 + Log: metaconfig: more thready fixes. + Branch: metaconfig + ! U/threads/d_asctime_r.U U/threads/d_ctime_r.U + ! U/threads/d_endgrent_r.U U/threads/d_endpwent_r.U + ! U/threads/d_getgrent_r.U U/threads/d_getgrgid_r.U + ! U/threads/d_getgrnam_r.U U/threads/d_getpwent_r.U + ! U/threads/d_getpwnam_r.U U/threads/d_getpwuid_r.U + ! U/threads/d_gmtime_r.U U/threads/d_localtime_r.U + ! U/threads/d_readdir64_r.U U/threads/d_readdir_r.U + ! U/threads/d_setgrent_r.U U/threads/d_setpwent_r.U + ! U/threads/d_strerror_r.U U/threads/d_ttyname_r.U +____________________________________________________________________________ +[ 15163] By: jhi on 2002/03/11 04:39:54 + Log: Skip obsoleted interfaces. + Branch: perl + ! Porting/findrfuncs +____________________________________________________________________________ +[ 15162] By: ams on 2002/03/11 03:48:14 + Log: Typo fixes. + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 15161] By: jhi on 2002/03/11 03:36:51 + Log: Upgrade to Locale::Codes 2.02. + Branch: perl + + lib/Locale/Codes/t/rename.t + ! MANIFEST lib/Locale/Codes/ChangeLog lib/Locale/Codes/README + ! lib/Locale/Codes/t/uk.t lib/Locale/Country.pm + ! lib/Locale/Country.pod +____________________________________________________________________________ +[ 15160] By: jhi on 2002/03/11 03:36:32 + Log: Subject: Re: [PATCH] for broken /proc/curproc/file on FreeBSD + From: Nicholas Clark <nick@unfortu.net> + Date: Sun, 10 Mar 2002 18:17:50 +0000 + Message-ID: <20020310181749.GC317@Bagpuss.unfortu.net> + + Subject: Re: [PATCH] for broken /proc/curproc/file on FreeBSD + From: sthoenna@efn.org (Yitzchak Scott-Thoennes) + Date: Sun, 10 Mar 2002 13:53:34 -0800 + Message-ID: <eX9i8gzkg26G092yn@efn.org> + + (and reenable the feature in freebsd, + and move the freebsd pr url to perl.c) + Branch: perl + ! hints/freebsd.sh perl.c pod/perldelta.pod +____________________________________________________________________________ +[ 15159] By: ams on 2002/03/11 03:34:13 + Log: Subject: [PATCH stash.t] access::readonly is gone + From: Michael G Schwern <schwern@pobox.com> + Date: Sun, 10 Mar 2002 16:18:14 -0500 + Message-Id: <20020310211813.GE27112@blackrider> + Branch: perl + ! ext/B/t/stash.t +____________________________________________________________________________ +[ 15158] By: ams on 2002/03/11 03:28:04 + Log: Subject: [PATCH] Raw socket require privileged user on Win2k + From: "Mattia Barbon" <mbarbon@dsi.unive.it> + Date: Sun, 10 Mar 2002 22:10:15 +0100 + Message-Id: <3C8BD9C7.610.7398DD@localhost> + Branch: perl + ! lib/Net/Ping/t/110_icmp_inst.t +____________________________________________________________________________ +[ 15157] By: jhi on 2002/03/11 03:12:01 + Log: Subject: [PATCH] Test::Simple/More/Builder 0.42 + From: Michael G Schwern <schwern@pobox.com> + Date: Sun, 10 Mar 2002 19:22:33 -0500 + Message-ID: <20020311002233.GE4927@blackrider> + Branch: perl + ! lib/Test/Builder.pm lib/Test/More.pm lib/Test/Simple.pm + ! lib/Test/Simple/Changes lib/Test/Simple/t/Builder.t + ! lib/Test/Simple/t/fail-more.t +____________________________________________________________________________ +[ 15156] By: jhi on 2002/03/11 03:10:55 + Log: Subject: [PATCH] Test.pm 1.18 -> 1.20 + From: Michael G Schwern <schwern@pobox.com> + Date: Sun, 10 Mar 2002 17:14:10 -0500 + Message-ID: <20020310221410.GA4915@blackrider> + Branch: perl + ! lib/Test.pm lib/Test/t/fail.t lib/Test/t/mix.t + ! lib/Test/t/onfail.t lib/Test/t/skip.t lib/Test/t/todo.t +____________________________________________________________________________ +[ 15155] By: jhi on 2002/03/11 03:09:16 + Log: Subject: [PATCH] more warnings tidyup + From: "Paul Marquess" <paul_marquess@yahoo.co.uk> + Date: Sun, 10 Mar 2002 21:01:39 -0000 + Message-ID: <AIEAJICLCBDNAAOLLOKLMEEGDPAA.paul_marquess@yahoo.co.uk> + Branch: perl + ! av.c doio.c doop.c dump.c gv.c hv.c malloc.c mg.c numeric.c + ! op.c perl.c pp.c pp_ctl.c pp_hot.c pp_pack.c pp_sys.c + ! regcomp.c regexec.c sv.c taint.c toke.c universal.c utf8.c + ! util.c +____________________________________________________________________________ +[ 15154] By: jhi on 2002/03/11 03:07:03 + Log: Subject: Re: [PATCH] xsubpp prototypes warnings + From: Nicholas Clark <nick@unfortu.net> + Date: Sun, 10 Mar 2002 23:21:07 +0000 + Message-ID: <20020310232107.GI317@Bagpuss.unfortu.net> + Branch: perl + ! ext/B/C/C.xs ext/Encode/CN/Makefile.PL + ! ext/Encode/JP/Makefile.PL ext/Encode/KR/Makefile.PL + ! ext/Encode/TW/Makefile.PL +____________________________________________________________________________ +[ 15153] By: ams on 2002/03/11 03:06:59 + Log: Subject: Re: [patch] IO::Socket::INET Broadcast patch + From: Max Baker <max@warped.org> + Date: Fri, 8 Mar 2002 10:56:19 -0800 + Message-Id: <20020308105619.A15039@warped.org> + Branch: perl + ! ext/IO/lib/IO/Socket/INET.pm +____________________________________________________________________________ +[ 15152] By: jhi on 2002/03/11 03:05:54 + Log: Subject: [PATCH] spelling correction + From: Nicholas Clark <nick@unfortu.net> + Date: Sun, 10 Mar 2002 18:34:42 +0000 + Message-ID: <20020310183441.GE317@Bagpuss.unfortu.net> + Branch: perl + ! pp.c pp_hot.c +____________________________________________________________________________ +[ 15151] By: jhi on 2002/03/11 03:04:33 + Log: DG/UX updates from Takis Psarogiannakopoulos. + Branch: perl + ! README.dgux hints/dgux.sh perl.h t/op/stat.t thread.h +____________________________________________________________________________ +[ 15150] By: ams on 2002/03/11 03:02:47 + Log: Subject: [PATCH] debugger filenames for Mac OS - db.patch (1/1) + From: Chris Nandor <pudge@pobox.com> + Date: Mon, 04 Mar 2002 17:48:12 -0500 + Message-Id: <pudge-3FDB8F.17481204032002@onion.valueclick.com> + Branch: perl + ! lib/DB.pm lib/perl5db.pl +____________________________________________________________________________ +[ 15149] By: jhi on 2002/03/11 03:01:26 + Log: metaconfig unit changes in preparation of reentrancy changes. + Branch: metaconfig + + U/threads/d_ctermid_r.U U/threads/d_readdir64_r.U + + U/threads/d_ttyname_r.U + ! U/threads/d_asctime_r.U U/threads/d_ctime_r.U + ! U/threads/d_endgrent_r.U U/threads/d_endhent_r.U + ! U/threads/d_endnent_r.U U/threads/d_endpent_r.U + ! U/threads/d_endpwent_r.U U/threads/d_getgrent_r.U + ! U/threads/d_getgrgid_r.U U/threads/d_getgrnam_r.U + ! U/threads/d_gethent_r.U U/threads/d_getnent_r.U + ! U/threads/d_getpwent_r.U U/threads/d_getpwnam_r.U + ! U/threads/d_getpwuid_r.U U/threads/d_gmtime_r.U + ! U/threads/d_localtime_r.U U/threads/d_readdir_r.U + ! U/threads/d_setgrent_r.U U/threads/d_setpwent_r.U + ! U/threads/d_strerror_r.U +____________________________________________________________________________ +[ 15148] By: jhi on 2002/03/10 22:32:33 + Log: Mysterious characters. + Branch: perl + ! utf8.h +____________________________________________________________________________ +[ 15147] By: jhi on 2002/03/10 17:58:43 + Log: Unused. + Branch: perl + ! op.c +____________________________________________________________________________ +[ 15146] By: jhi on 2002/03/10 16:35:55 + Log: Implement :std subpragma of the open pragma + that makes the standard filehandles to talk in + encodings. This change set off a weird warning + from op.c, though: disabled it now until someone + who knows what it is about comes along. + Branch: perl + ! lib/open.pm op.c +____________________________________________________________________________ +[ 15145] By: jhi on 2002/03/10 16:00:46 + Log: Document the logic of :locale better. + Branch: perl + ! lib/open.pm +____________________________________________________________________________ +[ 15144] By: jhi on 2002/03/10 15:53:57 + Log: Subject: [PATCH] for broken /proc/curproc/file on FreeBSD + From: Slaven Rezic <slaven.rezic@berlin.de> + Date: 10 Mar 2002 02:49:17 +0100 + Message-ID: <87lmd1qjj6.fsf@vran.herceg.de> + Branch: perl + ! hints/freebsd.sh +____________________________________________________________________________ +[ 15143] By: jhi on 2002/03/10 15:46:22 + Log: Subject: Encode::Tcl docs (was Re: UTF-16 and other missing(?) encodings) + From: SADAHIRO Tomoyuki <bqw10602@nifty.com> + Date: Sun, 10 Mar 2002 17:08:54 +0900 + Message-Id: <20020310170748.1F29.BQW10602@nifty.com> + Branch: perl + ! ext/Encode/lib/Encode/Tcl.pm + ! ext/Encode/lib/Encode/Tcl/Escape.pm + ! ext/Encode/lib/Encode/Tcl/Extended.pm + ! ext/Encode/lib/Encode/Tcl/Table.pm +____________________________________________________________________________ +[ 15142] By: jhi on 2002/03/10 15:43:54 + Log: The patch does the following: + - Nix the unneccessary diagnostics line + - Quell -w warnings if the first ENV doesn't exist + - While zh_CN means euc-cn, zh_TW almost invariably mean big5, as euc-tw + is too baroque and bloated for daily use (and for perl core inclusion). + - "Cannot figure out an encoding to use" when locale is 'C' is rendered + non-fatal. + - Consequently, the ^OPEN bits is set only when needed. + Branch: perl + ! lib/open.pm +____________________________________________________________________________ +[ 15141] By: jhi on 2002/03/10 05:15:26 + Log: Misc tiny tweaks from Sarathy, good for threaded builds. + Branch: perl + ! ext/Socket/Socket.xs hints/linux.sh pp_sys.c +____________________________________________________________________________ +[ 15140] By: jhi on 2002/03/10 05:12:08 + Log: Precedence problem. + Branch: perl + ! ext/Socket/socketpair.t +____________________________________________________________________________ +[ 15139] By: jhi on 2002/03/10 04:57:07 + Log: Renaming tweaks, and split off the reentrant "superbuffer" + init routine. + Branch: perl + ! embed.fnc embed.h global.sym intrpvar.h op.h perl.c proto.h + ! sv.c util.c +____________________________________________________________________________ +[ 15138] By: jhi on 2002/03/10 00:59:50 + Log: The 7-bit jis seems to be the hanging one. + Branch: perl + ! ext/Encode/t/Tcl.t +____________________________________________________________________________ +[ 15137] By: jhi on 2002/03/10 00:39:18 + Log: Begone. + Branch: perl + ! ext/Encode/MANIFEST +____________________________________________________________________________ +[ 15136] By: jhi on 2002/03/09 23:56:42 + Log: Better fix from Autrijus. + Branch: perl + ! ext/Encode/CN/CN.pm ext/Encode/Encode.pm ext/Encode/JP/JP.pm + ! ext/Encode/KR/KR.pm ext/Encode/TW/TW.pm +____________________________________________________________________________ +[ 15135] By: jhi on 2002/03/09 18:49:55 + Log: Not everybody has Encode::HanExtra. + Branch: perl + ! ext/Encode/Encode.pm +____________________________________________________________________________ +[ 15134] By: jhi on 2002/03/09 18:30:18 + Log: Decutandpasto. + Branch: perl + ! ext/Encode/lib/Encode/Tcl.pm +____________________________________________________________________________ +[ 15133] By: jhi on 2002/03/09 18:19:38 + Log: Subject: [PATCH] Data::Dumper + From: Nicholas Clark <nick@unfortu.net> + Date: Sat, 9 Mar 2002 19:03:54 +0000 + Message-ID: <20020309190353.GE307@Bagpuss.unfortu.net> + Branch: perl + ! ext/Data/Dumper/Dumper.pm ext/Data/Dumper/Dumper.xs + ! ext/Data/Dumper/t/dumper.t +____________________________________________________________________________ +[ 15132] By: jhi on 2002/03/09 16:55:40 + Log: Subject: [PATCH] socketpair.t w/o fork + From: "Mattia Barbon" <mbarbon@dsi.unive.it> + Date: Sat, 9 Mar 2002 14:55:11 +0100 + Message-ID: <3C8A224F.29578.13691BA@localhost> + + (modified as suggested by Sarathy) + Branch: perl + ! ext/Socket/socketpair.t +____________________________________________________________________________ +[ 15131] By: jhi on 2002/03/09 16:05:00 + Log: Subject: [PATCH perldelta] Mention Change 14727 + From: Autrijus Tang <autrijus@autrijus.org> + Date: Sat, 9 Mar 2002 23:31:40 +0800 + Message-ID: <20020309153140.GA4224@not.autrijus.org> + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 15130] By: jhi on 2002/03/09 16:02:58 + Log: Make Encode.pm implicitly load external CJK tables the first + time they're needed (instead of immediately), from Autrijus + Tang. + Branch: perl + ! ext/Encode/Encode.pm +____________________________________________________________________________ +[ 15129] By: jhi on 2002/03/09 16:01:00 + Log: Subject: Re: Two questions + From: Nicholas Clark <nick@unfortu.net> + Date: Sat, 9 Mar 2002 12:42:40 +0000 + Message-ID: <20020309124239.GC307@Bagpuss.unfortu.net> + Branch: perl + ! Porting/pumpkin.pod +____________________________________________________________________________ +[ 15128] By: jhi on 2002/03/09 04:19:22 + Log: Subject: [PATCH] pp_sys.c (pp_sselect to not clobber storage on BigEndian + From: Paul_GreenVOS@vos.stratus.com + Date: Fri, 8 Mar 02 22:34 est + Message-Id: <200203090336.WAA11215@mailhub1.stratus.com> + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 15127] By: jhi on 2002/03/09 01:34:41 + Log: Subject: [PATCH @15084] perl -Dt doesnt output newlines + From: davem@fdgroup.co.uk + Date: Sat, 9 Mar 2002 00:13:27 GMT + Message-Id: <200203090013.AAA01000@gizmo.fdgroup.co.uk> + Branch: perl + ! dump.c +____________________________________________________________________________ +[ 15126] By: jhi on 2002/03/09 01:23:16 + Log: Deglitch from Rafael. + Branch: perl + ! ext/B/t/lint.t +____________________________________________________________________________ +[ 15125] By: jhi on 2002/03/08 23:49:00 + Log: Still more portability. + Branch: perl + ! Porting/findrfuncs +____________________________________________________________________________ +[ 15124] By: jhi on 2002/03/08 22:54:50 + Log: More portability. + Branch: perl + ! Porting/findrfuncs +____________________________________________________________________________ +[ 15123] By: jhi on 2002/03/08 22:14:37 + Log: Shared library paths; running tests manually. + Branch: perl + ! INSTALL +____________________________________________________________________________ +[ 15122] By: jhi on 2002/03/08 22:02:37 + Log: Subject: RE: Two questions + From: "Green, Paul" <Paul.Green@stratus.com> + Date: Fri, 8 Mar 2002 17:55:19 -0500 + Message-ID: <A2A34F15EE916148BC4C4748223E67A4014E231C@EXNA4.stratus.com> + Branch: perl + ! Porting/pumpkin.pod +____________________________________________________________________________ +[ 15121] By: jhi on 2002/03/08 21:52:51 + Log: New shinier lint.t (and Lint.pm) from Rafael Garcia-Suarez. + (Lint.pm nit noticed by Michael Cook <michael@waxrat.com>) + Branch: perl + + ext/B/t/lint.t + ! MANIFEST ext/B/B/Lint.pm +____________________________________________________________________________ +[ 15120] By: jhi on 2002/03/08 20:27:42 + Log: metaconfig unit change for #15119. + Branch: metaconfig + ! U/threads/d_pthread_atfork.U +____________________________________________________________________________ +[ 15119] By: jhi on 2002/03/08 20:27:17 + Log: In DG/UX finding pthread_atfork requires a true compile, + from Takis Psarogiannakopoulos. + Branch: perl + ! Configure config_h.SH +____________________________________________________________________________ +[ 15118] By: jhi on 2002/03/08 20:07:07 + Log: Subject: [PATCH] Forgot an OVERLOAD character in xsubpp + From: John Peacock <jpeacock@rowman.com> + Date: Fri, 08 Mar 2002 15:52:41 -0500 + Message-ID: <3C892499.4050502@rowman.com> + Branch: perl + ! lib/ExtUtils/xsubpp +____________________________________________________________________________ +[ 15117] By: jhi on 2002/03/08 20:05:41 + Log: Subject: [PATCH @15109] test numbers for t/op/write.t + From: "Craig A. Berry" <craigberry@mac.com> + Date: Fri, 08 Mar 2002 15:02:51 -0600 + Message-Id: <5.1.0.14.2.20020308145949.030c8c90@exchi01> + Branch: perl + ! t/op/write.t +____________________________________________________________________________ +[ 15116] By: jhi on 2002/03/08 18:53:42 + Log: Subject: [PATCH] *BETTER* installperl script patch for VOS + From: Paul_GreenVOS@vos.stratus.com + Date: Fri, 8 Mar 02 14:45 est + Message-Id: <200203081947.OAA29065@mailhub1.stratus.com> + Branch: perl + ! installperl +____________________________________________________________________________ +[ 15115] By: jhi on 2002/03/08 18:52:30 + Log: Subject: [PATCH @15109] tm_tm_* for VMS + From: "Craig A. Berry" <craigberry@mac.com> + Date: Fri, 08 Mar 2002 13:07:52 -0600 + Message-Id: <5.1.0.14.2.20020308123619.01ae5230@exchi01> + Branch: perl + ! configure.com +____________________________________________________________________________ +[ 15114] By: jhi on 2002/03/08 18:51:27 + Log: Detypo. + Branch: perl + ! Changes +____________________________________________________________________________ +[ 15113] By: jhi on 2002/03/08 18:49:56 + Log: Better test for #14795 (bug id 20020124.005) from Andreas. + Branch: perl + ! t/op/pat.t +____________________________________________________________________________ +[ 15112] By: jhi on 2002/03/08 17:56:36 + Log: HP-UX nm seems to repeat itself. + Branch: perl + ! Porting/findrfuncs +____________________________________________________________________________ +[ 15111] By: jhi on 2002/03/08 17:50:21 + Log: Nice porting script from Sarathy. Well, less nice + in the sense that it shows the looong road ahead. + Branch: perl + + Porting/findrfuncs + ! MANIFEST Porting/makerel +____________________________________________________________________________ +[ 15110] By: jhi on 2002/03/08 15:58:25 + Log: Subject: Re: Performance considerations for UTF-8 + From: Jarkko Hietaniemi <jhi@iki.fi> + Date: Fri, 8 Mar 2002 18:53:28 +0200 + Message-ID: <20020308185328.D640@alpha.hut.fi> + + (put all in perlunicode) + Branch: perl + ! pod/perlunicode.pod +____________________________________________________________________________ +[ 15109] By: jhi on 2002/03/08 15:09:38 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ [ 15108] By: jhi on 2002/03/08 14:59:50 Log: Subject: Cygwin cygipc support skipped From: "Gerrit P. Haase" <gerrit@familiehaase.de> @@ -127,6 +127,13 @@ ext/Data/Dumper/Makefile.PL Data pretty printer, makefile writer ext/Data/Dumper/t/dumper.t See if Data::Dumper works ext/Data/Dumper/t/overload.t See if Data::Dumper works for overloaded data ext/Data/Dumper/Todo Data pretty printer, futures +ext/Data/Util/Changes Data/Hash::Util, Change log +ext/Data/Util/Makefile.PL Data/Hash::Util, Makefile.PL +ext/Data/Util/Util.xs Data/Hash::Util, Data::Util XS code +ext/Data/Util/lib/Data/Util.pm Data/Hash::Util, Data::Util +ext/Data/Util/lib/Hash/Util.pm Data/Hash::Util, Hash::Util +ext/Data/Util/t/Data.t Data/Hash::Util, Data::Util test +ext/Data/Util/t/Hash.t Data/Hash::Util, Hash::Util test ext/DB_File/Changes Berkeley DB extension change log ext/DB_File/dbinfo Berkeley DB database version checker ext/DB_File/DB_File.pm Berkeley DB extension Perl module @@ -1111,6 +1118,7 @@ lib/Locale/Codes/t/constants.t See if Locale::Codes work lib/Locale/Codes/t/country.t See if Locale::Codes work lib/Locale/Codes/t/currency.t See if Locale::Codes work lib/Locale/Codes/t/languages.t See if Locale::Codes work +lib/Locale/Codes/t/rename.t See if Locale::Codes work lib/Locale/Codes/t/script.t See if Locale::Codes work lib/Locale/Codes/t/uk.t See if Locale::Codes work lib/Locale/Constants.pm Locale::Codes @@ -2170,7 +2178,6 @@ t/io/read.t See if read works t/io/tell.t See if file seeking works t/io/utf8.t See if file seeking works t/lib/1_compile.t See if the various libraries and extensions compile -t/lib/access.t See if access::readonly and readonly hashes work t/lib/commonsense.t See if configuration meets basic needs t/lib/compmod.pl Helper for 1_compile.t t/lib/dprof/test1_t Perl code profiler tests diff --git a/Porting/findrfuncs b/Porting/findrfuncs index 36fb7e8fa6..ea019c982a 100644 --- a/Porting/findrfuncs +++ b/Porting/findrfuncs @@ -49,6 +49,8 @@ find(sub { open F, "<$File::Find::name" or die "Can't open $File::Find::name: $!"; my $line; + # None of the <netdb.h> _r prototypes are to be used in Tru64. + return if $^O eq 'dec_osf' && $_ eq 'netdb.h'; while (defined ($line = <F>)) { if ($line =~ /\b(\w+_r)\b/) { #warn "$1 => $File::Find::name\n"; @@ -61,6 +63,16 @@ find(sub { # delete bogus symbols grepped out of comments and such delete $rfuncs{setlocale_r} if $^O eq 'linux'; +# delete obsolete (as promised by man pages) symbols +if ($^O eq 'hpux') { + delete $rfuncs{crypt_r}; + delete $rfuncs{setlocale_r}; + delete $rfuncs{strerror_r}; +} elsif ($^O eq 'dec_osf') { + delete $rfuncs{crypt_r}; + delete $rfuncs{strerror_r}; +} + my %syms; for my $exe (@EXES) { diff --git a/README.dgux b/README.dgux index 640abab08c..accb7384a8 100644 --- a/README.dgux +++ b/README.dgux @@ -52,7 +52,7 @@ If you are using as compiler GCC-2.95.x rev(DG/UX) an easy solution for configuring perl in your DG/UX machine is to run the command: -./Configure -Dusethreads -Duse5005threads -des +./Configure -Dusethreads -Duseithreads -Dusedevel -des This will automatically accept all the defaults and in particular /usr/local/ as installation directory. @@ -65,7 +65,7 @@ have a standard DG/UX with C compiler GCC-2.7.2.x then you have no choice than to do an interactive build by issuing the command: -./Configure -Dusethreads -Duse5005threads +./Configure -Dusethreads -Duseithreads In particular with GCC-2.7.2.x accept all the defaults and *watch* out for the message: @@ -107,7 +107,7 @@ Centre for Mathematical Sciences Department of Pure Mathematics Wilberforce road Cambridge CB3 0WB , UK -email <takis@xfree86.org> +email <takis@XFree86.Org> =head1 SEE ALSO @@ -30,7 +30,7 @@ Perl_av_reify(pTHX_ AV *av) return; #ifdef DEBUGGING if (SvTIED_mg((SV*)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ WARN_DEBUGGING, "av_reify called on tied array"); + Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array"); #endif key = AvMAX(av) + 1; while (key > AvFILLp(av) + 1) @@ -395,7 +395,7 @@ Perl_av_clear(pTHX_ register AV *av) #ifdef DEBUGGING if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) { - Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array"); + Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array"); } #endif if (!av) @@ -248,7 +248,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (*name == '\0') { /* command is missing 19990114 */ if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open"); + Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open"); errno = EPIPE; goto say_false; } @@ -258,7 +258,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (!num_svs && name[len-1] == '|') { name[--len] = '\0' ; if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe"); + Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't open bidirectional pipe"); } mode[0] = 'w'; writing = 1; @@ -455,7 +455,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (*name == '\0') { /* command is missing 19990114 */ if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open"); + Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open"); errno = EPIPE; goto say_false; } @@ -504,19 +504,19 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } if (!fp) { if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n')) - Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open"); + Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open"); goto say_false; } if (ckWARN(WARN_IO)) { if ((IoTYPE(io) == IoTYPE_RDONLY) && (fp == PerlIO_stdout() || fp == PerlIO_stderr())) { - Perl_warner(aTHX_ WARN_IO, + Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle STD%s opened only for input", (fp == PerlIO_stdout()) ? "OUT" : "ERR"); } else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) { - Perl_warner(aTHX_ WARN_IO, + Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle STDIN opened only for output"); } } @@ -712,7 +712,7 @@ Perl_nextargv(pTHX_ register GV *gv) filegid = PL_statbuf.st_gid; if (!S_ISREG(PL_filemode)) { if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ WARN_INPLACE, + Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit: %s is not a regular file", PL_oldname ); do_close(gv,FALSE); @@ -744,7 +744,7 @@ Perl_nextargv(pTHX_ register GV *gv) ) { if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ WARN_INPLACE, + Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit: %s would not be unique", SvPVX(sv)); do_close(gv,FALSE); @@ -755,7 +755,7 @@ Perl_nextargv(pTHX_ register GV *gv) #if !defined(DOSISH) && !defined(__CYGWIN__) if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) { if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ WARN_INPLACE, + Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't rename %s to %s: %s, skipping file", PL_oldname, SvPVX(sv), Strerror(errno) ); do_close(gv,FALSE); @@ -771,7 +771,7 @@ Perl_nextargv(pTHX_ register GV *gv) (void)UNLINK(SvPVX(sv)); if (link(PL_oldname,SvPVX(sv)) < 0) { if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ WARN_INPLACE, + Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't rename %s to %s: %s, skipping file", PL_oldname, SvPVX(sv), Strerror(errno) ); do_close(gv,FALSE); @@ -785,7 +785,7 @@ Perl_nextargv(pTHX_ register GV *gv) # ifndef VMS /* Don't delete; use automatic file versioning */ if (UNLINK(PL_oldname) < 0) { if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ WARN_INPLACE, + Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't remove %s: %s, skipping file", PL_oldname, Strerror(errno) ); do_close(gv,FALSE); @@ -809,7 +809,7 @@ Perl_nextargv(pTHX_ register GV *gv) #endif { if (ckWARN_d(WARN_INPLACE)) - Perl_warner(aTHX_ WARN_INPLACE, "Can't do inplace edit on %s: %s", + Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit on %s: %s", PL_oldname, Strerror(errno) ); do_close(gv,FALSE); continue; @@ -843,12 +843,12 @@ Perl_nextargv(pTHX_ register GV *gv) if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0 && !S_ISREG(PL_statbuf.st_mode)) { - Perl_warner(aTHX_ WARN_INPLACE, + Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit: %s is not a regular file", PL_oldname); } else - Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s", + Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't open %s: %s", PL_oldname, Strerror(eno)); } } @@ -1243,7 +1243,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE) && ckWARN_d(WARN_UTF8)) { - Perl_warner(aTHX_ WARN_UTF8, "Wide character in print"); + Perl_warner(aTHX_ packWARN(WARN_UTF8), "Wide character in print"); } } tmps = SvPV(sv, len); @@ -1308,7 +1308,7 @@ Perl_my_stat(pTHX) PL_laststype = OP_STAT; PL_laststatval = PerlLIO_stat(s, &PL_statcache); if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n')) - Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "stat"); + Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); return PL_laststatval; } } @@ -1327,7 +1327,7 @@ Perl_my_lstat(pTHX) return PL_laststatval; } if (ckWARN(WARN_IO)) { - Perl_warner(aTHX_ WARN_IO, "Use of -l on filehandle %s", + Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %s", GvENAME(cGVOP_gv)); return (PL_laststatval = -1); } @@ -1338,14 +1338,14 @@ Perl_my_lstat(pTHX) sv = POPs; PUTBACK; if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV && ckWARN(WARN_IO)) { - Perl_warner(aTHX_ WARN_IO, "Use of -l on filehandle %s", + Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %s", GvENAME((GV*) SvRV(sv))); return (PL_laststatval = -1); } sv_setpv(PL_statname,SvPV(sv, n_a)); PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache); if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n')) - Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "lstat"); + Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat"); return PL_laststatval; } @@ -1386,7 +1386,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, else PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv)); if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s", + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", (really ? tmps : PL_Argv[0]), Strerror(errno)); if (do_report) { int e = errno; @@ -1524,7 +1524,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) int e = errno; if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s", + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", PL_Argv[0], Strerror(errno)); if (do_report) { PerlLIO_write(fd, (void*)&e, sizeof(int)); @@ -754,7 +754,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) #ifdef UV_IS_QUAD else if (size == 64) { if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ WARN_PORTABLE, + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), "Bit vector size > 32 non-portable"); if (offset >= srclen) retnum = 0; @@ -823,7 +823,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) #ifdef UV_IS_QUAD else if (size == 64) { if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ WARN_PORTABLE, + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), "Bit vector size > 32 non-portable"); retnum = ((UV) s[offset ] << 56) + @@ -910,7 +910,7 @@ Perl_do_vecset(pTHX_ SV *sv) #ifdef UV_IS_QUAD else if (size == 64) { if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ WARN_PORTABLE, + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), "Bit vector size > 32 non-portable"); s[offset ] = (lval >> 56) & 0xff; s[offset+1] = (lval >> 48) & 0xff; @@ -1373,7 +1373,7 @@ Perl_runops_debug(pTHX) { if (!PL_op) { if (ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN"); + Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); return 0; } diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 5a61a6dbd1..c405ef385e 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -1265,7 +1265,9 @@ sub declare_warnings { elsif (($to & WARN_MASK) eq "\0"x length($to)) { return "no warnings;\n"; } - return "BEGIN {\${^WARNING_BITS} = ".cstring($to)."}\n"; + my $wb = cstring($to); + $wb =~ s/([\$@])/\\$1/g; + return "BEGIN {\${^WARNING_BITS} = $wb}\n"; } sub declare_hints { diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm index d0cddbf371..5ae19beba0 100644 --- a/ext/B/B/Xref.pm +++ b/ext/B/B/Xref.pm @@ -251,7 +251,7 @@ sub pp_gvsv { } else { $gv = $op->gv; - $top = [$gv->STASH->NAME, '$', $gv->NAME]; + $top = [$gv->STASH->NAME, '$', $gv->SAFENAME]; } process($top, $op->private & OPpLVAL_INTRO || $op->private & OPpOUR_INTRO ? "intro" : "used"); @@ -267,7 +267,7 @@ sub pp_gv { } else { $gv = $op->gv; - $top = [$gv->STASH->NAME, "*", $gv->NAME]; + $top = [$gv->STASH->NAME, "*", $gv->SAFENAME]; } process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used"); } @@ -329,7 +329,8 @@ sub xref_definitions { return if $nodefs; $subname = "(definitions)"; foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS - strict vars FileHandle Exporter Carp)) { + strict vars FileHandle Exporter Carp PerlIO::Layer + attributes utf8 warnings)) { $exclude{$pack."::"} = 1; } no strict qw(vars refs); diff --git a/ext/B/C/C.xs b/ext/B/C/C.xs index 15c9c5c6fd..3c52e4a296 100644 --- a/ext/B/C/C.xs +++ b/ext/B/C/C.xs @@ -47,5 +47,7 @@ my_runops(pTHX) MODULE=B__C PACKAGE=B::C +PROTOTYPES: DISABLE + BOOT: PL_runops = my_runops; diff --git a/ext/B/t/stash.t b/ext/B/t/stash.t index f8b5209dc6..9916521414 100755 --- a/ext/B/t/stash.t +++ b/ext/B/t/stash.t @@ -66,7 +66,7 @@ print "# got = @got\n"; $got = "@got"; -my $expected = "access attributes Carp Carp::Heavy DB Exporter Exporter::Heavy main utf8 warnings"; +my $expected = "attributes Carp Carp::Heavy DB Exporter Exporter::Heavy main utf8 warnings"; { no strict 'vars'; diff --git a/ext/Data/Util/Changes b/ext/Data/Util/Changes new file mode 100644 index 0000000000..f877d08678 --- /dev/null +++ b/ext/Data/Util/Changes @@ -0,0 +1,27 @@ +0.04 Sun Mar 10 13:37:08 EST 2002 + * Bugs in the restricted hash implementation have been fixed. All + tests should pass on a perl sometime after about 15160 + * Minimum version is now 5.7.3 + - Changed diagnostic expecations to match new restricted hash + diagnostics. + +0.03 Sat Mar 9 20:11:00 EST 2002 + *** NOTE *** There are known failures in t/Hash.t. These are + due to bugs in perl's restricted hash implementation. They have + been left failing so Those That Know How To Fix It know where + the bugs are. + + * Data::Util::readonly() is now sv_readonly_flag() to make its + function less ambiguous. + * Hash::Util::lock_key/unlock_key is now lock_value/unlock_value + to make its functionality less ambiguous. It also takes + somewhat different arguments. + * Added lock_hash(), unlock_hash(). + +0.02 Wed Feb 27 23:35:58 EST 2002 + * lock_keys(%hash, @keys) implemented + * tarball name changed to the somewhat more proper Data-Hash-Utils + +0.01 Tue Feb 26 23:18:03 EST 2002 + - First released version + - There are some failures at the end of Hash.t diff --git a/ext/Data/Util/Makefile.PL b/ext/Data/Util/Makefile.PL new file mode 100644 index 0000000000..ef6bc3c3ab --- /dev/null +++ b/ext/Data/Util/Makefile.PL @@ -0,0 +1,53 @@ +# A template for Makefile.PL. +# - Set the $PACKAGE variable to the name of your module. +# - Set $LAST_API_CHANGE to reflect the last version you changed the API +# of your module. +# - Fill in your dependencies in PREREQ_PM +# Alternatively, you can say the hell with this and use h2xs. + +require 5.007003; + +use ExtUtils::MakeMaker; + +$PACKAGE = 'Data::Util'; +($PACKAGE_FILE = $PACKAGE) =~ s|::|/|g; +$LAST_API_CHANGE = 0.03; + +eval "require $PACKAGE"; + +unless ($@) { # Make sure we did find the module. + print <<"CHANGE_WARN" if ${$PACKAGE.'::VERSION'} < $LAST_API_CHANGE; + +NOTE: There have been API changes between this version and any older +than version $LAST_API_CHANGE! Please read the Changes file if you +are upgrading from a version older than $LAST_API_CHANGE. + +CHANGE_WARN +} + +WriteMakefile( + NAME => $PACKAGE, + DISTNAME => 'Data-Hash-Utils', + VERSION_FROM => "lib/$PACKAGE_FILE.pm", # finds $VERSION + PREREQ_PM => { }, +); + + +{ + package MY; + + sub test_via_harness { + my($self, $orig_perl, $tests) = @_; + + my @perls = ($orig_perl); + push @perls, qw(bleadperl) + if $ENV{PERL_TEST_ALL}; + + my $out; + foreach my $perl (@perls) { + $out .= $self->SUPER::test_via_harness($perl, $tests); + } + + return $out; + } +} diff --git a/ext/Data/Util/Util.xs b/ext/Data/Util/Util.xs new file mode 100644 index 0000000000..6d246ddf51 --- /dev/null +++ b/ext/Data/Util/Util.xs @@ -0,0 +1,29 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + + +MODULE=Data::Util PACKAGE=Data::Util + +int +sv_readonly_flag(...) +PROTOTYPE: \[$%@];$ +CODE: +{ + SV *sv = SvRV(ST(0)); + IV old = SvREADONLY(sv); + + if (items == 2) { + if (SvTRUE(ST(1))) { + SvREADONLY_on(sv); + } + else { + SvREADONLY_off(sv); + } + } + if (old) + XSRETURN_YES; + else + XSRETURN_NO; +} + diff --git a/ext/Data/Util/lib/Data/Util.pm b/ext/Data/Util/lib/Data/Util.pm new file mode 100644 index 0000000000..26e2993a9b --- /dev/null +++ b/ext/Data/Util/lib/Data/Util.pm @@ -0,0 +1,73 @@ +package Data::Util; + +require Exporter; +require DynaLoader; + +our @ISA = qw(Exporter DynaLoader); +our @EXPORT_OK = qw(sv_readonly_flag); +our $VERSION = 0.04; + +bootstrap Data::Util $VERSION; + +1; + +__END__ + +=head1 NAME + +Data::Util - A selection of general-utility data subroutines + +=head1 SYNOPSIS + + use Data::Util qw(sv_readonly_flag); + + my $sv_readonly = sv_readonly_flag(%some_data); + + sv_readonly_flag(@some_data, 1); # Set the sv_readonly flag on + # @some_data to true. + +=head1 DESCRIPTION + +C<Data::Util> contains a selection of subroutines which are useful on +scalars, hashes and lists (and thus wouldn't fit into Scalar, Hash or +List::Util). All of the routines herein will work equally well on a +scalar, hash, list or even hash & list elements. + + sv_readonly_flag($some_data); + sv_readonly_flag(@some_data); + sv_readonly_flag(%some_data); + sv_readonly_flag($some_data{key}); + sv_readonly_flag($some_data[3]); + +We'll just refer to the conglomeration as "DATA". + +By default C<Data::Util> does not export any subroutines. You can ask +for... + +=over 4 + +=item sv_readonly_flag + + my $sv_readonly = sv_readonly_flag(DATA); + sv_readonly_flag(DATA, 1); # set sv_readonly true + sv_readonly_flag(DATA, 0); # set sv_readonly false + +This gets/sets the sv_readonly flag on the given DATA. When setting +it returns the previous state of the flag. This is intended for +people I<that know what they're doing.> + +The exact behavior exhibited by a piece of DATA when sv_readonly is +set depends on what type of data it is. B<It doesn't even necessarily +make the data readonly!> Look for specific functions in Scalar::Util, +List::Util and Hash::Util for making those respective types readonly. + +=head1 AUTHOR + +Michael G Schwern <schwern@pobox.com> using XS code by Nick Ing-Simmons. + +=head1 SEE ALSO + +L<Scalar::Util>, L<List::Util>, L<Hash::Util> + +=cut + diff --git a/ext/Data/Util/lib/Hash/Util.pm b/ext/Data/Util/lib/Hash/Util.pm new file mode 100644 index 0000000000..c54fbdc0d1 --- /dev/null +++ b/ext/Data/Util/lib/Hash/Util.pm @@ -0,0 +1,191 @@ +package Hash::Util; + +require 5.007003; +use strict; +use Data::Util qw(sv_readonly_flag); +use Carp; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(lock_keys unlock_keys lock_value unlock_value + lock_hash unlock_hash + ); +our $VERSION = 0.04; + + +=head1 NAME + +Hash::Util - A selection of general-utility hash subroutines + +=head1 SYNOPSIS + + use Hash::Util qw(lock_keys unlock_keys + lock_value unlock_value + lock_hash unlock_hash + ); + + %hash = (foo => 42, bar => 23); + lock_keys(%hash); + lock_keys(%hash, @keyset); + unlock_keys(%hash); + + lock_value (%hash, 'foo'); + unlock_value(%hash, 'foo'); + + lock_hash (%hash); + unlock_hash(%hash); + + +=head1 DESCRIPTION + +C<Hash::Util> contains special functions for manipulating hashes that +don't really warrant a keyword. + +By default C<Hash::Util> does not export anything. + +=head2 Restricted hashes + +5.8.0 introduces the ability to restrict a hash to a certain set of +keys. No keys outside of this set can be added. It also introduces +the ability to lock an individual key so it cannot be deleted and the +value cannot be changed. + +This is intended to largely replace the deprecated pseudo-hashes. + +=over 4 + +=item lock_keys + +=item unlock_keys + + lock_keys(%hash); + lock_keys(%hash, @keys); + + unlock_keys(%hash;) + +Restricts the given %hash's set of keys to @keys. If @keys is not +given it restricts it to its current keyset. No more keys can be +added. delete() and exists() will still work, but it does not effect +the set of allowed keys. + +Removes the restriction on the %hash's keyset. + +=cut + +sub lock_keys (\%;@) { + my($hash, @keys) = @_; + + if( @keys ) { + my %keys = map { ($_ => 1) } @keys; + my %original_keys = map { ($_ => 1) } keys %$hash; + foreach my $k (keys %original_keys) { + die sprintf "Hash has key '$k' which is not in the new key ". + "set at %s line %d\n", (caller)[1,2] + unless $keys{$k}; + } + + foreach my $k (@keys) { + $hash->{$k} = undef unless exists $hash->{$k}; + } + sv_readonly_flag %$hash, 1; + + foreach my $k (@keys) { + delete $hash->{$k} unless $original_keys{$k}; + } + } + else { + sv_readonly_flag %$hash, 1; + } + + return undef; +} + +sub unlock_keys (\%) { + my($hash) = shift; + + sv_readonly_flag %$hash, 0; + return undef; +} + +=item lock_value + +=item unlock_value + + lock_key (%hash, $key); + unlock_key(%hash, $key); + +Locks and unlocks an individual key of a hash. The value of a locked +key cannot be changed. + +%hash must have already been locked for this to have useful effect. + +=cut + +sub lock_value (\%$) { + my($hash, $key) = @_; + carp "Cannot usefully lock values in an unlocked hash" + unless sv_readonly_flag %$hash; + sv_readonly_flag $hash->{$key}, 1; +} + +sub unlock_value (\%$) { + my($hash, $key) = @_; + sv_readonly_flag $hash->{$key}, 0; +} + + +=item B<lock_hash> + +=item B<unlock_hash> + + lock_hash(%hash); + unlock_hash(%hash); + +lock_hash() locks an entire hash, making all keys and values readonly. +No value can be changed, no keys can be added or deleted. + +unlock_hash() does the opposite. All keys and values are made +read/write. All values can be changed and keys can be added and +deleted. + +=cut + +sub lock_hash (\%) { + my($hash) = shift; + + lock_keys(%$hash); + + foreach my $key (keys %$hash) { + lock_value(%$hash, $key); + } + + return 1; +} + +sub unlock_hash (\%) { + my($hash) = shift; + + foreach my $key (keys %$hash) { + unlock_value(%$hash, $key); + } + + unlock_keys(%$hash); + + return 1; +} + + +=back + +=head1 AUTHOR + +Michael G Schwern <schwern@pobox.com> on top of code by Nick +Ing-Simmons and Jeffrey Friedl. + +=head1 SEE ALSO + +L<Scalar::Util>, L<List::Util>, L<Hash::Util> + +=cut + +1; diff --git a/ext/Data/Util/t/Data.t b/ext/Data/Util/t/Data.t new file mode 100644 index 0000000000..6198c3a9f3 --- /dev/null +++ b/ext/Data/Util/t/Data.t @@ -0,0 +1,42 @@ +#!/usr/bin/perl -Tw + +BEGIN { + if( $ENV{PERL_CORE} ) { + @INC = '../lib'; + chdir 't'; + } +} +use Test::More tests => 26; + +use Data::Util; +BEGIN { use_ok 'Data::Util', qw(sv_readonly_flag); } + +ok( !sv_readonly_flag $foo ); +ok( !sv_readonly_flag $foo, 1 ); +ok( sv_readonly_flag $foo ); +ok( sv_readonly_flag $foo, 0 ); +ok( !sv_readonly_flag $foo ); + +ok( !sv_readonly_flag @foo ); +ok( !sv_readonly_flag @foo, 1 ); +ok( sv_readonly_flag @foo ); +ok( sv_readonly_flag @foo, 0 ); +ok( !sv_readonly_flag @foo ); + +ok( !sv_readonly_flag $foo[2] ); +ok( !sv_readonly_flag $foo[2], 1 ); +ok( sv_readonly_flag $foo[2] ); +ok( sv_readonly_flag $foo[2], 0 ); +ok( !sv_readonly_flag $foo[2] ); + +ok( !sv_readonly_flag %foo ); +ok( !sv_readonly_flag %foo, 1 ); +ok( sv_readonly_flag %foo ); +ok( sv_readonly_flag %foo, 0 ); +ok( !sv_readonly_flag %foo ); + +ok( !sv_readonly_flag $foo{foo} ); +ok( !sv_readonly_flag $foo{foo}, 1 ); +ok( sv_readonly_flag $foo{foo} ); +ok( sv_readonly_flag $foo{foo}, 0 ); +ok( !sv_readonly_flag $foo{foo} ); diff --git a/ext/Data/Util/t/Hash.t b/ext/Data/Util/t/Hash.t new file mode 100644 index 0000000000..b1f9e79304 --- /dev/null +++ b/ext/Data/Util/t/Hash.t @@ -0,0 +1,171 @@ +#!/usr/bin/perl -Tw + +BEGIN { + if( $ENV{PERL_CORE} ) { + @INC = '../lib'; + chdir 't'; + } +} +use Test::More tests => 45; +use Data::Util qw(sv_readonly_flag); + +my @Exported_Funcs; +BEGIN { + @Exported_Funcs = qw(lock_keys unlock_keys + lock_value unlock_value + lock_hash unlock_hash + ); + use_ok 'Hash::Util', @Exported_Funcs; +} +foreach my $func (@Exported_Funcs) { + can_ok __PACKAGE__, $func; +} + +my %hash = (foo => 42, bar => 23, locked => 'yep'); +lock_keys(%hash); +eval { $hash{baz} = 99; }; +like( $@, qr/^Attempt to access disallowed key 'baz' in a fixed hash/, + 'lock_keys()'); +is( $hash{bar}, 23 ); +ok( !exists $hash{baz} ); + +delete $hash{bar}; +ok( !exists $hash{bar} ); +$hash{bar} = 69; +is( $hash{bar}, 69 ); + +eval { () = $hash{i_dont_exist} }; +like( $@, qr/^Attempt to access disallowed key 'i_dont_exist' in a fixed hash/ ); + +lock_value(%hash, 'locked'); +eval { print "# oops" if $hash{four} }; +like( $@, qr/^Attempt to access disallowed key 'four' in a fixed hash/ ); + +eval { $hash{"\x{2323}"} = 3 }; +like( $@, qr/^Attempt to access disallowed key '(.*)' in a fixed hash/, + 'wide hex key' ); + +eval { delete $hash{locked} }; +like( $@, qr/^Attempt to delete readonly key 'locked' from a fixed hash/, + 'trying to delete a locked key' ); +eval { $hash{locked} = 42; }; +like( $@, qr/^Modification of a read-only value attempted/, + 'trying to change a locked key' ); +is( $hash{locked}, 'yep' ); + +eval { delete $hash{I_dont_exist} }; +like( $@, qr/^Attempt to delete disallowed key 'I_dont_exist' from a fixed hash/, + 'trying to delete a key that doesnt exist' ); + +ok( !exists $hash{I_dont_exist} ); + +unlock_keys(%hash); +$hash{I_dont_exist} = 42; +is( $hash{I_dont_exist}, 42, 'unlock_keys' ); + +eval { $hash{locked} = 42; }; +like( $@, qr/^Modification of a read-only value attempted/, + ' individual key still readonly' ); +eval { delete $hash{locked} }, +is( $@, '', ' but can be deleted :(' ); + +unlock_value(%hash, 'locked'); +$hash{locked} = 42; +is( $hash{locked}, 42, 'unlock_value' ); + + +TODO: { +# local $TODO = 'assigning to a hash screws with locked keys'; + + my %hash = ( foo => 42, locked => 23 ); + + lock_keys(%hash); + lock_value(%hash, 'locked'); + eval { %hash = ( wubble => 42 ) }; # we know this will bomb + like( $@, qr/^Attempt to clear a fixed hash/ ); + + eval { unlock_value(%hash, 'locked') }; # but this shouldn't + is( $@, '', 'unlock_value() after denied assignment' ); + + is_deeply( \%hash, { foo => 42, locked => 23 }, + 'hash should not be altered by denied assignment' ); + unlock_keys(%hash); +} + +{ + my %hash = (KEY => 'val', RO => 'val'); + lock_keys(%hash); + lock_value(%hash, 'RO'); + + eval { %hash = (KEY => 1) }; + like( $@, qr/^Attempt to clear a fixed hash/ ); +} + +# TODO: This should be allowed but it might require putting extra +# code into aassign. +{ + my %hash = (KEY => 1, RO => 2); + lock_keys(%hash); + eval { %hash = (KEY => 1, RO => 2) }; + like( $@, qr/^Attempt to clear a fixed hash/ ); +} + + + +{ + my %hash = (); + lock_keys(%hash, qw(foo bar)); + is( keys %hash, 0, 'lock_keys() w/keyset shouldnt add new keys' ); + $hash{foo} = 42; + is( keys %hash, 1 ); + eval { $hash{wibble} = 42 }; + like( $@, qr/^Attempt to access disallowed key 'wibble' in a fixed hash/, + ' locked'); + + unlock_keys(%hash); + eval { $hash{wibble} = 23; }; + is( $@, '', 'unlock_keys' ); +} + + +{ + my %hash = (foo => 42, bar => undef, baz => 0); + lock_keys(%hash, qw(foo bar baz up down)); + is( keys %hash, 3, 'lock_keys() w/keyset didnt add new keys' ); + is_deeply( \%hash, { foo => 42, bar => undef, baz => 0 } ); + + eval { $hash{up} = 42; }; + is( $@, '' ); + + eval { $hash{wibble} = 23 }; + like( $@, qr/^Attempt to access disallowed key 'wibble' in a fixed hash/, ' locked' ); +} + + +{ + my %hash = (foo => 42, bar => undef); + eval { lock_keys(%hash, qw(foo baz)); }; + is( $@, sprintf("Hash has key 'bar' which is not in the new key ". + "set at %s line %d\n", __FILE__, __LINE__ - 2) ); +} + + +{ + my %hash = (foo => 42, bar => 23); + lock_hash( %hash ); + + ok( sv_readonly_flag(%hash) ); + ok( sv_readonly_flag($hash{foo}) ); + ok( sv_readonly_flag($hash{bar}) ); + + unlock_hash ( %hash ); + + ok( !sv_readonly_flag(%hash) ); + ok( !sv_readonly_flag($hash{foo}) ); + ok( !sv_readonly_flag($hash{bar}) ); +} + + +lock_keys(%ENV); +eval { () = $ENV{I_DONT_EXIST} }; +like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a fixed hash/, 'locked %ENV'); diff --git a/ext/Encode/CN/Makefile.PL b/ext/Encode/CN/Makefile.PL index 283bc03848..4dadad4a69 100644 --- a/ext/Encode/CN/Makefile.PL +++ b/ext/Encode/CN/Makefile.PL @@ -24,6 +24,7 @@ WriteMakefile( MAN3PODS => {}, # OS 390 winges about line numbers > 64K ??? XSOPT => '-nolinenumbers', + XSPROTOARG => '-noprototypes', ); package MY; @@ -87,6 +88,7 @@ Encode_XSEncoding(pTHX_ encode_t *enc) } MODULE = Encode::$name PACKAGE = Encode::$name +PROTOTYPES: DISABLE BOOT: { END diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm index 20843545da..a0cc7e2cff 100644 --- a/ext/Encode/Encode.pm +++ b/ext/Encode/Encode.pm @@ -228,7 +228,7 @@ sub define_encoding sub getEncoding { - my ($class,$name) = @_; + my ($class,$name,$skip_external) = @_; my $enc; if (ref($name) && $name->can('new_sequence')) { @@ -243,23 +243,26 @@ sub getEncoding { return $encoding{$lc}; } - if (exists $external_tables{$lc}) + + my $oc = $class->findAlias($name); + return $oc if defined $oc; + + $oc = $class->findAlias($lc) if $lc ne $name; + return $oc if defined $oc; + + if (!$skip_external and exists $external_tables{$lc}) { require $external_tables{$lc}; return $encoding{$name} if exists $encoding{$name}; } - my $oc = $class->findAlias($name); - return $oc if defined $oc; - return $class->findAlias($lc) if $lc ne $name; - return; } sub find_encoding { - my ($name) = @_; - return __PACKAGE__->getEncoding($name); + my ($name,$skip_external) = @_; + return __PACKAGE__->getEncoding($name,$skip_external); } sub encode @@ -455,7 +458,9 @@ repertoire. See L</"Encoding Names">. =item 2. As an object -Encoding objects are returned by C<find_encoding($name)>. +Encoding objects are returned by C<find_encoding($name, [$skip_external])>. +If the second parameter is true, Encode will refrain from loading external +modules for CJK encodings. =back diff --git a/ext/Encode/JP/Makefile.PL b/ext/Encode/JP/Makefile.PL index f7c5167c11..3aac0b033d 100644 --- a/ext/Encode/JP/Makefile.PL +++ b/ext/Encode/JP/Makefile.PL @@ -86,6 +86,7 @@ Encode_XSEncoding(pTHX_ encode_t *enc) } MODULE = Encode::$name PACKAGE = Encode::$name +PROTOTYPES: DISABLE BOOT: { END diff --git a/ext/Encode/KR/Makefile.PL b/ext/Encode/KR/Makefile.PL index cc50106d13..9b8303d506 100644 --- a/ext/Encode/KR/Makefile.PL +++ b/ext/Encode/KR/Makefile.PL @@ -85,6 +85,7 @@ Encode_XSEncoding(pTHX_ encode_t *enc) } MODULE = Encode::$name PACKAGE = Encode::$name +PROTOTYPES: DISABLE BOOT: { END diff --git a/ext/Encode/MANIFEST b/ext/Encode/MANIFEST index 736a018bcd..dcf7a80617 100644 --- a/ext/Encode/MANIFEST +++ b/ext/Encode/MANIFEST @@ -1,6 +1,10 @@ -CN/Makefile.PL CN/CN.pm -Encode/euc-jp.ucm +CN/Makefile.PL +compile +encengine.c +encode.h +Encode.pm +Encode.xs Encode/11643-1.enc Encode/11643-2.enc Encode/2022-cn.enc @@ -45,8 +49,8 @@ Encode/8859-9.enc Encode/8859-9.ucm Encode/ascii.enc Encode/ascii.ucm -Encode/big5.enc Encode/big5-hkscs.enc +Encode/big5.enc Encode/cp1006.enc Encode/cp1047.enc Encode/cp1047.ucm @@ -89,14 +93,16 @@ Encode/dingbats.ucm Encode/euc-cn.enc Encode/euc-jp-0212.enc Encode/euc-jp.enc +Encode/euc-jp.ucm Encode/euc-kr.enc Encode/gb12345.enc Encode/gb1988.enc Encode/gb2312.enc Encode/gsm0338.enc -Encode/iso-ir-165.enc Encode/ir-197.enc +Encode/iso-ir-165.enc Encode/jis0201.enc +Encode/jis0201.ucm Encode/jis0208.enc Encode/jis0212.enc Encode/koi8-f.enc @@ -121,50 +127,46 @@ Encode/macTurkish.enc Encode/macUkraine.enc Encode/nextstep.enc Encode/nextstep.ucm -Encode/roman8.enc Encode/posix-bc.enc Encode/posix-bc.ucm +Encode/roman8.enc Encode/roman8.ucm Encode/shiftjis.enc Encode/symbol.enc Encode/symbol.ucm Encode/viscii.enc Encode/viscii.ucm -Encode/jis0201.ucm -Encode.pm -Encode.xs -JP/Makefile.PL JP/JP.pm -KR/Makefile.PL +JP/Makefile.PL KR/KR.pm -MANIFEST -Makefile.PL -README -TW/Makefile.PL -TW/TW.pm -compile -encengine.c -encode.h +KR/Makefile.PL +lib/Encode/CN/HZ.pm lib/Encode/Encoding.pm lib/Encode/Internal.pm lib/Encode/iso10646_1.pm +lib/Encode/JP/Constants.pm +lib/Encode/JP/H2Z.pm +lib/Encode/JP/ISO_2022_JP.pm +lib/Encode/JP/JIS.pm lib/Encode/Tcl.pm +lib/Encode/Tcl/Escape.pm +lib/Encode/Tcl/Extended.pm +lib/Encode/Tcl/Table.pm lib/Encode/ucs2_le.pm lib/Encode/Unicode.pm lib/Encode/utf8.pm lib/Encode/XS.pm -lib/Encode/CN/HZ.pm -lib/Encode/Tcl/Escape.pm -lib/Encode/Tcl/Extended.pm -lib/Encode/Tcl/Table.pm -lib/Encode/JP/ISO_2022_JP.pm -lib/Encode/JP/H2Z.pm -lib/Encode/JP/Constants.pm -lib/Encode/JP/JIS.pm lib/EncodeFormat.pod -t/Tcl.t +Makefile.PL +MANIFEST +README +t/CN.t t/Encode.t -t/table.euc -t/table.ref t/japanese.pl t/JP.t +t/table.euc +t/table.ref +t/Tcl.t +t/TW.t +TW/Makefile.PL +TW/TW.pm diff --git a/ext/Encode/TW/Makefile.PL b/ext/Encode/TW/Makefile.PL index 331f6062ef..003428e6e8 100644 --- a/ext/Encode/TW/Makefile.PL +++ b/ext/Encode/TW/Makefile.PL @@ -85,6 +85,7 @@ Encode_XSEncoding(pTHX_ encode_t *enc) } MODULE = Encode::$name PACKAGE = Encode::$name +PROTOTYPES: DISABLE BOOT: { END diff --git a/ext/Encode/lib/Encode/Tcl.pm b/ext/Encode/lib/Encode/Tcl.pm index 812dcd171e..c423d8e968 100644 --- a/ext/Encode/lib/Encode/Tcl.pm +++ b/ext/Encode/lib/Encode/Tcl.pm @@ -10,13 +10,7 @@ use Encode qw(find_encoding); use base 'Encode::Encoding'; use Carp; -=head1 NAME - -Encode::Tcl - Tcl encodings - -=cut - - sub INC_search +sub INC_search { foreach my $dir (@INC) { @@ -27,7 +21,7 @@ Encode::Tcl - Tcl encodings if ($name =~ /^(.*)\.enc$/) { my $canon = $1; - my $obj = find_encoding($canon); + my $obj = find_encoding($canon, 1); # skip external tables if (!defined($obj)) { my $obj = bless { Name => $canon, File => "$dir/Encode/$name"},__PACKAGE__; @@ -134,3 +128,36 @@ require Encode::Tcl::Extended; 1; __END__ + +=head1 NAME + +Encode::Tcl - Tcl encodings + +=head1 SYNOPSIS + + use Encode; + use Encode::Tcl; + $unicode = decode('shiftjis', $shiftjis); + $shiftjis = encode('shiftjis', $unicode); + +=head1 DESCRIPTION + +This module provides the interface to encodings +defined by the format of encoding tables borrowed from Tcl +and not compiled in other Encode:: modules. + +See also F<Encode/EncodeFormat.pod> and F<Encode/*.enc> files. + +To find how to use this module in detail, see L<Encode>. + +=head1 SEE ALSO + +L<Encode> + +L<Encode::Tcl::Table> + +L<Encode::Tcl::Escape> + +L<Encode::Tcl::Extended> + +=cut diff --git a/ext/Encode/lib/Encode/Tcl/Escape.pm b/ext/Encode/lib/Encode/Tcl/Escape.pm index d3f55d7d5f..5697c99232 100644 --- a/ext/Encode/lib/Encode/Tcl/Escape.pm +++ b/ext/Encode/lib/Encode/Tcl/Escape.pm @@ -189,3 +189,40 @@ sub encode 1; __END__ + +=head1 NAME + +Encode::Tcl::Escape - Tcl Escape encodings + +=head1 SYNOPSIS + +none + +=head1 DESCRIPTION + +This module is used internally by Encode::Tcl +and handles type E of Tcl encodings (7-bit code only). + +Control sequences supported by this module are +ESCAPE SEQUENCEs to designate graphic character sets +and the following: + + name (abbr.) bit combination + + ESCAPE (ESC) 01/11 + SHIFT-IN (SI) 00/15 + SHIFT-OUT (SO) 00/14 + SINGLE SHIFT TWO (SS2) ESC 04/14 + SINGLE SHIFT THREE (SS3) ESC 04/15 + +Designation of control character sets are not supported. + +=head1 SEE ALSO + +L<Encode> + +L<Encode::Tcl> + +L<http://www.itscj.ipsj.or.jp/ISO-IR/> [ISOREG] + +=cut diff --git a/ext/Encode/lib/Encode/Tcl/Extended.pm b/ext/Encode/lib/Encode/Tcl/Extended.pm index 4b471d83e6..0fa3035b9e 100644 --- a/ext/Encode/lib/Encode/Tcl/Extended.pm +++ b/ext/Encode/lib/Encode/Tcl/Extended.pm @@ -140,3 +140,31 @@ sub encode } 1; __END__ + +=head1 NAME + +Encode::Tcl::Extended - Tcl EUC encodings + +=head1 SYNOPSIS + +none + +=head1 DESCRIPTION + +This module is used internally by Encode::Tcl +and handles type X of Tcl encodings (a Perl extenstion). + +Only F<euc-jp-0212.enc> belongs to type X. +This is a variant of EUC-JP with JIS X 0212 in G3. +If another Encode:: module would support the above encoding, +this module should be removed. + +=head1 SEE ALSO + +L<Encode> + +L<Encode::Tcl> + +L<Encode::JP> + +=cut diff --git a/ext/Encode/lib/Encode/Tcl/Table.pm b/ext/Encode/lib/Encode/Tcl/Table.pm index 1efedeed9e..2e9a83707c 100644 --- a/ext/Encode/lib/Encode/Tcl/Table.pm +++ b/ext/Encode/lib/Encode/Tcl/Table.pm @@ -137,3 +137,27 @@ sub encode } 1; __END__ + +=head1 NAME + +Encode::Tcl::Table - Tcl Table encodings + +=head1 SYNOPSIS + +none + +=head1 DESCRIPTION + +This module is used internally by Encode::Tcl +and handles types S, D, and M of Tcl encodings. + +Implementation for type M is restricted to encodings +in which bytes per a character is up to 2. + +=head1 SEE ALSO + +L<Encode> + +L<Encode::Tcl> + +=cut diff --git a/ext/IO/lib/IO/Socket/INET.pm b/ext/IO/lib/IO/Socket/INET.pm index 83efd09a58..f59c810bb4 100644 --- a/ext/IO/lib/IO/Socket/INET.pm +++ b/ext/IO/lib/IO/Socket/INET.pm @@ -159,6 +159,11 @@ sub configure { return _error($sock, $!, "$!"); } + if ($arg->{Broadcast}) { + $sock->sockopt(SO_BROADCAST,1) or + return _error($sock, $!, "$!"); + } + if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) { $sock->bind($lport || 0, $laddr) or return _error($sock, $!, "$!"); @@ -309,6 +314,7 @@ C<IO::Socket::INET> provides. ReuseAddr Set SO_REUSEADDR before binding Reuse Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr) ReusePort Set SO_REUSEPORT before binding + Broadcast Set SO_BROADCAST before binding Timeout Timeout value for various operations MultiHomed Try all adresses for multi-homed hosts Blocking Determine if connection will be blocking mode @@ -355,6 +361,12 @@ Examples: $sock = IO::Socket::INET->new('127.0.0.1:25'); + $sock = IO::Socket::INET->new(PeerPort => 9999, + PeerAddr => inet_ntoa(INADDR_BROADCAST), + Proto => udp, + LocalAddr => 'localhost', + Broadcast => 1 ) + or die "Can't bind : $@\n"; NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE @@ -261,7 +261,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) HV* basestash = gv_stashsv(sv, FALSE); if (!basestash) { if (ckWARN(WARN_MISC)) - Perl_warner(aTHX_ WARN_MISC, "Can't locate package %s for @%s::ISA", + Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %s for @%s::ISA", SvPVX(sv), HvNAME(stash)); continue; } @@ -786,7 +786,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) /* Adding a new symbol */ if (add & GV_ADDWARN && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "Had to create %s unexpectedly", nambeg); + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg); gv_init(gv, stash, name, len, add & GV_ADDMULTI); gv_init_sv(gv, sv_type); @@ -1173,7 +1173,7 @@ Perl_gv_check(pTHX_ HV *stash) #else CopFILEGV(PL_curcop) = gv_fetchfile(file); #endif - Perl_warner(aTHX_ WARN_ONCE, + Perl_warner(aTHX_ packWARN(WARN_ONCE), "Name \"%s::%s\" used only once: possible typo", HvNAME(stash), GvNAME(gv)); } @@ -1220,7 +1220,7 @@ Perl_gp_free(pTHX_ GV *gv) return; if (gp->gp_refcnt == 0) { if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Attempt to free unreferenced glob pointers"); return; } diff --git a/hints/dgux.sh b/hints/dgux.sh index 64cff33af9..350a9da892 100644 --- a/hints/dgux.sh +++ b/hints/dgux.sh @@ -29,61 +29,61 @@ # Department of Pure Mathematics # Wilberforce road # Cambridge CB3 0WB , UK -# e-mail <takis@xfree86.org> +# e-mail <takis@XFree86.Org> # Use GCC-2.95.2/3 rev (DG/UX) for threads # This compiler supports the -pthread switch # to link correctly DG/UX 's -lthread. +# March 2002 ########################################### cc=gcc ccflags="-DDGUX -D_DGUX_SOURCE" -# Debug build with GNU as,ld and -gstabs+ -# ccflags="-DDGUX -D_DGUX_SOURCE -gstabs+" +# Debug build. If using GNU as,ld use the flag -gstabs+ +# ccflags="-g -mstandard -DDGUX -D_DGUX_SOURCE -DDEBUGGING" # Dummy ; always compile with -O2 on GCC 2.95.2/3 rev (DG/UX) +# even if you debugging the program! optimize="-mno-legend -O2" archname="ix86-dgux" libpth="/usr/lib" ##################################### -# <takis@xfree86.org> +# <takis@XFree86.Org> # Change this if you want. # prefix =/usr/local ##################################### prefix=/usr/local -perlpath="$prefix/bin/perl57" -startperl="#! $prefix/bin/perl57" -privlib="$prefix/lib/perl57" +perlpath="$prefix/bin/perl58" +startperl="#! $prefix/bin/perl58" +privlib="$prefix/lib/perl58" man1dir="$prefix/man/man1" man3dir="$prefix/man/man3" -sitearch="$prefix/lib/perl57/$archname" -sitelib="$prefix/lib/perl57" +sitearch="$prefix/lib/perl58/$archname" +sitelib="$prefix/lib/perl58" #Do not overwrite by default /usr/bin/perl of DG/UX installusrbinperl="$undef" # Configure may fail to find lstat() # function in <sys/stat.h>. -d_lstat=define +d_lstat='define' -# Internal malloc is needed for correct operation -# of perl-5.7.x -# DG/UX native malloc is causing problems. -# Some perl tests they failing badly. +# Internal (perl) malloc is causing serious problems and +# test failures in DG/UX. Most notable Embed.t +# So for perl-5.7.3 and on do NOT use. # I have no time to investigate more. -# <takis@xfree86.org> +# <takis@XFree86.Org> case "$usemymalloc" in -'') usemymalloc='y' ;; +'') usemymalloc='n' ;; esac case "$uselongdouble" in '') uselongdouble='y' ;; esac -#### No for threads ???? ##### #usevfork=true usevfork=false @@ -137,10 +137,10 @@ plibpth="$plibpth $sde_path/$sde/usr/lib" unset sde_path default_sde sde ##################################### -# <takis@xfree86.org> +# <takis@XFree86.Org> ##################################### -libperl="libperl57.so" +libperl="libperl58.so" # Many functions (eg, gethostent(), killpg(), getpriority(), setruid() # dbm_*(), and plenty more) are defined in -ldgc. Usually you don't @@ -149,16 +149,17 @@ libperl="libperl57.so" # those functions as missing. ##################################### -# <takis@xfree86.org> +# <takis@XFree86.Org> ##################################### # libswanted="dgc gdbm $libswanted" #libswanted="dbm posix $libswanted" -# Remove malloc since we use the internal perl one. +# Do *NOT* add there the malloc native +# DG/UX library! libswanted="dbm posix resolv socket nsl dl m" ##################################### -# <takis@xfree86.org> +# <takis@XFree86.Org> ##################################### mydomain='.localhost' @@ -178,7 +179,7 @@ usedl=false # -G for loading. I haven't tested this. ##################################### -# <takis@xfree86.org> +# <takis@XFree86.Org> # Use -fPIC instead -fpic ##################################### @@ -189,7 +190,7 @@ lddlflags="-shared" ############################################################################ # DGUX Posix 4A Draft 10 Thread support -# <takis@xfree86.org> +# <takis@XFree86.Org> # use Configure -Dusethreads to enable ############################################################################ @@ -197,13 +198,17 @@ cat > UU/usethreads.cbu <<'EOCBU' case "$usethreads" in $define|true|[yY]*) ccflags="$ccflags" + # DG/UX has this for sure! Main Configure fails to + # detect it but it is needed! + d_pthread_atfork='define' shift # DG/UX's sched_yield is in -lrte - # Remove malloc since we use the internal perl one. + # Do *NOT* add there the malloc native + # DG/UX library! libswanted="dbm posix resolv socket nsl dl m rte" archname="ix86-dgux-thread" - sitearch="$prefix/lib/perl57/$archname" - sitelib="$prefix/lib/perl57" + sitearch="$prefix/lib/perl58/$archname" + sitelib="$prefix/lib/perl58" case "$cc" in *gcc*) #### Use GCC -2.95.2/3 rev (DG/UX) and -pthread @@ -212,7 +217,7 @@ $define|true|[yY]*) ld="gcc" ccflags="$ccflags -D_POSIX4A_DRAFT10_SOURCE" # Debug build : use -DS flag on command line perl - # ccflags="$ccflags -DDEBUGGING -D_POSIX4A_DRAFT10_SOURCE -pthread" + # ccflags="$ccflags -g -mstandard -DDEBUGGING -D_POSIX4A_DRAFT10_SOURCE -pthread" cccdlflags='-fPIC' lddlflags="-shared" #### Use GCC -2.95.2/3 rev (DG/UX) and -pthread diff --git a/hints/freebsd.sh b/hints/freebsd.sh index 7ce17351c7..41fe55f510 100644 --- a/hints/freebsd.sh +++ b/hints/freebsd.sh @@ -232,3 +232,4 @@ EOM unset lc_r esac EOCBU + diff --git a/hints/netbsd.sh b/hints/netbsd.sh index 1d3b270d87..f41a5b8f6d 100644 --- a/hints/netbsd.sh +++ b/hints/netbsd.sh @@ -98,7 +98,7 @@ $define|true|[yY]*) fi ;; esac -EOCBU +EOCBU # Recognize the NetBSD packages collection. # GDBM might be here. @@ -133,7 +133,7 @@ Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param) static void Perl_hv_notallowed(pTHX_ bool is_utf8, const char *key, I32 klen, - const char *keysave) + const char *keysave, const char *msg) { SV *sv = sv_newmortal(); if (key == keysave) { @@ -147,7 +147,7 @@ Perl_hv_notallowed(pTHX_ bool is_utf8, const char *key, I32 klen, if (is_utf8) { SvUTF8_on(sv); } - Perl_croak(aTHX_ "Attempt to access key '%"SVf"' in fixed hash",sv); + Perl_croak(aTHX_ msg, sv); } /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot @@ -266,7 +266,9 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval) } #endif if (!entry && SvREADONLY(hv)) { - Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave); + Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave, + "Attempt to access disallowed key '%"SVf"' in a fixed hash" + ); } if (lval) { /* gonna assign to this, so it better be there */ sv = NEWSV(61,0); @@ -400,7 +402,9 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) } #endif if (!entry && SvREADONLY(hv)) { - Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave); + Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave, + "Attempt to access disallowed key '%"SVf"' in a fixed hash" + ); } if (key != keysave) Safefree(key); @@ -523,7 +527,9 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 has } if (SvREADONLY(hv)) { - Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave); + Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave, + "Attempt to access disallowed key '%"SVf"' to a fixed hash" + ); } entry = new_HE(); @@ -644,7 +650,9 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash) } if (SvREADONLY(hv)) { - Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave); + Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave, + "Attempt to access disallowed key '%"SVf"' to a fixed hash" + ); } entry = new_HE(); @@ -770,7 +778,9 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags) } } else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) { - Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave); + Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave, + "Attempt to delete readonly key '%"SVf"' from a fixed hash" + ); } if (flags & G_DISCARD) @@ -804,7 +814,9 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags) return sv; } if (SvREADONLY(hv)) { - Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave); + Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave, + "Attempt to access disallowed key '%"SVf"' from a fixed hash" + ); } if (key != keysave) @@ -912,7 +924,9 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) return Nullsv; } else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) { - Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave); + Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave, + "Attempt to delete readonly key '%"SVf"' from a fixed hash" + ); } if (flags & G_DISCARD) @@ -946,7 +960,9 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) return sv; } if (SvREADONLY(hv)) { - Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave); + Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave, + "Attempt to delete disallowed key '%"SVf"' from a fixed hash" + ); } if (key != keysave) @@ -1446,6 +1462,11 @@ Perl_hv_clear(pTHX_ HV *hv) register XPVHV* xhv; if (!hv) return; + + if(SvREADONLY(hv)) { + Perl_croak(aTHX_ "Attempt to clear a fixed hash"); + } + xhv = (XPVHV*)SvANY(hv); hfreeentries(hv); xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */ @@ -1821,7 +1842,7 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash) if (str != save) Safefree(str); if (!found && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str); + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Attempt to free non-existent shared string '%s'",str); } /* get a (constant) string ptr from the global string table diff --git a/installperl b/installperl index 827e30a160..f36b4c0d05 100755 --- a/installperl +++ b/installperl @@ -413,10 +413,14 @@ if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VM if ($archname && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) { my $archperl = "$perl_verbase$ver-$Config{archname}$exe_ext"; safe_unlink("$installbin/$archperl"); - if ($^O eq 'mpeix' || $^O eq 'vos') { - # MPE and VOS don't support hard links, so use a symlink. + if ($^O eq 'mpeix') { + # MPE doesn't support hard links, so use a symlink. # We don't want another cloned copy. symlink($Config{perlpath}, "$installbin/$archperl"); + } elsif ($^O eq 'vos') { + # VOS doesn't support hard links, so use a symlink. + symlink("$installbin/$perl_verbase$ver$exe_ext", + "$installbin/$archperl"); } else { link("$installbin/$perl_verbase$ver$exe_ext", "$installbin/$archperl"); diff --git a/iperlsys.h b/iperlsys.h index 97a9a70505..7eda973426 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -1083,6 +1083,8 @@ struct IPerlProcInfo win32_dynaload((f)) #define PerlProc_GetOSError(s,e) \ win32_str_os_error((s), (e)) +#undef PerlProc_signal +#define PerlProc_signal(n, h) win32_signal((n), (h)) #endif #endif /* PERL_IMPLICIT_SYS */ @@ -93,6 +93,16 @@ sub DB { $usrctxt = "package $DB::package;"; # this won't let them modify, alas local(*DB::dbline) = "::_<$DB::filename"; + + # we need to check for pseudofiles on Mac OS (these are files + # not attached to a filename, but instead stored in Dev:Pseudo) + # since this is done late, $DB::filename will be "wrong" after + # skippkg + if ($^O eq 'MacOS' && $#DB::dbline < 0) { + $DB::filename = 'Dev:Pseudo'; + *DB::dbline = "::_<$DB::filename"; + } + my ($stop, $action); if (($stop,$action) = split(/\0/,$DB::dbline{$DB::lineno})) { if ($stop eq '1') { diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 249954d140..5a875f2ebf 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -442,8 +442,13 @@ EOT } push(@otherfiles, $attribs{FILES}) if $attribs{FILES}; push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all - perlmain.c tmon.out mon.out core core.*perl.*.? - *perl.core so_locations pm_to_blib + perlmain.c tmon.out mon.out]); + if ($^O eq 'vos') { + push(@otherfiles, qw[*.kp]); + } else { + push(@otherfiles, qw[core core.*perl.*.? *perl.core]); + } + push(@otherfiles, qw[so_locations pm_to_blib *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT) $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def lib$(BASEEXT).def diff --git a/lib/File/Find/t/find.t b/lib/File/Find/t/find.t index c74a646439..c28183348f 100644 --- a/lib/File/Find/t/find.t +++ b/lib/File/Find/t/find.t @@ -51,10 +51,10 @@ BEGIN { cleanup(); -find({wanted => sub { print "ok 1\n" if $_ eq 'access.t'; } }, +find({wanted => sub { print "ok 1\n" if $_ eq 'commonsense.t'; } }, File::Spec->curdir); -finddepth({wanted => sub { print "ok 2\n" if $_ eq 'access.t'; } }, +finddepth({wanted => sub { print "ok 2\n" if $_ eq 'commonsense.t'; } }, File::Spec->curdir); diff --git a/lib/File/Find/t/taint.t b/lib/File/Find/t/taint.t index 2c76138144..91fe8ee9d8 100644 --- a/lib/File/Find/t/taint.t +++ b/lib/File/Find/t/taint.t @@ -49,16 +49,16 @@ use Cwd; cleanup(); my $found; -find({wanted => sub { $found = 1 if ($_ eq 'access.t') }, +find({wanted => sub { $found = 1 if ($_ eq 'commonsense.t') }, untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); -ok($found, 'access.t found'); +ok($found, 'commonsense.t found'); $found = 0; -finddepth({wanted => sub { $found = 1 if $_ eq 'access.t'; }, +finddepth({wanted => sub { $found = 1 if $_ eq 'commonsense.t'; }, untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); -ok($found, 'access.t found again'); +ok($found, 'commonsense.t found again'); my $case = 2; my $FastFileTests_OK = 0; diff --git a/lib/Locale/Codes/ChangeLog b/lib/Locale/Codes/ChangeLog index 639e6319b3..e77140b4df 100644 --- a/lib/Locale/Codes/ChangeLog +++ b/lib/Locale/Codes/ChangeLog @@ -1,6 +1,15 @@ ChangeLog for Locale-Codes Distribution +2.02 2002-03-09 neilb + + * added semi-private routine rename_country() to Locale::Country, + based on a patch from Iain Chalmers. + * added test rename.t for the above function. + * renamed _alias_code to be alias_code. Have retained the old + name for backwards compatibility. Will remove it when the + major version number next changes. + 2.01 2002-02-18 neilb * Split the documentation for all modules into separate pod files. diff --git a/lib/Locale/Codes/README b/lib/Locale/Codes/README index 917b2c5b02..4bdd2183dd 100644 --- a/lib/Locale/Codes/README +++ b/lib/Locale/Codes/README @@ -1,6 +1,6 @@ Locale-Codes Distribution - v2.01 + v2.02 This distribution contains four Perl modules which can be used to process ISO codes for identifying languages, countries, scripts, diff --git a/lib/Locale/Codes/t/rename.t b/lib/Locale/Codes/t/rename.t new file mode 100644 index 0000000000..27f506c84b --- /dev/null +++ b/lib/Locale/Codes/t/rename.t @@ -0,0 +1,79 @@ +#!./perl +# +# rename.t - tests for Locale::Country with "uk" aliases to "gb" +# + +use Locale::Country; + +local $SIG{__WARN__} = sub { }; # muffle warnings from carp + +Locale::Country::rename_country('gb' => 'Great Britain'); + +#----------------------------------------------------------------------- +# This is an array of tests. Each test is eval'd as an expression. +# If it evaluates to FALSE, then "not ok N" is printed for the test, +# otherwise "ok N". +#----------------------------------------------------------------------- +@TESTS = +( + #================================================ + # TESTS FOR code2country + #================================================ + + #---- selection of examples which should all result in undef ----------- + '!defined code2country()', # no argument + '!defined code2country(undef)', # undef argument + '!defined code2country("zz")', # illegal code + '!defined code2country("ja")', # should be jp for country + '!defined code2country("uk")', # code for United Kingdom is 'gb' + + #---- this call should return 0, since code doesn't exist -------------- + '!Locale::Country::rename_country("ukz", "United Karz")', + + #---- some successful examples ----------------------------------------- + 'code2country("BO") eq "Bolivia"', + 'code2country("pk") eq "Pakistan"', + 'code2country("sn") eq "Senegal"', + 'code2country("us") eq "United States"', + 'code2country("ad") eq "Andorra"', # first in DATA segment + 'code2country("zw") eq "Zimbabwe"', # last in DATA segment + 'code2country("gb") eq "Great Britain"', # normally "United Kingdom" + + #================================================ + # TESTS FOR country2code + #================================================ + + #---- selection of examples which should all result in undef ----------- + '!defined country2code()', # no argument + '!defined country2code(undef)', # undef argument + '!defined country2code("Banana")', # illegal country name + + #---- some successful examples ----------------------------------------- + 'country2code("japan") eq "jp"', + 'country2code("japan") ne "ja"', + 'country2code("Japan") eq "jp"', + 'country2code("United States") eq "us"', + + 'country2code("Great Britain") eq "gb"', + 'country2code("Great Britain", LOCALE_CODE_ALPHA_3) eq "gbr"', + 'country2code("Great Britain", LOCALE_CODE_NUMERIC) eq "826"', + + 'country2code("United Kingdom") eq "gb"', + 'country2code("United Kingdom", LOCALE_CODE_ALPHA_3) eq "gbr"', + 'country2code("United Kingdom", LOCALE_CODE_NUMERIC) eq "826"', + + 'country2code("Andorra") eq "ad"', # first in DATA segment + 'country2code("Zimbabwe") eq "zw"', # last in DATA segment +); + +print "1..", int(@TESTS), "\n"; + +$testid = 1; +foreach $test (@TESTS) +{ + eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )"; + print "not ok $testid\n" if $@; + ++$testid; +} + +exit 0; diff --git a/lib/Locale/Codes/t/uk.t b/lib/Locale/Codes/t/uk.t index 948e2d1af2..ceca3721b5 100644 --- a/lib/Locale/Codes/t/uk.t +++ b/lib/Locale/Codes/t/uk.t @@ -10,7 +10,7 @@ BEGIN { use Locale::Country; -Locale::Country::_alias_code('uk' => 'gb'); +Locale::Country::alias_code('uk' => 'gb'); #----------------------------------------------------------------------- # This is an array of tests. Each test is eval'd as an expression. diff --git a/lib/Locale/Country.pm b/lib/Locale/Country.pm index 48cb47795b..9172721aa8 100644 --- a/lib/Locale/Country.pm +++ b/lib/Locale/Country.pm @@ -1,7 +1,7 @@ # # Locale::Country - ISO codes for country identification (ISO 3166) # -# $Id: Country.pm,v 2.1 2002/02/06 04:07:09 neilb Exp $ +# $Id: Country.pm,v 2.2 2002/03/06 10:45:38 neilb Exp $ # package Locale::Country; @@ -17,7 +17,7 @@ use Locale::Constants; # Public Global Variables #----------------------------------------------------------------------- use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); -$VERSION = sprintf("%d.%02d", q$Revision: 2.1 $ =~ /(\d+)\.(\d+)/); +$VERSION = sprintf("%d.%02d", q$Revision: 2.2 $ =~ /(\d+)\.(\d+)/); @ISA = qw(Exporter); @EXPORT = qw(code2country country2code all_country_codes all_country_names @@ -153,15 +153,15 @@ sub all_country_names #======================================================================= # -# _alias_code ( ALIAS => CODE [ , CODESET ] ) +# alias_code ( ALIAS => CODE [ , CODESET ] ) # # Add an alias for an existing code. If the CODESET isn't specified, # then we use the default (currently the alpha-2 codeset). # -# Locale::Country::_alias_code('uk' => 'gb'); +# Locale::Country::alias_code('uk' => 'gb'); # #======================================================================= -sub _alias_code +sub alias_code { my $alias = shift; my $real = shift; @@ -182,6 +182,81 @@ sub _alias_code return $alias; } +# old name of function for backwards compatibility +*_alias_code = *alias_code; + + +#======================================================================= +# +# rename_country +# +# change the official name for a country, eg: +# gb => 'Great Britain' +# rather than the standard 'United Kingdom'. The original is retained +# as an alias, but the new name will be returned if you lookup the +# name from code. +# +#======================================================================= +sub rename_country +{ + my $code = shift; + my $new_name = shift; + my $codeset = @_ > 0 ? shift : _code2codeset($code); + my $country; + my $c; + + + if (not defined $codeset) + { + carp "rename_country(): unknown country code \"$code\"\n"; + return 0; + } + + $country = $CODES->[$codeset]->{$code}; + + foreach my $cset (LOCALE_CODE_ALPHA_2, + LOCALE_CODE_ALPHA_3, + LOCALE_CODE_NUMERIC) + { + if ($cset == $codeset) + { + $c = $code; + } + else + { + $c = country_code2code($code, $codeset, $cset); + } + + $CODES->[$cset]->{$c} = $new_name; + $COUNTRIES->[$cset]->{"\L$new_name"} = $c; + } + + return 1; +} + + +#======================================================================= +# +# _code2codeset +# +# given a country code in an unknown codeset, return the codeset +# it is from, or undef. +# +#======================================================================= +sub _code2codeset +{ + my $code = shift; + + + foreach my $codeset (LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3, + LOCALE_CODE_NUMERIC) + { + return $codeset if (exists $CODES->[$codeset]->{$code}) + } + + return undef; +} + #======================================================================= # diff --git a/lib/Locale/Country.pod b/lib/Locale/Country.pod index bfa5bd5807..ff130aadc0 100644 --- a/lib/Locale/Country.pod +++ b/lib/Locale/Country.pod @@ -13,14 +13,15 @@ Locale::Country - ISO codes for country identification (ISO 3166) @codes = all_country_codes(); @names = all_country_names(); - # add "uk" as a pseudo country code for United Kingdom - Locale::Country::_alias_code('uk' => 'gb'); + # semi-private routines + Locale::Country::alias_code('uk' => 'gb'); + Locale::Country::rename_country('gb' => 'Great Britain'); =head1 DESCRIPTION The C<Locale::Country> module provides access to the ISO -codes for identifying countries, as defined in ISO 3166. +codes for identifying countries, as defined in ISO 3166-1. You can either access the codes via the L<conversion routines> (described below), or with the two functions which return lists of all country codes or all country names. @@ -141,12 +142,19 @@ depending on which code set you specify. =back -=head1 CODE ALIASING +=head1 SEMI-PRIVATE ROUTINES -This module supports a semi-private routine for specifying two letter -code aliases. +Locale::Country provides two semi-private routines for modifying +the internal data. +Given their status, they aren't exported by default, +and so need to be called by prefixing the function name with the +package name. - Locale::Country::_alias_code( ALIAS => CODE [, CODESET ] ) +=head2 alias_code + +Define a new code as an alias for an existing code: + + Locale::Country::alias_code( ALIAS => CODE [, CODESET ] ) This feature was added as a mechanism for handling a "uk" code. The ISO standard says that the two-letter code for @@ -156,13 +164,31 @@ By default the module does not understand "uk", since it is implementing an ISO standard. If you would like 'uk' to work as the two-letter code for United Kingdom, use the following: - use Locale::Country; - - Locale::Country::_alias_code('uk' => 'gb'); + Locale::Country::alias_code('uk' => 'gb'); With this code, both "uk" and "gb" are valid codes for United Kingdom, with the reverse lookup returning "uk" rather than the usual "gb". +B<Note:> this function was previously called _alias_code, +but the leading underscore has been dropped. +The old name will be supported for all 2.X releases for +backwards compatibility. + +=head2 rename_country + +If the official country name just isn't good enough for you, +you can rename a country. For example, the official country +name for code 'gb' is 'United Kingdom'. +If you want to change that, you might call: + + Locale::Country::rename_country('gb' => 'Great Britain'); + +This means that calling code2country('gb') will now return +'Great Britain' instead of 'United Kingdom'. +The original country name is retained as an alias, +so for the above example, country2code('United Kingdom') +will still return 'gb'. + =head1 EXAMPLES @@ -236,13 +262,20 @@ ISO codes for identification of scripts (ISO 15924). ISO three letter codes for identification of currencies and funds (ISO 4217). -=item ISO 3166 +=item Locale::SubCountry + +ISO codes for country sub-divisions (states, counties, provinces, etc), +as defined in ISO 3166-2. +This module is not part of the Locale-Codes distribution, +but is available from CPAN in CPAN/modules/by-module/Locale/ + +=item ISO 3166-1 The ISO standard which defines these codes. -=item http://www.din.de/gremien/nas/nabd/iso3166ma/ +=item http://www.iso.org/iso/en/prods-services/iso3166ma/index.html -Official home page for ISO 3166 +Official home page for the ISO 3166 maintenance agency. =item http://www.egt.ie/standards/iso3166/iso3166-1-en.html diff --git a/lib/Net/Ping/t/110_icmp_inst.t b/lib/Net/Ping/t/110_icmp_inst.t index bf27289163..41f8e155e5 100644 --- a/lib/Net/Ping/t/110_icmp_inst.t +++ b/lib/Net/Ping/t/110_icmp_inst.t @@ -16,6 +16,8 @@ plan tests => 2; ok 1; if (($> and $^O ne 'VMS') + or ($^O eq 'MSWin32' + and Win32::IsWinNT()) or ($^O eq 'VMS' and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/))) { skip "icmp ping requires root privileges.", 1; diff --git a/lib/Test.pm b/lib/Test.pm index dcc5f68698..d497217ff1 100644 --- a/lib/Test.pm +++ b/lib/Test.pm @@ -6,20 +6,30 @@ use strict; use Carp; use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish - qw($TESTOUT $ONFAIL %todo %history $planned @FAILDETAIL)#private-ish + qw($TESTOUT $TESTERR + $ONFAIL %todo %history $planned @FAILDETAIL) #private-ish ); -$VERSION = '1.18'; +# In case a test is run in a persistent environment. +sub _reset_globals { + %todo = (); + %history = (); + @FAILDETAIL = (); + $ntest = 1; + $TestLevel = 0; # how many extra stack frames to skip + $planned = 0; +} + +$VERSION = '1.20'; require Exporter; @ISA=('Exporter'); @EXPORT = qw(&plan &ok &skip); -@EXPORT_OK = qw($ntest $TESTOUT); +@EXPORT_OK = qw($ntest $TESTOUT $TESTERR); -$TestLevel = 0; # how many extra stack frames to skip $|=1; -$ntest=1; $TESTOUT = *STDOUT{IO}; +$TESTERR = *STDERR{IO}; # Use of this variable is strongly discouraged. It is set mainly to # help test coverage analyzers know which test is running. @@ -112,6 +122,8 @@ sub plan { local($\, $,); # guard against -l and other things that screw with # print + _reset_globals(); + my $max=0; for (my $x=0; $x < @_; $x+=2) { my ($k,$v) = @_[$x,$x+1]; @@ -275,13 +287,13 @@ sub ok ($;$$) { $context .= ' *TODO*' if $todo; if (!defined $expected) { if (!$diag) { - print $TESTOUT "# Failed test $ntest in $context\n"; + print $TESTERR "# Failed test $ntest in $context\n"; } else { - print $TESTOUT "# Failed test $ntest in $context: $diag\n"; + print $TESTERR "# Failed test $ntest in $context: $diag\n"; } } else { my $prefix = "Test $ntest"; - print $TESTOUT "# $prefix got: ". + print $TESTERR "# $prefix got: ". (defined $result? "'$result'":'<UNDEF>')." ($context)\n"; $prefix = ' ' x (length($prefix) - 5); if (defined $regex) { @@ -291,9 +303,9 @@ sub ok ($;$$) { $expected = "'$expected'"; } if (!$diag) { - print $TESTOUT "# $prefix Expected: $expected\n"; + print $TESTERR "# $prefix Expected: $expected\n"; } else { - print $TESTOUT "# $prefix Expected: $expected ($diag)\n"; + print $TESTERR "# $prefix Expected: $expected ($diag)\n"; } } push @FAILDETAIL, $detail; @@ -424,34 +436,33 @@ Again, best bet is to use the single argument form: ok( $fileglob eq '/path/to/some/*stuff/' ); -=head1 TODO +=head1 NOTE -Add todo(). - -Allow named tests. - -Implement noplan(). +This module is no longer actively being developed, only bug fixes and +small tweaks (I'll still accept patches). If you desire additional +functionality, consider L<Test::More> or L<Test::Unit>. =head1 SEE ALSO L<Test::Simple>, L<Test::More>, L<Test::Harness>, L<Devel::Cover> -L<Test::Unit> is an interesting alternative testing library. +L<Test::Builder> for building your own testing library. + +L<Test::Unit> is an interesting XUnit-style testing library. -L<Pod::Tests> and L<SelfTest> let you embed tests in code. +L<Test::Inline> and L<SelfTest> let you embed tests in code. =head1 AUTHOR Copyright (c) 1998-2000 Joshua Nathaniel Pritikin. All rights reserved. -Copyright (c) 2001 Michael G Schwern. +Copyright (c) 2001-2002 Michael G Schwern. Current maintainer, Michael G Schwern <schwern@pobox.com> This package is free software and is provided "as is" without express or implied warranty. It may be used, redistributed and/or modified -under the terms of the Perl Artistic License (see -http://www.perl.com/perl/misc/Artistic.html) +under the same terms as Perl itself. =cut diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm index 2d8edddc60..da63506b0b 100644 --- a/lib/Test/Builder.pm +++ b/lib/Test/Builder.pm @@ -8,7 +8,7 @@ $^C ||= 0; use strict; use vars qw($VERSION $CLASS); -$VERSION = '0.11'; +$VERSION = '0.12'; $CLASS = __PACKAGE__; my $IsVMS = $^O eq 'VMS'; @@ -934,6 +934,11 @@ sub current_test { if( defined $num ) { $Curr_Test = $num; + if( $num > @Test_Results ) { + for ($#Test_Results..$num-1) { + $Test_Results[$_] = 1; + } + } } return $Curr_Test; } diff --git a/lib/Test/More.pm b/lib/Test/More.pm index 4b03dff436..5cd89011b8 100644 --- a/lib/Test/More.pm +++ b/lib/Test/More.pm @@ -18,7 +18,7 @@ sub _carp { require Exporter; use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO); -$VERSION = '0.41'; +$VERSION = '0.42'; @ISA = qw(Exporter); @EXPORT = qw(ok use_ok require_ok is isnt like unlike is_deeply @@ -198,7 +198,7 @@ sub import { =head2 Test names By convention, each test is assigned a number in order. This is -largely done automatically for you. However, its often very useful to +largely done automatically for you. However, it's often very useful to assign a name to each test. Which would you rather see: ok 4 @@ -215,7 +215,7 @@ The later gives you some idea of what failed. It also makes it easier to find the test in your script, simply search for "simple exponential". -All test functions take a name argument. Its optional, but highly +All test functions take a name argument. It's optional, but highly suggested that you use it. @@ -412,7 +412,7 @@ and $that were: # && # undef -Its also useful in those cases where you are comparing numbers and +It's also useful in those cases where you are comparing numbers and is()'s use of C<eq> will interfere: cmp_ok( $big_hairy_number, '==', $another_big_hairy_number ); @@ -472,7 +472,7 @@ sub can_ok ($@) { } my $name; - $name = @methods == 1 ? "$class->can($methods[0])" + $name = @methods == 1 ? "$class->can('$methods[0]')" : "$class->can(...)"; my $ok = $Test->ok( !@nok, $name ); @@ -531,7 +531,7 @@ sub isa_ok ($$;$) { if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) { if( !UNIVERSAL::isa($object, $class) ) { my $ref = ref $object; - $diag = "$obj_name isn't a '$class' its a '$ref'"; + $diag = "$obj_name isn't a '$class' it's a '$ref'"; } } else { die <<WHOA; @@ -544,7 +544,7 @@ WHOA } elsif( !$rslt ) { my $ref = ref $object; - $diag = "$obj_name isn't a '$class' its a '$ref'"; + $diag = "$obj_name isn't a '$class' it's a '$ref'"; } } diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm index 339d0856df..f0b45c0820 100644 --- a/lib/Test/Simple.pm +++ b/lib/Test/Simple.pm @@ -4,7 +4,7 @@ use 5.004; use strict 'vars'; use vars qw($VERSION); -$VERSION = '0.41'; +$VERSION = '0.42'; use Test::Builder; diff --git a/lib/Test/Simple/Changes b/lib/Test/Simple/Changes index b13ab46b65..2de6efcf2e 100644 --- a/lib/Test/Simple/Changes +++ b/lib/Test/Simple/Changes @@ -1,5 +1,13 @@ Revision history for Perl extension Test::Simple +0.42 Wed Mar 6 15:00:24 EST 2002 + - Setting Test::Builder->current_test() now works (see what happens + when you forget to test things?) + - The change in is()'s undef/'' handling in 0.34 was an API change, + but I forgot to declare it as such. + - The apostrophilic jihad attacks! Philip Newtons patch for + grammar mistakes in the doc's. + 0.41 Mon Dec 17 22:45:20 EST 2001 * chromatic added diag() - Internal eval()'s sometimes interfering with $@ and $!. Fixed. @@ -26,7 +34,8 @@ Revision history for Perl extension Test::Simple - Little glitch in the test suite. No actual bug. 0.34 Tue Nov 27 15:43:56 EST 2001 - * Empty string no longer matches undef in is() and isnt(). + * **API CHANGE** Empty string no longer matches undef in is() + and isnt(). * Added isnt_eq and isnt_num to Test::Builder. 0.33 Mon Oct 22 21:05:47 EDT 2001 diff --git a/lib/Test/Simple/t/Builder.t b/lib/Test/Simple/t/Builder.t index 0ef079cef4..a5bfd155a6 100644 --- a/lib/Test/Simple/t/Builder.t +++ b/lib/Test/Simple/t/Builder.t @@ -10,7 +10,7 @@ BEGIN { use Test::Builder; my $Test = Test::Builder->new; -$Test->plan( tests => 4 ); +$Test->plan( tests => 7 ); my $default_lvl = $Test->level; $Test->level(0); @@ -21,3 +21,10 @@ $Test->ok( $default_lvl == 1, 'level()' ); $Test->is_eq('foo', 'foo', 'is_eq'); $Test->is_num('23.0', '23', 'is_num'); +$Test->is_num( $Test->current_test, 4, 'current_test() get' ); + +my $test_num = $Test->current_test + 1; +$Test->current_test( $test_num ); +print "ok $test_num - current_test() set\n"; + +$Test->ok( 1, 'counter still good' ); diff --git a/lib/Test/Simple/t/fail-more.t b/lib/Test/Simple/t/fail-more.t index 6fd88c8ee0..29f8eb25ac 100644 --- a/lib/Test/Simple/t/fail-more.t +++ b/lib/Test/Simple/t/fail-more.t @@ -165,13 +165,13 @@ OUT # Failed test ($0 at line 53) # can_ok() called with no methods # Failed test ($0 at line 55) -# The object isn't a 'Wibble' its a 'Foo' +# The object isn't a 'Wibble' it's a 'Foo' # Failed test ($0 at line 56) # My Wibble isn't a reference # Failed test ($0 at line 57) # Another Wibble isn't defined # Failed test ($0 at line 58) -# The object isn't a 'HASH' its a 'ARRAY' +# The object isn't a 'HASH' it's a 'ARRAY' # Failed test ($0 at line 68) # got: 'foo' # expected: 'bar' diff --git a/lib/Test/t/fail.t b/lib/Test/t/fail.t index b431502b8a..ce37464d04 100644 --- a/lib/Test/t/fail.t +++ b/lib/Test/t/fail.t @@ -1,11 +1,12 @@ # -*-perl-*- use strict; use vars qw($Expect); -use Test qw($TESTOUT $ntest ok skip plan); +use Test qw($TESTOUT $TESTERR $ntest ok skip plan); plan tests => 14; open F, ">fails"; $TESTOUT = *F{IO}; +$TESTERR = *F{IO}; my $r=0; { @@ -32,6 +33,7 @@ ok($r); # (failure==success :-) close F; $TESTOUT = *STDOUT{IO}; +$TESTERR = *STDERR{IO}; $ntest = 1; open F, "fails"; @@ -56,38 +58,38 @@ for (my $x=0; $x < @got; $x++) { BEGIN { $Expect = <<"EXPECT"; -# Failed test 1 in $0 at line 14 +# Failed test 1 in $0 at line 15 -# Failed test 2 in $0 at line 16 +# Failed test 2 in $0 at line 17 -# Test 3 got: '0' ($0 at line 17) +# Test 3 got: '0' ($0 at line 18) # Expected: '1' -# Test 4 got: '2' ($0 at line 18) +# Test 4 got: '2' ($0 at line 19) # Expected: '3' -# Test 5 got: '2' ($0 at line 19) +# Test 5 got: '2' ($0 at line 20) # Expected: '0' -# Test 6 got: '2' ($0 at line 22) +# Test 6 got: '2' ($0 at line 23) # Expected: '1' (\@list=0,0) -# Test 7 got: '2' ($0 at line 23) +# Test 7 got: '2' ($0 at line 24) # Expected: '1' (\@list=0,0) -# Test 8 got: 'segmentation fault' ($0 at line 24) +# Test 8 got: 'segmentation fault' ($0 at line 25) # Expected: qr{bongo} -# Failed test 9 in $0 at line 26 +# Failed test 9 in $0 at line 27 -# Failed test 10 in $0 at line 26 fail #2 +# Failed test 10 in $0 at line 27 fail #2 -# Failed test 11 in $0 at line 28 +# Failed test 11 in $0 at line 29 -# Test 12 got: <UNDEF> ($0 at line 29) +# Test 12 got: <UNDEF> ($0 at line 30) # Expected: '1' -# Failed test 13 in $0 at line 31 +# Failed test 13 in $0 at line 32 EXPECT } diff --git a/lib/Test/t/mix.t b/lib/Test/t/mix.t index d2dd491330..a746ba66b5 100644 --- a/lib/Test/t/mix.t +++ b/lib/Test/t/mix.t @@ -1,6 +1,6 @@ # -*-perl-*- use strict; -use Test qw(:DEFAULT $TESTOUT $ntest); +use Test qw(:DEFAULT $TESTOUT $TESTERR $ntest); ### This test is crafted in such a way as to prevent Test::Harness from ### seeing the todo tests, otherwise you get people sending in bug reports @@ -8,6 +8,7 @@ use Test qw(:DEFAULT $TESTOUT $ntest); open F, ">mix"; $TESTOUT = *F{IO}; +$TESTERR = *F{IO}; plan tests => 4, todo => [2,3]; @@ -27,6 +28,7 @@ skip(1,0); close F; $TESTOUT = *STDOUT{IO}; +$TESTERR = *STDERR{IO}; $ntest = 1; open F, "mix"; diff --git a/lib/Test/t/onfail.t b/lib/Test/t/onfail.t index dce4373401..85fe9eb884 100644 --- a/lib/Test/t/onfail.t +++ b/lib/Test/t/onfail.t @@ -1,7 +1,7 @@ # -*-perl-*- use strict; -use Test qw($ntest plan ok $TESTOUT); +use Test qw($ntest plan ok $TESTOUT $TESTERR); use vars qw($mycnt); BEGIN { plan test => 6, onfail => \&myfail } @@ -12,8 +12,10 @@ my $why = "zero != one"; # sneak in a test that Test::Harness wont see open J, ">junk"; $TESTOUT = *J{IO}; +$TESTERR = *J{IO}; ok(0, 1, $why); $TESTOUT = *STDOUT{IO}; +$TESTERR = *STDERR{IO}; close J; unlink "junk"; $ntest = 1; diff --git a/lib/Test/t/skip.t b/lib/Test/t/skip.t index 7db35e65dc..a6d1cf4c3c 100644 --- a/lib/Test/t/skip.t +++ b/lib/Test/t/skip.t @@ -1,9 +1,11 @@ # -*-perl-*- use strict; -use Test qw($TESTOUT $ntest plan ok skip); plan tests => 6; +use Test qw($TESTOUT $TESTERR $ntest plan ok skip); +plan tests => 6; open F, ">skips" or die "open skips: $!"; $TESTOUT = *F{IO}; +$TESTERR = *F{IO}; skip(1, 0); #should skip @@ -15,6 +17,7 @@ skip('skipping stones is more fun', sub { $skipped = 0 }); close F; $TESTOUT = *STDOUT{IO}; +$TESTERR = *STDERR{IO}; $ntest = 1; open F, "skips" or die "open skips: $!"; diff --git a/lib/Test/t/todo.t b/lib/Test/t/todo.t index 510e80dbd3..2f179e4547 100644 --- a/lib/Test/t/todo.t +++ b/lib/Test/t/todo.t @@ -1,6 +1,6 @@ # -*-perl-*- use strict; -use Test qw(:DEFAULT $TESTOUT $ntest); +use Test qw(:DEFAULT $TESTOUT $TESTERR $ntest); ### This test is crafted in such a way as to prevent Test::Harness from ### seeing the todo tests, otherwise you get people sending in bug reports @@ -8,6 +8,7 @@ use Test qw(:DEFAULT $TESTOUT $ntest); open F, ">todo"; $TESTOUT = *F{IO}; +$TESTERR = *F{IO}; my $tests = 5; plan tests => $tests, todo => [2..$tests]; @@ -21,6 +22,7 @@ ok(1,1); close F; $TESTOUT = *STDOUT{IO}; +$TESTERR = *STDERR{IO}; $ntest = 1; open F, "todo"; diff --git a/lib/encoding.pm b/lib/encoding.pm index 44fc2fdc00..441be3340a 100644 --- a/lib/encoding.pm +++ b/lib/encoding.pm @@ -100,6 +100,10 @@ If no encoding is specified, the environment variable L<PERL_ENCODING> is consulted. If that fails, "latin1" (ISO 8859-1) is assumed. If no encoding can be found, C<Unknown encoding '...'> error will be thrown. +Note if you want to get back to the original byte encoding, you need +to use things like I/O with encoding discplines (see L<open>) or the +Encode module, since C<no encoding> (or re-C<encoding>) do not work. + =head1 KNOWN PROBLEMS For native multibyte encodings (either fixed or variable length) @@ -107,6 +111,7 @@ the current implementation of the regular expressions may introduce recoding errors for longer regular expression literals than 127 bytes. The encoding pragma is not supported on EBCDIC platforms. +(Porters wanted.) =head1 SEE ALSO diff --git a/lib/open.pm b/lib/open.pm index b535d88239..7e3fdf051d 100644 --- a/lib/open.pm +++ b/lib/open.pm @@ -6,7 +6,7 @@ our $VERSION = '1.01'; my $locale_encoding; -sub in_locale { $^H & $locale::hint_bits } +sub in_locale { $^H & ($locale::hint_bits || 0)} sub _get_locale_encoding { unless (defined $locale_encoding) { @@ -16,10 +16,10 @@ sub _get_locale_encoding { I18N::Langinfo->import(qw(langinfo CODESET)); $locale_encoding = langinfo(CODESET()); }; - unless ($@) { - print "# locale_encoding = $locale_encoding\n"; - } my $country_language; + + no warnings 'uninitialized'; + if (not $locale_encoding && in_locale()) { if ($ENV{LC_ALL} =~ /^([^.]+)\.([^.]+)$/) { ($country_language, $locale_encoding) = ($1, $2); @@ -45,8 +45,10 @@ sub _get_locale_encoding { $locale_encoding = 'euc-jp'; } elsif ($country_language =~ /^ko_KR|korean?$/i) { $locale_encoding = 'euc-kr'; + } elsif ($country_language =~ /^zh_CN|chin(?:a|ese)?$/i) { + $locale_encoding = 'euc-cn'; } elsif ($country_language =~ /^zh_TW|taiwan(?:ese)?$/i) { - $locale_encoding = 'euc-tw'; + $locale_encoding = 'big5'; } croak "Locale encoding 'euc' too ambiguous" if $locale_encoding eq 'euc'; @@ -57,6 +59,7 @@ sub _get_locale_encoding { sub import { my ($class,@args) = @_; croak("`use open' needs explicit list of disciplines") unless @args; + my $std; $^H |= $open::hint_bits; my ($in,$out) = split(/\0/,(${^OPEN} || "\0"), -1); while (@args) { @@ -65,6 +68,9 @@ sub import { if ($type =~ /^:?(utf8|locale|encoding\(.+\))$/) { $type = 'IO'; $dscp = ":$1"; + } elsif ($type eq ':std') { + $std = 1; + next; } else { $dscp = shift(@args) || ''; } @@ -75,13 +81,14 @@ sub import { use Encode; _get_locale_encoding() unless defined $locale_encoding; - croak "Cannot figure out an encoding to use" + (carp("Cannot figure out an encoding to use"), last) unless defined $locale_encoding; if ($locale_encoding =~ /^utf-?8$/i) { $layer = "utf8"; } else { $layer = "encoding($locale_encoding)"; } + $std = 1; } else { unless(PerlIO::Layer::->find($layer)) { carp("Unknown discipline layer '$layer'"); @@ -92,7 +99,6 @@ sub import { $^H{"open_$type"} = $layer; } } - # print "# type = $type, val = @val\n"; if ($type eq 'IN') { $in = join(' ',@val); } @@ -106,7 +112,25 @@ sub import { croak "Unknown discipline class '$type'"; } } - ${^OPEN} = join("\0",$in,$out); + ${^OPEN} = join("\0",$in,$out) if $in or $out; + if ($std) { + if ($in) { + if ($in =~ /:utf8\b/) { + binmode(STDIN, ":utf8"); + } elsif ($in =~ /(\w+\(.+\))/) { + binmode(STDIN, ":$1"); + } + } + if ($out) { + if ($out =~ /:utf8\b/) { + binmode(STDOUT, ":utf8"); + binmode(STDERR, ":utf8"); + } elsif ($out =~ /(\w+\(.+\))/) { + binmode(STDOUT, ":$1"); + binmode(STDERR, ":$1"); + } + } + } } 1; @@ -128,6 +152,8 @@ open - perl pragma to set default disciplines for input and output use open ':locale'; use open ':encoding(iso-8859-7)'; + use open ':std'; + =head1 DESCRIPTION Full-fledged support for I/O disciplines is now implemented provided @@ -181,6 +207,41 @@ and these When open() is given an explicit list of layers they are appended to the list declared using this pragma. +The C<:std> subpragma on its own has no effect, but if combined with +the C<:utf8> or C<:encoding> subpragmas, it converts the standard +filehandles (STDIN, STDOUT, STDERR) to comply with encoding selected +for input/output handles. For example, if both input and out are +chosen to be C<:utf8>, a C<:std> will mean that STDIN, STDOUT, and +STDERR are also in C<:utf8>. On the other hand, if only output is +chosen to be in C<:encoding(koi8r)', a C<:std> will cause only the +STDOUT and STDERR to be in C<koi8r>. The C<:locale> subpragma +implicitly turns on C<:std>. + +The logic of C<:locale> is as follows: + +=over 4 + +=item 1. + +If the platform supports the langinfo(CODESET) interface, the codeset +returned is used as the default encoding for the open pragma. + +=item 2. + +If 1. didn't work but we are under the locale pragma, the environment +variables LC_ALL and LANG (in that order) are matched for encodings +(the part after C<.>, if any), and if any found, that is used +as the default encoding for the open pragma. + +=item 3. + +If 1. and 2. didn't work, the environment variables LC_ALL and LANG +(in that order) are matched for anything looking like UTF-8, and if +any found, C<:utf8> is used as the default encoding for the open +pragma. + +=back + Directory handles may also support disciplines in future. =head1 NONPERLIO FUNCTIONALITY diff --git a/lib/open.t b/lib/open.t index 5bc4b6d184..5897c2b32f 100644 --- a/lib/open.t +++ b/lib/open.t @@ -36,11 +36,14 @@ eval{ import( 'IN', 'macguffin' ) }; like( $warn, qr/Unknown discipline layer/, 'should warn about unknown discipline with bad discipline provided' ); -# now load a real-looking locale -$ENV{LC_ALL} = ' .utf8'; -import( 'IN', 'locale' ); -is( ${^OPEN}, ":utf8\0", - 'should set a valid locale layer' ); +SKIP: { + skip("no perlio, no :utf8", 1) unless $Config{useperlio}; + # now load a real-looking locale + $ENV{LC_ALL} = ' .utf8'; + import( 'IN', 'locale' ); + is( ${^OPEN}, ":utf8\0", + 'should set a valid locale layer' ); +} # and see if it sets the magic variables appropriately import( 'IN', ':crlf' ); diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 3365691a7e..711755eed9 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -667,6 +667,14 @@ sub DB { $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' . "package $package;"; # this won't let them modify, alas local(*dbline) = $main::{'_<' . $filename}; + + # we need to check for pseudofiles on Mac OS (these are files + # not attached to a filename, but instead stored in Dev:Pseudo) + if ($^O eq 'MacOS' && $#dbline < 0) { + $filename_ini = $filename = 'Dev:Pseudo'; + *dbline = $main::{'_<' . $filename}; + } + $max = $#dbline; if ($dbline{$line} && (($stop,$action) = split(/\0/,$dbline{$line}))) { if ($stop eq '1') { diff --git a/lib/utf8.pm b/lib/utf8.pm index 7b1ef0ddc4..9023eb6eb2 100644 --- a/lib/utf8.pm +++ b/lib/utf8.pm @@ -79,29 +79,37 @@ The following functions are defined in the C<utf8::> package by the perl core. Converts internal representation of string to the Perl's internal I<UTF-X> form. Returns the number of octets necessary to represent -the string as I<UTF-X>. +the string as I<UTF-X>. Note that this should not be used to convert +a legacy byte encoding to Unicode: use Encode for that. Affected +by the encoding pragma. =item * utf8::downgrade($string[, CHECK]) Converts internal representation of string to be un-encoded bytes. +Note that this should not be used to convert Unicode back to a legacy +byte encoding: use Encode for that. B<Not> affected by the encoding +pragma. =item * utf8::encode($string) -Converts (in-place) I<$string> from logical characters to octet sequence -representing it in Perl's I<UTF-X> encoding. +Converts (in-place) I<$string> from logical characters to octet +sequence representing it in Perl's I<UTF-X> encoding. Note that this +should not be used to convert a legacy byte encoding to Unicode: use +Encode for that. =item * $flag = utf8::decode($string) Attempts to convert I<$string> in-place from Perl's I<UTF-X> encoding -into logical characters. +into logical characters. Note that this should not be used to convert +Unicode back to a legacy byte encoding: use Encode for that. =back -C<utf8::encode> is like C<utf8::upgrade> but the UTF8 flag does not -get turned on. See L<perlunicode> for more on the UTF8 flag and the C -API functions C<sv_utf8_upgrade>, C<sv_utf8_downgrade>, -C<sv_utf8_encode>, C<sv_utf8_decode> that are wrapped by the Perl -functions C<utf8::upgrade>, C<utf8::downgrade>, C<utf8::encode> and +C<utf8::encode> is like C<utf8::upgrade>, but the UTF8 flag is cleared. +See L<perlunicode> for more on the UTF8 flag and the C API functions +C<sv_utf8_upgrade>, C<sv_utf8_downgrade>, C<sv_utf8_encode>, +and C<sv_utf8_decode>, which are wrapped by the Perl functions +C<utf8::upgrade>, C<utf8::downgrade>, C<utf8::encode> and C<utf8::decode>. =head1 SEE ALSO @@ -1595,7 +1595,7 @@ Perl_mfree(void *mp) { dTHX; if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC)) - Perl_warner(aTHX_ WARN_MALLOC, "%s free() ignored (RMAGIC, PERL_CORE)", + Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s free() ignored (RMAGIC, PERL_CORE)", ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad"); } @@ -1608,7 +1608,7 @@ Perl_mfree(void *mp) { dTHX; if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC)) - Perl_warner(aTHX_ WARN_MALLOC, "%s", "Bad free() ignored (PERL_CORE)"); + Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s", "Bad free() ignored (PERL_CORE)"); } #else warn("%s", "Bad free() ignored"); @@ -1695,7 +1695,7 @@ Perl_realloc(void *mp, size_t nbytes) { dTHX; if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC)) - Perl_warner(aTHX_ WARN_MALLOC, "%srealloc() %signored", + Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%srealloc() %signored", (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "), ovp->ov_rmagic == RMAGIC - 1 ? "of freed memory " : ""); @@ -1710,7 +1710,7 @@ Perl_realloc(void *mp, size_t nbytes) { dTHX; if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC)) - Perl_warner(aTHX_ WARN_MALLOC, "%s", + Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s", "Bad realloc() ignored"); } #else @@ -1171,7 +1171,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) i = whichsig(s); /* ...no, a brick */ if (!i) { if (ckWARN(WARN_SIGNAL)) - Perl_warner(aTHX_ WARN_SIGNAL, "No such signal: SIG%s", s); + Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s); return 0; } #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS) @@ -2374,7 +2374,7 @@ Perl_sighandler(int sig) if (!cv || !CvROOT(cv)) { if (ckWARN(WARN_SIGNAL)) - Perl_warner(aTHX_ WARN_SIGNAL, "SIG%s handler \"%s\" not defined.\n", + Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "SIG%s handler \"%s\" not defined.\n", PL_sig_name[sig], (gv ? GvENAME(gv) : ((cv && CvGV(cv)) ? GvENAME(CvGV(cv)) @@ -175,7 +175,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* Bah. We're just overflowed. */ if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ WARN_OVERFLOW, + Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), "Integer overflow in binary number"); overflowed = TRUE; value_nv = (NV) value; @@ -198,7 +198,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { goto redo; } if (ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ WARN_DIGIT, + Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal binary digit '%c' ignored", *s); break; } @@ -209,7 +209,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #endif ) { if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ WARN_PORTABLE, + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), "Binary number > 0b11111111111111111111111111111111 non-portable"); } *len_p = s - start; @@ -290,7 +290,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* Bah. We're just overflowed. */ if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ WARN_OVERFLOW, + Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), "Integer overflow in hexadecimal number"); overflowed = TRUE; value_nv = (NV) value; @@ -313,7 +313,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { goto redo; } if (ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ WARN_DIGIT, + Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal hexadecimal digit '%c' ignored", *s); break; } @@ -324,7 +324,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #endif ) { if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ WARN_PORTABLE, + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), "Hexadecimal number > 0xffffffff non-portable"); } *len_p = s - start; @@ -372,7 +372,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* Bah. We're just overflowed. */ if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ WARN_OVERFLOW, + Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), "Integer overflow in octal number"); overflowed = TRUE; value_nv = (NV) value; @@ -399,7 +399,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { * someone seems to want to use the digits eight and nine). */ if (digit == 8 || digit == 9) { if (ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ WARN_DIGIT, + Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal octal digit '%c' ignored", *s); } break; @@ -411,7 +411,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #endif ) { if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ WARN_PORTABLE, + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), "Octal number > 037777777777 non-portable"); } *len_p = s - start; @@ -199,7 +199,7 @@ Perl_pad_allocmy(pTHX_ char *name) || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)) && strEQ(name, SvPVX(sv))) { - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "\"%s\" variable %s masks earlier declaration in same %s", (PL_in_my == KEY_our ? "our" : "my"), name, @@ -216,9 +216,9 @@ Perl_pad_allocmy(pTHX_ char *name) && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash) && strEQ(name, SvPVX(sv))) { - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "\"our\" variable %s redeclared", name); - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "\t(Did you mean \"local\" instead of \"our\"?)\n"); break; } @@ -359,7 +359,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, if (ckWARN(WARN_CLOSURE) && !CvUNIQUE(bcv) && !CvUNIQUE(cv)) { - Perl_warner(aTHX_ WARN_CLOSURE, + Perl_warner(aTHX_ packWARN(WARN_CLOSURE), "Variable \"%s\" may be unavailable", name); } @@ -372,7 +372,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv) && !(SvFLAGS(sv) & SVpad_OUR)) { - Perl_warner(aTHX_ WARN_CLOSURE, + Perl_warner(aTHX_ packWARN(WARN_CLOSURE), "Variable \"%s\" will not stay shared", name); } } @@ -509,7 +509,7 @@ Perl_pad_leavemy(pTHX_ I32 fill) if (PL_min_intro_pending && fill < PL_min_intro_pending) { for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) { if ((sv = svp[off]) && sv != &PL_sv_undef && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "%s never introduced", SvPVX(sv)); + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "%s never introduced", SvPVX(sv)); } } /* "Deintroduce" my variables that are leaving with this scope. */ @@ -925,9 +925,11 @@ S_cop_free(pTHX_ COP* cop) SvREFCNT_dec(cop->cop_warnings); if (! specialCopIO(cop->cop_io)) { #ifdef USE_ITHREADS +#if 0 STRLEN len; char *s = SvPV(cop->cop_io,len); - Perl_warn(aTHX_ "io='%.*s'",(int) len,s); + Perl_warn(aTHX_ "io='%.*s'",(int) len,s); /* ??? --jhi */ +#endif #else SvREFCNT_dec(cop->cop_io); #endif @@ -993,7 +995,7 @@ S_scalarboolean(pTHX_ OP *o) if (PL_copline != NOLINE) CopLINE_set(PL_curcop, PL_copline); - Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be =="); + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Found = in conditional, should be =="); CopLINE_set(PL_curcop, oldline); } } @@ -1065,7 +1067,7 @@ Perl_scalar(pTHX_ OP *o) break; case OP_SORT: if (ckWARN(WARN_VOID)) - Perl_warner(aTHX_ WARN_VOID, "Useless use of sort in scalar context"); + Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of sort in scalar context"); } return o; } @@ -1279,7 +1281,7 @@ Perl_scalarvoid(pTHX_ OP *o) break; } if (useless && ckWARN(WARN_VOID)) - Perl_warner(aTHX_ WARN_VOID, "Useless use of %s in void context", useless); + Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless); return o; } @@ -2184,7 +2186,7 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) const char *sample = ((left->op_type == OP_RV2AV || left->op_type == OP_PADAV) ? "@array" : "%hash"); - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "Applying %s to %s will act on scalar(%s)", desc, sample, sample); } @@ -2380,7 +2382,7 @@ Perl_localize(pTHX_ OP *o, I32 lex) s++; if (*s == ';' || *s == '=') - Perl_warner(aTHX_ WARN_PARENTHESIS, + Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS), "Parentheses missing around \"%s\" list", lex ? (PL_in_my == KEY_our ? "our" : "my") : "local"); } @@ -3355,7 +3357,7 @@ Perl_package(pTHX_ OP *o) op_free(o); } else { - deprecate_old("\"package\" with no arguments"); + deprecate("\"package\" with no arguments"); sv_setpv(PL_curstname,"<none>"); PL_curstash = Nullhv; } @@ -3896,7 +3898,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) } if (first->op_type == OP_CONST) { if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE)) - Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional"); + Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional"); if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) { op_free(first); *firstp = Nullop; @@ -3943,7 +3945,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) if (warnop) { line_t oldline = CopLINE(PL_curcop); CopLINE_set(PL_curcop, PL_copline); - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "Value of %s%s can be \"0\"; test with defined()", PL_op_desc[warnop], ((warnop == OP_READLINE || warnop == OP_GLOB) @@ -4651,7 +4653,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p) Perl_sv_catpvf(aTHX_ msg, "(%s)", p); else sv_catpv(msg, "none"); - Perl_warner(aTHX_ WARN_PROTOTYPE, "%"SVf, msg); + Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, msg); } } @@ -4791,7 +4793,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1) && ckWARN_d(WARN_PROTOTYPE)) { - Perl_warner(aTHX_ WARN_PROTOTYPE, "Runaway prototype"); + Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype"); } cv_ckproto((CV*)gv, NULL, ps); } @@ -4851,7 +4853,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) line_t oldline = CopLINE(PL_curcop); if (PL_copline != NOLINE) CopLINE_set(PL_curcop, PL_copline); - Perl_warner(aTHX_ WARN_REDEFINE, + Perl_warner(aTHX_ packWARN(WARN_REDEFINE), CvCONST(cv) ? "Constant subroutine %s redefined" : "Subroutine %s redefined", name); CopLINE_set(PL_curcop, oldline); @@ -5119,7 +5121,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) PL_checkav = newAV(); DEBUG_x( dump_sub(gv) ); if (PL_main_start && ckWARN(WARN_VOID)) - Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block"); + Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run CHECK block"); av_unshift(PL_checkav, 1); av_store(PL_checkav, 0, (SV*)cv); GvCV(gv) = 0; /* cv has been hijacked */ @@ -5129,7 +5131,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) PL_initav = newAV(); DEBUG_x( dump_sub(gv) ); if (PL_main_start && ckWARN(WARN_VOID)) - Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block"); + Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT block"); av_push(PL_initav, (SV*)cv); GvCV(gv) = 0; /* cv has been hijacked */ } @@ -5210,7 +5212,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) line_t oldline = CopLINE(PL_curcop); if (PL_copline != NOLINE) CopLINE_set(PL_curcop, PL_copline); - Perl_warner(aTHX_ WARN_REDEFINE, + Perl_warner(aTHX_ packWARN(WARN_REDEFINE), CvCONST(cv) ? "Constant subroutine %s redefined" : "Subroutine %s redefined" ,name); @@ -5270,7 +5272,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) if (!PL_checkav) PL_checkav = newAV(); if (PL_main_start && ckWARN(WARN_VOID)) - Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block"); + Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run CHECK block"); av_unshift(PL_checkav, 1); av_store(PL_checkav, 0, (SV*)cv); GvCV(gv) = 0; /* cv has been hijacked */ @@ -5279,7 +5281,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) if (!PL_initav) PL_initav = newAV(); if (PL_main_start && ckWARN(WARN_VOID)) - Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block"); + Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT block"); av_push(PL_initav, (SV*)cv); GvCV(gv) = 0; /* cv has been hijacked */ } @@ -5316,7 +5318,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) line_t oldline = CopLINE(PL_curcop); if (PL_copline != NOLINE) CopLINE_set(PL_curcop, PL_copline); - Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name); + Perl_warner(aTHX_ packWARN(WARN_REDEFINE), "Format %s redefined",name); CopLINE_set(PL_curcop, oldline); } SvREFCNT_dec(cv); @@ -5387,7 +5389,7 @@ Perl_oopsAV(pTHX_ OP *o) default: if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsAV"); + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsAV"); break; } return o; @@ -5412,7 +5414,7 @@ Perl_oopsHV(pTHX_ OP *o) default: if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsHV"); + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsHV"); break; } return o; @@ -5427,8 +5429,8 @@ Perl_newAVREF(pTHX_ OP *o) return o; } else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV) - && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) { - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), + && ckWARN(WARN_DEPRECATED)) { + Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Using an array as a reference is deprecated"); } return newUNOP(OP_RV2AV, 0, scalar(o)); @@ -5451,8 +5453,8 @@ Perl_newHVREF(pTHX_ OP *o) return o; } else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV) - && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) { - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), + && ckWARN(WARN_DEPRECATED)) { + Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Using a hash as a reference is deprecated"); } return newUNOP(OP_RV2HV, 0, scalar(o)); @@ -5903,7 +5905,7 @@ Perl_ck_fun(pTHX_ OP *o) case OA_AVREF: if ((type == OP_PUSH || type == OP_UNSHIFT) && !kid->op_sibling && ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Useless use of %s with no values", PL_op_desc[type]); @@ -6673,7 +6675,7 @@ Perl_ck_join(pTHX_ OP *o) char *pmstr = "STRING"; if (PM_GETRE(kPMOP)) pmstr = PM_GETRE(kPMOP)->precomp; - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "/%s/ should probably be written as \"%s\"", pmstr, pmstr); } @@ -7088,7 +7090,7 @@ Perl_peep(pTHX_ register OP *o) /* XXX could check prototype here instead of just carping */ SV *sv = sv_newmortal(); gv_efullname3(sv, gv, Nullch); - Perl_warner(aTHX_ WARN_PROTOTYPE, + Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%s() called too early to check prototype", SvPV_nolen(sv)); } @@ -7157,9 +7159,9 @@ Perl_peep(pTHX_ register OP *o) line_t oldline = CopLINE(PL_curcop); CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next)); - Perl_warner(aTHX_ WARN_EXEC, + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Statement unlikely to be reached"); - Perl_warner(aTHX_ WARN_EXEC, + Perl_warner(aTHX_ packWARN(WARN_EXEC), "\t(Maybe you meant system() when you said exec()?)\n"); CopLINE_set(PL_curcop, oldline); } diff --git a/patchlevel.h b/patchlevel.h index d78c1a3281..dc3bd86b7d 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -79,7 +79,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL - ,"DEVEL15108" + ,"DEVEL15172" ,NULL }; @@ -706,18 +706,18 @@ perl_destruct(pTHXx) FREETMPS; if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) { if (PL_scopestack_ix != 0) - Perl_warner(aTHX_ WARN_INTERNAL, + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Unbalanced scopes: %ld more ENTERs than LEAVEs\n", (long)PL_scopestack_ix); if (PL_savestack_ix != 0) - Perl_warner(aTHX_ WARN_INTERNAL, + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Unbalanced saves: %ld more saves than restores\n", (long)PL_savestack_ix); if (PL_tmps_floor != -1) - Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n", + Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced tmps: %ld more allocs than frees\n", (long)PL_tmps_floor + 1); if (cxstack_ix != -1) - Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced context: %ld more PUSHes than POPs\n", + Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n", (long)cxstack_ix + 1); } @@ -758,7 +758,7 @@ perl_destruct(pTHXx) hent = array[0]; for (;;) { if (hent && ckWARN_d(WARN_INTERNAL)) { - Perl_warner(aTHX_ WARN_INTERNAL, + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Unbalanced string table refcount: (%d) for \"%s\"", HeVAL(hent) - Nullsv, HeKEY(hent)); HeVAL(hent) = Nullsv; @@ -794,7 +794,7 @@ perl_destruct(pTHXx) SvREADONLY_off(&PL_sv_undef); if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count); + Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count); #if defined(PERLIO_LAYERS) /* No more IO - including error messages ! */ @@ -1350,7 +1350,7 @@ print \" \\@INC:\\n @INC\\n\";"); Sighandler_t sigstate = rsignal_state(SIGCHLD); if (sigstate == SIG_IGN) { if (ckWARN(WARN_SIGNAL)) - Perl_warner(aTHX_ WARN_SIGNAL, + Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "Can't ignore signal CHLD, forcing to default"); (void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL); } @@ -2272,7 +2272,7 @@ Perl_moreswitches(pTHX_ char *s) PL_debug |= DEBUG_TOP_FLAG; #else if (ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ WARN_DEBUGGING, + Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Recompile perl with -DDEBUGGING to use -D switch\n"); for (s++; isALNUM(*s); s++) ; #endif @@ -3441,7 +3441,13 @@ S_procself_val(pTHX_ SV *sv, char *arg0) { char buf[MAXPATHLEN]; int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1); - if (len > 0) { + /* FreeBSD's implementation is acknowledged to be imperfect, sometimes + returning the text "unknown" from the readlink rather than the path + to the executable (or returning an error from the readlink). Any valid + path has a '/' in it somewhere, so use that to validate the result. + See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703 + */ + if (len > 0 && memchr(buf, '/', len)) { sv_setpvn(sv,buf,len); } else { @@ -21,6 +21,10 @@ #define USE_STDIO #endif /* PERL_FOR_X2P */ +#if defined(DGUX) +#include <sys/fcntl.h> +#endif + #define VOIDUSED 1 #ifdef PERL_MICRO # include "uconfig.h" diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 65e7fcffd5..77056e4456 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2566,19 +2566,6 @@ known but the current suspect is the F<ixemul> library. Don't panic. Read INSTALL 'make test' section instead. -=head2 FreeBSD 4.3, 4.4, 4.5 fail lib/File/Spec/t/rel2abs2rel.t - -F<lib/File/Spec/t/rel2abs2rel.t> tests that "`` works" by running a a perl 1 -liner in backticks, using "$^X" as the path to perl. It is known to be -failing on FreeBSD 4.3, 4.4 and 4.5, but only when run as part of make test. -This seems to be a kernel problem rather than perl - reading the symlink -F</proc/curproc/file> returns "unknown" rather than the path to perl, and a -kernel debugger reveals that variable C<numfullpathfail2> in -F</usr/src/sys/kern/vfs_cache.c> is being incremented whenever -F</proc/curproc/file> fails to return the perl executable's path. -[If you find that if fails on other versions of FreeBSD, please use perlbug -to report them to us. If you are able to fix the bug, even better.] - =head2 HP-UX lib/posix Subtest 9 Fails When LP64-Configured If perl is configured with -Duse64bitall, the successful result of the diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 3cd4ece052..c86ed26e5a 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -183,12 +183,26 @@ spots. This is now heavily deprecated. must either both be scalars or both be lists. Otherwise Perl won't know which context to supply to the right side. -=item Attempt to access key '%_' in fixed hash +=item Attempt to access disallowed key '%s' in a fixed hash -(F) A hash has been marked as READONLY at the C level to turn it -into a "record" with a fixed set of keys. The failing code -has attempted to get or set the value of a key which does not -exist or to delete a key. +(F) The failing code has attempted to get or set a key which is not in +the current set of allowed keys of a fixed hash. + +=item Attempt to clear a fixed hash + +(F) It is currently not allowed to clear a fixed hash, even if the +new hash would contain the same keys as before. This may change in +the future. + +=item Attempt to delete readonly key '%s' from a fixed hash + +(F) The failing code attempted to delete a key whose value has been +declared readonly from a fixed hash. + +=item Attempt to delete disallowed key '%s' from a fixed hash + +(F) The failing code attempted to delete from a fixed hash a key which +is not in its key set. =item Attempt to bless into a reference diff --git a/pod/perlfaq.pod b/pod/perlfaq.pod index 059dd13c34..4fc7b8a21f 100644 --- a/pod/perlfaq.pod +++ b/pod/perlfaq.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq - frequently asked questions about Perl ($Date: 2002/01/31 04:27:54 $) +perlfaq - frequently asked questions about Perl ($Date: 2002/03/11 21:32:23 $) =head1 DESCRIPTION @@ -341,6 +341,10 @@ Why aren't my random numbers random? =item * +How do I get a random number between X and Y? + +=item * + How do I find the week-of-the-year/day-of-the-year? =item * diff --git a/pod/perlfaq1.pod b/pod/perlfaq1.pod index f2154d2a1e..89fe4dd915 100644 --- a/pod/perlfaq1.pod +++ b/pod/perlfaq1.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq1 - General Questions About Perl ($Revision: 1.6 $, $Date: 2002/01/31 01:46:23 $) +perlfaq1 - General Questions About Perl ($Revision: 1.7 $, $Date: 2002/02/21 14:49:15 $) =head1 DESCRIPTION @@ -216,7 +216,7 @@ i.e. the current interpreter. Hence Tom's quip that "Nothing but perl can parse Perl." You may or may not choose to follow this usage. For example, parallelism means "awk and perl" and "Python and Perl" look OK, while "awk and Perl" and "Python and perl" do not. But never -write "PERL", because perl isn't really an acronym, apocryphal +write "PERL", because perl is not an acronym, apocryphal folklore and post-facto expansions notwithstanding. =head2 Is it a Perl program or a Perl script? diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod index da70187acd..ad7351d650 100644 --- a/pod/perlfaq2.pod +++ b/pod/perlfaq2.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.8 $, $Date: 2002/02/08 22:31:57 $) +perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.9 $, $Date: 2002/03/09 21:01:13 $) =head1 DESCRIPTION @@ -183,7 +183,7 @@ following groups: comp.infosystems.www.authoring.cgi Writing CGI scripts for the Web. -There is also Usenet gateway to Perl mailing lists sponsored by perl.org at +There is also a Usenet gateway to Perl mailing lists sponsored by perl.org at nntp://nntp.perl.org, or a web interface to the same lists at http://nntp.perl.org/group/. Other groups are listed at http://lists.perl.org. diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod index 8df3c8281d..b530516431 100644 --- a/pod/perlfaq4.pod +++ b/pod/perlfaq4.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq4 - Data Manipulation ($Revision: 1.14 $, $Date: 2002/02/08 22:30:23 $) +perlfaq4 - Data Manipulation ($Revision: 1.19 $, $Date: 2002/03/11 22:15:19 $) =head1 DESCRIPTION @@ -346,6 +346,20 @@ random numbers, but this takes quite a while. If you want a better pseudorandom generator than comes with your operating system, look at ``Numerical Recipes in C'' at http://www.nr.com/ . +=head2 How do I get a random number between X and Y? + +Use the following simple function. It selects a random integer between +(and possibly including!) the two given integers, e.g., +C<random_int_in(50,120)> + + sub random_int_in ($$) { + my($min, $max) = @_; + # Assumes that the two arguments are integers themselves! + return $min if $min == $max; + ($min, $max) = ($max, $min) if $min > $max; + return $min + int rand(1 + $max - $min); + } + =head1 Data: Dates =head2 How do I find the week-of-the-year/day-of-the-year? @@ -690,6 +704,11 @@ integers: while ($string =~ /-\d+/g) { $count++ } print "There are $count negative numbers in the string"; +Another version uses a global match in list context, then assigns the +result to a scalar, producing a count of the number of matches. + + $count = () = $string =~ /-\d+/g; + =head2 How do I capitalize all the words on one line? To make the first letter of each word upper case: @@ -1125,11 +1144,11 @@ designed to answer this question quickly and efficiently. Arrays aren't. That being said, there are several ways to approach this. If you are going to make this query many times over arbitrary string values, -the fastest way is probably to invert the original array and keep an -associative array lying about whose keys are the first array's values. +the fastest way is probably to invert the original array and maintain a +hash whose keys are the first array's values. @blues = qw/azure cerulean teal turquoise lapis-lazuli/; - undef %is_blue; + %is_blue = (); for (@blues) { $is_blue{$_} = 1 } Now you can check whether $is_blue{$some_color}. It might have been a @@ -1139,7 +1158,7 @@ If the values are all small integers, you could use a simple indexed array. This kind of an array will take up less space: @primes = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31); - undef @is_tiny_prime; + @is_tiny_prime = (); for (@primes) { $is_tiny_prime[$_] = 1 } # or simply @istiny_prime[@primes] = (1) x @primes; @@ -1885,9 +1904,9 @@ Assuming that you don't care about IEEE notations like "NaN" or if (/^-?\d+$/) { print "is an integer\n" } if (/^[+-]?\d+$/) { print "is a +/- integer\n" } if (/^-?\d+\.?\d*$/) { print "is a real number\n" } - if (/^-?(?:\d+(?:\.\d*)?|\.\d+)$/) { print "is a decimal number" } + if (/^-?(?:\d+(?:\.\d*)?|\.\d+)$/) { print "is a decimal number\n" } if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) - { print "a C float" } + { print "a C float\n" } If you're on a POSIX system, Perl's supports the C<POSIX::strtod> function. Its semantics are somewhat cumbersome, so here's a C<getnum> diff --git a/pod/perlfaq5.pod b/pod/perlfaq5.pod index 695b5361e8..986333465b 100644 --- a/pod/perlfaq5.pod +++ b/pod/perlfaq5.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq5 - Files and Formats ($Revision: 1.9 $, $Date: 2002/02/11 19:30:21 $) +perlfaq5 - Files and Formats ($Revision: 1.12 $, $Date: 2002/03/11 22:25:25 $) =head1 DESCRIPTION @@ -350,37 +350,23 @@ See L<perlform/"Accessing Formatting Internals"> for an swrite() function. =head2 How can I output my numbers with commas added? -This one will do it for you: +This one from Benjamin Goldberg will do it for you: - sub commify { - my $number = shift; - 1 while ($number =~ s/^([-+]?\d+)(\d{3})/$1,$2/); - return $number; - } - - $n = 23659019423.2331; - print "GOT: ", commify($n), "\n"; - - GOT: 23,659,019,423.2331 - -You can't just: - - s/^([-+]?\d+)(\d{3})/$1,$2/g; + s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; -because you have to put the comma in and then recalculate your -position. +or written verbosely: -Alternatively, this code commifies all numbers in a line regardless of -whether they have decimal portions, are preceded by + or -, or -whatever: - - # from Andrew Johnson <ajohnson@gpu.srv.ualberta.ca> - sub commify { - my $input = shift; - $input = reverse $input; - $input =~ s<(\d\d\d)(?=\d)(?!\d*\.)><$1,>g; - return scalar reverse $input; - } + s/( + ^[-+]? # beginning of number. + \d{1,3}? # first digits before first comma + (?= # followed by, (but not included in the match) : + (?>(?:\d{3})+) # some positive multiple of three digits. + (?!\d) # an *exact* multiple, not x * 3 + 1 or whatever. + ) + | # or: + \G\d{3} # after the last group, get three digits + (?=\d) # but they have to have more digits after them. + )/$1,/xg; =head2 How can I translate tildes (~) in a filename? @@ -501,35 +487,24 @@ best therefore to use glob() only in list context. Normally perl ignores trailing blanks in filenames, and interprets certain leading characters (or a trailing "|") to mean something -special. To avoid this, you might want to use a routine like the one below. -It turns incomplete pathnames into explicit relative ones, and tacks a -trailing null byte on the name to make perl leave it alone: - - sub safe_filename { - local $_ = shift; - s#^([^./])#./$1#; - $_ .= "\0"; - return $_; - } +special. - $badpath = "<<<something really wicked "; - $fn = safe_filename($badpath"); - open(FH, "> $fn") or "couldn't open $badpath: $!"; +The three argument form of open() lets you specify the mode +separately from the filename. The open() function treats +special mode characters and whitespace in the filename as +literals -This assumes that you are using POSIX (portable operating systems -interface) paths. If you are on a closed, non-portable, proprietary -system, you may have to adjust the C<"./"> above. + open FILE, "<", " file "; # filename is " file " + open FILE, ">", ">file"; # filename is ">file" + -It would be a lot clearer to use sysopen(), though: +It may be a lot clearer to use sysopen(), though: use Fcntl; $badpath = "<<<something really wicked "; sysopen (FH, $badpath, O_WRONLY | O_CREAT | O_TRUNC) or die "can't open $badpath: $!"; -For more information, see also the new L<perlopentut> if you have it -(new for 5.6). - =head2 How can I reliably rename a file? If your operating system supports a proper mv(1) utility or its functional @@ -688,14 +663,17 @@ Don't forget them or you'll be quite sorry. =head2 How do I get a file's timestamp in perl? -If you want to retrieve the time at which the file was last read, -written, or had its meta-data (owner, etc) changed, you use the B<-M>, -B<-A>, or B<-C> file test operations as documented in L<perlfunc>. These -retrieve the age of the file (measured against the start-time of your -program) in days as a floating point number. To retrieve the "raw" -time in seconds since the epoch, you would call the stat function, -then use localtime(), gmtime(), or POSIX::strftime() to convert this -into human-readable form. +If you want to retrieve the time at which the file was last +read, written, or had its meta-data (owner, etc) changed, +you use the B<-M>, B<-A>, or B<-C> file test operations as +documented in L<perlfunc>. These retrieve the age of the +file (measured against the start-time of your program) in +days as a floating point number. Some platforms may not have +all of these times. See L<perlport> for details. To +retrieve the "raw" time in seconds since the epoch, you +would call the stat function, then use localtime(), +gmtime(), or POSIX::strftime() to convert this into +human-readable form. Here's an example: @@ -1021,7 +999,7 @@ Or, just use the fdopen(3S) feature of open(): close F; } -=head2 Why can't I use "C:\temp\foo" in DOS paths? What doesn't `C:\temp\foo.exe` work? +=head2 Why can't I use "C:\temp\foo" in DOS paths? Why doesn't `C:\temp\foo.exe` work? Whoops! You just put a tab and a formfeed into that filename! Remember that within double quoted strings ("like\this"), the diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 9af82a54cc..cda5285d7d 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -886,7 +886,7 @@ actions depending on which function is being called. Function pointer Action taken ---------------- ------------ - svt_get Do something after the value of the SV is retrieved. + svt_get Do something before the value of the SV is retrieved. svt_set Do something after the SV is assigned a value. svt_len Report on the SV's length. svt_clear Clear something the SV represents. diff --git a/pod/perlreftut.pod b/pod/perlreftut.pod index 073d358da5..1e4ad8f05a 100644 --- a/pod/perlreftut.pod +++ b/pod/perlreftut.pod @@ -65,14 +65,14 @@ references. A reference is a scalar value that I<refers to> an entire array or an entire hash (or to just about anything else). Names are one kind of -reference that you're already familiar with. Think of the President: -a messy, inconvenient bag of blood and bones. But to talk about him, -or to represent him in a computer program, all you need is the easy, -convenient scalar string "Bill Clinton". +reference that you're already familiar with. Think of the President +of the United States: a messy, inconvenient bag of blood and bones. +But to talk about him, or to represent him in a computer program, all +you need is the easy, convenient scalar string "George Bush". References in Perl are like names for arrays and hashes. They're Perl's private, internal names, so you can be sure they're -unambiguous. Unlike "Bill Clinton", a reference only refers to one +unambiguous. Unlike "George Bush", a reference only refers to one thing, and you always know what it refers to. If you have a reference to an array, you can recover the entire array from it. If you have a reference to a hash, you can recover the entire hash. But the diff --git a/pod/perlsub.pod b/pod/perlsub.pod index 7933dc2a64..cff3edadfa 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -169,7 +169,7 @@ Do not, however, be tempted to do this: Like the flattened incoming parameter list, the return list is also flattened on return. So all you have managed to do here is stored -everything in C<@a> and made C<@b> an empty list. See +everything in C<@a> and made C<@b> empty. See L<Pass by Reference> for alternatives. A subroutine may be called using an explicit C<&> prefix. The @@ -727,7 +727,7 @@ table entries: sub ioqueue { local (*READER, *WRITER); # not my! - pipe (READER, WRITER); or die "pipe: $!"; + pipe (READER, WRITER) or die "pipe: $!"; return (*READER, *WRITER); } ($head, $tail) = ioqueue(); diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 604e7f10e8..3e76390151 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -866,16 +866,18 @@ argument is not a HASH or ARRAY element, %s argument is not a HASH or ARRAY element or slice, %s argument is not a subroutine name, Argument "%s" isn't numeric%s, Array @%s missing the @ in argument %d of %s(), assertion botched: %s, Assertion failed: file "%s", Assignment to both a list and a -scalar, Attempt to access key '%_' in fixed hash, Attempt to bless into a -reference, Attempt to free non-arena SV: 0x%lx, Attempt to free nonexistent -shared string, Attempt to free temp prematurely, Attempt to free -unreferenced glob pointers, Attempt to free unreferenced scalar, Attempt to -join self, Attempt to pack pointer to temporary value, Attempt to use -reference as lvalue in substr, Bad arg length for %s, is %d, should be %s, -Bad evalled substitution pattern, Bad filehandle: %s, Bad free() ignored, -Bad hash, Bad index while coercing array into hash, Badly placed ()'s, Bad -name after %s::, Bad realloc() ignored, Bad symbol for array, Bad symbol -for filehandle, Bad symbol for hash, Bareword found in conditional, +scalar, Attempt to access disallowed key '%s' in a fixed hash, Attempt to +clear a fixed hash, Attempt to delete readonly key '%s' from a fixed hash, +Attempt to delete disallowed key '%s' from a fixed hash, Attempt to bless +into a reference, Attempt to free non-arena SV: 0x%lx, Attempt to free +nonexistent shared string, Attempt to free temp prematurely, Attempt to +free unreferenced glob pointers, Attempt to free unreferenced scalar, +Attempt to join self, Attempt to pack pointer to temporary value, Attempt +to use reference as lvalue in substr, Bad arg length for %s, is %d, should +be %s, Bad evalled substitution pattern, Bad filehandle: %s, Bad free() +ignored, Bad hash, Bad index while coercing array into hash, Badly placed +()'s, Bad name after %s::, Bad realloc() ignored, Bad symbol for array, Bad +symbol for filehandle, Bad symbol for hash, Bareword found in conditional, Bareword "%s" not allowed while "strict subs" in use, Bareword "%s" refers to nonexistent package, BEGIN failed--compilation aborted, BEGIN not safe after errors--compilation aborted, \1 better written as $1, Binary number > @@ -2382,8 +2384,6 @@ v1.30, 03 August 1998, v1.23, 10 July 1998 =item AUTHORS / CONTRIBUTORS -=item VERSION - =back =head2 perllocale - Perl locale handling (internationalization and @@ -2553,13 +2553,7 @@ to enable UTF-8/UTF-EBCDIC in scripts =item Character encodings for input and output -=back - -=item CAVEATS - -=item UNICODE REGULAR EXPRESSION SUPPORT LEVEL - -=over 4 +=item Unicode Regular Expression Support Level =item Unicode Encodings @@ -2571,7 +2565,7 @@ to enable UTF-8/UTF-EBCDIC in scripts =back -=item SEE ALSO +=item BUGS =back @@ -4615,8 +4609,8 @@ PL_modglobal, PL_na, PL_sv_no, PL_sv_undef, PL_sv_yes =item GV Functions -GvSV, gv_fetchmeth, gv_fetchmethod, gv_fetchmethod_autoload, gv_stashpv, -gv_stashsv +GvSV, gv_fetchmeth, gv_fetchmethod, gv_fetchmethod_autoload, +gv_fetchmeth_autoload, gv_stashpv, gv_stashsv =item Handy Values @@ -4669,22 +4663,22 @@ svtype, SVt_IV, SVt_NV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG =item SV Manipulation Functions -get_sv, looks_like_number, newRV_inc, newRV_noinc, newSV, newSViv, newSVnv, -newSVpv, newSVpvf, newSVpvn, newSVpvn_share, newSVrv, newSVsv, newSVuv, -new_vstring, SvCUR, SvCUR_set, SvEND, SvGROW, SvIOK, SvIOKp, SvIOK_notUV, -SvIOK_off, SvIOK_on, SvIOK_only, SvIOK_only_UV, SvIOK_UV, SvIV, SvIVX, -SvIVx, SvLEN, SvNIOK, SvNIOKp, SvNIOK_off, SvNOK, SvNOKp, SvNOK_off, -SvNOK_on, SvNOK_only, SvNV, SvNVx, SvNVX, SvOK, SvOOK, SvPOK, SvPOKp, -SvPOK_off, SvPOK_on, SvPOK_only, SvPOK_only_UTF8, SvPV, SvPVbyte, -SvPVbytex, SvPVbytex_force, SvPVbyte_force, SvPVbyte_nolen, SvPVutf8, -SvPVutf8x, SvPVutf8x_force, SvPVutf8_force, SvPVutf8_nolen, SvPVx, SvPVX, -SvPV_force, SvPV_force_nomg, SvPV_nolen, SvREFCNT, SvREFCNT_dec, -SvREFCNT_inc, SvROK, SvROK_off, SvROK_on, SvRV, SvSTASH, SvTAINT, -SvTAINTED, SvTAINTED_off, SvTAINTED_on, SvTRUE, SvTYPE, SvUNLOCK, SvUOK, -SvUPGRADE, SvUTF8, SvUTF8_off, SvUTF8_on, SvUV, SvUVX, SvUVx, sv_2bool, -sv_2cv, sv_2io, sv_2iv, sv_2mortal, sv_2nv, sv_2pvbyte, sv_2pvbyte_nolen, -sv_2pvutf8, sv_2pvutf8_nolen, sv_2pv_flags, sv_2pv_nolen, sv_2uv, -sv_backoff, sv_bless, sv_catpv, sv_catpvf, sv_catpvf_mg, sv_catpvn, +get_sv, looks_like_number, memcmp_byte_utf8, newRV_inc, newRV_noinc, newSV, +newSViv, newSVnv, newSVpv, newSVpvf, newSVpvn, newSVpvn_share, newSVrv, +newSVsv, newSVuv, new_vstring, SvCUR, SvCUR_set, SvEND, SvGROW, SvIOK, +SvIOKp, SvIOK_notUV, SvIOK_off, SvIOK_on, SvIOK_only, SvIOK_only_UV, +SvIOK_UV, SvIV, SvIVx, SvIVX, SvLEN, SvNIOK, SvNIOKp, SvNIOK_off, SvNOK, +SvNOKp, SvNOK_off, SvNOK_on, SvNOK_only, SvNV, SvNVx, SvNVX, SvOK, SvOOK, +SvPOK, SvPOKp, SvPOK_off, SvPOK_on, SvPOK_only, SvPOK_only_UTF8, SvPV, +SvPVbyte, SvPVbytex, SvPVbytex_force, SvPVbyte_force, SvPVbyte_nolen, +SvPVutf8, SvPVutf8x, SvPVutf8x_force, SvPVutf8_force, SvPVutf8_nolen, +SvPVx, SvPVX, SvPV_force, SvPV_force_nomg, SvPV_nolen, SvREFCNT, +SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off, SvROK_on, SvRV, SvSTASH, +SvTAINT, SvTAINTED, SvTAINTED_off, SvTAINTED_on, SvTRUE, SvTYPE, SvUNLOCK, +SvUOK, SvUPGRADE, SvUTF8, SvUTF8_off, SvUTF8_on, SvUV, SvUVx, SvUVX, +sv_2bool, sv_2cv, sv_2io, sv_2iv, sv_2mortal, sv_2nv, sv_2pvbyte, +sv_2pvbyte_nolen, sv_2pvutf8, sv_2pvutf8_nolen, sv_2pv_flags, sv_2pv_nolen, +sv_2uv, sv_backoff, sv_bless, sv_catpv, sv_catpvf, sv_catpvf_mg, sv_catpvn, sv_catpvn_flags, sv_catpvn_mg, sv_catpv_mg, sv_catsv, sv_catsv_flags, sv_catsv_mg, sv_chop, sv_clear, sv_cmp, sv_cmp_locale, sv_collxfrm, sv_copypv, sv_dec, sv_derived_from, sv_eq, sv_force_normal, @@ -5037,6 +5031,8 @@ PerlIO_apply_layers(f,mode,layers), PerlIO_binmode(f,ptype,imode,layers), =item Make v-strings overloaded objects +=item Allow restricted hash assignment + =back =item Vague ideas @@ -5384,8 +5380,6 @@ I<The Road goes ever on and on, down from the door where it began.> =item New Unicode Properties -=item Perl Parser Stress Tested - =item REF(...) Instead Of SCALAR(...) =item pack/unpack D/F recycled @@ -5462,12 +5456,6 @@ I<The Road goes ever on and on, down from the door where it began.> =item lib/ftmp-security tests warn 'system possibly insecure' -=item Cygwin intermittent failures of lib/Memoize/t/expire_file 11 and 12 - -=item FreeBSD 4.5 fails lib/File/Spec/t/rel2abs2rel.t - -=item HP-UX lib/io_multihomed Fails When LP64-Configured - =item HP-UX lib/posix Subtest 9 Fails When LP64-Configured =item Linux With Sfio Fails op/misc Test 48 @@ -7337,50 +7325,6 @@ Source, Compiled Module Source, Perl Modules/Scripts =back -=head2 perldos - Perl under DOS, W31, W95. - -=over 4 - -=item SYNOPSIS - -=item DESCRIPTION - -=over 4 - -=item Prerequisites for Compiling Perl on DOS - -DJGPP, Pthreads - -=item Shortcomings of Perl under DOS - -=item Building Perl on DOS - -=item Testing Perl on DOS - -=item Installation of Perl on DOS - -=back - -=item BUILDING AND INSTALLING MODULES ON DOS - -=over 4 - -=item Building Prerequisites for Perl on DOS - -=item Unpacking CPAN Modules on DOS - -=item Building Non-XS Modules on DOS - -=item Building XS Modules on DOS - -=back - -=item AUTHOR - -=item SEE ALSO - -=back - =head2 perlepoc, README.epoc - Perl for EPOC =over 4 @@ -8961,7 +8905,7 @@ code =item Utility functions $num_octets = utf8::upgrade($string);, utf8::downgrade($string[, CHECK]), -utf8::encode($string), $flag = utf8::decode($string) +utf8::encode($string) =back @@ -10458,13 +10402,13 @@ C<d_strtoll>, C<d_strtoq>, C<d_strtoul>, C<d_strtoull>, C<d_strtouq>, C<d_strxfrm>, C<d_suidsafe>, C<d_symlink>, C<d_syscall>, C<d_syscallproto>, C<d_sysconf>, C<d_sysernlst>, C<d_syserrlst>, C<d_system>, C<d_tcgetpgrp>, C<d_tcsetpgrp>, C<d_telldir>, C<d_telldirproto>, C<d_time>, C<d_times>, -C<d_truncate>, C<d_tzname>, C<d_u32align>, C<d_ualarm>, C<d_umask>, -C<d_uname>, C<d_union_semun>, C<d_unordered>, C<d_usleep>, -C<d_usleepproto>, C<d_ustat>, C<d_vendorarch>, C<d_vendorbin>, -C<d_vendorlib>, C<d_vfork>, C<d_void_closedir>, C<d_voidsig>, C<d_voidtty>, -C<d_volatile>, C<d_vprintf>, C<d_wait4>, C<d_waitpid>, C<d_wcstombs>, -C<d_wctomb>, C<d_writev>, C<d_xenix>, C<date>, C<db_hashtype>, -C<db_prefixtype>, C<db_version_major>, C<db_version_minor>, +C<d_tm_tm_gmtoff>, C<d_tm_tm_zone>, C<d_truncate>, C<d_tzname>, +C<d_u32align>, C<d_ualarm>, C<d_umask>, C<d_uname>, C<d_union_semun>, +C<d_unordered>, C<d_usleep>, C<d_usleepproto>, C<d_ustat>, C<d_vendorarch>, +C<d_vendorbin>, C<d_vendorlib>, C<d_vfork>, C<d_void_closedir>, +C<d_voidsig>, C<d_voidtty>, C<d_volatile>, C<d_vprintf>, C<d_wait4>, +C<d_waitpid>, C<d_wcstombs>, C<d_wctomb>, C<d_writev>, C<d_xenix>, C<date>, +C<db_hashtype>, C<db_prefixtype>, C<db_version_major>, C<db_version_minor>, C<db_version_patch>, C<defvoidused>, C<direntrytype>, C<dlext>, C<dlsrc>, C<doublesize>, C<drand01>, C<dynamic_ext> @@ -10891,6 +10835,70 @@ Dumper =back +=head2 Data::Util - A selection of general-utility data subroutines + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +sv_readonly_flag + +=item AUTHOR + +=item SEE ALSO + +=back + +=head2 Data::Utilib::Data::Util, Data::Util - A selection of +general-utility data subroutines + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +sv_readonly_flag + +=item AUTHOR + +=item SEE ALSO + +=back + +=head2 Data::Utilib::Hash::Util, Hash::Util - A selection of +general-utility hash subroutines + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=over 4 + +=item Restricted hashes + +lock_keys, unlock_keys + +=back + +=back + +lock_value, unlock_value + +B<lock_hash>, B<unlock_hash> + +=over 4 + +=item AUTHOR + +=item SEE ALSO + +=back + =head2 Devel::DProf - a Perl code profiler =over 4 @@ -11203,8 +11211,103 @@ variants of EBCDIC, symbol and dingbats as used by Tk on X11 =head2 Encode::Tcl - Tcl encodings +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=back + +=head2 Encode::Tcl::Escape - Tcl Escape encodings + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=back + +=head2 Encode::Tcl::Extended - Tcl EUC encodings + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=back + +=head2 Encode::Tcl::Table - Tcl Table encodings + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=back + =head2 Encode::lib::Encode::Tcl, Encode::Tcl - Tcl encodings +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=back + +=head2 Encode::lib::Encode::Tcl::Escape, Encode::Tcl::Escape - Tcl Escape +encodings + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=back + +=head2 Encode::lib::Encode::Tcl::Extended, Encode::Tcl::Extended - Tcl EUC +encodings + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=back + +=head2 Encode::lib::Encode::Tcl::Table, Encode::Tcl::Table - Tcl Table +encodings + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=back + =head2 Encode::lib::EncodeFormat, EncodeFormat - the format of encoding tables of the Encode extension @@ -12988,6 +13091,36 @@ clustering =back +=head2 Hash::Util - A selection of general-utility hash subroutines + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=over 4 + +=item Restricted hashes + +lock_keys, unlock_keys + +=back + +=back + +lock_value, unlock_value + +B<lock_hash>, B<unlock_hash> + +=over 4 + +=item AUTHOR + +=item SEE ALSO + +=back + =head2 I18N::Collate - compare 8-bit scalar data according to the current locale @@ -13931,7 +14064,15 @@ country_code2code( CODE, CODESET, CODESET ) C<all_country_codes( [ CODESET ] )>, C<all_country_names( [ CODESET ] )> -=item CODE ALIASING +=item SEMI-PRIVATE ROUTINES + +=over 4 + +=item alias_code + +=item rename_country + +=back =item EXAMPLES @@ -13941,8 +14082,8 @@ C<all_country_codes( [ CODESET ] )>, C<all_country_names( [ CODESET ] )> =item SEE ALSO -Locale::Language, Locale::Script, Locale::Currency, ISO 3166, -http://www.din.de/gremien/nas/nabd/iso3166ma/, +Locale::Language, Locale::Script, Locale::Currency, Locale::SubCountry, ISO +3166-1, http://www.iso.org/iso/en/prods-services/iso3166ma/index.html, http://www.egt.ie/standards/iso3166/iso3166-1-en.html, http://www.cia.gov/cia/publications/factbook/docs/app-f.html @@ -17148,7 +17289,7 @@ NORMAL TESTS, SKIPPED TESTS, TODO TESTS =item BUGS and CAVEATS -=item TODO +=item NOTE =item SEE ALSO diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 2f840555fb..9695e6d44c 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -525,6 +525,16 @@ Instead of having to guess whether a string is a v-string and thus needs to be displayed with %vd, make v-strings (readonly) objects (class "vstring"?) with a stringify overload. +=head2 Allow restricted hash assignment + +Currently you're not allowed to assign to a restricted hash at all, +even with the same keys. + + %restricted = (foo => 42); # error + +This should be allowed if the new keyset is a subset of the old +keyset. May require more extra code than we'd like in pp_aassign. + =head1 Vague ideas Ideas which have been discussed, and which may or may not happen. diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index a885555640..518d239dd6 100644 --- a/pod/perlunicode.pod +++ b/pod/perlunicode.pod @@ -873,6 +873,10 @@ sv_utf8_upgrade(sv) converts the string of the scalar to its UTF-8 encoded form. sv_utf8_downgrade(sv) does the opposite (if possible). sv_utf8_encode(sv) is like sv_utf8_upgrade but the UTF8 flag does not get turned on. sv_utf8_decode() does the opposite of sv_utf8_encode(). +Note that none of these are to be used as general purpose encoding/decoding +interfaces: use Encode for that. sv_utf8_upgrade() is affected by the +encoding pragma, but sv_utf8_downgrade() is not (since the encoding +pragma is designed to be a one-way street). =item * @@ -519,7 +519,7 @@ PP(pp_bless) Perl_croak(aTHX_ "Attempt to bless into a reference"); ptr = SvPV(ssv,len); if (ckWARN(WARN_MISC) && len == 0) - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "Explicit blessing to '' (assuming package main)"); stash = gv_stashpvn(ptr, len, TRUE); } @@ -555,7 +555,7 @@ PP(pp_gelem) case 'F': if (strEQ(elem, "FILEHANDLE")) { /* finally deprecated in 5.8.0 */ - deprecate_old("*glob{FILEHANDLE}"); + deprecate("*glob{FILEHANDLE}"); tmpRef = (SV*)GvIOp(gv); } else @@ -776,7 +776,7 @@ PP(pp_undef) break; case SVt_PVCV: if (ckWARN(WARN_MISC) && cv_const_sv((CV*)sv)) - Perl_warner(aTHX_ WARN_MISC, "Constant subroutine %s undefined", + Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined", CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv))); /* FALL THROUGH */ case SVt_PVFM: @@ -1389,7 +1389,7 @@ PP(pp_subtract) buv = (UV)-biv; } /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve, - else "IV" now, independant of how it came in. + else "IV" now, independent of how it came in. if a, b represents positive, A, B negative, a maps to -A etc a - b => (a - b) A - b => -(a + b) @@ -2956,7 +2956,7 @@ PP(pp_substr) if (lvalue || repl) Perl_croak(aTHX_ "substr outside of string"); if (ckWARN(WARN_SUBSTR)) - Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string"); + Perl_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string"); RETPUSHUNDEF; } else { @@ -2992,7 +2992,7 @@ PP(pp_substr) STRLEN n_a; SvPV_force(sv,n_a); if (ckWARN(WARN_SUBSTR)) - Perl_warner(aTHX_ WARN_SUBSTR, + Perl_warner(aTHX_ packWARN(WARN_SUBSTR), "Attempt to use reference as lvalue in substr"); } if (SvOK(sv)) /* is it defined ? */ @@ -3867,7 +3867,7 @@ PP(pp_anonhash) if (MARK < SP) sv_setsv(val, *++MARK); else if (ckWARN(WARN_MISC)) - Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in anonymous hash"); + Perl_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash"); (void)hv_store_ent(hv,key,val,0); } SP = ORIGMARK; @@ -3928,7 +3928,7 @@ PP(pp_splice) } if (offset > AvFILLp(ary) + 1) { if (ckWARN(WARN_MISC)) - Perl_warner(aTHX_ WARN_MISC, "splice() offset past end of array" ); + Perl_warner(aTHX_ packWARN(WARN_MISC), "splice() offset past end of array" ); offset = AvFILLp(ary) + 1; } after = AvFILLp(ary) + 1 - (offset + length); @@ -396,7 +396,7 @@ PP(pp_formline) else { sv = &PL_sv_no; if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, "Not enough format arguments"); + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments"); } break; @@ -1022,27 +1022,27 @@ S_dopoptolabel(pTHX_ char *label) switch (CxTYPE(cx)) { case CXt_SUBST: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s", OP_NAME(PL_op)); break; case CXt_SUB: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s", OP_NAME(PL_op)); break; case CXt_FORMAT: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s", OP_NAME(PL_op)); break; case CXt_EVAL: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s", OP_NAME(PL_op)); break; case CXt_NULL: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s", OP_NAME(PL_op)); return -1; case CXt_LOOP: @@ -1157,27 +1157,27 @@ S_dopoptoloop(pTHX_ I32 startingblock) switch (CxTYPE(cx)) { case CXt_SUBST: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s", OP_NAME(PL_op)); break; case CXt_SUB: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s", OP_NAME(PL_op)); break; case CXt_FORMAT: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s", OP_NAME(PL_op)); break; case CXt_EVAL: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s", OP_NAME(PL_op)); break; case CXt_NULL: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s", OP_NAME(PL_op)); return -1; case CXt_LOOP: @@ -1268,7 +1268,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) sv_catpvn(err, message, msglen); if (ckWARN(WARN_MISC)) { STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; - Perl_warner(aTHX_ WARN_MISC, SvPVX(err)+start); + Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX(err)+start); } } } @@ -2913,7 +2913,7 @@ PP(pp_require) PERL_VERSION, PERL_SUBVERSION); } if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ WARN_PORTABLE, + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), "v-string in use/require non-portable"); RETPUSHYES; } @@ -170,7 +170,7 @@ PP(pp_concat) if (llen >= 2 && lpv[llen - 2] == '1' && lpv[llen - 1] == '9' && (llen == 2 || !isDIGIT(lpv[llen - 3]))) { - Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s", + Perl_warner(aTHX_ packWARN(WARN_Y2K), "Possible Y2K bug: %s", "about to append an integer to '19'"); } } @@ -421,7 +421,7 @@ PP(pp_add) buv = (UV)-biv; } /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve, - else "IV" now, independant of how it came in. + else "IV" now, independent of how it came in. if a, b represents positive, A, B negative, a maps to -A etc a + b => (a + b) A + b => -(a - b) @@ -927,11 +927,11 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) (SvTYPE(SvRV(*relem)) == SVt_PVAV || SvTYPE(SvRV(*relem)) == SVt_PVHV)) { - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "Reference found where even-sized list expected"); } else - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in hash assignment"); } if (SvTYPE(hash) == SVt_PVAV) { @@ -1488,7 +1488,7 @@ Perl_do_readline(pTHX) if (ckWARN2(WARN_GLOB, WARN_CLOSED) && (!io || !(IoFLAGS(io) & IOf_START))) { if (type == OP_GLOB) - Perl_warner(aTHX_ WARN_GLOB, + Perl_warner(aTHX_ packWARN(WARN_GLOB), "glob failed (can't start child: %s)", Strerror(errno)); else @@ -1545,7 +1545,7 @@ Perl_do_readline(pTHX) } else if (type == OP_GLOB) { if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) { - Perl_warner(aTHX_ WARN_GLOB, + Perl_warner(aTHX_ packWARN(WARN_GLOB), "glob failed (child exited with status %d%s)", (int)(STATUS_CURRENT >> 8), (STATUS_CURRENT & 0x80) ? ", core dumped" : ""); @@ -2879,11 +2879,11 @@ void Perl_sub_crush_depth(pTHX_ CV *cv) { if (CvANON(cv)) - Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on anonymous subroutine"); + Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine"); else { SV* tmpstr = sv_newmortal(); gv_efullname3(tmpstr, CvGV(cv), Nullch); - Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on subroutine \"%s\"", + Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%s\"", SvPVX(tmpstr)); } } @@ -2900,7 +2900,7 @@ PP(pp_aelem) SV *sv; if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)) - Perl_warner(aTHX_ WARN_MISC, "Use of reference \"%s\" as array index", SvPV_nolen(elemsv)); + Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%s\" as array index", SvPV_nolen(elemsv)); if (elem > 0) elem -= PL_curcop->cop_arybase; if (SvTYPE(av) != SVt_PVAV) @@ -207,7 +207,7 @@ S_measure_struct(pTHX_ char *pat, register char *patend) Perl_croak(aTHX_ "%s not allowed in length fields", buf); case ',': /* grandfather in commas but with a warning */ if (commas++ == 0 && ckWARN(WARN_UNPACK)) - Perl_warner(aTHX_ WARN_UNPACK, + Perl_warner(aTHX_ packWARN(WARN_UNPACK), "Invalid type in unpack: '%c'", (int)datumtype); /* FALL THROUGH */ case '%': @@ -500,7 +500,7 @@ Perl_unpack_str(pTHX_ char *pat, register char *patend, register char *s, char * Perl_croak(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype); case ',': /* grandfather in commas but with a warning */ if (commas++ == 0 && ckWARN(WARN_UNPACK)) - Perl_warner(aTHX_ WARN_UNPACK, + Perl_warner(aTHX_ packWARN(WARN_UNPACK), "Invalid type in unpack: '%c'", (int)datumtype); break; case '%': @@ -1794,7 +1794,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg Perl_croak(aTHX_ "Invalid type in pack: '%c'", (int)datumtype); case ',': /* grandfather in commas but with a warning */ if (commas++ == 0 && ckWARN(WARN_PACK)) - Perl_warner(aTHX_ WARN_PACK, + Perl_warner(aTHX_ packWARN(WARN_PACK), "Invalid type in pack: '%c'", (int)datumtype); break; case '%': @@ -2016,7 +2016,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg aint = SvIV(fromstr); if ((aint < 0 || aint > 255) && ckWARN(WARN_PACK)) - Perl_warner(aTHX_ WARN_PACK, + Perl_warner(aTHX_ packWARN(WARN_PACK), "Character in \"C\" format wrapped"); achar = aint & 255; sv_catpvn(cat, &achar, sizeof(char)); @@ -2025,7 +2025,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg aint = SvIV(fromstr); if ((aint < -128 || aint > 127) && ckWARN(WARN_PACK)) - Perl_warner(aTHX_ WARN_PACK, + Perl_warner(aTHX_ packWARN(WARN_PACK), "Character in \"c\" format wrapped"); achar = aint & 255; sv_catpvn(cat, &achar, sizeof(char)); @@ -2353,7 +2353,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg || (SvPADTMP(fromstr) && !SvREADONLY(fromstr)))) { - Perl_warner(aTHX_ WARN_PACK, + Perl_warner(aTHX_ packWARN(WARN_PACK), "Attempt to pack pointer to temporary value"); } if (SvPOK(fromstr) || SvNIOK(fromstr)) @@ -852,7 +852,7 @@ PP(pp_untie) } else if (ckWARN(WARN_UNTIE)) { if (mg && SvREFCNT(obj) > 1) - Perl_warner(aTHX_ WARN_UNTIE, + Perl_warner(aTHX_ packWARN(WARN_UNTIE), "untie attempted while %"UVuf" inner references still exist", (UV)SvREFCNT(obj) - 1 ) ; } @@ -1357,10 +1357,10 @@ PP(pp_leavewrite) name = SvPV_nolen(sv); } if (name && *name) - Perl_warner(aTHX_ WARN_IO, + Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle %s opened only for input", name); else - Perl_warner(aTHX_ WARN_IO, + Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle opened only for input"); } else if (ckWARN(WARN_CLOSED)) @@ -1371,7 +1371,7 @@ PP(pp_leavewrite) else { if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) { if (ckWARN(WARN_IO)) - Perl_warner(aTHX_ WARN_IO, "page overflow"); + Perl_warner(aTHX_ packWARN(WARN_IO), "page overflow"); } if (!do_print(PL_formtarget, fp)) PUSHs(&PL_sv_no); @@ -1443,10 +1443,10 @@ PP(pp_prtf) name = SvPV_nolen(sv); } if (name && *name) - Perl_warner(aTHX_ WARN_IO, + Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle %s opened only for input", name); else - Perl_warner(aTHX_ WARN_IO, + Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle opened only for input"); } else if (ckWARN(WARN_CLOSED)) @@ -1680,10 +1680,10 @@ PP(pp_sysread) name = SvPV_nolen(sv); } if (name && *name) - Perl_warner(aTHX_ WARN_IO, + Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle %s opened only for output", name); else - Perl_warner(aTHX_ WARN_IO, + Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle opened only for output"); } goto say_undef; @@ -2731,7 +2731,7 @@ PP(pp_stat) if (PL_op->op_type == OP_LSTAT) { if (gv != PL_defgv) { if (ckWARN(WARN_IO)) - Perl_warner(aTHX_ WARN_IO, + Perl_warner(aTHX_ packWARN(WARN_IO), "lstat() on filehandle %s", GvENAME(gv)); } else if (PL_laststype != OP_LSTAT) Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat"); @@ -2760,7 +2760,7 @@ PP(pp_stat) else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { gv = (GV*)SvRV(sv); if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO)) - Perl_warner(aTHX_ WARN_IO, + Perl_warner(aTHX_ packWARN(WARN_IO), "lstat() on filehandle %s", GvENAME(gv)); goto do_fstat; } @@ -2775,7 +2775,7 @@ PP(pp_stat) PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache); if (PL_laststatval < 0) { if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n')) - Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "stat"); + Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); max = 0; } } @@ -3321,7 +3321,7 @@ PP(pp_fttext) sv_setpv(PL_statname, SvPV(sv, n_a)); if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) { if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n')) - Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open"); + Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open"); RETPUSHUNDEF; } PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache); @@ -3422,7 +3422,7 @@ PP(pp_chdir) ) { if( MAXARG == 1 ) - deprecate_old("chdir('') or chdir(undef) as chdir()"); + deprecate("chdir('') or chdir(undef) as chdir()"); tmps = SvPV(*svp, n_a); } else { @@ -385,14 +385,14 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #define vWARN(loc,m) \ STMT_START { \ IV offset = loc - RExC_precomp; \ - Perl_warner(aTHX_ WARN_REGEXP, "%s" REPORT_LOCATION,\ + Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s" REPORT_LOCATION,\ m, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END \ #define vWARNdep(loc,m) \ STMT_START { \ IV offset = loc - RExC_precomp; \ - Perl_warner(aTHX_ packWARN3(WARN_DEPRECATED, WARN_REGEXP, WARN_SYNTAX), "%s" REPORT_LOCATION,\ + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP), "%s" REPORT_LOCATION,\ m, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END \ @@ -400,7 +400,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #define vWARN2(loc, m, a1) \ STMT_START { \ IV offset = loc - RExC_precomp; \ - Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\ + Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,\ a1, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -408,7 +408,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #define vWARN3(loc, m, a1, a2) \ STMT_START { \ IV offset = loc - RExC_precomp; \ - Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION, \ + Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \ a1, a2, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -416,7 +416,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #define vWARN4(loc, m, a1, a2, a3) \ STMT_START { \ IV offset = loc - RExC_precomp; \ - Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\ + Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,\ a1, a2, a3, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -425,7 +425,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #define vWARN5(loc, m, a1, a2, a3, a4) \ STMT_START { \ IV offset = loc - RExC_precomp; \ - Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION, \ + Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \ a1, a2, a3, a4, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -2162,7 +2162,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) *flagp = TRYAGAIN; return NULL; case 'p': /* (?p...) */ - if (SIZE_ONLY && ckWARN3(WARN_DEPRECATED, WARN_REGEXP, WARN_SYNTAX)) + if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP)) vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})"); /* FALL THROUGH*/ case '?': /* (??...) */ @@ -3110,7 +3110,7 @@ S_regmatch(pTHX_ regnode *prog) if (ckWARN(WARN_REGEXP) && n >= REG_INFTY && !(PL_reg_flags & RF_warned)) { PL_reg_flags |= RF_warned; - Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded", + Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded", "Complex regular subexpression recursion", REG_INFTY - 1); } @@ -3162,7 +3162,7 @@ S_regmatch(pTHX_ regnode *prog) if (ckWARN(WARN_REGEXP) && n >= REG_INFTY && !(PL_reg_flags & RF_warned)) { PL_reg_flags |= RF_warned; - Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded", + Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded", "Complex regular subexpression recursion", REG_INFTY - 1); } @@ -199,7 +199,7 @@ S_del_sv(pTHX_ SV *p) } if (!ok) { if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Attempt to free non-arena SV: 0x%"UVxf, PTR2UV(p)); return; @@ -546,10 +546,10 @@ void Perl_report_uninit(pTHX) { if (PL_op) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit, + Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit, " in ", OP_DESC(PL_op)); else - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit, "", ""); + Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit, "", ""); } /* grab a new IV body from the free list, allocating more if necessary */ @@ -1824,11 +1824,11 @@ S_not_a_number(pTHX_ SV *sv) } if (PL_op) - Perl_warner(aTHX_ WARN_NUMERIC, + Perl_warner(aTHX_ packWARN(WARN_NUMERIC), "Argument \"%s\" isn't numeric in %s", pv, OP_DESC(PL_op)); else - Perl_warner(aTHX_ WARN_NUMERIC, + Perl_warner(aTHX_ packWARN(WARN_NUMERIC), "Argument \"%s\" isn't numeric", pv); } @@ -3313,6 +3313,9 @@ Forces the SV to string form if it is not already. Always sets the SvUTF8 flag to avoid future validity checks even if all the bytes have hibit clear. +This is not as a general purpose byte encoding to Unicode interface: +use the Encode extension for that. + =cut */ @@ -3332,6 +3335,9 @@ if all the bytes have hibit clear. If C<flags> has C<SV_GMAGIC> bit set, will C<mg_get> on C<sv> if appropriate, else not. C<sv_utf8_upgrade> and C<sv_utf8_upgrade_nomg> are implemented in terms of this function. +This is not as a general purpose byte encoding to Unicode interface: +use the Encode extension for that. + =cut */ @@ -3397,6 +3403,9 @@ This may not be possible if the PV contains non-byte encoding characters; if this is the case, either returns false or, if C<fail_ok> is not true, croaks. +This is not as a general purpose Unicode to byte encoding interface: +use the Encode extension for that. + =cut */ @@ -3784,7 +3793,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) || sv_cmp(cv_const_sv(cv), cv_const_sv((CV*)sref))))) { - Perl_warner(aTHX_ WARN_REDEFINE, + Perl_warner(aTHX_ packWARN(WARN_REDEFINE), CvCONST(cv) ? "Constant subroutine %s redefined" : "Subroutine %s redefined", @@ -3964,7 +3973,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) else { if (dtype == SVt_PVGV) { if (ckWARN(WARN_MISC)) - Perl_warner(aTHX_ WARN_MISC, "Undefined value assigned to typeglob"); + Perl_warner(aTHX_ packWARN(WARN_MISC), "Undefined value assigned to typeglob"); } else (void)SvOK_off(dstr); @@ -4731,7 +4740,7 @@ Perl_sv_rvweaken(pTHX_ SV *sv) Perl_croak(aTHX_ "Can't weaken a nonreference"); else if (SvWEAKREF(sv)) { if (ckWARN(WARN_MISC)) - Perl_warner(aTHX_ WARN_MISC, "Reference is already weak"); + Perl_warner(aTHX_ packWARN(WARN_MISC), "Reference is already weak"); return sv; } tsv = SvRV(sv); @@ -4898,7 +4907,7 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv) U32 refcnt = SvREFCNT(sv); SV_CHECK_THINKFIRST(sv); if (SvREFCNT(nsv) != 1 && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "Reference miscount in sv_replace()"); + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Reference miscount in sv_replace()"); if (SvMAGICAL(sv)) { if (SvMAGICAL(nsv)) mg_free(nsv); @@ -5173,7 +5182,7 @@ Perl_sv_free(pTHX_ SV *sv) return; } if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free unreferenced scalar"); + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Attempt to free unreferenced scalar"); return; } ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv)); @@ -5182,7 +5191,7 @@ Perl_sv_free(pTHX_ SV *sv) #ifdef DEBUGGING if (SvTEMP(sv)) { if (ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ WARN_DEBUGGING, + Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to free temp prematurely: SV 0x%"UVxf, PTR2UV(sv)); return; @@ -6520,7 +6529,7 @@ Perl_newSVsv(pTHX_ register SV *old) return Nullsv; if (SvTYPE(old) == SVTYPEMASK) { if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "semi-panic: attempt to dup freed string"); + Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string"); return Nullsv; } new_SV(sv); @@ -8283,7 +8292,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV if (n >= 2 && s[n-2] == '1' && s[n-1] == '9' && (n == 2 || !isDIGIT(s[n-3]))) { - Perl_warner(aTHX_ WARN_Y2K, + Perl_warner(aTHX_ packWARN(WARN_Y2K), "Possible Y2K bug: %%%c %s", c, "format string following '19'"); } @@ -8420,7 +8429,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV (UV)c & 0xFF); } else sv_catpv(msg, "end of string"); - Perl_warner(aTHX_ WARN_PRINTF, "%"SVf, msg); /* yes, this is reentrant */ + Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, msg); /* yes, this is reentrant */ } /* output mangled stuff ... */ diff --git a/t/lib/access.t b/t/lib/access.t deleted file mode 100644 index da7193e6d4..0000000000 --- a/t/lib/access.t +++ /dev/null @@ -1,82 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -$| = 1; -print "1..19\n"; - -my $t = 1; - -sub ok -{ - my $val = shift; - if ($val) - { - print "ok $t\n"; - } - else - { - my ($pack,$file,$line) = caller; - print "not ok $t # $file:$line\n"; - } - $t++; -} - -my %hash = ( one => 1, two => 2);; -ok(!access::readonly(%hash)); - -ok(!access::readonly(%hash,1)); - -ok(!access::readonly($hash{two},1)); - -eval { $hash{'three'} = 3 }; -#warn "$@"; -ok($@ =~ /^Attempt to access key 'three' in fixed hash/); - -eval { print "# oops" if $hash{'four'}}; -#warn "$@"; -ok($@ =~ /^Attempt to access key 'four' in fixed hash/); - -eval { $hash{"\x{2323}"} = 3 }; -#warn "$@"; -ok($@ =~ /^Attempt to access key '(.*)' in fixed hash/); -#ok(ord($1) == 0x2323); - -eval { delete $hash{'two'}}; -#warn "$@"; -ok($@); - -eval { delete $hash{'one'}}; -ok(not $@); - -ok($hash{two} == 2); - -eval { delete $hash{'four'}}; -#warn "$@"; -ok($@ =~ /^Attempt to access key 'four' in fixed hash/); - -ok(not exists $hash{'one'}); - -ok(!exists $hash{'three'}); - -ok(access::readonly(%hash,0)); - -ok(!access::readonly(%hash)); - -my $scalar = 1; -ok(!access::readonly($scalar)); - -ok(!access::readonly($scalar,1)); - -eval { $scalar++ }; -#warn $@; -ok($@ =~ /^Modification of a read-only value attempted/); - -ok(access::readonly($scalar,0)); - -ok(!access::readonly($scalar)); - - diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys index 8dc0bf90a4..be8bb6244c 100644 --- a/t/lib/warnings/pp_sys +++ b/t/lib/warnings/pp_sys @@ -403,16 +403,18 @@ binmode() on unopened filehandle at - line 4. ######## # pp_sys.c [pp_lstat] use warnings 'io'; -lstat STDIN; +open FH, "harness" or die "# $!"; +lstat FH; open my $fh, $0 or die "# $!"; lstat $fh; no warnings 'io'; -lstat STDIN; +lstat FH; lstat $fh; +close FH; close $fh; EXPECT -lstat() on filehandle STDIN at - line 3. -lstat() on filehandle $fh at - line 5. +lstat() on filehandle FH at - line 4. +lstat() on filehandle $fh at - line 6. ######## # pp_sys.c [pp_getc] use warnings qw(unopened closed) ; diff --git a/t/op/stat.t b/t/op/stat.t index 791f7e5737..9306d2ffa2 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -22,6 +22,7 @@ $Is_NetWare = $^O eq 'NetWare'; $Is_OS2 = $^O eq 'os2'; $Is_Solaris = $^O eq 'solaris'; $Is_VMS = $^O eq 'VMS'; +$Is_DGUX = $^O eq 'dgux'; $Is_Dosish = $Is_Dos || $Is_OS2 || $Is_MSWin32 || $Is_NetWare || $Is_Cygwin; @@ -200,20 +201,20 @@ unlink($tmpfile_link); ok(! -e $tmpfile_link, ' -e on unlinked file'); SKIP: { - skip "No character, socket or block special files", 3 + skip "No character, socket or block special files", 6 if $Is_MSWin32 || $Is_NetWare || $Is_Dos; - skip "/dev isn't available to test against", 3 + skip "/dev isn't available to test against", 6 unless -d '/dev' && -r '/dev' && -x '/dev'; my $LS = $Config{d_readlink} ? "ls -lL" : "ls -l"; my $CMD = "$LS /dev 2>/dev/null"; my $DEV = qx($CMD); - skip "$CMD failed", 3 if $DEV eq ''; + skip "$CMD failed", 6 if $DEV eq ''; my @DEV = do { my $dev; opendir($dev, "/dev") ? readdir($dev) : () }; - skip "opendir failed: $!", 3 if @DEV == 0; + skip "opendir failed: $!", 6 if @DEV == 0; # /dev/stdout might be either character special or a named pipe, # or a symlink, or a socket, depending on which OS and how are @@ -243,15 +244,21 @@ SKIP: { is($c1, $c2, "ls and $_[1] agreeing on /dev ($c1 $c2)"); }; +SKIP: { + skip("DG/UX ls -L broken", 3) if $Is_DGUX; + $try->('b', '-b'); $try->('c', '-c'); $try->('s', '-S'); + } ok(! -b $Curdir, '!-b cwd'); ok(! -c $Curdir, '!-c cwd'); ok(! -S $Curdir, '!-S cwd'); +} + SKIP: { my($cnt, $uid); $cnt = $uid = 0; @@ -322,7 +329,11 @@ SKIP: { ok(-T 'op/stat.t', '-T'); ok(! -B 'op/stat.t', '!-B'); +SKIP: { + skip("DG/UX", 1) if $Is_DGUX; ok(-B $Perl, '-B'); +} + ok(! -T $Perl, '!-T'); open(FOO,'op/stat.t'); @@ -57,7 +57,7 @@ Perl_taint_proper(pTHX_ const char *f, const char *s) ug = " while running with -T switch"; if (PL_unsafe || PL_taint_warn) { if(ckWARN(WARN_TAINT)) - Perl_warner(aTHX_ WARN_TAINT, f, s, ug); + Perl_warner(aTHX_ packWARN(WARN_TAINT), f, s, ug); } else { Perl_croak(aTHX_ f, s, ug); @@ -87,7 +87,7 @@ #endif #ifdef DGUX -# define THREAD_CREATE_NEEDS_STACK (16*1024) +# define THREAD_CREATE_NEEDS_STACK (32*1024) #endif #ifdef I_MACH_CTHREADS @@ -316,7 +316,7 @@ void Perl_deprecate(pTHX_ char *s) { if (ckWARN(WARN_DEPRECATED)) - Perl_warner(aTHX_ WARN_DEPRECATED, "Use of %s is deprecated", s); + Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of %s is deprecated", s); } void @@ -678,7 +678,7 @@ S_check_uni(pTHX) if (ckWARN_d(WARN_AMBIGUOUS)){ char ch = *s; *s = '\0'; - Perl_warner(aTHX_ WARN_AMBIGUOUS, + Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Warning: Use of \"%s\" without parens is ambiguous", PL_last_uni); *s = ch; @@ -1417,7 +1417,7 @@ S_scan_const(pTHX_ char *start) isDIGIT(*s) && *s != '0' && !isDIGIT(s[1])) { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, "\\%c better written as $%c", *s, *s); + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s); *--s = '$'; break; } @@ -1443,7 +1443,7 @@ S_scan_const(pTHX_ char *start) if (ckWARN(WARN_MISC) && isALNUM(*s) && *s != '_') - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "Unrecognized escape \\%c passed through", *s); /* default action is to copy the quoted character */ @@ -3304,7 +3304,7 @@ Perl_yylex(pTHX) && isIDFIRST_lazy_if(s,UTF) && PL_bufptr == PL_linestart) { CopLINE_dec(PL_curcop); - Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi); + Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), PL_warn_nosemi); CopLINE_inc(PL_curcop); } BAop(OP_BIT_AND); @@ -3337,7 +3337,7 @@ Perl_yylex(pTHX) if (tmp == '~') PMop(OP_MATCH); if (ckWARN(WARN_SYNTAX) && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp)) - Perl_warner(aTHX_ WARN_SYNTAX, "Reversed %c= operator",(int)tmp); + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Reversed %c= operator",(int)tmp); s--; if (PL_expect == XSTATE && isALPHA(tmp) && (s == PL_linestart+1 || s[-2] == '\n') ) @@ -3481,7 +3481,7 @@ Perl_yylex(pTHX) PL_bufptr = skipspace(PL_bufptr); while (t < PL_bufend && *t != ']') t++; - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Multidimensional syntax %.*s not supported", (t - PL_bufptr) + 1, PL_bufptr); } @@ -3499,7 +3499,7 @@ Perl_yylex(pTHX) t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len); for (; isSPACE(*t); t++) ; if (*t == ';' && get_cv(tmpbuf, FALSE)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "You need to quote \"%s\"", tmpbuf); } } @@ -3578,7 +3578,7 @@ Perl_yylex(pTHX) if (*t == '}' || *t == ']') { t++; PL_bufptr = skipspace(PL_bufptr); - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Scalar value %.*s better written as $%.*s", t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1); } @@ -3705,7 +3705,7 @@ Perl_yylex(pTHX) case '\\': s++; if (ckWARN(WARN_SYNTAX) && PL_lex_inwhat && isDIGIT(*s)) - Perl_warner(aTHX_ WARN_SYNTAX,"Can't use \\%c to mean $%c in expression", + Perl_warner(aTHX_ packWARN(WARN_SYNTAX),"Can't use \\%c to mean $%c in expression", *s, *s); if (PL_expect == XOPERATOR) no_op("Backslash",s); @@ -3848,14 +3848,14 @@ Perl_yylex(pTHX) else { /* no override */ tmp = -tmp; if (tmp == KEY_dump && ckWARN(WARN_MISC)) { - Perl_warner(aTHX_ WARN_MISC, + Perl_warner(aTHX_ packWARN(WARN_MISC), "dump() better written as CORE::dump()"); } gv = Nullgv; gvp = 0; if (ckWARN(WARN_AMBIGUOUS) && hgv && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */ - Perl_warner(aTHX_ WARN_AMBIGUOUS, + Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Ambiguous call resolved as CORE::%s(), %s", GvENAME(hgv), "qualify as such or use &"); } @@ -3886,7 +3886,7 @@ Perl_yylex(pTHX) if (PL_expect == XOPERATOR) { if (PL_bufptr == PL_linestart) { CopLINE_dec(PL_curcop); - Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi); + Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), PL_warn_nosemi); CopLINE_inc(PL_curcop); } else @@ -3901,7 +3901,7 @@ Perl_yylex(pTHX) PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':') { if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV)) - Perl_warner(aTHX_ WARN_BAREWORD, + Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword \"%s\" refers to nonexistent package", PL_tokenbuf); len -= 2; @@ -4015,7 +4015,7 @@ Perl_yylex(pTHX) if (gv && GvCVu(gv)) { CV* cv; if (lastchar == '-' && ckWARN_d(WARN_AMBIGUOUS)) - Perl_warner(aTHX_ WARN_AMBIGUOUS, + Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Ambiguous use of -%s resolved as -&%s()", PL_tokenbuf, PL_tokenbuf); /* Check for a constant sub */ @@ -4064,7 +4064,7 @@ Perl_yylex(pTHX) if (lastchar != '-') { for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ; if (!*d && strNE(PL_tokenbuf,"main")) - Perl_warner(aTHX_ WARN_RESERVED, PL_warn_reserved, + Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved, PL_tokenbuf); } } @@ -4072,10 +4072,10 @@ Perl_yylex(pTHX) safe_bareword: if (lastchar && strchr("*%&", lastchar) && ckWARN_d(WARN_AMBIGUOUS)) { - Perl_warner(aTHX_ WARN_AMBIGUOUS, + Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Operator or semicolon missing before %c%s", lastchar, PL_tokenbuf); - Perl_warner(aTHX_ WARN_AMBIGUOUS, + Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Ambiguous use of %c resolved as operator %c", lastchar, lastchar); } @@ -4614,7 +4614,7 @@ Perl_yylex(pTHX) for (d = s; isALNUM_lazy_if(d,UTF); d++) ; t = skipspace(d); if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)) - Perl_warner(aTHX_ WARN_PRECEDENCE, + Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE), "Precedence problem: open %.*s should be open(%.*s)", d-s,s, d-s,s); } @@ -4690,12 +4690,12 @@ Perl_yylex(pTHX) if (!warned && ckWARN(WARN_QW)) { for (; !isSPACE(*d) && len; --len, ++d) { if (*d == ',') { - Perl_warner(aTHX_ WARN_QW, + Perl_warner(aTHX_ packWARN(WARN_QW), "Possible attempt to separate words with commas"); ++warned; } else if (*d == '#') { - Perl_warner(aTHX_ WARN_QW, + Perl_warner(aTHX_ packWARN(WARN_QW), "Possible attempt to put comments in qw() list"); ++warned; } @@ -5004,7 +5004,7 @@ Perl_yylex(pTHX) } d[tmp] = '\0'; if (bad_proto && ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Illegal character in prototype for %s : %s", SvPVX(PL_subname), d); SvCUR(PL_lex_stuff) = tmp; @@ -5311,7 +5311,7 @@ S_pending_ident(pTHX) && ckWARN(WARN_AMBIGUOUS)) { /* Downgraded from fatal to warning 20000522 mjd */ - Perl_warner(aTHX_ WARN_AMBIGUOUS, + Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Possible unintended interpolation of %s in string", PL_tokenbuf); } @@ -5947,7 +5947,7 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what) if (*w) for (; *w && isSPACE(*w); w++) ; if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */ - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%s (...) interpreted as function",name); } } @@ -6220,7 +6220,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) { if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) { const char *brack = *s == '[' ? "[...]" : "{...}"; - Perl_warner(aTHX_ WARN_AMBIGUOUS, + Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Ambiguous use of %c{%s%s} resolved to %c%s%s", funny, dest, brack, funny, dest, brack); } @@ -6252,7 +6252,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des if (ckWARN(WARN_AMBIGUOUS) && (keyword(dest, d - dest) || get_cv(dest, FALSE))) { - Perl_warner(aTHX_ WARN_AMBIGUOUS, + Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Ambiguous use of %c{%s} resolved to %c%s", funny, dest, funny, dest); } @@ -7100,7 +7100,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) if (*s == '_') { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s++; } @@ -7124,7 +7124,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* _ are ignored -- but warned about if consecutive */ case '_': if (ckWARN(WARN_SYNTAX) && lastub && s == lastub + 1) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s++; break; @@ -7167,7 +7167,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) overflowed = TRUE; n = (NV) u; if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ WARN_OVERFLOW, + Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), "Integer overflow in %s number", base); } else @@ -7197,13 +7197,13 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* final misplaced underbar check */ if (s[-1] == '_') { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number"); + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); } sv = NEWSV(92,0); if (overflowed) { if (ckWARN(WARN_PORTABLE) && n > 4294967295.0) - Perl_warner(aTHX_ WARN_PORTABLE, + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), "%s number > %s non-portable", Base, max); sv_setnv(sv, n); @@ -7211,7 +7211,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) else { #if UVSIZE > 4 if (ckWARN(WARN_PORTABLE) && u > 0xffffffff) - Perl_warner(aTHX_ WARN_PORTABLE, + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), "%s number > %s non-portable", Base, max); #endif @@ -7240,7 +7240,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) */ if (*s == '_') { if (ckWARN(WARN_SYNTAX) && lastub && s == lastub + 1) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s++; } @@ -7256,7 +7256,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* final misplaced underbar check */ if (lastub && s == lastub + 1) { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number"); + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); } /* read a decimal portion if there is one. avoid @@ -7269,7 +7269,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) if (*s == '_') { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s; } @@ -7282,7 +7282,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) Perl_croak(aTHX_ number_too_long); if (*s == '_') { if (ckWARN(WARN_SYNTAX) && lastub && s == lastub + 1) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s; } @@ -7292,7 +7292,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* fractional part ending in underbar? */ if (s[-1] == '_') { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); } if (*s == '.' && isDIGIT(s[1])) { @@ -7313,7 +7313,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* stray preinitial _ */ if (*s == '_') { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s++; } @@ -7325,7 +7325,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* stray initial _ */ if (*s == '_') { if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s++; } @@ -7341,7 +7341,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) if (ckWARN(WARN_SYNTAX) && ((lastub && s == lastub + 1) || (!isDIGIT(s[1]) && s[1] != '_'))) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); lastub = s++; } diff --git a/universal.c b/universal.c index d629dfd1c9..ae12e27984 100644 --- a/universal.c +++ b/universal.c @@ -93,7 +93,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, HV* basestash = gv_stashsv(sv, FALSE); if (!basestash) { if (ckWARN(WARN_MISC)) - Perl_warner(aTHX_ WARN_SYNTAX, + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %s for @%s::ISA", SvPVX(sv), HvNAME(stash)); continue; @@ -167,7 +167,6 @@ XS(XS_utf8_upgrade); XS(XS_utf8_downgrade); XS(XS_utf8_unicode_to_native); XS(XS_utf8_native_to_unicode); -XS(XS_access_readonly); void Perl_boot_core_UNIVERSAL(pTHX) @@ -184,7 +183,6 @@ Perl_boot_core_UNIVERSAL(pTHX) newXS("utf8::downgrade", XS_utf8_downgrade, file); newXS("utf8::native_to_unicode", XS_utf8_native_to_unicode, file); newXS("utf8::unicode_to_native", XS_utf8_unicode_to_native, file); - newXSproto("access::readonly",XS_access_readonly, file, "\\[$%@];$"); } @@ -460,22 +458,3 @@ XS(XS_utf8_unicode_to_native) XSRETURN(1); } -XS(XS_access_readonly) -{ - dXSARGS; - SV *sv = SvRV(ST(0)); - IV old = SvREADONLY(sv); - if (items == 2) { - if (SvTRUE(ST(1))) { - SvREADONLY_on(sv); - } - else { - SvREADONLY_off(sv); - } - } - if (old) - XSRETURN_YES; - else - XSRETURN_NO; -} - @@ -57,7 +57,7 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags) if (ckWARN(WARN_UTF8)) { if (UNICODE_IS_SURROGATE(uv) && !(flags & UNICODE_ALLOW_SURROGATE)) - Perl_warner(aTHX_ WARN_UTF8, "UTF-16 surrogate 0x%04"UVxf, uv); + Perl_warner(aTHX_ packWARN(WARN_UTF8), "UTF-16 surrogate 0x%04"UVxf, uv); else if ( ((uv >= 0xFDD0 && uv <= 0xFDEF && !(flags & UNICODE_ALLOW_FDD0)) @@ -72,7 +72,7 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags) ((uv <= PERL_UNICODE_MAX) || !(flags & UNICODE_ALLOW_SUPER)) ) - Perl_warner(aTHX_ WARN_UTF8, + Perl_warner(aTHX_ packWARN(WARN_UTF8), "Unicode character 0x%04"UVxf" is illegal", uv); } if (UNI_IS_INVARIANT(uv)) { @@ -469,10 +469,10 @@ malformed: char *s = SvPVX(sv); if (PL_op) - Perl_warner(aTHX_ WARN_UTF8, + Perl_warner(aTHX_ packWARN(WARN_UTF8), "%s in %s", s, OP_DESC(PL_op)); else - Perl_warner(aTHX_ WARN_UTF8, "%s", s); + Perl_warner(aTHX_ packWARN(WARN_UTF8), "%s", s); } } @@ -67,13 +67,13 @@ END_EXTERN_C Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte - U+0000..U+007F 00..7F - U+0080..U+07FF C2..DF 80..BF - U+0800..U+0FFF E0 A0..BF 80..BF - U+1000..U+CFFF E1..EC 80..BF 80..BF - U+D000..U+D7FF ED 80..9F 80..BF + U+0000..U+007F 00..7F + U+0080..U+07FF C2..DF 80..BF + U+0800..U+0FFF E0 A0..BF 80..BF + U+1000..U+CFFF E1..EC 80..BF 80..BF + U+D000..U+D7FF ED 80..9F 80..BF U+D800..U+DFFF ******* ill-formed ******* - U+E000..U+FFFF EE..EF 80..BF 80..BF + U+E000..U+FFFF EE..EF 80..BF 80..BF U+10000..U+3FFFF F0 90..BF 80..BF 80..BF U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF U+100000..U+10FFFF F4 80..8F 80..BF 80..BF diff --git a/utfebcdic.h b/utfebcdic.h index 7cf44dfac0..7931940e46 100644 --- a/utfebcdic.h +++ b/utfebcdic.h @@ -101,7 +101,7 @@ EXTCONST unsigned char PL_a2e[] = { /* ASCII (iso-8859-1) to EBCDIC (IBM-1047) * 0x8C, 0x49, 0xCD, 0xCE, 0xCB, 0xCF, 0xCC, 0xE1, 0x70, 0xDD, 0xDE, 0xDB, 0xDC, 0x8D, 0x8E, 0xDF }; -EXTCONST unsigned char PL_e2a[] = { /* ASCII (iso-8859-1) to EBCDIC (IBM-1047) */ +EXTCONST unsigned char PL_e2a[] = { /* EBCDIC (IBM-1047) to ASCII (iso-8859-1) */ 0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, 0x10, 0x11, 0x12, 0x13, 0x9D, 0x0A, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F, 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x17, 0x1B, 0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x05, 0x06, 0x07, @@ -3445,25 +3445,25 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op) if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) { if (name && *name) - Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for %sput", + Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle %s opened only for %sput", name, (op == OP_phoney_INPUT_ONLY ? "in" : "out")); else - Perl_warner(aTHX_ WARN_IO, "Filehandle opened only for %sput", + Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle opened only for %sput", (op == OP_phoney_INPUT_ONLY ? "in" : "out")); } else if (name && *name) { - Perl_warner(aTHX_ warn_type, + Perl_warner(aTHX_ packWARN(warn_type), "%s%s on %s %s %s", func, pars, vile, type, name); if (io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP)) - Perl_warner(aTHX_ warn_type, + Perl_warner(aTHX_ packWARN(warn_type), "\t(Are you trying to call %s%s on dirhandle %s?)\n", func, pars, name); } else { - Perl_warner(aTHX_ warn_type, + Perl_warner(aTHX_ packWARN(warn_type), "%s%s on %s %s", func, pars, vile, type); if (gv && io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP)) - Perl_warner(aTHX_ warn_type, + Perl_warner(aTHX_ packWARN(warn_type), "\t(Are you trying to call %s%s on dirhandle?)\n", func, pars); } @@ -4026,7 +4026,7 @@ Perl_new_vstring(pTHX_ char *s, SV *sv) rev += (*end - '0') * mult; mult *= 10; if (orev > rev && ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ WARN_OVERFLOW, + Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), "Integer overflow in decimal number"); } } diff --git a/win32/Makefile b/win32/Makefile index 7b7bf345fb..b1c7beee03 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1,1116 +1,1116 @@ -#
-# Makefile to build perl on Windows NT using Microsoft NMAKE.
-# Supported compilers:
-# Visual C++ 5.x (possibly other versions)
-#
-# This is set up to build a perl.exe that runs off a shared library
-# (perl57.dll). Also makes individual DLLs for the XS extensions.
-#
-
-##
-## Make sure you read README.win32 *before* you mess with anything here!
-##
-
-##
-## Build configuration. Edit the values below to suit your needs.
-##
-
-#
-# Set these to wherever you want "nmake install" to put your
-# newly built perl.
-#
-INST_DRV = c:
-INST_TOP = $(INST_DRV)\perl
-
-#
-# Comment this out if you DON'T want your perl installation to be versioned.
-# This means that the new installation will overwrite any files from the
-# old installation at the same INST_TOP location. Leaving it enabled is
-# the safest route, as perl adds the extra version directory to all the
-# locations it installs files to. If you disable it, an alternative
-# versioned installation can be obtained by setting INST_TOP above to a
-# path that includes an arbitrary version string.
-#
-#INST_VER = \5.7.2
-
-#
-# Comment this out if you DON'T want your perl installation to have
-# architecture specific components. This means that architecture-
-# specific files will be installed along with the architecture-neutral
-# files. Leaving it enabled is safer and more flexible, in case you
-# want to build multiple flavors of perl and install them together in
-# the same location. Commenting it out gives you a simpler
-# installation that is easier to understand for beginners.
-#
-#INST_ARCH = \$(ARCHNAME)
-
-#
-# uncomment to enable multiple interpreters. This is need for fork()
-# emulation.
-#
-USE_MULTI = define
-
-#
-# Beginnings of interpreter cloning/threads; still very incomplete.
-# This should be enabled to get the fork() emulation. This needs
-# USE_MULTI as well.
-#
-USE_ITHREADS = define
-
-#
-# uncomment to enable the implicit "host" layer for all system calls
-# made by perl. This needs USE_MULTI above. This is also needed to
-# get fork().
-#
-USE_IMP_SYS = define
-
-#
-# uncomment to enable the experimental PerlIO I/O subsystem.
-USE_PERLIO = define
-
-#
-# WARNING! This option is deprecated and will eventually go away (enable
-# USE_ITHREADS instead).
-#
-# uncomment to enable threads-capabilities. This is incompatible with
-# USE_ITHREADS, and is only here for people who may have come to rely
-# on the experimental Thread support that was in 5.005.
-#
-#USE_5005THREADS = define
-
-#
-# uncomment one of the following lines if you are using either
-# Visual C++ 2.x or Visual C++ 6.x (aka Visual Studio 98)
-#
-#CCTYPE = MSVC20
-#CCTYPE = MSVC60
-
-#
-# uncomment next line if you want debug version of perl (big,slow)
-#
-#CFG = Debug
-
-#
-# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler.
-# It has patches that fix known bugs in older versions of MSVCRT.DLL.
-# This currently requires VC 5.0 with Service Pack 3 or later.
-# Get it from CPAN at http://www.cpan.org/authors/id/D/DO/DOUGL/
-# and follow the directions in the package to install.
-#
-# Not recommended if you have VC 6.x and you're not running Windows 9x.
-#
-#USE_PERLCRT = define
-
-#
-# uncomment to enable linking with setargv.obj under the Visual C
-# compiler. Setting this options enables perl to expand wildcards in
-# arguments, but it may be harder to use alternate methods like
-# File::DosGlob that are more powerful. This option is supported only with
-# Visual C.
-#
-#USE_SETARGV = define
-
-#
-# if you have the source for des_fcrypt(), uncomment this and make sure the
-# file exists (see README.win32). File should be located in the same
-# directory as this file.
-#
-#CRYPT_SRC = fcrypt.c
-
-#
-# if you didn't set CRYPT_SRC and if you have des_fcrypt() available in a
-# library, uncomment this, and make sure the library exists (see README.win32)
-# Specify the full pathname of the library.
-#
-#CRYPT_LIB = fcrypt.lib
-
-#
-# set this if you wish to use perl's malloc
-# WARNING: Turning this on/off WILL break binary compatibility with extensions
-# you may have compiled with/without it. Be prepared to recompile all
-# extensions if you change the default. Currently, this cannot be enabled
-# if you ask for USE_IMP_SYS above.
-#
-#PERL_MALLOC = define
-
-#
-# set the install locations of the compiler include/libraries
-# Running VCVARS32.BAT is *required* when using Visual C.
-# Some versions of Visual C don't define MSVCDIR in the environment,
-# so you may have to set CCHOME explicitly (spaces in the path name should
-# not be quoted)
-#
-#CCHOME = f:\msvc20
-CCHOME = $(MSVCDIR)
-CCINCDIR = $(CCHOME)\include
-CCLIBDIR = $(CCHOME)\lib
-
-#
-# Additional compiler flags can be specified here.
-#
-
-#
-# This should normally be disabled. Adding -DPERL_POLLUTE enables support
-# for old symbols by default, at the expense of extreme pollution. You most
-# probably just want to build modules that won't compile with
-# perl Makefile.PL POLLUTE=1
-# instead of enabling this. Please report such modules to the respective
-# authors.
-#
-#BUILDOPT = $(BUILDOPT) -DPERL_POLLUTE
-
-#
-# This should normally be disabled. Enabling it will disable the File::Glob
-# implementation of CORE::glob.
-#
-#BUILDOPT = $(BUILDOPT) -DPERL_EXTERNAL_GLOB
-
-#
-# This should normally be disabled. Enabling it causes perl to read scripts
-# in text mode (which is the 5.005 behavior) and will break ByteLoader.
-#BUILDOPT = $(BUILDOPT) -DPERL_TEXTMODE_SCRIPTS
-
-#
-# specify semicolon-separated list of extra directories that modules will
-# look for libraries (spaces in path names need not be quoted)
-#
-EXTRALIBDIRS =
-
-#
-# set this to your email address (perl will guess a value from
-# from your loginname and your hostname, which may not be right)
-#
-#EMAIL =
-
-##
-## Build configuration ends.
-##
-
-##################### CHANGE THESE ONLY IF YOU MUST #####################
-
-!IF "$(CRYPT_SRC)$(CRYPT_LIB)" == ""
-D_CRYPT = undef
-!ELSE
-D_CRYPT = define
-CRYPT_FLAG = -DHAVE_DES_FCRYPT
-!ENDIF
-
-!IF "$(PERL_MALLOC)" == ""
-PERL_MALLOC = undef
-!ENDIF
-
-!IF "$(USE_5005THREADS)" == ""
-USE_5005THREADS = undef
-!ENDIF
-
-!IF "$(USE_5005THREADS)" == "define"
-USE_ITHREADS = undef
-!ENDIF
-
-!IF "$(USE_IMP_SYS)" == "define"
-PERL_MALLOC = undef
-!ENDIF
-
-!IF "$(USE_MULTI)" == ""
-USE_MULTI = undef
-!ENDIF
-
-!IF "$(USE_ITHREADS)" == ""
-USE_ITHREADS = undef
-!ENDIF
-
-!IF "$(USE_IMP_SYS)" == ""
-USE_IMP_SYS = undef
-!ENDIF
-
-!IF "$(USE_PERLIO)" == ""
-USE_PERLIO = undef
-!ENDIF
-
-!IF "$(USE_PERLCRT)" == ""
-USE_PERLCRT = undef
-!ENDIF
-
-!IF "$(USE_IMP_SYS)$(USE_MULTI)$(USE_5005THREADS)" == "defineundefundef"
-USE_MULTI = define
-!ENDIF
-
-!IF "$(USE_ITHREADS)$(USE_MULTI)" == "defineundef"
-USE_MULTI = define
-USE_5005THREADS = undef
-!ENDIF
-
-!IF "$(USE_MULTI)$(USE_5005THREADS)" != "undefundef"
-BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT
-!ENDIF
-
-!IF "$(USE_IMP_SYS)" != "undef"
-BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS
-!ENDIF
-
-!IF "$(PROCESSOR_ARCHITECTURE)" == ""
-PROCESSOR_ARCHITECTURE = x86
-!ENDIF
-
-!IF "$(USE_5005THREADS)" == "define"
-ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread
-!ELSE
-!IF "$(USE_MULTI)" == "define"
-ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi
-!ELSE
-!IF "$(USE_PERLIO)" == "define"
-ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-perlio
-!ELSE
-ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)
-!ENDIF
-!ENDIF
-!ENDIF
-
-!IF "$(USE_PERLIO)" == "define"
-BUILDOPT = $(BUILDOPT) -DUSE_PERLIO
-!ENDIF
-
-!IF "$(USE_ITHREADS)" == "define"
-ARCHNAME = $(ARCHNAME)-thread
-!ENDIF
-
-# Visual Studio 98 specific
-!IF "$(CCTYPE)" == "MSVC60"
-
-# VC 6.0 can load the socket dll on demand. Makes the test suite
-# run in about 10% less time.
-DELAYLOAD = -DELAYLOAD:wsock32.dll -DELAYLOAD:shell32.dll delayimp.lib
-!ENDIF
-
-ARCHDIR = ..\lib\$(ARCHNAME)
-COREDIR = ..\lib\CORE
-AUTODIR = ..\lib\auto
-LIBDIR = ..\lib
-EXTDIR = ..\ext
-PODDIR = ..\pod
-EXTUTILSDIR = $(LIBDIR)\ExtUtils
-
-#
-INST_SCRIPT = $(INST_TOP)$(INST_VER)\bin
-INST_BIN = $(INST_SCRIPT)$(INST_ARCH)
-INST_LIB = $(INST_TOP)$(INST_VER)\lib
-INST_ARCHLIB = $(INST_LIB)$(INST_ARCH)
-INST_COREDIR = $(INST_ARCHLIB)\CORE
-INST_POD = $(INST_LIB)\pod
-INST_HTML = $(INST_TOP)$(INST_VER)\html
-
-#
-# Programs to compile, build .lib files and link
-#
-
-CC = cl
-LINK32 = link
-LIB32 = $(LINK32) -lib
-RSC = rc
-
-#
-# Options
-#
-
-INCLUDES = -I$(COREDIR) -I.\include -I. -I..
-#PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX
-DEFINES = -DWIN32 -D_CONSOLE -DNO_STRICT $(CRYPT_FLAG)
-LOCDEFS = -DPERLDLL -DPERL_CORE
-SUBSYS = console
-CXX_FLAG = -TP -GX
-
-!IF "$(USE_PERLCRT)" != "define"
-LIBC = msvcrt.lib
-!ELSE
-LIBC = PerlCRT.lib
-!ENDIF
-
-PERLEXE_RES =
-PERLDLL_RES =
-
-!IF "$(CFG)" == "Debug"
-! IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE = -Od -MD -Z7 -DDEBUGGING
-! ELSE
-OPTIMIZE = -Od -MD -Zi -DDEBUGGING
-! ENDIF
-LINK_DBG = -debug -pdb:none
-!ELSE
-# -O1 yields smaller code, which turns out to be faster than -O2
-#OPTIMIZE = -O2 -MD -DNDEBUG
-OPTIMIZE = -O1 -MD -DNDEBUG
-LINK_DBG = -release
-!ENDIF
-
-!IF "$(USE_PERLCRT)" != "define"
-BUILDOPT = $(BUILDOPT) -DPERL_MSVCRT_READFIX
-!ENDIF
-
-LIBBASEFILES = $(CRYPT_LIB) \
- oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib \
- comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib \
- netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
- version.lib odbc32.lib odbccp32.lib
-
-# we add LIBC here, since we may be using PerlCRT.dll
-LIBFILES = $(LIBBASEFILES) $(LIBC)
-
-CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \
- $(PCHFLAGS) $(OPTIMIZE)
-LINK_FLAGS = -nologo -nodefaultlib $(LINK_DBG) \
- -libpath:"$(INST_COREDIR)" \
- -machine:$(PROCESSOR_ARCHITECTURE)
-OBJOUT_FLAG = -Fo
-EXEOUT_FLAG = -Fe
-
-CFLAGS_O = $(CFLAGS) $(BUILDOPT)
-
-#################### do not edit below this line #######################
-############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ##############
-
-o = .obj
-
-#
-# Rules
-#
-
-.SUFFIXES : .c $(o) .dll .lib .exe .rc .res
-
-.c$(o):
- $(CC) -c -I$(<D) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $<
-
-.y.c:
- $(NOOP)
-
-$(o).dll:
- $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \
- -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL)
-
-.rc.res:
- $(RSC) -i.. $<
-
-#
-# various targets
-
-# makedef.pl must be updated if this changes, and this should normally
-# only change when there is an incompatible revision of the public API.
-# XXX so why did we change it from perl56 to perl57?
-PERLIMPLIB = ..\perl57.lib
-PERLDLL = ..\perl57.dll
-
-MINIPERL = ..\miniperl.exe
-MINIDIR = .\mini
-PERLEXE = ..\perl.exe
-WPERLEXE = ..\wperl.exe
-GLOBEXE = ..\perlglob.exe
-CONFIGPM = ..\lib\Config.pm
-MINIMOD = ..\lib\ExtUtils\Miniperl.pm
-X2P = ..\x2p\a2p.exe
-
-# Nominate a target which causes extensions to be re-built
-# This used to be $(PERLEXE), but at worst it is the .dll that they depend
-# on and really only the interface - i.e. the .def file used to export symbols
-# from the .dll
-PERLDEP = perldll.def
-
-PL2BAT = bin\pl2bat.pl
-GLOBBAT = bin\perlglob.bat
-
-UTILS = \
- ..\utils\h2ph \
- ..\utils\splain \
- ..\utils\dprofpp \
- ..\utils\perlbug \
- ..\utils\pl2pm \
- ..\utils\c2ph \
- ..\utils\h2xs \
- ..\utils\perldoc \
- ..\utils\perlcc \
- ..\utils\perlivp \
- ..\utils\libnetcfg \
- ..\pod\checkpods \
- ..\pod\pod2html \
- ..\pod\pod2latex \
- ..\pod\pod2man \
- ..\pod\pod2text \
- ..\pod\pod2usage \
- ..\pod\podchecker \
- ..\pod\podselect \
- ..\x2p\find2perl \
- ..\x2p\s2p \
- ..\lib\ExtUtils\xsubpp \
- bin\exetype.pl \
- bin\runperl.pl \
- bin\pl2bat.pl \
- bin\perlglob.pl \
- bin\search.pl
-
-MAKE = nmake -nologo
-MAKE_BARE = nmake
-
-CFGSH_TMPL = config.vc
-CFGH_TMPL = config_H.vc
-
-XCOPY = xcopy /f /r /i /d
-RCOPY = xcopy /f /r /i /e /d
-NOOP = @echo
-NULL =
-
-DEL = del
-
-#
-# filenames given to xsubpp must have forward slashes (since it puts
-# full pathnames in #line strings)
-XSUBPP = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \
- -C++ -prototypes
-
-MICROCORE_SRC = \
- ..\av.c \
- ..\deb.c \
- ..\doio.c \
- ..\doop.c \
- ..\dump.c \
- ..\globals.c \
- ..\gv.c \
- ..\hv.c \
- ..\locale.c \
- ..\mg.c \
- ..\numeric.c \
- ..\op.c \
- ..\perl.c \
- ..\perlapi.c \
- ..\perly.c \
- ..\pp.c \
- ..\pp_ctl.c \
- ..\pp_hot.c \
- ..\pp_pack.c \
- ..\pp_sort.c \
- ..\pp_sys.c \
- ..\regcomp.c \
- ..\regexec.c \
- ..\run.c \
- ..\scope.c \
- ..\sv.c \
- ..\taint.c \
- ..\toke.c \
- ..\universal.c \
- ..\utf8.c \
- ..\util.c \
- ..\xsutils.c
-
-EXTRACORE_SRC = $(EXTRACORE_SRC) perllib.c
-
-!IF "$(PERL_MALLOC)" == "define"
-EXTRACORE_SRC = $(EXTRACORE_SRC) ..\malloc.c
-!ENDIF
-
-EXTRACORE_SRC = $(EXTRACORE_SRC) ..\perlio.c
-
-WIN32_SRC = \
- .\win32.c \
- .\win32sck.c \
- .\win32thread.c
-
-!IF "$(USE_PERLIO)" == "define"
-WIN32_SRC = $(WIN32_SRC) .\win32io.c
-!ENDIF
-
-!IF "$(CRYPT_SRC)" != ""
-WIN32_SRC = $(WIN32_SRC) .\$(CRYPT_SRC)
-!ENDIF
-
-DLL_SRC = $(DYNALOADER).c
-
-X2P_SRC = \
- ..\x2p\a2p.c \
- ..\x2p\hash.c \
- ..\x2p\str.c \
- ..\x2p\util.c \
- ..\x2p\walk.c
-
-CORE_NOCFG_H = \
- ..\av.h \
- ..\cop.h \
- ..\cv.h \
- ..\dosish.h \
- ..\embed.h \
- ..\form.h \
- ..\gv.h \
- ..\handy.h \
- ..\hv.h \
- ..\iperlsys.h \
- ..\mg.h \
- ..\nostdio.h \
- ..\op.h \
- ..\opcode.h \
- ..\perl.h \
- ..\perlapi.h \
- ..\perlsdio.h \
- ..\perlsfio.h \
- ..\perly.h \
- ..\pp.h \
- ..\proto.h \
- ..\regexp.h \
- ..\scope.h \
- ..\sv.h \
- ..\thread.h \
- ..\unixish.h \
- ..\utf8.h \
- ..\util.h \
- ..\warnings.h \
- ..\XSUB.h \
- ..\EXTERN.h \
- ..\perlvars.h \
- ..\intrpvar.h \
- ..\thrdvar.h \
- .\include\dirent.h \
- .\include\netdb.h \
- .\include\sys\socket.h \
- .\win32.h
-
-CORE_H = $(CORE_NOCFG_H) .\config.h
-
-MICROCORE_OBJ = $(MICROCORE_SRC:.c=.obj)
-CORE_OBJ = $(MICROCORE_OBJ) $(EXTRACORE_SRC:.c=.obj)
-WIN32_OBJ = $(WIN32_SRC:.c=.obj)
-MINICORE_OBJ = $(MICROCORE_OBJ:..\=.\mini\) \
- $(MINIDIR)\miniperlmain$(o) \
- $(MINIDIR)\perlio$(o)
-MINIWIN32_OBJ = $(WIN32_OBJ:.\=.\mini\)
-MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ)
-DLL_OBJ = $(DLL_SRC:.c=.obj)
-X2P_OBJ = $(X2P_SRC:.c=.obj)
-
-PERLDLL_OBJ = $(CORE_OBJ)
-PERLEXE_OBJ = perlmain$(o)
-
-PERLDLL_OBJ = $(PERLDLL_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
-#PERLEXE_OBJ = $(PERLEXE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
-
-!IF "$(USE_SETARGV)" != ""
-SETARGV_OBJ = setargv$(o)
-!ENDIF
-
-DYNALOADER = $(EXTDIR)\DynaLoader\DynaLoader
-SOCKET = $(EXTDIR)\Socket\Socket
-FCNTL = $(EXTDIR)\Fcntl\Fcntl
-OPCODE = $(EXTDIR)\Opcode\Opcode
-SDBM_FILE = $(EXTDIR)\SDBM_File\SDBM_File
-IO = $(EXTDIR)\IO\IO
-POSIX = $(EXTDIR)\POSIX\POSIX
-ATTRS = $(EXTDIR)\attrs\attrs
-THREAD = $(EXTDIR)\Thread\Thread
-B = $(EXTDIR)\B\B
-RE = $(EXTDIR)\re\re
-DUMPER = $(EXTDIR)\Data\Dumper\Dumper
-ERRNO = $(EXTDIR)\Errno\Errno
-PEEK = $(EXTDIR)\Devel\Peek\Peek
-BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader
-DPROF = $(EXTDIR)\Devel\DProf\DProf
-GLOB = $(EXTDIR)\File\Glob\Glob
-HOSTNAME = $(EXTDIR)\Sys\Hostname\Hostname
-STORABLE = $(EXTDIR)\Storable\Storable
-FILTER = $(EXTDIR)\Filter\Util\Call\Call
-ENCODE = $(EXTDIR)\Encode\Encode
-MD5 = $(EXTDIR)\Digest\MD5\MD5
-PERLIOSCALAR = $(EXTDIR)\PerlIO\Scalar\Scalar
-MIMEBASE64 = $(EXTDIR)\MIME\Base64\Base64
-TIMEHIRES = $(EXTDIR)\Time\HiRes\HiRes
-CWD = $(EXTDIR)\Cwd\Cwd
-LISTUTIL = $(EXTDIR)\List\Util\Util
-PERLIOVIA = $(EXTDIR)\PerlIO\Via\Via
-XSTYPEMAP = $(EXTDIR)\XS\Typemap\Typemap
-UNICODENORMALIZE = $(EXTDIR)\Unicode\Normalize\Normalize
-
-SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll
-FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll
-OPCODE_DLL = $(AUTODIR)\Opcode\Opcode.dll
-SDBM_FILE_DLL = $(AUTODIR)\SDBM_File\SDBM_File.dll
-IO_DLL = $(AUTODIR)\IO\IO.dll
-POSIX_DLL = $(AUTODIR)\POSIX\POSIX.dll
-ATTRS_DLL = $(AUTODIR)\attrs\attrs.dll
-THREAD_DLL = $(AUTODIR)\Thread\Thread.dll
-B_DLL = $(AUTODIR)\B\B.dll
-DUMPER_DLL = $(AUTODIR)\Data\Dumper\Dumper.dll
-PEEK_DLL = $(AUTODIR)\Devel\Peek\Peek.dll
-RE_DLL = $(AUTODIR)\re\re.dll
-BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll
-DPROF_DLL = $(AUTODIR)\Devel\DProf\DProf.dll
-GLOB_DLL = $(AUTODIR)\File\Glob\Glob.dll
-HOSTNAME_DLL = $(AUTODIR)\Sys\Hostname\Hostname.dll
-STORABLE_DLL = $(AUTODIR)\Storable\Storable.dll
-FILTER_DLL = $(AUTODIR)\Filter\Util\Call\Call.dll
-ENCODE_DLL = $(AUTODIR)\Encode\Encode.dll
-MD5_DLL = $(AUTODIR)\Digest\MD5\MD5.dll
-PERLIOSCALAR_DLL = $(AUTODIR)\PerlIO\Scalar\Scalar.dll
-MIMEBASE64_DLL = $(AUTODIR)\MIME\Base64\Base64.dll
-TIMEHIRES_DLL = $(AUTODIR)\Time\HiRes\HiRes.dll
-CWD_DLL = $(AUTODIR)\Cwd\Cwd.dll
-LISTUTIL_DLL = $(AUTODIR)\List\Util\Util.dll
-PERLIOVIA_DLL = $(AUTODIR)\PerlIO\Via\Via.dll
-XSTYPEMAP_DLL = $(AUTODIR)\XS\Typemap\Typemap.dll
-UNICODENORMALIZE_DLL = $(AUTODIR)\Unicode\Normalize\Normalize.dll
-
-EXTENSION_C = \
- $(SOCKET).c \
- $(FCNTL).c \
- $(OPCODE).c \
- $(SDBM_FILE).c \
- $(IO).c \
- $(POSIX).c \
- $(ATTRS).c \
- $(THREAD).c \
- $(RE).c \
- $(DUMPER).c \
- $(PEEK).c \
- $(B).c \
- $(BYTELOADER).c \
- $(DPROF).c \
- $(GLOB).c \
- $(HOSTNAME).c \
- $(STORABLE).c \
- $(FILTER).c \
- $(ENCODE).c \
- $(MD5).c \
- $(PERLIOSCALAR).c \
- $(MIMEBASE64).c \
- $(TIMEHIRES).c \
- $(CWD).c \
- $(LISTUTIL).c \
- $(PERLIOVIA).c \
- $(XSTYPEMAP).c \
- $(UNICODENORMALIZE).c
-
-EXTENSION_DLL = \
- $(SOCKET_DLL) \
- $(FCNTL_DLL) \
- $(OPCODE_DLL) \
- $(SDBM_FILE_DLL)\
- $(IO_DLL) \
- $(POSIX_DLL) \
- $(ATTRS_DLL) \
- $(DUMPER_DLL) \
- $(PEEK_DLL) \
- $(B_DLL) \
- $(RE_DLL) \
- $(THREAD_DLL) \
- $(BYTELOADER_DLL) \
- $(DPROF_DLL) \
- $(GLOB_DLL) \
- $(HOSTNAME_DLL) \
- $(STORABLE_DLL) \
- $(FILTER_DLL) \
- $(ENCODE_DLL) \
- $(MD5_DLL) \
- $(PERLIOSCALAR_DLL) \
- $(MIMEBASE64_DLL) \
- $(TIMEHIRES_DLL) \
- $(CWD_DLL) \
- $(LISTUTIL_DLL) \
- $(PERLIOVIA_DLL) \
- $(XSTYPEMAP_DLL) \
- $(UNICODENORMALIZE_DLL)
-
-POD2HTML = $(PODDIR)\pod2html
-POD2MAN = $(PODDIR)\pod2man
-POD2LATEX = $(PODDIR)\pod2latex
-POD2TEXT = $(PODDIR)\pod2text
-
-CFG_VARS = \
- "INST_DRV=$(INST_DRV)" \
- "INST_TOP=$(INST_TOP)" \
- "INST_VER=$(INST_VER)" \
- "INST_ARCH=$(INST_ARCH)" \
- "archname=$(ARCHNAME)" \
- "cc=$(CC)" \
- "ld=$(LINK32)" \
- "ccflags=-nologo -Gf -W3 $(OPTIMIZE:"=\") $(DEFINES) $(BUILDOPT)" \
- "cf_email=$(EMAIL)" \
- "d_crypt=$(D_CRYPT)" \
- "d_mymalloc=$(PERL_MALLOC)" \
- "libs=$(LIBFILES)" \
- "incpath=$(CCINCDIR:"=\")" \
- "libperl=$(PERLIMPLIB:..\=)" \
- "libpth=$(CCLIBDIR:"=\");$(EXTRALIBDIRS:"=\")" \
- "libc=$(LIBC)" \
- "make=$(MAKE_BARE)" \
- "use5005threads=$(USE_5005THREADS)" \
- "useithreads=$(USE_ITHREADS)" \
- "usethreads=$(USE_5005THREADS)" \
- "usemultiplicity=$(USE_MULTI)" \
- "useperlio=$(USE_PERLIO)" \
- "LINK_FLAGS=$(LINK_FLAGS:"=\")" \
- "optimize=$(OPTIMIZE:"=\")"
-
-#
-# Top targets
-#
-
-all : .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) \
- $(X2P) Extensions
- @echo Everything is up to date. '$(MAKE_BARE) test' to run test suite.
-
-$(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
-
-#------------------------------------------------------------
-
-$(GLOBEXE) : perlglob$(o)
- $(LINK32) $(LINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \
- perlglob$(o) setargv$(o)
-
-perlglob$(o) : perlglob.c
-
-config.w32 : $(CFGSH_TMPL)
- copy $(CFGSH_TMPL) config.w32
-
-.\config.h : $(CFGH_TMPL)
- -del /f config.h
- copy $(CFGH_TMPL) config.h
-
-..\config.sh : config.w32 $(MINIPERL) config_sh.PL
- $(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) config.w32 > ..\config.sh
-
-# this target is for when changes to the main config.sh happen
-# edit config.{b,v,g}c and make this target once for each supported
-# compiler (e.g. `nmake CCTYPE=BORLAND regen_config_h`)
-regen_config_h:
- perl config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh
- cd ..
- -del /f perl.exe
- perl configpm
- cd win32
- -del /f $(CFGH_TMPL)
- -mkdir $(COREDIR)
- -perl -I..\lib config_h.PL "INST_VER=$(INST_VER)"
- rename config.h $(CFGH_TMPL)
-
-$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl
- cd ..
- miniperl configpm
- cd win32
- if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL)
- $(XCOPY) ..\*.h $(COREDIR)\*.*
- $(XCOPY) *.h $(COREDIR)\*.*
- $(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.*
- $(RCOPY) include $(COREDIR)\*.*
- -$(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)"
- if errorlevel 1 $(MAKE) /$(MAKEFLAGS) $(CONFIGPM)
-
-$(MINIPERL) : $(MINIDIR) $(MINI_OBJ)
- $(LINK32) -subsystem:console -out:$@ @<<
- $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ)
-<<
-
-$(MINIDIR) :
- if not exist "$(MINIDIR)" mkdir "$(MINIDIR)"
-
-$(MINICORE_OBJ) : $(CORE_NOCFG_H)
- $(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB $(OBJOUT_FLAG)$@ ..\$(*F).c
-
-$(MINIWIN32_OBJ) : $(CORE_NOCFG_H)
- $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*F).c
-
-# -DPERL_IMPLICIT_SYS needs C++ for perllib.c
-# This is the only file that depends on perlhost.h, vmem.h, and vdir.h
-!IF "$(USE_IMP_SYS)" == "define"
-perllib$(o) : perllib.c .\perlhost.h .\vdir.h .\vmem.h
- $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c
-!ENDIF
-
-# 1. we don't want to rebuild miniperl.exe when config.h changes
-# 2. we don't want to rebuild miniperl.exe with non-default config.h
-$(MINI_OBJ) : $(CORE_NOCFG_H)
-
-$(WIN32_OBJ) : $(CORE_H)
-$(CORE_OBJ) : $(CORE_H)
-$(DLL_OBJ) : $(CORE_H)
-$(X2P_OBJ) : $(CORE_H)
-
-perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl
- $(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \
- CCTYPE=$(CCTYPE) > perldll.def
-
-$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES)
- $(LINK32) -dll -def:perldll.def -base:0x28000000 -out:$@ @<<
- $(LINK_FLAGS) $(DELAYLOAD) $(LIBFILES) $(PERLDLL_OBJ) $(PERLDLL_RES)
-<<
- $(XCOPY) $(PERLIMPLIB) $(COREDIR)
-
-$(MINIMOD) : $(MINIPERL) ..\minimod.pl
- cd ..
- miniperl minimod.pl > lib\ExtUtils\Miniperl.pm
- cd win32
-
-..\x2p\a2p$(o) : ..\x2p\a2p.c
- $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\a2p.c
-
-..\x2p\hash$(o) : ..\x2p\hash.c
- $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\hash.c
-
-..\x2p\str$(o) : ..\x2p\str.c
- $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\str.c
-
-..\x2p\util$(o) : ..\x2p\util.c
- $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\util.c
-
-..\x2p\walk$(o) : ..\x2p\walk.c
- $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\walk.c
-
-$(X2P) : $(MINIPERL) $(X2P_OBJ)
- $(MINIPERL) ..\x2p\find2perl.PL
- $(MINIPERL) ..\x2p\s2p.PL
- $(LINK32) -subsystem:console -out:$@ @<<
- $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ)
-<<
-
-perlmain.c : runperl.c
- copy runperl.c perlmain.c
-
-perlmain$(o) : perlmain.c
- $(CC) $(CFLAGS_O) -UPERLDLL $(OBJOUT_FLAG)$@ -c perlmain.c
-
-$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) $(PERLEXE_RES)
- $(LINK32) -subsystem:console -out:$@ -stack:0x1000000 $(LINK_FLAGS) \
- $(LIBFILES) $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) $(PERLEXE_RES)
- copy $(PERLEXE) $(WPERLEXE)
- $(MINIPERL) -I..\lib bin\exetype.pl $(WPERLEXE) WINDOWS
- copy splittree.pl ..
- $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR)
-
-$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
- if not exist $(AUTODIR) mkdir $(AUTODIR)
- cd $(EXTDIR)\$(*B)
- ..\$(MINIPERL) -I..\..\lib $(*B)_pm.PL
- ..\$(MINIPERL) -I..\..\lib XSLoader_pm.PL
- cd ..\..\win32
- $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
- $(XCOPY) $(EXTDIR)\$(*B)\XSLoader.pm $(LIBDIR)\$(NULL)
- cd $(EXTDIR)\$(*B)
- $(XSUBPP) dl_win32.xs > $(*B).c
- cd ..\..\win32
-
-$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
- copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
-
-#----------------------------------------------------------------------------------
-Extensions: buildext.pl $(PERLDEP) $(CONFIGPM)
- $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR)
-
-Extensions_clean:
- -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) clean
-
-#----------------------------------------------------------------------------------
-
-doc: $(PERLEXE)
- $(PERLEXE) -I..\lib ..\installhtml --podroot=.. --htmldir=./html \
- --podpath=pod:lib:ext:utils --htmlroot="file://$(INST_HTML::=|)" \
- --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse
-
-utils: $(PERLEXE) $(X2P)
- cd ..\utils
- $(MAKE) PERL=$(MINIPERL)
- cd ..\pod
- copy ..\README.aix .\perlaix.pod
- copy ..\README.amiga .\perlamiga.pod
- copy ..\README.apollo .\perlapollo.pod
- copy ..\README.beos .\perlbeos.pod
- copy ..\README.bs2000 .\perlbs2000.pod
- copy ..\README.ce .\perlce.pod
- copy ..\README.cygwin .\perlcygwin.pod
- copy ..\README.dgux .\perldgux.pod
- copy ..\README.dos .\perldos.pod
- copy ..\README.epoc .\perlepoc.pod
- copy ..\README.hurd .\perlhurd.pod
- copy ..\README.hpux .\perlhpux.pod
- copy ..\README.machten .\perlmachten.pod
- copy ..\README.macos .\perlmacos.pod
- copy ..\README.mint .\perlmint.pod
- copy ..\README.mpeix .\perlmpeix.pod
- copy ..\README.netware .\perlnetware.pod
- copy ..\README.os2 .\perlos2.pod
- copy ..\README.os390 .\perlos390.pod
- copy ..\README.plan9 .\perlplan9.pod
- copy ..\README.qnx .\perlqnx.pod
- copy ..\README.solaris .\perlsolaris.pod
- copy ..\README.tru64 .\perltru64.pod
- copy ..\README.uts .\perluts.pod
- copy ..\README.vmesa .\perlvmesa.pod
- copy ..\vms\perlvms.pod .\perlvms.pod
- copy ..\README.vos .\perlvos.pod
- copy ..\README.win32 .\perlwin32.pod
- $(MAKE) -f ..\win32\pod.mak converters
- cd ..\lib
- $(PERLEXE) lib_pm.PL
- cd ..\win32
- $(PERLEXE) $(PL2BAT) $(UTILS)
-
-distclean: clean
- -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \
- $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD)
- -del /f *.def *.map
- -del /f $(EXTENSION_DLL)
- -del /f $(EXTENSION_C) $(DYNALOADER).c $(ERRNO).pm
- -del /f $(EXTDIR)\DynaLoader\dl_win32.xs
- -del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm
- -del /f $(LIBDIR)\XSLoader.pm
- -del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm
- -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm
- -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm
- -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm
- -del /f $(LIBDIR)\Data\Dumper.pm $(LIBDIR)\ByteLoader.pm
- -del /f $(LIBDIR)\Devel\Peek.pm $(LIBDIR)\Devel\DProf.pm
- -del /f $(LIBDIR)\File\Glob.pm
- -del /f $(LIBDIR)\Storable.pm
- -del /f $(LIBDIR)\Filter\Util\Call.pm
- -del /f $(LIBDIR)\Digest\MD5.pm
- -del /f $(LIBDIR)\PerlIO\Scalar.pm
- -del /f $(LIBDIR)\PerlIO\Via.pm
- -del /f $(LIBDIR)\MIME\Base64.pm
- -del /f $(LIBDIR)\MIME\QuotedPrint.pm
- -del /f $(LIBDIR)\List\Util.pm
- -del /f $(LIBDIR)\Scalar\Util.pm
- -del /f $(LIBDIR)\Time\HiRes.pm
- -del /f $(LIBDIR)\XS\Typemap.pm
- -del /f $(LIBDIR)\Unicode\Normalize.pm
- -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO
- -rmdir /s $(LIBDIR)\IO
- -if exist $(LIBDIR)\Thread rmdir /s /q $(LIBDIR)\Thread
- -rmdir /s $(LIBDIR)\Thread
- -if exist $(LIBDIR)\B rmdir /s /q $(LIBDIR)\B
- -rmdir /s $(LIBDIR)\B
- -if exist $(LIBDIR)\Data rmdir /s /q $(LIBDIR)\Data
- -rmdir /s $(LIBDIR)\Data
- -if exist $(LIBDIR)\Filter\Util rmdir /s /q $(LIBDIR)\Filter\Util
- -if exist $(LIBDIR)\Digest rmdir /s /q $(LIBDIR)\Digest
- -rmdir /s $(LIBDIR)\Digest
- -if exist $(LIBDIR)\MIME rmdir /s /q $(LIBDIR)\MIME
- -rmdir /s $(LIBDIR)\MIME
- -if exist $(LIBDIR)\List rmdir /s /q $(LIBDIR)\List
- -rmdir /s $(LIBDIR)\List
- -if exist $(LIBDIR)\Scalar rmdir /s /q $(LIBDIR)\Scalar
- -rmdir /s $(LIBDIR)\Scalar
- -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
- -rmdir /s $(LIBDIR)\XS
- cd $(PODDIR)
- -del /f *.html *.bat checkpods \
- perlaix.pod perlamiga.pod perlapollo.pod perlbeos.pod \
- perlbs2000.pod perlce.pod perlcygwin.pod perldgux.pod \
- perldos.pod perlepoc.pod perlhurd.pod \
- perlhpux.pod perlmachten.pod \
- perlmacos.pod perlmint.pod perlmpeix.pod perlnetware.pod \
- perlos2.pod perlos390.pod perlplan9.pod perlqnx.pod \
- perlsolaris.pod perltru64.pod perluts.pod \
- perlvmesa.pod perlvms.pod perlvos.pod \
- perlwin32.pod pod2html pod2latex pod2man pod2text pod2usage \
- podchecker podselect
- cd ..\utils
- -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc perlivp dprofpp
- -del /f *.bat
- cd ..\win32
- cd ..\x2p
- -del /f find2perl s2p
- -del /f *.bat
- cd ..\win32
- -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
- -del /f $(CONFIGPM)
- -del /f bin\*.bat
- cd $(EXTDIR)
- -del /s *.lib *.def *.map *.pdb *.bs Makefile *$(o) pm_to_blib
- cd ..\win32
- -if exist $(AUTODIR) rmdir /s /q $(AUTODIR)
- -rmdir /s $(AUTODIR)
- -if exist $(COREDIR) rmdir /s /q $(COREDIR)
- -rmdir /s $(COREDIR)
-
-install : all installbare installhtml
-
-installbare : utils
- $(PERLEXE) ..\installperl
- if exist $(WPERLEXE) $(XCOPY) $(WPERLEXE) $(INST_BIN)\*.*
- $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
- $(XCOPY) bin\*.bat $(INST_SCRIPT)\*.*
-
-installhtml : doc
- $(RCOPY) html\*.* $(INST_HTML)\*.*
-
-inst_lib : $(CONFIGPM)
- copy splittree.pl ..
- $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR)
- $(RCOPY) ..\lib $(INST_LIB)\*.*
-
-minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM) utils
- $(XCOPY) $(MINIPERL) ..\t\perl.exe
- $(XCOPY) $(GLOBEXE) ..\t\$(NULL)
- attrib -r ..\t\*.*
- copy test ..\t
- cd ..\t
- $(MINIPERL) -I..\lib test base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t
- cd ..\win32
-
-test-prep : all utils
- $(XCOPY) $(PERLEXE) ..\t\$(NULL)
- $(XCOPY) $(PERLDLL) ..\t\$(NULL)
- $(XCOPY) $(GLOBEXE) ..\t\$(NULL)
-
-test : test-prep
- cd ..\t
- $(PERLEXE) -I..\lib harness
- cd ..\win32
-
-test-notty : test-prep
- set PERL_SKIP_TTY_TEST=1
- cd ..\t
- $(PERLEXE) -I..\lib harness
- cd ..\win32
-
-test-wide : test-prep
- set HARNESS_PERL_SWITCHES=-C
- cd ..\t
- $(PERLEXE) -I..\lib harness
- cd ..\win32
-
-test-wide-notty : test-prep
- set PERL_SKIP_TTY_TEST=1
- set HARNESS_PERL_SWITCHES=-C
- cd ..\t
- $(PERLEXE) -I..\lib harness
- cd ..\win32
-
-clean : Extensions_clean
- -@$(DEL) miniperlmain$(o)
- -@$(DEL) $(MINIPERL)
- -@$(DEL) perlglob$(o)
- -@$(DEL) perlmain$(o)
- -@$(DEL) config.w32
- -@$(DEL) config.h
- -@$(DEL) $(GLOBEXE)
- -@$(DEL) $(PERLEXE)
- -@$(DEL) $(WPERLEXE)
- -@$(DEL) $(PERLDLL)
- -@$(DEL) $(CORE_OBJ)
- -if exist $(MINIDIR) rmdir /s /q $(MINIDIR)
- -rmdir /s $(MINIDIR)
- -@$(DEL) $(WIN32_OBJ)
- -@$(DEL) $(DLL_OBJ)
- -@$(DEL) $(X2P_OBJ)
- -@$(DEL) ..\*$(o) ..\*.lib ..\*.exp *$(o) *.lib *.exp *.res
- -@$(DEL) ..\t\*.exe ..\t\*.dll ..\t\*.bat
- -@$(DEL) ..\x2p\*.exe ..\x2p\*.bat
- -@$(DEL) *.ilk
- -@$(DEL) *.pdb
-
-# Handy way to run perlbug -ok without having to install and run the
-# installed perlbug. We don't re-run the tests here - we trust the user.
-# Please *don't* use this unless all tests pass.
-# If you want to report test failures, use "nmake nok" instead.
-ok: utils
- $(PERLEXE) -I..\lib ..\utils\perlbug -ok -s "(UNINSTALLED)"
-
-okfile: utils
- $(PERLEXE) -I..\lib ..\utils\perlbug -ok -s "(UNINSTALLED)" -F perl.ok
-
-nok: utils
- $(PERLEXE) -I..\lib ..\utils\perlbug -nok -s "(UNINSTALLED)"
-
-nokfile: utils
- $(PERLEXE) -I..\lib ..\utils\perlbug -nok -s "(UNINSTALLED)" -F perl.nok
+# +# Makefile to build perl on Windows NT using Microsoft NMAKE. +# Supported compilers: +# Visual C++ 5.x (possibly other versions) +# +# This is set up to build a perl.exe that runs off a shared library +# (perl57.dll). Also makes individual DLLs for the XS extensions. +# + +## +## Make sure you read README.win32 *before* you mess with anything here! +## + +## +## Build configuration. Edit the values below to suit your needs. +## + +# +# Set these to wherever you want "nmake install" to put your +# newly built perl. +# +INST_DRV = c: +INST_TOP = $(INST_DRV)\perl + +# +# Comment this out if you DON'T want your perl installation to be versioned. +# This means that the new installation will overwrite any files from the +# old installation at the same INST_TOP location. Leaving it enabled is +# the safest route, as perl adds the extra version directory to all the +# locations it installs files to. If you disable it, an alternative +# versioned installation can be obtained by setting INST_TOP above to a +# path that includes an arbitrary version string. +# +#INST_VER = \5.7.2 + +# +# Comment this out if you DON'T want your perl installation to have +# architecture specific components. This means that architecture- +# specific files will be installed along with the architecture-neutral +# files. Leaving it enabled is safer and more flexible, in case you +# want to build multiple flavors of perl and install them together in +# the same location. Commenting it out gives you a simpler +# installation that is easier to understand for beginners. +# +#INST_ARCH = \$(ARCHNAME) + +# +# uncomment to enable multiple interpreters. This is need for fork() +# emulation. +# +USE_MULTI = define + +# +# Beginnings of interpreter cloning/threads; still very incomplete. +# This should be enabled to get the fork() emulation. This needs +# USE_MULTI as well. +# +USE_ITHREADS = define + +# +# uncomment to enable the implicit "host" layer for all system calls +# made by perl. This needs USE_MULTI above. This is also needed to +# get fork(). +# +USE_IMP_SYS = define + +# +# uncomment to enable the experimental PerlIO I/O subsystem. +USE_PERLIO = define + +# +# WARNING! This option is deprecated and will eventually go away (enable +# USE_ITHREADS instead). +# +# uncomment to enable threads-capabilities. This is incompatible with +# USE_ITHREADS, and is only here for people who may have come to rely +# on the experimental Thread support that was in 5.005. +# +#USE_5005THREADS = define + +# +# uncomment one of the following lines if you are using either +# Visual C++ 2.x or Visual C++ 6.x (aka Visual Studio 98) +# +#CCTYPE = MSVC20 +#CCTYPE = MSVC60 + +# +# uncomment next line if you want debug version of perl (big,slow) +# +#CFG = Debug + +# +# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler. +# It has patches that fix known bugs in older versions of MSVCRT.DLL. +# This currently requires VC 5.0 with Service Pack 3 or later. +# Get it from CPAN at http://www.cpan.org/authors/id/D/DO/DOUGL/ +# and follow the directions in the package to install. +# +# Not recommended if you have VC 6.x and you're not running Windows 9x. +# +#USE_PERLCRT = define + +# +# uncomment to enable linking with setargv.obj under the Visual C +# compiler. Setting this options enables perl to expand wildcards in +# arguments, but it may be harder to use alternate methods like +# File::DosGlob that are more powerful. This option is supported only with +# Visual C. +# +#USE_SETARGV = define + +# +# if you have the source for des_fcrypt(), uncomment this and make sure the +# file exists (see README.win32). File should be located in the same +# directory as this file. +# +#CRYPT_SRC = fcrypt.c + +# +# if you didn't set CRYPT_SRC and if you have des_fcrypt() available in a +# library, uncomment this, and make sure the library exists (see README.win32) +# Specify the full pathname of the library. +# +#CRYPT_LIB = fcrypt.lib + +# +# set this if you wish to use perl's malloc +# WARNING: Turning this on/off WILL break binary compatibility with extensions +# you may have compiled with/without it. Be prepared to recompile all +# extensions if you change the default. Currently, this cannot be enabled +# if you ask for USE_IMP_SYS above. +# +#PERL_MALLOC = define + +# +# set the install locations of the compiler include/libraries +# Running VCVARS32.BAT is *required* when using Visual C. +# Some versions of Visual C don't define MSVCDIR in the environment, +# so you may have to set CCHOME explicitly (spaces in the path name should +# not be quoted) +# +#CCHOME = f:\msvc20 +CCHOME = $(MSVCDIR) +CCINCDIR = $(CCHOME)\include +CCLIBDIR = $(CCHOME)\lib + +# +# Additional compiler flags can be specified here. +# + +# +# This should normally be disabled. Adding -DPERL_POLLUTE enables support +# for old symbols by default, at the expense of extreme pollution. You most +# probably just want to build modules that won't compile with +# perl Makefile.PL POLLUTE=1 +# instead of enabling this. Please report such modules to the respective +# authors. +# +#BUILDOPT = $(BUILDOPT) -DPERL_POLLUTE + +# +# This should normally be disabled. Enabling it will disable the File::Glob +# implementation of CORE::glob. +# +#BUILDOPT = $(BUILDOPT) -DPERL_EXTERNAL_GLOB + +# +# This should normally be disabled. Enabling it causes perl to read scripts +# in text mode (which is the 5.005 behavior) and will break ByteLoader. +#BUILDOPT = $(BUILDOPT) -DPERL_TEXTMODE_SCRIPTS + +# +# specify semicolon-separated list of extra directories that modules will +# look for libraries (spaces in path names need not be quoted) +# +EXTRALIBDIRS = + +# +# set this to your email address (perl will guess a value from +# from your loginname and your hostname, which may not be right) +# +#EMAIL = + +## +## Build configuration ends. +## + +##################### CHANGE THESE ONLY IF YOU MUST ##################### + +!IF "$(CRYPT_SRC)$(CRYPT_LIB)" == "" +D_CRYPT = undef +!ELSE +D_CRYPT = define +CRYPT_FLAG = -DHAVE_DES_FCRYPT +!ENDIF + +!IF "$(PERL_MALLOC)" == "" +PERL_MALLOC = undef +!ENDIF + +!IF "$(USE_5005THREADS)" == "" +USE_5005THREADS = undef +!ENDIF + +!IF "$(USE_5005THREADS)" == "define" +USE_ITHREADS = undef +!ENDIF + +!IF "$(USE_IMP_SYS)" == "define" +PERL_MALLOC = undef +!ENDIF + +!IF "$(USE_MULTI)" == "" +USE_MULTI = undef +!ENDIF + +!IF "$(USE_ITHREADS)" == "" +USE_ITHREADS = undef +!ENDIF + +!IF "$(USE_IMP_SYS)" == "" +USE_IMP_SYS = undef +!ENDIF + +!IF "$(USE_PERLIO)" == "" +USE_PERLIO = undef +!ENDIF + +!IF "$(USE_PERLCRT)" == "" +USE_PERLCRT = undef +!ENDIF + +!IF "$(USE_IMP_SYS)$(USE_MULTI)$(USE_5005THREADS)" == "defineundefundef" +USE_MULTI = define +!ENDIF + +!IF "$(USE_ITHREADS)$(USE_MULTI)" == "defineundef" +USE_MULTI = define +USE_5005THREADS = undef +!ENDIF + +!IF "$(USE_MULTI)$(USE_5005THREADS)" != "undefundef" +BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT +!ENDIF + +!IF "$(USE_IMP_SYS)" != "undef" +BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS +!ENDIF + +!IF "$(PROCESSOR_ARCHITECTURE)" == "" +PROCESSOR_ARCHITECTURE = x86 +!ENDIF + +!IF "$(USE_5005THREADS)" == "define" +ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread +!ELSE +!IF "$(USE_MULTI)" == "define" +ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi +!ELSE +!IF "$(USE_PERLIO)" == "define" +ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-perlio +!ELSE +ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) +!ENDIF +!ENDIF +!ENDIF + +!IF "$(USE_PERLIO)" == "define" +BUILDOPT = $(BUILDOPT) -DUSE_PERLIO +!ENDIF + +!IF "$(USE_ITHREADS)" == "define" +ARCHNAME = $(ARCHNAME)-thread +!ENDIF + +# Visual Studio 98 specific +!IF "$(CCTYPE)" == "MSVC60" + +# VC 6.0 can load the socket dll on demand. Makes the test suite +# run in about 10% less time. +DELAYLOAD = -DELAYLOAD:wsock32.dll -DELAYLOAD:shell32.dll delayimp.lib +!ENDIF + +ARCHDIR = ..\lib\$(ARCHNAME) +COREDIR = ..\lib\CORE +AUTODIR = ..\lib\auto +LIBDIR = ..\lib +EXTDIR = ..\ext +PODDIR = ..\pod +EXTUTILSDIR = $(LIBDIR)\ExtUtils + +# +INST_SCRIPT = $(INST_TOP)$(INST_VER)\bin +INST_BIN = $(INST_SCRIPT)$(INST_ARCH) +INST_LIB = $(INST_TOP)$(INST_VER)\lib +INST_ARCHLIB = $(INST_LIB)$(INST_ARCH) +INST_COREDIR = $(INST_ARCHLIB)\CORE +INST_POD = $(INST_LIB)\pod +INST_HTML = $(INST_TOP)$(INST_VER)\html + +# +# Programs to compile, build .lib files and link +# + +CC = cl +LINK32 = link +LIB32 = $(LINK32) -lib +RSC = rc + +# +# Options +# + +INCLUDES = -I$(COREDIR) -I.\include -I. -I.. +#PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX +DEFINES = -DWIN32 -D_CONSOLE -DNO_STRICT $(CRYPT_FLAG) +LOCDEFS = -DPERLDLL -DPERL_CORE +SUBSYS = console +CXX_FLAG = -TP -GX + +!IF "$(USE_PERLCRT)" != "define" +LIBC = msvcrt.lib +!ELSE +LIBC = PerlCRT.lib +!ENDIF + +PERLEXE_RES = +PERLDLL_RES = + +!IF "$(CFG)" == "Debug" +! IF "$(CCTYPE)" == "MSVC20" +OPTIMIZE = -Od -MD -Z7 -DDEBUGGING +! ELSE +OPTIMIZE = -Od -MD -Zi -DDEBUGGING +! ENDIF +LINK_DBG = -debug -pdb:none +!ELSE +# -O1 yields smaller code, which turns out to be faster than -O2 +#OPTIMIZE = -O2 -MD -DNDEBUG +OPTIMIZE = -O1 -MD -DNDEBUG +LINK_DBG = -release +!ENDIF + +!IF "$(USE_PERLCRT)" != "define" +BUILDOPT = $(BUILDOPT) -DPERL_MSVCRT_READFIX +!ENDIF + +LIBBASEFILES = $(CRYPT_LIB) \ + oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib \ + comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib \ + netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ + version.lib odbc32.lib odbccp32.lib + +# we add LIBC here, since we may be using PerlCRT.dll +LIBFILES = $(LIBBASEFILES) $(LIBC) + +CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \ + $(PCHFLAGS) $(OPTIMIZE) +LINK_FLAGS = -nologo -nodefaultlib $(LINK_DBG) \ + -libpath:"$(INST_COREDIR)" \ + -machine:$(PROCESSOR_ARCHITECTURE) +OBJOUT_FLAG = -Fo +EXEOUT_FLAG = -Fe + +CFLAGS_O = $(CFLAGS) $(BUILDOPT) + +#################### do not edit below this line ####################### +############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## + +o = .obj + +# +# Rules +# + +.SUFFIXES : .c $(o) .dll .lib .exe .rc .res + +.c$(o): + $(CC) -c -I$(<D) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $< + +.y.c: + $(NOOP) + +$(o).dll: + $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \ + -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL) + +.rc.res: + $(RSC) -i.. $< + +# +# various targets + +# makedef.pl must be updated if this changes, and this should normally +# only change when there is an incompatible revision of the public API. +# XXX so why did we change it from perl56 to perl57? +PERLIMPLIB = ..\perl57.lib +PERLDLL = ..\perl57.dll + +MINIPERL = ..\miniperl.exe +MINIDIR = .\mini +PERLEXE = ..\perl.exe +WPERLEXE = ..\wperl.exe +GLOBEXE = ..\perlglob.exe +CONFIGPM = ..\lib\Config.pm +MINIMOD = ..\lib\ExtUtils\Miniperl.pm +X2P = ..\x2p\a2p.exe + +# Nominate a target which causes extensions to be re-built +# This used to be $(PERLEXE), but at worst it is the .dll that they depend +# on and really only the interface - i.e. the .def file used to export symbols +# from the .dll +PERLDEP = perldll.def + +PL2BAT = bin\pl2bat.pl +GLOBBAT = bin\perlglob.bat + +UTILS = \ + ..\utils\h2ph \ + ..\utils\splain \ + ..\utils\dprofpp \ + ..\utils\perlbug \ + ..\utils\pl2pm \ + ..\utils\c2ph \ + ..\utils\h2xs \ + ..\utils\perldoc \ + ..\utils\perlcc \ + ..\utils\perlivp \ + ..\utils\libnetcfg \ + ..\pod\checkpods \ + ..\pod\pod2html \ + ..\pod\pod2latex \ + ..\pod\pod2man \ + ..\pod\pod2text \ + ..\pod\pod2usage \ + ..\pod\podchecker \ + ..\pod\podselect \ + ..\x2p\find2perl \ + ..\x2p\s2p \ + ..\lib\ExtUtils\xsubpp \ + bin\exetype.pl \ + bin\runperl.pl \ + bin\pl2bat.pl \ + bin\perlglob.pl \ + bin\search.pl + +MAKE = nmake -nologo +MAKE_BARE = nmake + +CFGSH_TMPL = config.vc +CFGH_TMPL = config_H.vc + +XCOPY = xcopy /f /r /i /d +RCOPY = xcopy /f /r /i /e /d +NOOP = @echo +NULL = + +DEL = del + +# +# filenames given to xsubpp must have forward slashes (since it puts +# full pathnames in #line strings) +XSUBPP = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \ + -C++ -prototypes + +MICROCORE_SRC = \ + ..\av.c \ + ..\deb.c \ + ..\doio.c \ + ..\doop.c \ + ..\dump.c \ + ..\globals.c \ + ..\gv.c \ + ..\hv.c \ + ..\locale.c \ + ..\mg.c \ + ..\numeric.c \ + ..\op.c \ + ..\perl.c \ + ..\perlapi.c \ + ..\perly.c \ + ..\pp.c \ + ..\pp_ctl.c \ + ..\pp_hot.c \ + ..\pp_pack.c \ + ..\pp_sort.c \ + ..\pp_sys.c \ + ..\regcomp.c \ + ..\regexec.c \ + ..\run.c \ + ..\scope.c \ + ..\sv.c \ + ..\taint.c \ + ..\toke.c \ + ..\universal.c \ + ..\utf8.c \ + ..\util.c \ + ..\xsutils.c + +EXTRACORE_SRC = $(EXTRACORE_SRC) perllib.c + +!IF "$(PERL_MALLOC)" == "define" +EXTRACORE_SRC = $(EXTRACORE_SRC) ..\malloc.c +!ENDIF + +EXTRACORE_SRC = $(EXTRACORE_SRC) ..\perlio.c + +WIN32_SRC = \ + .\win32.c \ + .\win32sck.c \ + .\win32thread.c + +!IF "$(USE_PERLIO)" == "define" +WIN32_SRC = $(WIN32_SRC) .\win32io.c +!ENDIF + +!IF "$(CRYPT_SRC)" != "" +WIN32_SRC = $(WIN32_SRC) .\$(CRYPT_SRC) +!ENDIF + +DLL_SRC = $(DYNALOADER).c + +X2P_SRC = \ + ..\x2p\a2p.c \ + ..\x2p\hash.c \ + ..\x2p\str.c \ + ..\x2p\util.c \ + ..\x2p\walk.c + +CORE_NOCFG_H = \ + ..\av.h \ + ..\cop.h \ + ..\cv.h \ + ..\dosish.h \ + ..\embed.h \ + ..\form.h \ + ..\gv.h \ + ..\handy.h \ + ..\hv.h \ + ..\iperlsys.h \ + ..\mg.h \ + ..\nostdio.h \ + ..\op.h \ + ..\opcode.h \ + ..\perl.h \ + ..\perlapi.h \ + ..\perlsdio.h \ + ..\perlsfio.h \ + ..\perly.h \ + ..\pp.h \ + ..\proto.h \ + ..\regexp.h \ + ..\scope.h \ + ..\sv.h \ + ..\thread.h \ + ..\unixish.h \ + ..\utf8.h \ + ..\util.h \ + ..\warnings.h \ + ..\XSUB.h \ + ..\EXTERN.h \ + ..\perlvars.h \ + ..\intrpvar.h \ + ..\thrdvar.h \ + .\include\dirent.h \ + .\include\netdb.h \ + .\include\sys\socket.h \ + .\win32.h + +CORE_H = $(CORE_NOCFG_H) .\config.h + +MICROCORE_OBJ = $(MICROCORE_SRC:.c=.obj) +CORE_OBJ = $(MICROCORE_OBJ) $(EXTRACORE_SRC:.c=.obj) +WIN32_OBJ = $(WIN32_SRC:.c=.obj) +MINICORE_OBJ = $(MICROCORE_OBJ:..\=.\mini\) \ + $(MINIDIR)\miniperlmain$(o) \ + $(MINIDIR)\perlio$(o) +MINIWIN32_OBJ = $(WIN32_OBJ:.\=.\mini\) +MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ) +DLL_OBJ = $(DLL_SRC:.c=.obj) +X2P_OBJ = $(X2P_SRC:.c=.obj) + +PERLDLL_OBJ = $(CORE_OBJ) +PERLEXE_OBJ = perlmain$(o) + +PERLDLL_OBJ = $(PERLDLL_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +#PERLEXE_OBJ = $(PERLEXE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) + +!IF "$(USE_SETARGV)" != "" +SETARGV_OBJ = setargv$(o) +!ENDIF + +DYNALOADER = $(EXTDIR)\DynaLoader\DynaLoader +SOCKET = $(EXTDIR)\Socket\Socket +FCNTL = $(EXTDIR)\Fcntl\Fcntl +OPCODE = $(EXTDIR)\Opcode\Opcode +SDBM_FILE = $(EXTDIR)\SDBM_File\SDBM_File +IO = $(EXTDIR)\IO\IO +POSIX = $(EXTDIR)\POSIX\POSIX +ATTRS = $(EXTDIR)\attrs\attrs +THREAD = $(EXTDIR)\Thread\Thread +B = $(EXTDIR)\B\B +RE = $(EXTDIR)\re\re +DUMPER = $(EXTDIR)\Data\Dumper\Dumper +ERRNO = $(EXTDIR)\Errno\Errno +PEEK = $(EXTDIR)\Devel\Peek\Peek +BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader +DPROF = $(EXTDIR)\Devel\DProf\DProf +GLOB = $(EXTDIR)\File\Glob\Glob +HOSTNAME = $(EXTDIR)\Sys\Hostname\Hostname +STORABLE = $(EXTDIR)\Storable\Storable +FILTER = $(EXTDIR)\Filter\Util\Call\Call +ENCODE = $(EXTDIR)\Encode\Encode +MD5 = $(EXTDIR)\Digest\MD5\MD5 +PERLIOSCALAR = $(EXTDIR)\PerlIO\Scalar\Scalar +MIMEBASE64 = $(EXTDIR)\MIME\Base64\Base64 +TIMEHIRES = $(EXTDIR)\Time\HiRes\HiRes +CWD = $(EXTDIR)\Cwd\Cwd +LISTUTIL = $(EXTDIR)\List\Util\Util +PERLIOVIA = $(EXTDIR)\PerlIO\Via\Via +XSTYPEMAP = $(EXTDIR)\XS\Typemap\Typemap +UNICODENORMALIZE = $(EXTDIR)\Unicode\Normalize\Normalize + +SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll +FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll +OPCODE_DLL = $(AUTODIR)\Opcode\Opcode.dll +SDBM_FILE_DLL = $(AUTODIR)\SDBM_File\SDBM_File.dll +IO_DLL = $(AUTODIR)\IO\IO.dll +POSIX_DLL = $(AUTODIR)\POSIX\POSIX.dll +ATTRS_DLL = $(AUTODIR)\attrs\attrs.dll +THREAD_DLL = $(AUTODIR)\Thread\Thread.dll +B_DLL = $(AUTODIR)\B\B.dll +DUMPER_DLL = $(AUTODIR)\Data\Dumper\Dumper.dll +PEEK_DLL = $(AUTODIR)\Devel\Peek\Peek.dll +RE_DLL = $(AUTODIR)\re\re.dll +BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll +DPROF_DLL = $(AUTODIR)\Devel\DProf\DProf.dll +GLOB_DLL = $(AUTODIR)\File\Glob\Glob.dll +HOSTNAME_DLL = $(AUTODIR)\Sys\Hostname\Hostname.dll +STORABLE_DLL = $(AUTODIR)\Storable\Storable.dll +FILTER_DLL = $(AUTODIR)\Filter\Util\Call\Call.dll +ENCODE_DLL = $(AUTODIR)\Encode\Encode.dll +MD5_DLL = $(AUTODIR)\Digest\MD5\MD5.dll +PERLIOSCALAR_DLL = $(AUTODIR)\PerlIO\Scalar\Scalar.dll +MIMEBASE64_DLL = $(AUTODIR)\MIME\Base64\Base64.dll +TIMEHIRES_DLL = $(AUTODIR)\Time\HiRes\HiRes.dll +CWD_DLL = $(AUTODIR)\Cwd\Cwd.dll +LISTUTIL_DLL = $(AUTODIR)\List\Util\Util.dll +PERLIOVIA_DLL = $(AUTODIR)\PerlIO\Via\Via.dll +XSTYPEMAP_DLL = $(AUTODIR)\XS\Typemap\Typemap.dll +UNICODENORMALIZE_DLL = $(AUTODIR)\Unicode\Normalize\Normalize.dll + +EXTENSION_C = \ + $(SOCKET).c \ + $(FCNTL).c \ + $(OPCODE).c \ + $(SDBM_FILE).c \ + $(IO).c \ + $(POSIX).c \ + $(ATTRS).c \ + $(THREAD).c \ + $(RE).c \ + $(DUMPER).c \ + $(PEEK).c \ + $(B).c \ + $(BYTELOADER).c \ + $(DPROF).c \ + $(GLOB).c \ + $(HOSTNAME).c \ + $(STORABLE).c \ + $(FILTER).c \ + $(ENCODE).c \ + $(MD5).c \ + $(PERLIOSCALAR).c \ + $(MIMEBASE64).c \ + $(TIMEHIRES).c \ + $(CWD).c \ + $(LISTUTIL).c \ + $(PERLIOVIA).c \ + $(XSTYPEMAP).c \ + $(UNICODENORMALIZE).c + +EXTENSION_DLL = \ + $(SOCKET_DLL) \ + $(FCNTL_DLL) \ + $(OPCODE_DLL) \ + $(SDBM_FILE_DLL)\ + $(IO_DLL) \ + $(POSIX_DLL) \ + $(ATTRS_DLL) \ + $(DUMPER_DLL) \ + $(PEEK_DLL) \ + $(B_DLL) \ + $(RE_DLL) \ + $(THREAD_DLL) \ + $(BYTELOADER_DLL) \ + $(DPROF_DLL) \ + $(GLOB_DLL) \ + $(HOSTNAME_DLL) \ + $(STORABLE_DLL) \ + $(FILTER_DLL) \ + $(ENCODE_DLL) \ + $(MD5_DLL) \ + $(PERLIOSCALAR_DLL) \ + $(MIMEBASE64_DLL) \ + $(TIMEHIRES_DLL) \ + $(CWD_DLL) \ + $(LISTUTIL_DLL) \ + $(PERLIOVIA_DLL) \ + $(XSTYPEMAP_DLL) \ + $(UNICODENORMALIZE_DLL) + +POD2HTML = $(PODDIR)\pod2html +POD2MAN = $(PODDIR)\pod2man +POD2LATEX = $(PODDIR)\pod2latex +POD2TEXT = $(PODDIR)\pod2text + +CFG_VARS = \ + "INST_DRV=$(INST_DRV)" \ + "INST_TOP=$(INST_TOP)" \ + "INST_VER=$(INST_VER)" \ + "INST_ARCH=$(INST_ARCH)" \ + "archname=$(ARCHNAME)" \ + "cc=$(CC)" \ + "ld=$(LINK32)" \ + "ccflags=-nologo -Gf -W3 $(OPTIMIZE:"=\") $(DEFINES) $(BUILDOPT)" \ + "cf_email=$(EMAIL)" \ + "d_crypt=$(D_CRYPT)" \ + "d_mymalloc=$(PERL_MALLOC)" \ + "libs=$(LIBFILES)" \ + "incpath=$(CCINCDIR:"=\")" \ + "libperl=$(PERLIMPLIB:..\=)" \ + "libpth=$(CCLIBDIR:"=\");$(EXTRALIBDIRS:"=\")" \ + "libc=$(LIBC)" \ + "make=$(MAKE_BARE)" \ + "use5005threads=$(USE_5005THREADS)" \ + "useithreads=$(USE_ITHREADS)" \ + "usethreads=$(USE_5005THREADS)" \ + "usemultiplicity=$(USE_MULTI)" \ + "useperlio=$(USE_PERLIO)" \ + "LINK_FLAGS=$(LINK_FLAGS:"=\")" \ + "optimize=$(OPTIMIZE:"=\")" + +# +# Top targets +# + +all : .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) \ + $(X2P) Extensions + @echo Everything is up to date. '$(MAKE_BARE) test' to run test suite. + +$(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c + +#------------------------------------------------------------ + +$(GLOBEXE) : perlglob$(o) + $(LINK32) $(LINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \ + perlglob$(o) setargv$(o) + +perlglob$(o) : perlglob.c + +config.w32 : $(CFGSH_TMPL) + copy $(CFGSH_TMPL) config.w32 + +.\config.h : $(CFGH_TMPL) + -del /f config.h + copy $(CFGH_TMPL) config.h + +..\config.sh : config.w32 $(MINIPERL) config_sh.PL + $(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) config.w32 > ..\config.sh + +# this target is for when changes to the main config.sh happen +# edit config.{b,v,g}c and make this target once for each supported +# compiler (e.g. `nmake CCTYPE=BORLAND regen_config_h`) +regen_config_h: + perl config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh + cd .. + -del /f perl.exe + perl configpm + cd win32 + -del /f $(CFGH_TMPL) + -mkdir $(COREDIR) + -perl -I..\lib config_h.PL "INST_VER=$(INST_VER)" + rename config.h $(CFGH_TMPL) + +$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl + cd .. + miniperl configpm + cd win32 + if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL) + $(XCOPY) ..\*.h $(COREDIR)\*.* + $(XCOPY) *.h $(COREDIR)\*.* + $(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.* + $(RCOPY) include $(COREDIR)\*.* + -$(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" + if errorlevel 1 $(MAKE) /$(MAKEFLAGS) $(CONFIGPM) + +$(MINIPERL) : $(MINIDIR) $(MINI_OBJ) + $(LINK32) -subsystem:console -out:$@ @<< + $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ) +<< + +$(MINIDIR) : + if not exist "$(MINIDIR)" mkdir "$(MINIDIR)" + +$(MINICORE_OBJ) : $(CORE_NOCFG_H) + $(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB $(OBJOUT_FLAG)$@ ..\$(*F).c + +$(MINIWIN32_OBJ) : $(CORE_NOCFG_H) + $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*F).c + +# -DPERL_IMPLICIT_SYS needs C++ for perllib.c +# This is the only file that depends on perlhost.h, vmem.h, and vdir.h +!IF "$(USE_IMP_SYS)" == "define" +perllib$(o) : perllib.c .\perlhost.h .\vdir.h .\vmem.h + $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c +!ENDIF + +# 1. we don't want to rebuild miniperl.exe when config.h changes +# 2. we don't want to rebuild miniperl.exe with non-default config.h +$(MINI_OBJ) : $(CORE_NOCFG_H) + +$(WIN32_OBJ) : $(CORE_H) +$(CORE_OBJ) : $(CORE_H) +$(DLL_OBJ) : $(CORE_H) +$(X2P_OBJ) : $(CORE_H) + +perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl + $(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \ + CCTYPE=$(CCTYPE) > perldll.def + +$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES) + $(LINK32) -dll -def:perldll.def -base:0x28000000 -out:$@ @<< + $(LINK_FLAGS) $(DELAYLOAD) $(LIBFILES) $(PERLDLL_OBJ) $(PERLDLL_RES) +<< + $(XCOPY) $(PERLIMPLIB) $(COREDIR) + +$(MINIMOD) : $(MINIPERL) ..\minimod.pl + cd .. + miniperl minimod.pl > lib\ExtUtils\Miniperl.pm + cd win32 + +..\x2p\a2p$(o) : ..\x2p\a2p.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\a2p.c + +..\x2p\hash$(o) : ..\x2p\hash.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\hash.c + +..\x2p\str$(o) : ..\x2p\str.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\str.c + +..\x2p\util$(o) : ..\x2p\util.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\util.c + +..\x2p\walk$(o) : ..\x2p\walk.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\walk.c + +$(X2P) : $(MINIPERL) $(X2P_OBJ) + $(MINIPERL) ..\x2p\find2perl.PL + $(MINIPERL) ..\x2p\s2p.PL + $(LINK32) -subsystem:console -out:$@ @<< + $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ) +<< + +perlmain.c : runperl.c + copy runperl.c perlmain.c + +perlmain$(o) : perlmain.c + $(CC) $(CFLAGS_O) -UPERLDLL $(OBJOUT_FLAG)$@ -c perlmain.c + +$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) $(PERLEXE_RES) + $(LINK32) -subsystem:console -out:$@ -stack:0x1000000 $(LINK_FLAGS) \ + $(LIBFILES) $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) $(PERLEXE_RES) + copy $(PERLEXE) $(WPERLEXE) + $(MINIPERL) -I..\lib bin\exetype.pl $(WPERLEXE) WINDOWS + copy splittree.pl .. + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) + +$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) + if not exist $(AUTODIR) mkdir $(AUTODIR) + cd $(EXTDIR)\$(*B) + ..\$(MINIPERL) -I..\..\lib $(*B)_pm.PL + ..\$(MINIPERL) -I..\..\lib XSLoader_pm.PL + cd ..\..\win32 + $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) + $(XCOPY) $(EXTDIR)\$(*B)\XSLoader.pm $(LIBDIR)\$(NULL) + cd $(EXTDIR)\$(*B) + $(XSUBPP) dl_win32.xs > $(*B).c + cd ..\..\win32 + +$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs + copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs + +#---------------------------------------------------------------------------------- +Extensions: buildext.pl $(PERLDEP) $(CONFIGPM) + $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) + +Extensions_clean: + -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) clean + +#---------------------------------------------------------------------------------- + +doc: $(PERLEXE) + $(PERLEXE) -I..\lib ..\installhtml --podroot=.. --htmldir=./html \ + --podpath=pod:lib:ext:utils --htmlroot="file://$(INST_HTML::=|)" \ + --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse + +utils: $(PERLEXE) $(X2P) + cd ..\utils + $(MAKE) PERL=$(MINIPERL) + cd ..\pod + copy ..\README.aix .\perlaix.pod + copy ..\README.amiga .\perlamiga.pod + copy ..\README.apollo .\perlapollo.pod + copy ..\README.beos .\perlbeos.pod + copy ..\README.bs2000 .\perlbs2000.pod + copy ..\README.ce .\perlce.pod + copy ..\README.cygwin .\perlcygwin.pod + copy ..\README.dgux .\perldgux.pod + copy ..\README.dos .\perldos.pod + copy ..\README.epoc .\perlepoc.pod + copy ..\README.hurd .\perlhurd.pod + copy ..\README.hpux .\perlhpux.pod + copy ..\README.machten .\perlmachten.pod + copy ..\README.macos .\perlmacos.pod + copy ..\README.mint .\perlmint.pod + copy ..\README.mpeix .\perlmpeix.pod + copy ..\README.netware .\perlnetware.pod + copy ..\README.os2 .\perlos2.pod + copy ..\README.os390 .\perlos390.pod + copy ..\README.plan9 .\perlplan9.pod + copy ..\README.qnx .\perlqnx.pod + copy ..\README.solaris .\perlsolaris.pod + copy ..\README.tru64 .\perltru64.pod + copy ..\README.uts .\perluts.pod + copy ..\README.vmesa .\perlvmesa.pod + copy ..\vms\perlvms.pod .\perlvms.pod + copy ..\README.vos .\perlvos.pod + copy ..\README.win32 .\perlwin32.pod + $(MAKE) -f ..\win32\pod.mak converters + cd ..\lib + $(PERLEXE) lib_pm.PL + cd ..\win32 + $(PERLEXE) $(PL2BAT) $(UTILS) + +distclean: clean + -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \ + $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD) + -del /f *.def *.map + -del /f $(EXTENSION_DLL) + -del /f $(EXTENSION_C) $(DYNALOADER).c $(ERRNO).pm + -del /f $(EXTDIR)\DynaLoader\dl_win32.xs + -del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm + -del /f $(LIBDIR)\XSLoader.pm + -del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm + -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm + -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm + -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm + -del /f $(LIBDIR)\Data\Dumper.pm $(LIBDIR)\ByteLoader.pm + -del /f $(LIBDIR)\Devel\Peek.pm $(LIBDIR)\Devel\DProf.pm + -del /f $(LIBDIR)\File\Glob.pm + -del /f $(LIBDIR)\Storable.pm + -del /f $(LIBDIR)\Filter\Util\Call.pm + -del /f $(LIBDIR)\Digest\MD5.pm + -del /f $(LIBDIR)\PerlIO\Scalar.pm + -del /f $(LIBDIR)\PerlIO\Via.pm + -del /f $(LIBDIR)\MIME\Base64.pm + -del /f $(LIBDIR)\MIME\QuotedPrint.pm + -del /f $(LIBDIR)\List\Util.pm + -del /f $(LIBDIR)\Scalar\Util.pm + -del /f $(LIBDIR)\Time\HiRes.pm + -del /f $(LIBDIR)\XS\Typemap.pm + -del /f $(LIBDIR)\Unicode\Normalize.pm + -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO + -rmdir /s $(LIBDIR)\IO + -if exist $(LIBDIR)\Thread rmdir /s /q $(LIBDIR)\Thread + -rmdir /s $(LIBDIR)\Thread + -if exist $(LIBDIR)\B rmdir /s /q $(LIBDIR)\B + -rmdir /s $(LIBDIR)\B + -if exist $(LIBDIR)\Data rmdir /s /q $(LIBDIR)\Data + -rmdir /s $(LIBDIR)\Data + -if exist $(LIBDIR)\Filter\Util rmdir /s /q $(LIBDIR)\Filter\Util + -if exist $(LIBDIR)\Digest rmdir /s /q $(LIBDIR)\Digest + -rmdir /s $(LIBDIR)\Digest + -if exist $(LIBDIR)\MIME rmdir /s /q $(LIBDIR)\MIME + -rmdir /s $(LIBDIR)\MIME + -if exist $(LIBDIR)\List rmdir /s /q $(LIBDIR)\List + -rmdir /s $(LIBDIR)\List + -if exist $(LIBDIR)\Scalar rmdir /s /q $(LIBDIR)\Scalar + -rmdir /s $(LIBDIR)\Scalar + -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS + -rmdir /s $(LIBDIR)\XS + cd $(PODDIR) + -del /f *.html *.bat checkpods \ + perlaix.pod perlamiga.pod perlapollo.pod perlbeos.pod \ + perlbs2000.pod perlce.pod perlcygwin.pod perldgux.pod \ + perldos.pod perlepoc.pod perlhurd.pod \ + perlhpux.pod perlmachten.pod \ + perlmacos.pod perlmint.pod perlmpeix.pod perlnetware.pod \ + perlos2.pod perlos390.pod perlplan9.pod perlqnx.pod \ + perlsolaris.pod perltru64.pod perluts.pod \ + perlvmesa.pod perlvms.pod perlvos.pod \ + perlwin32.pod pod2html pod2latex pod2man pod2text pod2usage \ + podchecker podselect + cd ..\utils + -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc perlivp dprofpp + -del /f *.bat + cd ..\win32 + cd ..\x2p + -del /f find2perl s2p + -del /f *.bat + cd ..\win32 + -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new + -del /f $(CONFIGPM) + -del /f bin\*.bat + cd $(EXTDIR) + -del /s *.lib *.def *.map *.pdb *.bs Makefile *$(o) pm_to_blib + cd ..\win32 + -if exist $(AUTODIR) rmdir /s /q $(AUTODIR) + -rmdir /s $(AUTODIR) + -if exist $(COREDIR) rmdir /s /q $(COREDIR) + -rmdir /s $(COREDIR) + +install : all installbare installhtml + +installbare : utils + $(PERLEXE) ..\installperl + if exist $(WPERLEXE) $(XCOPY) $(WPERLEXE) $(INST_BIN)\*.* + $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* + $(XCOPY) bin\*.bat $(INST_SCRIPT)\*.* + +installhtml : doc + $(RCOPY) html\*.* $(INST_HTML)\*.* + +inst_lib : $(CONFIGPM) + copy splittree.pl .. + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) + $(RCOPY) ..\lib $(INST_LIB)\*.* + +minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM) utils + $(XCOPY) $(MINIPERL) ..\t\perl.exe + $(XCOPY) $(GLOBEXE) ..\t\$(NULL) + attrib -r ..\t\*.* + copy test ..\t + cd ..\t + $(MINIPERL) -I..\lib test base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t + cd ..\win32 + +test-prep : all utils + $(XCOPY) $(PERLEXE) ..\t\$(NULL) + $(XCOPY) $(PERLDLL) ..\t\$(NULL) + $(XCOPY) $(GLOBEXE) ..\t\$(NULL) + +test : test-prep + cd ..\t + $(PERLEXE) -I..\lib harness + cd ..\win32 + +test-notty : test-prep + set PERL_SKIP_TTY_TEST=1 + cd ..\t + $(PERLEXE) -I..\lib harness + cd ..\win32 + +test-wide : test-prep + set HARNESS_PERL_SWITCHES=-C + cd ..\t + $(PERLEXE) -I..\lib harness + cd ..\win32 + +test-wide-notty : test-prep + set PERL_SKIP_TTY_TEST=1 + set HARNESS_PERL_SWITCHES=-C + cd ..\t + $(PERLEXE) -I..\lib harness + cd ..\win32 + +clean : Extensions_clean + -@$(DEL) miniperlmain$(o) + -@$(DEL) $(MINIPERL) + -@$(DEL) perlglob$(o) + -@$(DEL) perlmain$(o) + -@$(DEL) config.w32 + -@$(DEL) config.h + -@$(DEL) $(GLOBEXE) + -@$(DEL) $(PERLEXE) + -@$(DEL) $(WPERLEXE) + -@$(DEL) $(PERLDLL) + -@$(DEL) $(CORE_OBJ) + -if exist $(MINIDIR) rmdir /s /q $(MINIDIR) + -rmdir /s $(MINIDIR) + -@$(DEL) $(WIN32_OBJ) + -@$(DEL) $(DLL_OBJ) + -@$(DEL) $(X2P_OBJ) + -@$(DEL) ..\*$(o) ..\*.lib ..\*.exp *$(o) *.lib *.exp *.res + -@$(DEL) ..\t\*.exe ..\t\*.dll ..\t\*.bat + -@$(DEL) ..\x2p\*.exe ..\x2p\*.bat + -@$(DEL) *.ilk + -@$(DEL) *.pdb + +# Handy way to run perlbug -ok without having to install and run the +# installed perlbug. We don't re-run the tests here - we trust the user. +# Please *don't* use this unless all tests pass. +# If you want to report test failures, use "nmake nok" instead. +ok: utils + $(PERLEXE) -I..\lib ..\utils\perlbug -ok -s "(UNINSTALLED)" + +okfile: utils + $(PERLEXE) -I..\lib ..\utils\perlbug -ok -s "(UNINSTALLED)" -F perl.ok + +nok: utils + $(PERLEXE) -I..\lib ..\utils\perlbug -nok -s "(UNINSTALLED)" + +nokfile: utils + $(PERLEXE) -I..\lib ..\utils\perlbug -nok -s "(UNINSTALLED)" -F perl.nok |