Change 16230: Integrate from bleadperl
[email protected] (Chris Nandor) Sat, 27 Apr 2002 19:13:18 -0400
| Newsgroups | perl.perl5.changes.mac |
|---|---|
| Message-ID | <p05100302b8f0e0e51222@[10.0.1.177]> |
Change 16230 by pudge@pudge-mobile on 2002/04/27 21:50:45 Integrate from bleadperl Affected files ... .... //depot/macperl/Changes#2 integrate .... //depot/macperl/INSTALL#2 integrate .... //depot/macperl/MANIFEST#2 integrate .... //depot/macperl/Makefile.SH#2 integrate .... //depot/macperl/NetWare/Makefile#2 integrate .... //depot/macperl/README.win32#2 integrate .... //depot/macperl/configure.com#2 integrate .... //depot/macperl/dump.c#2 integrate .... //depot/macperl/embed.fnc#2 integrate .... //depot/macperl/embed.h#2 integrate .... //depot/macperl/ext/B/B.xs#2 integrate .... //depot/macperl/ext/ByteLoader/ByteLoader.xs#2 integrate .... //depot/macperl/ext/Cwd/t/cwd.t#2 integrate .... //depot/macperl/ext/Data/Dumper/Dumper.xs#2 integrate .... //depot/macperl/ext/Devel/DProf/DProf.xs#2 integrate .... //depot/macperl/ext/Digest/MD5/MD5.xs#2 integrate .... //depot/macperl/ext/Digest/MD5/t/files.t#2 integrate .... //depot/macperl/ext/Encode/AUTHORS#2 integrate .... //depot/macperl/ext/Encode/CN/Makefile.PL#2 integrate .... //depot/macperl/ext/Encode/Changes#2 integrate .... //depot/macperl/ext/Encode/Encode.pm#2 integrate .... //depot/macperl/ext/Encode/Encode.xs#2 integrate .... //depot/macperl/ext/Encode/Encode/encode.h#2 integrate .... //depot/macperl/ext/Encode/JP/Makefile.PL#2 integrate .... //depot/macperl/ext/Encode/KR/Makefile.PL#2 integrate .... //depot/macperl/ext/Encode/MANIFEST#2 integrate .... //depot/macperl/ext/Encode/TW/Makefile.PL#2 integrate .... //depot/macperl/ext/Encode/Unicode/Unicode.pm#2 integrate .... //depot/macperl/ext/Encode/Unicode/Unicode.xs#2 integrate .... //depot/macperl/ext/Encode/encoding.pm#2 integrate .... //depot/macperl/ext/Encode/lib/Encode/Alias.pm#2 integrate .... //depot/macperl/ext/Encode/lib/Encode/CN/HZ.pm#2 integrate .... //depot/macperl/ext/Encode/lib/Encode/Config.pm#2 integrate .... //depot/macperl/ext/Encode/lib/Encode/Encoding.pm#2 integrate .... //depot/macperl/ext/Encode/lib/Encode/Guess.pm#1 branch .... //depot/macperl/ext/Encode/lib/Encode/JP/H2Z.pm#2 integrate .... //depot/macperl/ext/Encode/lib/Encode/JP/JIS7.pm#2 integrate .... //depot/macperl/ext/Encode/lib/Encode/KR/2022_KR.pm#2 integrate .... //depot/macperl/ext/Encode/lib/Encode/MIME/Header.pm#1 branch .... //depot/macperl/ext/Encode/t/CJKT.t#2 integrate .... //depot/macperl/ext/Encode/t/at-cn.t#2 integrate .... //depot/macperl/ext/Encode/t/at-tw.t#2 integrate .... //depot/macperl/ext/Encode/t/fallback.t#2 integrate .... //depot/macperl/ext/Encode/t/guess.t#1 branch .... //depot/macperl/ext/Encode/t/jperl.t#2 integrate .... //depot/macperl/ext/Encode/t/mime-header.t#1 branch .... //depot/macperl/ext/File/Glob/bsd_glob.c#2 integrate .... //depot/macperl/ext/IO/IO.xs#2 integrate .... //depot/macperl/ext/Opcode/Opcode.xs#2 integrate .... //depot/macperl/ext/POSIX/POSIX.xs#2 integrate .... //depot/macperl/ext/PerlIO/Via/Via.xs#2 integrate .... //depot/macperl/ext/PerlIO/encoding/encoding.pm#2 integrate .... //depot/macperl/ext/PerlIO/encoding/encoding.xs#2 integrate .... //depot/macperl/ext/PerlIO/t/via.t#2 integrate .... //depot/macperl/ext/Storable/Storable.pm#2 integrate .... //depot/macperl/ext/Storable/Storable.xs#2 integrate .... //depot/macperl/ext/Storable/t/croak.t#1 branch .... //depot/macperl/ext/Storable/t/downgrade.t#1 branch .... //depot/macperl/ext/Storable/t/make_downgrade.pl#1 branch .... //depot/macperl/ext/Storable/t/malice.t#2 integrate .... //depot/macperl/ext/Storable/t/restrict.t#2 integrate .... //depot/macperl/ext/Storable/t/utf8hash.t#2 integrate .... //depot/macperl/ext/Time/HiRes/HiRes.pm#2 integrate .... //depot/macperl/ext/Time/HiRes/HiRes.xs#2 integrate .... //depot/macperl/ext/threads/shared/shared.xs#2 integrate .... //depot/macperl/ext/threads/shared/t/cond.t#1 branch .... //depot/macperl/ext/threads/shared/t/queue.t#2 integrate .... //depot/macperl/hints/netbsd.sh#2 integrate .... //depot/macperl/installperl#2 integrate .... //depot/macperl/lib/ExtUtils/Changes#2 integrate .... //depot/macperl/lib/ExtUtils/Command/MM.pm#2 integrate .... //depot/macperl/lib/ExtUtils/MM.pm#2 integrate .... //depot/macperl/lib/ExtUtils/MM_Cygwin.pm#2 integrate .... //depot/macperl/lib/ExtUtils/MM_NW5.pm#2 integrate .... //depot/macperl/lib/ExtUtils/MM_Unix.pm#2 integrate .... //depot/macperl/lib/ExtUtils/MM_VMS.pm#2 integrate .... //depot/macperl/lib/ExtUtils/MM_Win32.pm#2 integrate .... //depot/macperl/lib/ExtUtils/MakeMaker.pm#2 integrate .... //depot/macperl/lib/ExtUtils/Manifest.pm#2 integrate .... //depot/macperl/lib/ExtUtils/t/00setup_dummy.t#1 branch .... //depot/macperl/lib/ExtUtils/t/Big-Fat-Dummy/Liar/Makefile.PL#2 delete .... //depot/macperl/lib/ExtUtils/t/Big-Fat-Dummy/Liar/lib/Big/Fat/Liar.pm#2 delete .... //depot/macperl/lib/ExtUtils/t/Big-Fat-Dummy/Makefile.PL#2 delete .... //depot/macperl/lib/ExtUtils/t/Big-Fat-Dummy/lib/Big/Fat/Dummy.pm#2 delete .... //depot/macperl/lib/ExtUtils/t/INST.t#2 integrate .... //depot/macperl/lib/ExtUtils/t/INST_PREFIX.t#2 integrate .... //depot/macperl/lib/ExtUtils/t/MM_Unix.t#2 integrate .... //depot/macperl/lib/ExtUtils/t/Manifest.t#2 integrate .... //depot/macperl/lib/ExtUtils/t/Problem-Module/Makefile.PL#2 delete .... //depot/macperl/lib/ExtUtils/t/Problem-Module/subdir/Makefile.PL#2 delete .... //depot/macperl/lib/ExtUtils/t/VERSION_FROM.t#1 branch .... //depot/macperl/lib/ExtUtils/t/backwards.t#1 branch .... //depot/macperl/lib/ExtUtils/t/basic.t#2 integrate .... //depot/macperl/lib/ExtUtils/t/hints.t#2 integrate .... //depot/macperl/lib/ExtUtils/t/prefixify.t#2 integrate .... //depot/macperl/lib/ExtUtils/t/problems.t#2 integrate .... //depot/macperl/lib/ExtUtils/t/zz_cleanup_dummy.t#1 branch .... //depot/macperl/lib/Test/Builder.pm#2 integrate .... //depot/macperl/lib/Test/Harness.pm#2 integrate .... //depot/macperl/lib/Test/Harness/Changes#2 integrate .... //depot/macperl/lib/Test/Harness/Straps.pm#2 integrate .... //depot/macperl/lib/Test/Harness/t/strap-analyze.t#2 integrate .... //depot/macperl/lib/Test/Harness/t/test-harness.t#2 integrate .... //depot/macperl/lib/Test/More.pm#2 integrate .... //depot/macperl/lib/Test/Simple.pm#2 integrate .... //depot/macperl/lib/Test/Simple/Changes#2 integrate .... //depot/macperl/lib/Test/Simple/t/Builder.t#2 integrate .... //depot/macperl/lib/Test/Simple/t/More.t#2 integrate .... //depot/macperl/lib/Test/Simple/t/curr_test.t#1 branch .... //depot/macperl/lib/Test/Simple/t/diag.t#2 integrate .... //depot/macperl/lib/Test/Simple/t/exit.t#2 integrate .... //depot/macperl/lib/Test/Simple/t/maybe_regex.t#1 branch .... //depot/macperl/lib/Test/Simple/t/output.t#2 integrate .... //depot/macperl/lib/Test/Simple/t/strays.t#1 branch .... //depot/macperl/lib/Test/Simple/t/undef.t#2 integrate .... //depot/macperl/lib/Test/Simple/t/use_ok.t#2 integrate .... //depot/macperl/lib/overload.t#2 integrate .... //depot/macperl/makedef.pl#3 integrate .... //depot/macperl/op.c#2 integrate .... //depot/macperl/op.h#2 integrate .... //depot/macperl/patchlevel.h#2 integrate .... //depot/macperl/perlio.c#2 integrate .... //depot/macperl/perlio.h#2 integrate .... //depot/macperl/perliol.h#2 integrate .... //depot/macperl/pod/perldelta.pod#2 integrate .... //depot/macperl/pod/perldiag.pod#2 integrate .... //depot/macperl/pod/perltodo.pod#2 integrate .... //depot/macperl/pod/perluniintro.pod#2 integrate .... //depot/macperl/pp_ctl.c#3 integrate .... //depot/macperl/pp_hot.c#2 integrate .... //depot/macperl/pp_sys.c#2 integrate .... //depot/macperl/proto.h#2 integrate .... //depot/macperl/regcomp.c#2 integrate .... //depot/macperl/sv.c#2 integrate .... //depot/macperl/t/TEST#2 integrate .... //depot/macperl/t/harness#2 integrate .... //depot/macperl/t/japh/abigail.t#2 integrate .... //depot/macperl/t/lib/MakeMaker/Test/Utils.pm#2 integrate .... //depot/macperl/t/lib/sample-tests/bignum#1 branch .... //depot/macperl/t/lib/sample-tests/die#1 branch .... //depot/macperl/t/lib/sample-tests/die_head_end#1 branch .... //depot/macperl/t/lib/sample-tests/die_last_minute#1 branch .... //depot/macperl/t/lib/sample-tests/taint#2 integrate .... //depot/macperl/t/lib/warnings/op#2 integrate .... //depot/macperl/t/lib/warnings/pp_hot#2 integrate .... //depot/macperl/t/op/subst.t#2 integrate .... //depot/macperl/t/op/system_tests#2 delete .... //depot/macperl/t/win32/system.t#2 integrate .... //depot/macperl/t/win32/system_tests#1 branch .... //depot/macperl/toke.c#2 integrate .... //depot/macperl/uconfig.h#2 integrate .... //depot/macperl/uconfig.sh#2 integrate .... //depot/macperl/util.c#2 integrate .... //depot/macperl/vms/descrip_mms.template#2 integrate .... //depot/macperl/vms/test.com#2 integrate .... //depot/macperl/vms/vms.c#2 integrate .... //depot/macperl/vos/vos.c#2 integrate .... //depot/macperl/win32/Makefile#2 integrate .... //depot/macperl/win32/buildext.pl#2 integrate .... //depot/macperl/win32/makefile.mk#2 integrate Differences ... ==== //depot/macperl/Changes#2 (text) ==== Index: perl/Changes --- perl/Changes.~1~ Sat Apr 27 16:00:05 2002 +++ perl/Changes Sat Apr 27 16:00:05 2002 @@ -28,6 +28,1185 @@ Version v5.7.X Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 16224] By: jhi on 2002/04/27 17:53:20 + Log: Integrate perlio; + + Correct which var is nulled, stack movement protection. + Branch: perl + !> ext/PerlIO/encoding/encoding.xs +____________________________________________________________________________ +[ 16223] By: jhi on 2002/04/27 17:43:26 + Log: Subject: PATCH t/TEST + From: Mark-Jason Dominus <[email protected]> + Date: Sat, 27 Apr 2002 14:06:56 -0400 + Message-ID: <[email protected]> + Branch: perl + ! t/TEST +____________________________________________________________________________ +[ 16222] By: sky on 2002/04/27 17:00:29 + Log: Ahem, look another way. + Branch: perl + ! ext/threads/shared/t/queue.t +____________________________________________________________________________ +[ 16221] By: nick on 2002/04/27 16:34:48 + Log: Correct which var is nulled, stack movement protection. + Branch: perlio + ! ext/PerlIO/encoding/encoding.xs +____________________________________________________________________________ +[ 16220] By: jhi on 2002/04/27 16:27:18 + Log: Integrate perlio; + + Fix weird warnings and/pr segfaults on binmode(,"encoding(...)") + - if encoding loads Encode then stack grows. + - pp_binmode was not allowing for that to happen + - added PUTBACK/SPAGAIN. + Branch: perl + !> pp_sys.c +____________________________________________________________________________ +[ 16219] By: jhi on 2002/04/27 16:23:44 + Log: First half of NetBSD patch-ai, from Johnny Lam: + + The first part removes "installman" and "installhtml" from the + .PHONY target, which was causing problems during installation. + + (the installman and installhtml are not phony targets, + they are real files) + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 16218] By: nick on 2002/04/27 16:22:40 + Log: Integrate mainline + Branch: perlio + +> ext/threads/shared/t/cond.t + !> MANIFEST ext/threads/shared/shared.xs + !> ext/threads/shared/t/queue.t +____________________________________________________________________________ +[ 16217] By: jhi on 2002/04/27 16:20:49 + Log: NetBSD patch-ab from Johnny Lam: + + Some tweaks to the NetBSD hints file to make the Configure + process more useful when not building from pkgsrc. This file + will definitely need to change again when the 1.6 release of + NetBSD comes out, but I'll handle the changes at the later + date. + Branch: perl + ! hints/netbsd.sh +____________________________________________________________________________ +[ 16216] By: nick on 2002/04/27 16:19:21 + Log: Fix weird warnings and/pr segfaults on binmode(,"encoding(...)") + - if encoding loads Encode then stack grows. + - pp_binmode was not allowing for that to happen + - added PUTBACK/SPAGAIN. + Branch: perlio + ! pp_sys.c +____________________________________________________________________________ +[ 16215] By: jhi on 2002/04/27 15:52:24 + Log: Integrate perlio; + + Fix fd leak on Via(bogus). + Finish implementing PerlIOVia_open(). + Export more guts of PerlIO_* so Via_open() can work. + Fix various PerlIO_allocate() features exposed by above. + + Re-instate $PerlIO::encoding::check at boot. + (Retaining Dan's XS side require though I don't see need.) + Branch: perl + !> embed.fnc ext/PerlIO/Via/Via.xs + !> ext/PerlIO/encoding/encoding.pm + !> ext/PerlIO/encoding/encoding.xs ext/PerlIO/t/via.t makedef.pl + !> perlio.c perlio.h perliol.h +____________________________________________________________________________ +[ 16214] By: jhi on 2002/04/27 15:48:34 + Log: Upgrade to Encode 1.62. + Branch: perl + ! ext/Encode/Changes ext/Encode/Encode.pm ext/Encode/Encode.xs +____________________________________________________________________________ +[ 16213] By: ams on 2002/04/27 15:38:50 + Log: Subject: Re: Change 16122: Try to be clearer about perlio. + From: Philip Newton <[email protected]> + Date: Sat, 27 Apr 2002 08:51:30 +0200 + Message-Id: <[email protected]> + + Subject: Re: Change 16183: Stop being coy. + From: Philip Newton <[email protected]> + Date: Sat, 27 Apr 2002 08:52:13 +0200 + Message-Id: <[email protected]> + Branch: perl + ! INSTALL pod/perldelta.pod +____________________________________________________________________________ +[ 16212] By: sky on 2002/04/27 13:54:46 + Log: Add test numbers to make "make test" happy. Order is irrelevant + but number of oks is not. + Branch: perl + ! ext/threads/shared/t/queue.t +____________________________________________________________________________ +[ 16211] By: nick on 2002/04/27 13:29:55 + Log: Re-instate $PerlIO::encoding::check at boot. + (Retaining Dan's XS side require though I don't see need.) + Branch: perlio + ! ext/PerlIO/encoding/encoding.pm + ! ext/PerlIO/encoding/encoding.xs +____________________________________________________________________________ +[ 16210] By: sky on 2002/04/27 12:56:44 + Log: Fixed race condtions and deadlocks in interaction with + cond_wait/cond_signal and lock. + Now we wait for a lock to gie up if we return from COND_WAIT + and we are still locked. We also notifiers potential + lockers that it is free for locking when we go into COND_WAIT. + Branch: perl + + ext/threads/shared/t/cond.t + ! MANIFEST ext/threads/shared/shared.xs + ! ext/threads/shared/t/queue.t +____________________________________________________________________________ +[ 16209] By: nick on 2002/04/27 12:32:41 + Log: Integrate mainline + Branch: perlio + +> t/win32/system_tests + - t/op/system_tests + !> MANIFEST ext/Digest/MD5/t/files.t ext/Time/HiRes/HiRes.pm + !> hints/netbsd.sh lib/ExtUtils/MM_Unix.pm lib/Time/Local.pm + !> pod/perldelta.pod pod/perltodo.pod pp_ctl.c t/japh/abigail.t + !> t/lib/warnings/pp_hot t/win32/system.t +____________________________________________________________________________ +[ 16208] By: sky on 2002/04/27 11:46:53 + Log: Saving locks after we set it to 0 was kind of pointless. + Hunting down fixes in cond_* functions. + Branch: perl + ! ext/threads/shared/shared.xs +____________________________________________________________________________ +[ 16207] By: nick on 2002/04/27 10:12:00 + Log: Fix fd leak on Via(bogus). + Finish implementing PerlIOVia_open(). + Export more guts of PerlIO_* so Via_open() can work. + Fix various PerlIO_allocate() features exposed by above. + Branch: perlio + ! ext/PerlIO/Via/Via.xs ext/PerlIO/t/via.t makedef.pl perlio.c + ! perlio.h perliol.h +____________________________________________________________________________ +[ 16206] By: jhi on 2002/04/27 00:52:30 + Log: NetBSD and OpenBSD cannot do comments at #! line + (or long #! lines?) + Branch: perl + ! t/japh/abigail.t +____________________________________________________________________________ +[ 16205] By: jhi on 2002/04/26 23:56:32 + Log: Add taint rethink to the todo list. + Branch: perl + ! pod/perltodo.pod +____________________________________________________________________________ +[ 16204] By: jhi on 2002/04/26 22:33:45 + Log: Integrate changes #16199 and #16201 from macperl; + + Time::Local compatibility patches, from Graham + + MacPerl require() portability patches + Branch: perl + !> lib/Time/Local.pm pp_ctl.c +____________________________________________________________________________ +[ 16203] By: jhi on 2002/04/26 21:47:06 + Log: Subject: [PATCH] Re: [ID 20020425.012] segfault when printing to close indirect filehandle + From: Nicholas Clark <[email protected]> + Date: Fri, 26 Apr 2002 23:27:23 +0100 + Message-ID: <[email protected]> + Branch: perl + ! t/lib/warnings/pp_hot +____________________________________________________________________________ +[ 16202] By: pudge on 2002/04/26 21:11:06 + Log: Working on MacPerl tests + Branch: macperl + ! macos/MacPerlTests.cmd +____________________________________________________________________________ +[ 16201] By: pudge on 2002/04/26 21:10:49 + Log: MacPerl require() portability patches + Branch: macperl + ! pp_ctl.c +____________________________________________________________________________ +[ 16200] By: pudge on 2002/04/26 21:09:45 + Log: Fix a few MacPerl_CanonDir() problems + Branch: macperl + ! macos/macish.c macos/macish.h +____________________________________________________________________________ +[ 16199] By: pudge on 2002/04/26 21:08:52 + Log: Time::Local compatibility patches, from Graham + Branch: macperl + ! lib/Time/Local.pm +____________________________________________________________________________ +[ 16198] By: jhi on 2002/04/26 20:10:53 + Log: Subject: Re: [PATCH ext/Time/HiRes/HiRes.pm] Political Correctness + From: Simon Cozens <[email protected]> + Date: Fri, 26 Apr 2002 21:58:21 +0100 + Message-ID: <[email protected]> + Branch: perl + ! ext/Time/HiRes/HiRes.pm +____________________________________________________________________________ +[ 16197] By: jhi on 2002/04/26 20:04:44 + Log: NetBSD: if the /usr/pkg/lib is there, the linker wants + to know about it always (not just when using the pth). + Branch: perl + ! hints/netbsd.sh +____________________________________________________________________________ +[ 16196] By: jhi on 2002/04/26 18:27:39 + Log: EBCDIC MD5.xs checksum update from Merijn Broeren. + Branch: perl + ! ext/Digest/MD5/t/files.t +____________________________________________________________________________ +[ 16195] By: jhi on 2002/04/26 17:56:51 + Log: Subject: FIXIN problem under Win32 + From: Nikola Knezevic <[email protected]> + Date: Thu, 25 Apr 2002 23:03:31 +0200 + Message-ID: <[email protected]> + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 16194] By: nick on 2002/04/26 17:36:16 + Log: Integrate mainline + Branch: perlio + +> ext/Encode/lib/Encode/Guess.pm + +> ext/Encode/lib/Encode/MIME/Header.pm ext/Encode/t/guess.t + +> ext/Encode/t/mime-header.t ext/Storable/t/croak.t + +> ext/Storable/t/downgrade.t ext/Storable/t/make_downgrade.pl + +> lib/Test/Simple/t/curr_test.t lib/Test/Simple/t/maybe_regex.t + +> lib/Test/Simple/t/strays.t t/lib/sample-tests/bignum + +> t/lib/sample-tests/die t/lib/sample-tests/die_head_end + +> t/lib/sample-tests/die_last_minute + !> (integrate 94 files) +____________________________________________________________________________ +[ 16193] By: jhi on 2002/04/26 17:11:30 + Log: Subject: [PATCH t\win32] system_tests are relevant only to win32\system.t + From: Nikola Knezevic <[email protected]> + Date: Fri, 26 Apr 2002 15:38:16 +0200 + Message-ID: <[email protected]> + Branch: perl + + t/win32/system_tests + - t/op/system_tests + ! MANIFEST t/win32/system.t +____________________________________________________________________________ +[ 16192] By: jhi on 2002/04/26 16:45:28 + Log: Mention explicitly the NetBSD + pth combination. + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 16191] By: jhi on 2002/04/26 15:06:20 + Log: Subject: [PATCH] Fix email address. + From: Abigail <[email protected]> + Date: Fri, 26 Apr 2002 18:03:11 +0200 + Message-ID: <[email protected]> + Branch: perl + ! t/japh/abigail.t +____________________________________________________________________________ +[ 16190] By: jhi on 2002/04/26 14:33:03 + Log: NetWare update from C Aditya. + Branch: perl + ! NetWare/Makefile lib/ExtUtils/MM_NW5.pm + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 16189] By: jhi on 2002/04/26 13:35:48 + Log: Subject: [PATCH vms/test.com] use t/TEST + From: "Craig A. Berry" <[email protected]> + Date: Fri, 26 Apr 2002 09:34:46 -0500 + Message-Id: <a05111708b8ef12696579@[172.16.52.1]> + Branch: perl + ! vms/test.com +____________________________________________________________________________ +[ 16188] By: jhi on 2002/04/26 13:34:35 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 16187] By: jhi on 2002/04/26 12:43:48 + Log: Subject: [Encode] s/=over2/=over 2/g + From: Dan Kogai <[email protected]> + Date: Fri, 26 Apr 2002 14:57:09 +0900 + Message-Id: <[email protected]> + Branch: perl + ! ext/Encode/Encode.pm +____________________________________________________________________________ +[ 16186] By: jhi on 2002/04/26 12:28:18 + Log: Use temp int variable in the W*() since direct casting + to either an int or an IV would not be right. + Branch: perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 16185] By: jhi on 2002/04/26 12:23:02 + Log: The #16182 radiates U32ness. + Branch: perl + ! embed.fnc embed.h proto.h regcomp.c toke.c +____________________________________________________________________________ +[ 16184] By: jhi on 2002/04/26 12:00:04 + Log: Subject: t/TEST ported to VMS + From: "Craig A. Berry" <[email protected]> + Date: Fri, 26 Apr 2002 00:13:31 -0500 + Message-Id: <a05111705b8ee84f53e79@[172.16.52.1]> + Branch: perl + ! t/TEST +____________________________________________________________________________ +[ 16183] By: jhi on 2002/04/26 11:57:58 + Log: Stop being coy. + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 16182] By: jhi on 2002/04/26 11:53:58 + Log: Subject: Re: binary compatibility + From: Mark-Jason Dominus <[email protected]> + Date: Wed, 24 Apr 2002 17:35:07 -0400 + Message-ID: <[email protected]> + Branch: perl + ! op.h +____________________________________________________________________________ +[ 16181] By: gsar on 2002/04/26 07:39:20 + Log: fix typo that caused pseudo-fork() crashes on win64 (we were only + allocating half of the retstack!) + Branch: perl + ! README.win32 sv.c +____________________________________________________________________________ +[ 16180] By: gsar on 2002/04/26 06:27:11 + Log: temporary variable not wide enough to hold all the bits in + op->op_targ + Branch: perl + ! op.c +____________________________________________________________________________ +[ 16179] By: jhi on 2002/04/26 03:21:50 + Log: Add an idea/question from Damian. + Branch: perl + ! pod/perltodo.pod +____________________________________________________________________________ +[ 16178] By: gsar on 2002/04/26 02:46:52 + Log: build missing utilities on windows; clean stray files + Branch: perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 16177] By: jhi on 2002/04/26 02:33:19 + Log: Upgrade to Encode 1.61, from Dan Kogai. + Branch: perl + ! ext/Encode/AUTHORS ext/Encode/Changes ext/Encode/Encode.pm + ! ext/Encode/Encode.xs ext/Encode/Unicode/Unicode.xs + ! ext/Encode/lib/Encode/Guess.pm + ! ext/Encode/lib/Encode/MIME/Header.pm ext/Encode/t/CJKT.t + ! ext/Encode/t/guess.t ext/Encode/t/jperl.t + ! ext/Encode/t/mime-header.t +____________________________________________________________________________ +[ 16176] By: jhi on 2002/04/26 01:22:04 + Log: Subject: [PATCH doc] bytes::length TIMTOWTDI + From: [email protected] (Andreas J. Koenig) + Date: Tue, 23 Apr 2002 04:40:42 +0200 + Message-ID: <[email protected]> + Branch: perl + ! pod/perluniintro.pod +____________________________________________________________________________ +[ 16175] By: gsar on 2002/04/26 01:10:17 + Log: MD5.xs checksum, ascii only (TODO: someone with access to an EBCDIC + platform needs to fill in the other branch here) + Branch: perl + ! ext/Digest/MD5/t/files.t +____________________________________________________________________________ +[ 16174] By: gsar on 2002/04/26 00:45:36 + Log: MANIFEST is needlessly held open for entire duration of "make test" + Branch: perl + ! t/TEST t/harness +____________________________________________________________________________ +[ 16173] By: gsar on 2002/04/26 00:41:39 + Log: various signed/unsigned mismatch nits + Branch: perl + ! ext/B/B.xs ext/ByteLoader/ByteLoader.xs + ! ext/Data/Dumper/Dumper.xs ext/Devel/DProf/DProf.xs + ! ext/Digest/MD5/MD5.xs ext/Encode/Unicode/Unicode.xs + ! ext/File/Glob/bsd_glob.c ext/IO/IO.xs ext/Opcode/Opcode.xs + ! ext/PerlIO/encoding/encoding.xs ext/Storable/Storable.xs + ! ext/Time/HiRes/HiRes.xs regcomp.c +____________________________________________________________________________ +[ 16172] By: jhi on 2002/04/25 23:48:03 + Log: Subject: [PATCH] Re: [PATCH] another Storable test (Re: perl@16005) + From: Nicholas Clark <[email protected]> + Date: Thu, 25 Apr 2002 22:41:57 +0100 + Message-ID: <[email protected]> + Branch: perl + + ext/Storable/t/croak.t ext/Storable/t/downgrade.t + + ext/Storable/t/make_downgrade.pl + ! MANIFEST ext/Storable/Storable.pm ext/Storable/Storable.xs + ! ext/Storable/t/malice.t ext/Storable/t/restrict.t + ! ext/Storable/t/utf8hash.t +____________________________________________________________________________ +[ 16171] By: jhi on 2002/04/25 22:16:49 + Log: Extra guidance for JAPH debuggers. + Branch: perl + ! t/japh/abigail.t +____________________________________________________________________________ +[ 16170] By: jhi on 2002/04/25 22:13:02 + Log: Subject: [PATCH] fix vos/vos.c to implement pow(0,0) + From: [email protected] + Date: Wed, 24 Apr 02 18:27 edt + Message-Id: <[email protected]> + Branch: perl + ! vos/vos.c +____________________________________________________________________________ +[ 16169] By: ams on 2002/04/25 20:33:35 + Log: Subject: [PATCH] don't build B/C twice on VMS + From: "Craig A. Berry" <[email protected]> + Date: Thu, 25 Apr 2002 16:00:57 -0500 + Message-Id: <a05111702b8ee1bab9144@[172.16.52.1]> + Branch: perl + ! configure.com +____________________________________________________________________________ +[ 16168] By: ams on 2002/04/25 20:31:19 + Log: Subject: Re: POSIX::WEXITSTATUS broken again + From: Andy Dougherty <[email protected]> + Date: Thu, 25 Apr 2002 17:01:08 -0400 (EDT) + Message-Id: <Pine.SOL.4.10.10204251656510.2019-100000@maxwell.phys.lafayette.edu> + Branch: perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 16167] By: ams on 2002/04/25 19:49:09 + Log: Subject: [PATCH] Re: [PATCH] ext/attrs.t getting skipped + From: [email protected] (Yitzchak Scott-Thoennes) + Date: Thu, 25 Apr 2002 13:39:35 -0700 + Message-Id: <[email protected]> + Branch: perl + ! t/harness +____________________________________________________________________________ +[ 16166] By: ams on 2002/04/25 19:43:06 + Log: $fh->close(); print $fh "foo" would segfault under -w in + report_evil_fh() because $fh doesn't have a name. + Branch: perl + ! util.c +____________________________________________________________________________ +[ 16165] By: gsar on 2002/04/25 18:19:32 + Log: cwd.t wasn't running all the tests because cmd.exe wasn't + being found properly + Branch: perl + ! ext/Cwd/t/cwd.t +____________________________________________________________________________ +[ 16164] By: jhi on 2002/04/25 17:45:03 + Log: Brace yourself from Craig Berry to keep older compilers happy. + Branch: perl + ! vms/vms.c +____________________________________________________________________________ +[ 16163] By: jhi on 2002/04/25 17:43:50 + Log: More %{} overload tests. + Branch: perl + ! lib/overload.t +____________________________________________________________________________ +[ 16162] By: gsar on 2002/04/25 17:41:48 + Log: some extension builds need to find pl2bat.bat on windows + Branch: perl + ! win32/buildext.pl +____________________________________________________________________________ +[ 16161] By: jhi on 2002/04/25 17:26:53 + Log: Subject: [PATCH MM 5.91_02] MM_VMS.pm: handle empty PM_TO_BLIB + From: "Craig A. Berry" <[email protected]> + Date: Thu, 25 Apr 2002 12:30:06 -0500 + Message-Id: <a05111700b8edeb2f3419@[172.16.52.1]> + Branch: perl + ! lib/ExtUtils/MM_VMS.pm +____________________________________________________________________________ +[ 16160] By: gsar on 2002/04/25 17:04:10 + Log: windows build fails if there is no perlglob.exe in the PATH + Branch: perl + ! win32/buildext.pl +____________________________________________________________________________ +[ 16159] By: jhi on 2002/04/25 16:06:25 + Log: Mysterious setlocale() core dump in ancient Solaris + found by Merijn Broeren. Doesn't look like Perl's fault. + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 16158] By: jhi on 2002/04/25 14:38:13 + Log: Subject: Re: [PATCH] pp_ctl.c:pp_require + From: "Newton, Philip" <[email protected]> + Date: Thu, 25 Apr 2002 17:35:23 +0200 + Message-ID: <[email protected]> + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 16157] By: jhi on 2002/04/25 14:30:40 + Log: Subject: [PATCH] pp_ctl.c:pp_require + From: "Newton, Philip" <[email protected]> + Date: Thu, 25 Apr 2002 16:01:14 +0200 + Message-ID: <[email protected]> + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 16156] By: jhi on 2002/04/25 14:29:16 + Log: -Wformat cleanups from Robin Barker. + Branch: perl + ! dump.c embed.fnc proto.h sv.c +____________________________________________________________________________ +[ 16155] By: jhi on 2002/04/25 14:27:07 + Log: Subject: [PATCH] Test::Harness 2.01 -> 2.03 + From: Michael G Schwern <[email protected]> + Date: Thu, 25 Apr 2002 01:51:27 -0400 + Message-ID: <20020425055127.GB3456@blackrider> + Branch: perl + + t/lib/sample-tests/bignum t/lib/sample-tests/die + + t/lib/sample-tests/die_head_end + + t/lib/sample-tests/die_last_minute + ! MANIFEST lib/Test/Harness.pm lib/Test/Harness/Changes + ! lib/Test/Harness/Straps.pm lib/Test/Harness/t/strap-analyze.t + ! lib/Test/Harness/t/test-harness.t t/lib/sample-tests/taint +____________________________________________________________________________ +[ 16154] By: jhi on 2002/04/25 14:24:53 + Log: Subject: [PATCH] Test::Simple/More/Builder 0.42 -> 0.44 + From: Michael G Schwern <[email protected]> + Date: Thu, 25 Apr 2002 01:32:10 -0400 + Message-ID: <20020425053210.GA3334@blackrider> + Branch: perl + + lib/Test/Simple/t/curr_test.t lib/Test/Simple/t/maybe_regex.t + + lib/Test/Simple/t/strays.t + ! MANIFEST 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/More.t + ! lib/Test/Simple/t/diag.t lib/Test/Simple/t/exit.t + ! lib/Test/Simple/t/output.t lib/Test/Simple/t/undef.t + ! lib/Test/Simple/t/use_ok.t +____________________________________________________________________________ +[ 16153] By: jhi on 2002/04/25 14:12:35 + Log: Elaborate a bit on Storable. + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 16152] By: jhi on 2002/04/25 12:59:50 + Log: Cleaner Encode tests under -Mutf8. + Branch: perl + ! ext/Encode/t/at-cn.t ext/Encode/t/at-tw.t ext/Encode/t/jperl.t +____________________________________________________________________________ +[ 16151] By: jhi on 2002/04/25 00:57:24 + Log: Subject: [PATCH] installperl + From: Abe Timmerman <[email protected]> + Date: Thu, 25 Apr 2002 01:00:00 +0200 + Message-ID: <[email protected]> + Branch: perl + ! installperl +____________________________________________________________________________ +[ 16150] By: jhi on 2002/04/25 00:48:09 + Log: Subject: Re: [Encode] Patch to fix Encod-XML::SAX conflicts + From: Dan Kogai <[email protected]> + Date: Thu, 25 Apr 2002 10:49:13 +0900 + Message-Id: <[email protected]> + Branch: perl + ! ext/PerlIO/encoding/encoding.xs +____________________________________________________________________________ +[ 16149] By: jhi on 2002/04/24 22:57:53 + Log: Stray =back. + Branch: perl + ! README.win32 +____________________________________________________________________________ +[ 16148] By: rgs on 2002/04/24 21:12:40 + Log: Add an untested warning variant. + Branch: perl + ! t/lib/warnings/op +____________________________________________________________________________ +[ 16147] By: jhi on 2002/04/24 20:37:15 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 16146] By: jhi on 2002/04/24 20:21:43 + Log: Wrong plan. + Branch: perl + ! ext/Encode/t/mime-header.t +____________________________________________________________________________ +[ 16145] By: jhi on 2002/04/24 20:20:53 + Log: Upgrade to Encode 1.60, from Dan Kogai. + Branch: perl + + ext/Encode/lib/Encode/Guess.pm + + ext/Encode/lib/Encode/MIME/Header.pm ext/Encode/t/guess.t + + ext/Encode/t/mime-header.t + ! MANIFEST ext/Encode/CN/Makefile.PL ext/Encode/Changes + ! ext/Encode/Encode.pm ext/Encode/Encode.xs + ! ext/Encode/Encode/encode.h ext/Encode/JP/Makefile.PL + ! ext/Encode/KR/Makefile.PL ext/Encode/MANIFEST + ! ext/Encode/TW/Makefile.PL ext/Encode/lib/Encode/Config.pm + ! ext/Encode/lib/Encode/JP/JIS7.pm ext/Encode/t/fallback.t +____________________________________________________________________________ +[ 16144] By: gsar on 2002/04/24 18:59:05 + Log: another case of enabling binmode() where it should not be: if the + *.enc files are CRLF terminated, the result gets CRCRLF terminations + Branch: perl + ! ext/Encode/t/CJKT.t +____________________________________________________________________________ +[ 16143] By: jhi on 2002/04/24 18:34:27 + Log: microperl update; boldly assume time() and time_t + (since we assume ANSI and i_time, anyway). + Branch: perl + ! uconfig.h uconfig.sh +____________________________________________________________________________ +[ 16142] By: jhi on 2002/04/24 18:30:14 + Log: Integrate #16136, #16137, #16138 from macperl; + + Silly fix for the SC compiler's fixation with "comp" as a type + + Skip more PerlIO symbols for sfio + + Play nicely in miniperl + Branch: perl + !> ext/Unicode/Normalize/Normalize.xs lib/File/Copy.pm + !> lib/File/Spec/Mac.pm makedef.pl +____________________________________________________________________________ +[ 16141] By: pudge on 2002/04/24 18:15:19 + Log: Sync configpm and config.h for use in 5.8 + (still need to do config.sh) + Branch: macperl + ! macos/config.h macos/configpm +____________________________________________________________________________ +[ 16140] By: pudge on 2002/04/24 18:14:05 + Log: Make MM_MacOS work with new MakeMaker + Branch: macperl + ! macos/lib/ExtUtils/MM_MacOS.pm +____________________________________________________________________________ +[ 16139] By: pudge on 2002/04/24 18:13:34 + Log: Makefile.mk changes for 5.8: additional extensions + and source files; bump version + Branch: macperl + ! macos/MPVersion.r macos/Makefile.mk macos/macperl/Makefile.mk +____________________________________________________________________________ +[ 16138] By: pudge on 2002/04/24 18:12:22 + Log: Play nicely in miniperl + Branch: macperl + ! lib/File/Copy.pm lib/File/Spec/Mac.pm +____________________________________________________________________________ +[ 16137] By: pudge on 2002/04/24 18:10:34 + Log: Skip more PerlIO symbols for sfio + Branch: macperl + ! makedef.pl +____________________________________________________________________________ +[ 16136] By: pudge on 2002/04/24 18:09:37 + Log: Silly fix for the SC compiler's fixation with "comp" as a type + Branch: macperl + ! ext/Unicode/Normalize/Normalize.xs +____________________________________________________________________________ +[ 16135] By: pudge on 2002/04/24 18:08:45 + Log: Merge macperl xsubpp with current xsubpp + Branch: macperl + ! macos/xsubpp +____________________________________________________________________________ +[ 16134] By: nick on 2002/04/24 18:08:37 + Log: Integrate mainline + Branch: perlio + +> lib/ExtUtils/t/00setup_dummy.t lib/ExtUtils/t/VERSION_FROM.t + +> lib/ExtUtils/t/backwards.t lib/ExtUtils/t/zz_cleanup_dummy.t + - lib/ExtUtils/t/Big-Fat-Dummy/Liar/Makefile.PL + - lib/ExtUtils/t/Big-Fat-Dummy/Liar/lib/Big/Fat/Liar.pm + - lib/ExtUtils/t/Big-Fat-Dummy/Makefile.PL + - lib/ExtUtils/t/Big-Fat-Dummy/lib/Big/Fat/Dummy.pm + - lib/ExtUtils/t/Problem-Module/Makefile.PL + - lib/ExtUtils/t/Problem-Module/subdir/Makefile.PL + !> (integrate 44 files) +____________________________________________________________________________ +[ 16133] By: pudge on 2002/04/24 18:05:50 + Log: Delete more included modules from bundled_ext + Branch: macperl + - macos/bundled_ext/Digest/MD5/Changes + - macos/bundled_ext/Digest/MD5/MD5.pm + - macos/bundled_ext/Digest/MD5/MD5.xs + - macos/bundled_ext/Digest/MD5/Makefile.PL + - macos/bundled_ext/Digest/MD5/Makefile.mk + - macos/bundled_ext/Digest/MD5/README + - macos/bundled_ext/Digest/MD5/hints/dec_osf.pl + - macos/bundled_ext/Digest/MD5/hints/irix_6.pl + - macos/bundled_ext/Digest/MD5/rfc1321.txt + - macos/bundled_ext/Digest/MD5/t/badfile.t + - macos/bundled_ext/Digest/MD5/t/files.t + - macos/bundled_ext/Digest/MD5/t/md5-aaa.t + - macos/bundled_ext/Digest/MD5/typemap + - macos/bundled_ext/Filter/Util/Call/Call.pm + - macos/bundled_ext/Filter/Util/Call/Call.xs + - macos/bundled_ext/Filter/Util/Call/Makefile.PL + - macos/bundled_ext/Filter/Util/Call/ppport.h + - macos/bundled_ext/Filter/t/call.t + - macos/bundled_ext/Filter/t/filter-util.pl + - macos/bundled_ext/List/Util/ChangeLog + - macos/bundled_ext/List/Util/Makefile.PL + - macos/bundled_ext/List/Util/README + - macos/bundled_ext/List/Util/Util.xs + - macos/bundled_ext/List/Util/lib/List/Util.pm + - macos/bundled_ext/List/Util/lib/Scalar/Util.pm + - macos/bundled_ext/List/Util/t/blessed.t + - macos/bundled_ext/List/Util/t/dualvar.t + - macos/bundled_ext/List/Util/t/first.t + - macos/bundled_ext/List/Util/t/max.t + - macos/bundled_ext/List/Util/t/maxstr.t + - macos/bundled_ext/List/Util/t/min.t + - macos/bundled_ext/List/Util/t/minstr.t + - macos/bundled_ext/List/Util/t/readonly.t + - macos/bundled_ext/List/Util/t/reduce.t + - macos/bundled_ext/List/Util/t/reftype.t + - macos/bundled_ext/List/Util/t/shuffle.t + - macos/bundled_ext/List/Util/t/sum.t + - macos/bundled_ext/List/Util/t/tainted.t + - macos/bundled_ext/List/Util/t/weak.t + - macos/bundled_ext/MIME/Base64/Base64.pm + - macos/bundled_ext/MIME/Base64/Base64.xs + - macos/bundled_ext/MIME/Base64/Changes + - macos/bundled_ext/MIME/Base64/Makefile.PL + - macos/bundled_ext/MIME/Base64/QuotedPrint.pm + - macos/bundled_ext/MIME/Base64/README + - macos/bundled_ext/MIME/Base64/t/base64.t + - macos/bundled_ext/MIME/Base64/t/quoted-print.t + - macos/bundled_ext/MIME/Base64/t/unicode.t + - macos/bundled_ext/Storable/ChangeLog + - macos/bundled_ext/Storable/Makefile.PL + - macos/bundled_ext/Storable/README + - macos/bundled_ext/Storable/Storable.pm + - macos/bundled_ext/Storable/Storable.xs + - macos/bundled_ext/Storable/t/blessed.t + - macos/bundled_ext/Storable/t/canonical.t + - macos/bundled_ext/Storable/t/compat-0.6.t + - macos/bundled_ext/Storable/t/dclone.t + - macos/bundled_ext/Storable/t/dump.pl + - macos/bundled_ext/Storable/t/forgive.t + - macos/bundled_ext/Storable/t/freeze.t + - macos/bundled_ext/Storable/t/lock.t + - macos/bundled_ext/Storable/t/overload.t + - macos/bundled_ext/Storable/t/recurse.t + - macos/bundled_ext/Storable/t/retrieve.t + - macos/bundled_ext/Storable/t/store.t + - macos/bundled_ext/Storable/t/tied.t + - macos/bundled_ext/Storable/t/tied_hook.t + - macos/bundled_ext/Storable/t/tied_items.t + - macos/bundled_ext/Storable/t/utf8.t + - macos/bundled_ext/Time/HiRes/Changes + - macos/bundled_ext/Time/HiRes/HiRes.pm + - macos/bundled_ext/Time/HiRes/HiRes.t + - macos/bundled_ext/Time/HiRes/HiRes.xs + - macos/bundled_ext/Time/HiRes/Makefile.PL + - macos/bundled_ext/Time/HiRes/hints/dynixptx.pl + - macos/bundled_ext/Time/HiRes/hints/sco.pl +____________________________________________________________________________ +[ 16132] By: jhi on 2002/04/24 17:03:22 + Log: Thou shalt not assume %x works for UVs. + Branch: perl + ! ext/Encode/Encode.xs +____________________________________________________________________________ +[ 16131] By: nick on 2002/04/24 15:50:31 + Log: Submit an old integrate + Branch: perlio + +> (branch 27 files) + - ext/Encode/t/CN.t ext/Encode/t/JP.t ext/Encode/t/KR.t + - ext/Encode/t/TW.t ext/Encode/t/bogus.ucm + - ext/Encode/t/gb2312.euc ext/Encode/t/gb2312.ref + - ext/Encode/t/jisx0201.euc ext/Encode/t/jisx0201.ref + - ext/Encode/t/jisx0208.euc ext/Encode/t/jisx0208.ref + - ext/Encode/t/jisx0212.euc ext/Encode/t/jisx0212.ref + - ext/Encode/t/ksc5601.euc ext/Encode/t/ksc5601.ref + !> (integrate 84 files) +____________________________________________________________________________ +[ 16130] By: jhi on 2002/04/24 15:38:12 + Log: Partially retract #12056, from Craig Berry. + Branch: perl + ! vms/vms.c +____________________________________________________________________________ +[ 16129] By: pudge on 2002/04/24 14:37:10 + Log: Delete more included modules from bundled_lib + Branch: macperl + - macos/bundled_lib/blib/lib/Class/ISA.pm + - macos/bundled_lib/blib/lib/Digest.pm + - macos/bundled_lib/blib/lib/Filter/Simple.pm + - macos/bundled_lib/blib/lib/Memoize.pm + - macos/bundled_lib/blib/lib/Memoize/AnyDBM_File.pm + - macos/bundled_lib/blib/lib/Memoize/Expire.pm + - macos/bundled_lib/blib/lib/Memoize/ExpireFile.pm + - macos/bundled_lib/blib/lib/Memoize/ExpireTest.pm + - macos/bundled_lib/blib/lib/Memoize/NDBM_File.pm + - macos/bundled_lib/blib/lib/Memoize/SDBM_File.pm + - macos/bundled_lib/blib/lib/Memoize/Storable.pm + - macos/bundled_lib/blib/lib/NEXT.pm + - macos/bundled_lib/blib/lib/Net/Cmd.pm + - macos/bundled_lib/blib/lib/Net/Config.pm + - macos/bundled_lib/blib/lib/Net/Domain.pm + - macos/bundled_lib/blib/lib/Net/FTP.pm + - macos/bundled_lib/blib/lib/Net/FTP/A.pm + - macos/bundled_lib/blib/lib/Net/FTP/E.pm + - macos/bundled_lib/blib/lib/Net/FTP/I.pm + - macos/bundled_lib/blib/lib/Net/FTP/L.pm + - macos/bundled_lib/blib/lib/Net/FTP/dataconn.pm + - macos/bundled_lib/blib/lib/Net/HTTP/Methods.pm + - macos/bundled_lib/blib/lib/Net/HTTP/NB.pm + - macos/bundled_lib/blib/lib/Net/NNTP.pm + - macos/bundled_lib/blib/lib/Net/Netrc.pm + - macos/bundled_lib/blib/lib/Net/POP3.pm + - macos/bundled_lib/blib/lib/Net/SMTP.pm + - macos/bundled_lib/blib/lib/Net/Time.pm + - macos/bundled_lib/blib/lib/Net/libnetFAQ.pod + - macos/bundled_lib/blib/lib/Switch.pm + - macos/bundled_lib/t/Class/ISA/test.pl + - macos/bundled_lib/t/Digest/Digest.t + - macos/bundled_lib/t/Filter/Simple/ExportTest.pm + - macos/bundled_lib/t/Filter/Simple/FilterOnlyTest.pm + - macos/bundled_lib/t/Filter/Simple/FilterTest.pm + - macos/bundled_lib/t/Filter/Simple/ImportTest.pm + - macos/bundled_lib/t/Filter/Simple/data.t + - macos/bundled_lib/t/Filter/Simple/export.t + - macos/bundled_lib/t/Filter/Simple/filter.t + - macos/bundled_lib/t/Filter/Simple/filter_only.t + - macos/bundled_lib/t/Filter/Simple/import.t + - macos/bundled_lib/t/Memoize/array.t + - macos/bundled_lib/t/Memoize/array_confusion.t + - macos/bundled_lib/t/Memoize/correctness.t + - macos/bundled_lib/t/Memoize/errors.t + - macos/bundled_lib/t/Memoize/expire.t + - macos/bundled_lib/t/Memoize/expire_file.t + - macos/bundled_lib/t/Memoize/expire_module_n.t + - macos/bundled_lib/t/Memoize/expire_module_t.t + - macos/bundled_lib/t/Memoize/flush.t + - macos/bundled_lib/t/Memoize/normalize.t + - macos/bundled_lib/t/Memoize/prototype.t + - macos/bundled_lib/t/Memoize/speed.t + - macos/bundled_lib/t/Memoize/tie.t + - macos/bundled_lib/t/Memoize/tie_gdbm.t + - macos/bundled_lib/t/Memoize/tie_ndbm.t + - macos/bundled_lib/t/Memoize/tie_sdbm.t + - macos/bundled_lib/t/Memoize/tie_storable.t + - macos/bundled_lib/t/Memoize/tiefeatures.t + - macos/bundled_lib/t/Memoize/unmemoize.t + - macos/bundled_lib/t/NEXT/actual.t + - macos/bundled_lib/t/NEXT/actuns.t + - macos/bundled_lib/t/NEXT/next.t + - macos/bundled_lib/t/NEXT/unseen.t + - macos/bundled_lib/t/Switch/t/given.t + - macos/bundled_lib/t/Switch/t/nested.t + - macos/bundled_lib/t/Switch/t/switch.t + - macos/bundled_lib/t/libnet/config.t + - macos/bundled_lib/t/libnet/ftp.t + - macos/bundled_lib/t/libnet/hostname.t + - macos/bundled_lib/t/libnet/libnet_t.pl + - macos/bundled_lib/t/libnet/netrc.t + - macos/bundled_lib/t/libnet/nntp.t + - macos/bundled_lib/t/libnet/require.t + - macos/bundled_lib/t/libnet/smtp.t +____________________________________________________________________________ +[ 16128] By: pudge on 2002/04/24 14:18:55 + Log: Remove Text::Balanced from bundled_lib (already in lib) + Branch: macperl + - macos/bundled_lib/blib/lib/Text/Balanced.pm + - macos/bundled_lib/t/Text/Balanced/t/extbrk.t + - macos/bundled_lib/t/Text/Balanced/t/extcbk.t + - macos/bundled_lib/t/Text/Balanced/t/extdel.t + - macos/bundled_lib/t/Text/Balanced/t/extmul.t + - macos/bundled_lib/t/Text/Balanced/t/extqlk.t + - macos/bundled_lib/t/Text/Balanced/t/exttag.t + - macos/bundled_lib/t/Text/Balanced/t/extvar.t + - macos/bundled_lib/t/Text/Balanced/t/gentag.t +____________________________________________________________________________ +[ 16127] By: jhi on 2002/04/24 14:17:16 + Log: A word of warning to the users of UTF-8 locales. + Branch: perl + ! pod/perluniintro.pod +____________________________________________________________________________ +[ 16126] By: jhi on 2002/04/24 12:54:17 + Log: Forgotten from #16125. + Branch: perl + ! t/lib/MakeMaker/Test/Utils.pm +____________________________________________________________________________ +[ 16125] By: jhi on 2002/04/24 05:16:09 + Log: Upgrade to MakeMaker 5.91_02, from Michael Schwern. + Branch: perl + + lib/ExtUtils/t/00setup_dummy.t lib/ExtUtils/t/VERSION_FROM.t + + lib/ExtUtils/t/backwards.t lib/ExtUtils/t/zz_cleanup_dummy.t + - lib/ExtUtils/t/Big-Fat-Dummy/Liar/Makefile.PL + - lib/ExtUtils/t/Big-Fat-Dummy/Liar/lib/Big/Fat/Liar.pm + - lib/ExtUtils/t/Big-Fat-Dummy/Makefile.PL + - lib/ExtUtils/t/Big-Fat-Dummy/lib/Big/Fat/Dummy.pm + - lib/ExtUtils/t/Problem-Module/Makefile.PL + - lib/ExtUtils/t/Problem-Module/subdir/Makefile.PL + ! MANIFEST lib/ExtUtils/Changes lib/ExtUtils/Command/MM.pm + ! lib/ExtUtils/MM.pm lib/ExtUtils/MM_Cygwin.pm + ! lib/ExtUtils/MM_NW5.pm lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MM_Win32.pm + ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm + ! lib/ExtUtils/t/INST.t lib/ExtUtils/t/INST_PREFIX.t + ! lib/ExtUtils/t/MM_Unix.t lib/ExtUtils/t/Manifest.t + ! lib/ExtUtils/t/basic.t lib/ExtUtils/t/hints.t + ! lib/ExtUtils/t/prefixify.t lib/ExtUtils/t/problems.t +____________________________________________________________________________ +[ 16124] By: jhi on 2002/04/24 02:03:08 + Log: Subject: New UTF-8 surprise + From: [email protected] (Andreas J. Koenig) + Date: Mon, 22 Apr 2002 12:08:48 +0200 + Message-ID: <[email protected]> + Branch: perl + ! pp_hot.c t/op/subst.t +____________________________________________________________________________ +[ 16123] By: gsar on 2002/04/24 01:25:17 + Log: create a //depot/macperl/... branch with a //depot/macperl/macos/... + tree that is branched from //depot/maint-5.6/macperl/macos/... + Branch: macperl + +> (branch 3590 files) +____________________________________________________________________________ +[ 16122] By: jhi on 2002/04/23 23:52:11 + Log: Try to be clearer about perlio. + Branch: perl + ! INSTALL +____________________________________________________________________________ +[ 16121] By: jhi on 2002/04/23 23:45:41 + Log: Subject: Re: binary compatibility + From: Andy Dougherty <[email protected]> + Date: Tue, 23 Apr 2002 16:21:26 -0400 (EDT) + Message-ID: <Pine.SOL.4.10.10204231614020.754-100000@maxwell.phys.lafayette.edu> + Branch: perl + ! INSTALL patchlevel.h +____________________________________________________________________________ +[ 16120] By: jhi on 2002/04/23 23:41:52 + Log: Go on record about the binary backward incompatibility. + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 16119] By: jhi on 2002/04/23 23:09:02 + Log: Subject: [PATCH] was: t/win32/system.t Borland too helpful + From: "Vadim Konovalov" <[email protected]> + Date: Wed, 24 Apr 2002 01:51:43 +0400 + Message-ID: <006e01c1eb11$156d2390$695cc3d9@vad> + Branch: perl + ! t/win32/system.t +____________________________________________________________________________ +[ 16118] By: jhi on 2002/04/23 23:08:12 + Log: Subject: [PATCH: perl@16083] fix lib/locale.t for VMS with many installed locales + From: [email protected] + Date: Tue, 23 Apr 2002 17:14:32 -0400 + Message-ID: <[email protected]> + Branch: perl + ! lib/locale.t +____________________________________________________________________________ +[ 16117] By: jhi on 2002/04/23 23:07:02 + Log: Subject: [PATCH Redux] Nuke obsolete way to build debugging (etc) perls + From: [email protected] + Date: Tue, 23 Apr 02 15:06 edt + Message-Id: <[email protected]> + Branch: perl + ! Makefile.SH cflags.SH +____________________________________________________________________________ +[ 16116] By: jhi on 2002/04/23 23:05:14 + Log: metaconfig unit change for #16115. + Branch: metaconfig + ! U/compline/byteorder.U + Branch: perl + ! config_h.SH +____________________________________________________________________________ +[ 16115] By: jhi on 2002/04/23 23:04:24 + Log: Regen Configure to mirror #16111 (with one added tweak). + Branch: perl + ! Configure +____________________________________________________________________________ +[ 16114] By: jhi on 2002/04/23 22:54:46 + Log: Retract #16109. + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 16113] By: jhi on 2002/04/23 22:38:04 + Log: FAQ sync. + Branch: perl + ! pod/perlfaq3.pod pod/perlfaq8.pod +____________________________________________________________________________ +[ 16112] By: jhi on 2002/04/23 22:34:08 + Log: use encoding no more defaults to Latin 1. + Branch: perl + ! pod/perluniintro.pod +____________________________________________________________________________ +[ 16111] By: gsar on 2002/04/23 22:27:07 + Log: Configure test for byteorder loses bits + Branch: perl + ! Configure +____________________________________________________________________________ +[ 16110] By: gsar on 2002/04/23 21:32:03 + Log: hacking around byteorder variance between config.sh and config.h + isn't needed after change#16099 + Branch: perl + ! ext/Storable/t/malice.t +____________________________________________________________________________ +[ 16109] By: jhi on 2002/04/23 17:54:33 + Log: (retracted by #16114) + + Subject: [PATCH] Nuke obsolete way to build debugging (etc) perls + From: "Green, Paul" <[email protected]> + Date: Tue, 23 Apr 2002 13:47:19 -0400 + Message-ID: <[email protected]> + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 16108] By: jhi on 2002/04/23 14:45:07 + Log: Subject: [PATCH] lib/File/Find.pm for QNX, NTO + From: Norton Allen <[email protected]> + Date: Tue, 23 Apr 2002 11:50:07 -0400 (edt) + Message-Id: <[email protected]> + Branch: perl + ! lib/File/Find.pm +____________________________________________________________________________ +[ 16107] By: jhi on 2002/04/23 14:44:13 + Log: Subject: [PATCH] README.qnx, hints/qnx.sh + From: Norton Allen <[email protected]> + Date: Tue, 23 Apr 2002 11:48:54 -0400 (edt) + Message-Id: <[email protected]> + Branch: perl + ! README.qnx hints/qnx.sh +____________________________________________________________________________ +[ 16106] By: jhi on 2002/04/23 13:57:48 + Log: Subject: [PATCH] pod/perlhist.pod + From: Abigail <[email protected]> + Date: Tue, 23 Apr 2002 16:21:31 +0200 + Message-ID: <[email protected]> + + (removed 5.005_04 which never happened) + Branch: perl + ! pod/perlhist.pod +____________________________________________________________________________ +[ 16105] By: jhi on 2002/04/23 13:46:31 + Log: Subject: Re: [PATCH abigail.t] another portability attempt + From: Abigail <[email protected]> + Date: Tue, 23 Apr 2002 11:35:54 +0200 + Message-ID: <[email protected]> + Branch: perl + ! t/japh/abigail.t +____________________________________________________________________________ +[ 16104] By: jhi on 2002/04/23 13:35:03 + Log: NetWare tweak from C Aditya. + Branch: perl + ! NetWare/Nwmain.c NetWare/nw5.c +____________________________________________________________________________ +[ 16103] By: gsar on 2002/04/23 06:33:25 + Log: fix a typo + Branch: perl + ! regexec.c +____________________________________________________________________________ +[ 16102] By: jhi on 2002/04/23 04:41:43 + Log: Uncurliff. + Branch: perl + ! README.ko +____________________________________________________________________________ +[ 16101] By: jhi on 2002/04/23 04:36:27 + Log: Pointer to UV casting. + Branch: perl + ! regexec.c +____________________________________________________________________________ +[ 16100] By: jhi on 2002/04/23 02:36:09 + Log: metaconfig unit change for #16099. + Branch: metaconfig + ! U/compline/byteorder.U +____________________________________________________________________________ +[ 16099] By: jhi on 2002/04/23 02:35:52 + Log: Use UV (not long) for BYTEORDER. + Branch: perl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH +____________________________________________________________________________ +[ 16098] By: jhi on 2002/04/23 02:18:10 + Log: # cpp commands must start in the first column. + Branch: perl + ! scope.c +____________________________________________________________________________ +[ 16097] By: jhi on 2002/04/23 01:52:36 + Log: Reborn as text. + Branch: perl + + NetWare/interface.cpp +____________________________________________________________________________ +[ 16096] By: jhi on 2002/04/23 01:52:00 + Log: Dead as binary. + Branch: perl + - NetWare/interface.cpp +____________________________________________________________________________ +[ 16095] By: jhi on 2002/04/23 01:49:37 + Log: Undo #16091, a time-warped escapee. + Branch: perl + ! lib/ExtUtils/t/MM_Cygwin.t +____________________________________________________________________________ +[ 16094] By: jhi on 2002/04/23 01:43:42 + Log: *size tweaks from Sarathy. + Branch: perl + ! ext/Storable/t/malice.t +____________________________________________________________________________ +[ 16093] By: jhi on 2002/04/23 01:12:50 + Log: Subject: [PATCH pod/perlguts.pod] remove a redundant =over + From: Stas Bekman <[email protected]> + Date: Tue, 23 Apr 2002 01:52:22 +0800 + Message-ID: <[email protected]> + Branch: perl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 16092] By: jhi on 2002/04/23 01:05:37 + Log: Subject: [PATCH] (Updated) Work around bug in gcc 2.95.2 on hppa targets + From: [email protected] + Date: Mon, 22 Apr 02 20:35 edt + Message-Id: <[email protected]> + Branch: perl + + hints/t001.c + ! MANIFEST hints/README.hints hints/vos.sh +____________________________________________________________________________ +[ 16091] By: jhi on 2002/04/23 00:42:12 + Log: (retracted by #16095) + Branch: perl + ! lib/ExtUtils/t/MM_Cygwin.t +____________________________________________________________________________ +[ 16090] By: jhi on 2002/04/23 00:16:09 + Log: Subject: Re: perl@16083 + From: Nicholas Clark <[email protected]> + Date: Mon, 22 Apr 2002 23:17:45 +0100 + Message-ID: <[email protected]> + Branch: perl + ! ext/Storable/t/malice.t +____________________________________________________________________________ +[ 16089] By: jhi on 2002/04/23 00:12:09 + Log: Upgrade to Encode 1.58. + Branch: perl + + ext/Encode/t/CJKT.t ext/Encode/t/at-cn.t ext/Encode/t/at-tw.t + + ext/Encode/t/big5-eten.enc ext/Encode/t/big5-eten.utf + + ext/Encode/t/big5-hkscs.enc ext/Encode/t/big5-hkscs.utf + + ext/Encode/t/gb2312.enc ext/Encode/t/gb2312.utf + + ext/Encode/t/jisx0201.enc ext/Encode/t/jisx0201.utf + + ext/Encode/t/jisx0208.enc ext/Encode/t/jisx0208.utf + + ext/Encode/t/jisx0212.enc ext/Encode/t/jisx0212.utf + + ext/Encode/t/ksc5601.enc ext/Encode/t/ksc5601.utf + - ext/Encode/t/CN.t ext/Encode/t/JP.t ext/Encode/t/KR.t + - ext/Encode/t/TW.t ext/Encode/t/bogus.ucm + - ext/Encode/t/gb2312.euc ext/Encode/t/gb2312.ref + - ext/Encode/t/jisx0201.euc ext/Encode/t/jisx0201.ref + - ext/Encode/t/jisx0208.euc ext/Encode/t/jisx0208.ref + - ext/Encode/t/jisx0212.euc ext/Encode/t/jisx0212.ref + - ext/Encode/t/ksc5601.euc ext/Encode/t/ksc5601.ref + ! MANIFEST ext/Encode/Changes ext/Encode/Encode.pm + ! ext/Encode/Encode.xs ext/Encode/MANIFEST ext/Encode/TW/TW.pm + ! ext/Encode/bin/ucm2table ext/Encode/t/perlio.t +____________________________________________________________________________ +[ 16088] By: jhi on 2002/04/22 19:55:18 + Log: On Win32 the end.t failure should be gone now. + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 16087] By: jhi on 2002/04/22 19:51:29 + Log: Subject: [PATCH] update VOS-specific pod files + From: [email protected] + Date: Mon, 22 Apr 02 16:02 edt + Message-Id: <[email protected]> + Branch: perl + ! README.vos pod/perlport.pod +____________________________________________________________________________ +[ 16086] By: jhi on 2002/04/22 19:50:05 + Log: Subject: [PATCH] cleanup ./hints/vos.sh + From: [email protected] + Date: Mon, 22 Apr 02 15:26 edt + Message-Id: <[email protected]> + Branch: perl + ! hints/vos.sh +____________________________________________________________________________ +[ 16085] By: jhi on 2002/04/22 19:48:20 + Log: Upgrade to Encode 1.57, from Dan Kogai. + Branch: perl + ! ext/Encode/Changes ext/Encode/Encode.pm ext/Encode/Encode.xs + ! ext/Encode/Unicode/Unicode.pm ext/Encode/lib/Encode/CN/HZ.pm + ! ext/Encode/lib/Encode/Encoding.pm + ! ext/Encode/lib/Encode/JP/JIS7.pm + ! ext/Encode/lib/Encode/KR/2022_KR.pm ext/Encode/t/JP.t + ! ext/Encode/t/KR.t ext/Encode/t/jperl.t ext/Encode/t/perlio.t +____________________________________________________________________________ +[ 16084] By: ams on 2002/04/22 18:10:13 + Log: Subject: [PATCH perl5005delta perlhack perlhist] small corrections + From: Stas Bekman <[email protected]> + Date: Tue, 23 Apr 2002 01:59:07 +0800 + Message-Id: <[email protected]> + Branch: perl + ! pod/perl5005delta.pod pod/perlhack.pod pod/perlhist.pod +____________________________________________________________________________ +[ 16083] By: jhi on 2002/04/22 16:41:03 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ [ 16082] By: jhi on 2002/04/22 16:22:50 Log: In MANIFEST but not added. Branch: perl ==== //depot/macperl/INSTALL#2 (text) ==== Index: perl/INSTALL --- perl/INSTALL.~1~ Sat Apr 27 16:00:05 2002 +++ perl/INSTALL Sat Apr 27 16:00:05 2002 @@ -24,7 +24,7 @@ Each of these is explained in further detail below. -B<NOTE>: starting from the release 5.6.0 Perl will use a version +B<NOTE>: starting from the release 5.6.0, Perl will use a version scheme where even-numbered subreleases (like 5.6) are stable maintenance releases and odd-numbered subreleases (like 5.7) are unstable development releases. Development releases should not be @@ -806,23 +806,23 @@ =head2 Selecting File IO mechanisms -Executive summary: in Perl 5.8 you should use the default "PerlIO" +Executive summary: in Perl 5.8, you should use the default "PerlIO" as the IO mechanism unless you have a good reason not to. In more detail: previous versions of perl used the standard IO mechanisms as defined in stdio.h. Versions 5.003_02 and later of perl -introuced alternate IO mechanisms via a "PerlIO" abstraction, but up -until and including Perl 5.6 stdio mechanism was still the default and -the only supported mechanism. +introduced alternate IO mechanisms via a "PerlIO" abstraction, but up +until and including Perl 5.6, the stdio mechanism was still the default +and the only supported mechanism. -Starting from Perl 5.8 the default mechanism is to use the PerlIO +Starting from Perl 5.8, the default mechanism is to use the PerlIO abstraction, because it allows better control of I/O mechanisms, instead of having to work with (often, work around) vendors' I/O implementations. -This PerlIO abstraction can be disabled (but again, unless you know -what you are doing, should not) either on the Configure command line -with +This PerlIO abstraction can be (but again, unless you know what you +are doing, should not be) disabled either on the Configure command +line with sh Configure -Uuseperlio ==== //depot/macperl/MANIFEST#2 (text) ==== Index: perl/MANIFEST --- perl/MANIFEST.~1~ Sat Apr 27 16:00:05 2002 +++ perl/MANIFEST Sat Apr 27 16:00:05 2002 @@ -197,71 +197,67 @@ ext/DynaLoader/README Dynamic Loader notes and intro ext/DynaLoader/XSLoader_pm.PL Simple XS Loader perl module ext/Encode/AUTHORS List of authors +ext/Encode/bin/enc2xs Encode module generator +ext/Encode/bin/piconv iconv by perl +ext/Encode/bin/ucm2table Table Generator for testing +ext/Encode/bin/ucmlint A UCM Lint utility +ext/Encode/bin/unidump Unicode Dump like hexdump(1) ext/Encode/Byte/Byte.pm Encode extension ext/Encode/Byte/Makefile.PL Encode extension +ext/Encode/Changes Change Log ext/Encode/CN/CN.pm Encode extension ext/Encode/CN/Makefile.PL Encode extension -ext/Encode/Changes Change Log ext/Encode/EBCDIC/EBCDIC.pm Encode extension ext/Encode/EBCDIC/Makefile.PL Encode extension +ext/Encode/encengine.c Encode extension ext/Encode/Encode.pm Mother of all Encode extensions ext/Encode/Encode.xs Encode extension ext/Encode/Encode/Changes.e2x Skeleton file for enc2xs ext/Encode/Encode/ConfigLocal_PM.e2x Skeleton file for enc2xs +ext/Encode/Encode/encode.h Encode extension header file ext/Encode/Encode/Makefile_PL.e2x Skeleton file for enc2xs ext/Encode/Encode/README.e2x Skeleton file for enc2xs ext/Encode/Encode/_PM.e2x Skeleton file for enc2xs ext/Encode/Encode/_T.e2x Skeleton file for enc2xs -ext/Encode/Encode/encode.h Encode extension header file +ext/Encode/encoding.pm Perl Pragmactic Module ext/Encode/JP/JP.pm Encode extension ext/Encode/JP/Makefile.PL Encode extension ext/Encode/KR/KR.pm Encode extension ext/Encode/KR/Makefile.PL Encode extension -ext/Encode/MANIFEST Encode extension -ext/Encode/Makefile.PL Encode extension makefile writer -ext/Encode/README Encode extension -ext/Encode/Symbol/Makefile.PL Encode extension -ext/Encode/Symbol/Symbol.pm Encode extension -ext/Encode/TW/Makefile.PL Encode extension -ext/Encode/TW/TW.pm Encode extension -ext/Encode/Unicode/Makefile.PL Encode extension -ext/Encode/Unicode/Unicode.pm Encode extension -ext/Encode/Unicode/Unicode.xs Encode extension -ext/Encode/bin/enc2xs Encode module generator -ext/Encode/bin/piconv iconv by perl -ext/Encode/bin/ucm2table Table Generator for testing -ext/Encode/bin/ucmlint A UCM Lint utility -ext/Encode/bin/unidump Unicode Dump like hexdump(1) -ext/Encode/encengine.c Encode extension -ext/Encode/encoding.pm Perl Pragmactic Module ext/Encode/lib/Encode/Alias.pm Encode extension ext/Encode/lib/Encode/CJKConstants.pm Encode extension ext/Encode/lib/Encode/CN/HZ.pm Encode extension ext/Encode/lib/Encode/Config.pm Encode configuration module ext/Encode/lib/Encode/Encoder.pm OO Encoder ext/Encode/lib/Encode/Encoding.pm Encode extension +ext/Encode/lib/Encode/Guess.pm Encode Extension ext/Encode/lib/Encode/JP/H2Z.pm Encode extension ext/Encode/lib/Encode/JP/JIS7.pm Encode extension ext/Encode/lib/Encode/KR/2022_KR.pm Encode extension +ext/Encode/lib/Encode/MIME/Header.pm Encode extension ext/Encode/lib/Encode/PerlIO.pod Documents for Encode & PerlIO ext/Encode/lib/Encode/Supported.pod Documents for supported encodings -ext/Encode/t/unibench.pl benchmark script +ext/Encode/Makefile.PL Encode extension makefile writer +ext/Encode/MANIFEST Encode extension +ext/Encode/README Encode extension +ext/Encode/Symbol/Makefile.PL Encode extension +ext/Encode/Symbol/Symbol.pm Encode extension ext/Encode/t/Aliases.t test script -ext/Encode/t/CJKT.t test script -ext/Encode/t/Encode.t test script -ext/Encode/t/Encoder.t test script -ext/Encode/t/Unicode.t test script ext/Encode/t/at-cn.t test script ext/Encode/t/at-tw.t test script ext/Encode/t/big5-eten.enc test data ext/Encode/t/big5-eten.utf test data ext/Encode/t/big5-hkscs.enc test data ext/Encode/t/big5-hkscs.utf test data +ext/Encode/t/CJKT.t test script +ext/Encode/t/Encode.t test script +ext/Encode/t/Encoder.t test script ext/Encode/t/encoding.t test script ext/Encode/t/fallback.t test script ext/Encode/t/gb2312.enc test data ext/Encode/t/gb2312.utf test data ext/Encode/t/grow.t test script +ext/Encode/t/guess.t test script ext/Encode/t/jisx0201.enc test data ext/Encode/t/jisx0201.utf test data ext/Encode/t/jisx0208.enc test data @@ -271,7 +267,12 @@ ext/Encode/t/jperl.t test script ext/Encode/t/ksc5601.enc test data ext/Encode/t/ksc5601.utf test data +ext/Encode/t/mime-header.t test script ext/Encode/t/perlio.t test script +ext/Encode/t/unibench.pl benchmark script +ext/Encode/t/Unicode.t test script +ext/Encode/TW/Makefile.PL Encode extension +ext/Encode/TW/TW.pm Encode extension ext/Encode/ucm/8859-1.ucm Unicode Character Map ext/Encode/ucm/8859-10.ucm Unicode Character Map ext/Encode/ucm/8859-11.ucm Unicode Character Map @@ -360,9 +361,9 @@ ext/Encode/ucm/macIceland.ucm Unicode Character Map ext/Encode/ucm/macJapanese.ucm Unicode Character Map ext/Encode/ucm/macKorean.ucm Unicode Character Map +ext/Encode/ucm/macRoman.ucm Unicode Character Map ext/Encode/ucm/macROMnn.ucm Unicode Character Map ext/Encode/ucm/macRUMnn.ucm Unicode Character Map -ext/Encode/ucm/macRoman.ucm Unicode Character Map ext/Encode/ucm/macSami.ucm Unicode Character Map ext/Encode/ucm/macSymbol.ucm Unicode Character Map ext/Encode/ucm/macThai.ucm Unicode Character Map @@ -373,6 +374,9 @@ ext/Encode/ucm/shiftjis.ucm Unicode Character Map ext/Encode/ucm/symbol.ucm Unicode Character Map ext/Encode/ucm/viscii.ucm Unicode Character Map +ext/Encode/Unicode/Makefile.PL Encode extension +ext/Encode/Unicode/Unicode.pm Encode extension +ext/Encode/Unicode/Unicode.xs Encode extension ext/Errno/ChangeLog See if Errno works ext/Errno/Errno.t See if Errno works ext/Errno/Errno_pm.PL Errno perl module create script @@ -595,10 +599,13 @@ ext/Storable/t/blessed.t See if Storable works ext/Storable/t/canonical.t See if Storable works ext/Storable/t/compat06.t See if Storable works +ext/Storable/t/croak.t See if Storable works ext/Storable/t/dclone.t See if Storable works +ext/Storable/t/downgrade.t See if Storable works ext/Storable/t/forgive.t See if Storable works ext/Storable/t/freeze.t See if Storable works ext/Storable/t/lock.t See if Storable works +ext/Storable/t/make_downgrade.pl See if Storable works ext/Storable/t/malice.t See if Storable copes with corrupt files ext/Storable/t/overload.t See if Storable works ext/Storable/t/recurse.t See if Storable works @@ -655,6 +662,7 @@ ext/threads/shared/t/0nothread.t Tests for basic shared array functionality. ext/threads/shared/t/av_refs.t Tests for arrays containing references ext/threads/shared/t/av_simple.t Tests for basic shared array functionality. +ext/threads/shared/t/cond.t Test condition variables ext/threads/shared/t/hv_refs.t Test shared hashes containing references ext/threads/shared/t/hv_simple.t Tests for basic shared hash functionality. ext/threads/shared/t/no_share.t Tests for disabled share on variables. @@ -1025,11 +1033,9 @@ lib/ExtUtils/MM_Win95.pm MakeMaker methods for Win95 lib/ExtUtils/MY.pm MakeMaker user override class lib/ExtUtils/Packlist.pm Manipulates .packlist files +lib/ExtUtils/t/00setup_dummy.t Setup MakeMaker test module +lib/ExtUtils/t/backwards.t Check MakeMaker's backwards compatibility lib/ExtUtils/t/basic.t See if MakeMaker can build a module -lib/ExtUtils/t/Big-Fat-Dummy/Liar/lib/Big/Fat/Liar.pm MakeMaker dummy module -lib/ExtUtils/t/Big-Fat-Dummy/Liar/Makefile.PL MakeMaker dummy module -lib/ExtUtils/t/Big-Fat-Dummy/lib/Big/Fat/Dummy.pm MakeMaker dummy module -lib/ExtUtils/t/Big-Fat-Dummy/Makefile.PL MakeMaker dummy module lib/ExtUtils/t/Command.t See if ExtUtils::Command works (Win32 only) lib/ExtUtils/t/Constant.t See if ExtUtils::Constant works lib/ExtUtils/t/Embed.t See if ExtUtils::Embed and embedding works @@ -1047,10 +1053,10 @@ lib/ExtUtils/t/MM_Win32.t See if ExtUtils::MM_Win32 works lib/ExtUtils/t/Packlist.t See if Packlist works lib/ExtUtils/t/prefixify.t See if MakeMaker can apply a PREFIX -lib/ExtUtils/t/Problem-Module/Makefile.PL MakeMaker dummy module -lib/ExtUtils/t/Problem-Module/subdir/Makefile.PL MakeMaker dummy module lib/ExtUtils/t/problems.t How MakeMaker reacts to build problems lib/ExtUtils/t/testlib.t See if ExtUtils::testlib works +lib/ExtUtils/t/VERSION_FROM.t See if MakeMaker's VERSION_FROM works +lib/ExtUtils/t/zz_cleanup_dummy.t Cleanup MakeMaker test module lib/ExtUtils/testlib.pm Fixes up @INC to use just-built extension lib/ExtUtils/typemap Extension interface types lib/ExtUtils/xsubpp External subroutine preprocessor @@ -1425,6 +1431,7 @@ lib/Test/Simple/README Test::Simple README lib/Test/Simple/t/buffer.t Test::Builder buffering test lib/Test/Simple/t/Builder.t Test::Builder tests +lib/Test/Simple/t/curr_test.t Test::Builder->curr_test tests lib/Test/Simple/t/diag.t Test::More diag() test lib/Test/Simple/t/exit.t Test::Simple test, exit codes lib/Test/Simple/t/extra.t Test::Simple test @@ -1434,6 +1441,7 @@ lib/Test/Simple/t/filehandles.t Test::Simple test, STDOUT can be played with lib/Test/Simple/t/import.t Test::More test, importing functions lib/Test/Simple/t/is_deeply.t Test::More test, is_deeply() +lib/Test/Simple/t/maybe_regex.t Test::Builder->maybe_regex() tests lib/Test/Simple/t/missing.t Test::Simple test, missing tests lib/Test/Simple/t/More.t Test::More test, basic stuff lib/Test/Simple/t/no_ending.t Test::Builder test, no_ending() @@ -1447,6 +1455,7 @@ lib/Test/Simple/t/simple.t Test::Simple test, basic stuff lib/Test/Simple/t/skip.t Test::More test, SKIP tests lib/Test/Simple/t/skipall.t Test::More test, skip all tests +lib/Test/Simple/t/strays.t Test::Builder stray newline checks lib/Test/Simple/t/todo.t Test::More test, TODO tests lib/Test/Simple/t/undef.t Test::More test, undefs don't cause warnings lib/Test/Simple/t/useing.t Test::More test, compile test @@ -2338,8 +2347,12 @@ t/lib/Math/BigInt/Subclass.pm Empty subclass of BigInt for test t/lib/Math/BigRat/Test.pm Math::BigRat test helper t/lib/sample-tests/bailout Test data for Test::Harness +t/lib/sample-tests/bignum Test data for Test::Harness t/lib/sample-tests/combined Test data for Test::Harness t/lib/sample-tests/descriptive Test data for Test::Harness +t/lib/sample-tests/die Test data for Test::Harness +t/lib/sample-tests/die_head_end Test data for Test::Harness +t/lib/sample-tests/die_last_minute Test data for Test::Harness t/lib/sample-tests/duplicates Test data for Test::Harness t/lib/sample-tests/head_end Test data for Test::Harness t/lib/sample-tests/head_fail Test data for Test::Harness @@ -2511,7 +2524,6 @@ t/op/subst_wamp.t See if substitution works with $& present t/op/sub_lval.t See if lvalue subroutines work t/op/sysio.t See if sysread and syswrite work -t/op/system_tests Test runner for system.t t/op/taint.t See if tainting works t/op/tie.t See if tie/untie functions work t/op/tiearray.t See if tie for arrays works @@ -2587,6 +2599,7 @@ t/uni/upper.t See if Unicode casing works t/win32/longpath.t Test if Win32::GetLongPathName() works t/win32/system.t See if system works in Win* +t/win32/system_tests Test runner for system.t t/x2p/s2p.t See if s2p/psed work taint.c Tainting code thrdvar.h Per-thread variables ==== //depot/macperl/Makefile.SH#2 (text) ==== Index: perl/Makefile.SH --- perl/Makefile.SH.~1~ Sat Apr 27 16:00:05 2002 +++ perl/Makefile.SH Sat Apr 27 16:00:05 2002 @@ -701,7 +701,7 @@ -@test -s extras.lst && $(LDLIBPTH) PATH=`pwd`:${PATH} PERL5LIB=`pwd`/lib ./perl -Ilib -MCPAN -e '@ARGV&&install(@ARGV)' `cat extras.lst` .PHONY: install install-strip install-all install-verbose install-silent \ - no-install install.perl install.man installman install.html installhtml + no-install install.perl install.man install.html install-strip: $(MAKE) STRIPFLAGS=-s install ==== //depot/macperl/NetWare/Makefile#2 (text) ==== Index: perl/NetWare/Makefile --- perl/NetWare/Makefile.~1~ Sat Apr 27 16:00:05 2002 +++ perl/NetWare/Makefile Sat Apr 27 16:00:05 2002 @@ -277,7 +277,7 @@ FCNTL_NLM = $(AUTODIR)\Fcntl\Fcntl.NLM IO_NLM = $(AUTODIR)\IO\IO.NLM OPCODE_NLM = $(AUTODIR)\Opcode\Opcode.NLM -SDBM_FILE_NLM = $(AUTODIR)\SDBM_File\SDBM_File.NLM +SDBM_FILE_NLM = $(AUTODIR)\SDBM_File\SDBM_File.NLM POSIX_NLM = $(AUTODIR)\POSIX\POSIX.NLM ATTRS_NLM = $(AUTODIR)\attrs\attrs.NLM THREAD_NLM = $(AUTODIR)\Thread\Thread.NLM @@ -297,7 +297,6 @@ UNICODENORMALIZE_NLM = $(EXTDIR)\Unicode\Normalize\Normalize.NLM EXTENSION_NLM = \ - $(SDBM_FILE_NLM) \ $(POSIX_NLM) \ $(THREAD_NLM) \ $(DUMPER_NLM) \ @@ -318,8 +317,8 @@ $(ATTRS_NLM) \ $(BYTELOADER_NLM) \ $(IO_NLM) \ - $(UNICODENORMALIZE_NLM) - + $(UNICODENORMALIZE_NLM) \ + $(SDBM_FILE_NLM) # Begin - Following is required to build NetWare specific extensions CGI2Perl, Perl2UCS and UCSExt CGI2PERL = CGI2Perl\CGI2Perl @@ -922,7 +921,7 @@ HEADERS : @echo . . . . making stdio.h and string.h - @copy << stdio.h >\nwnul + @copy << stdio.h >\nul /* * (C) Copyright 2002 Novell Inc. All Rights Reserved. @@ -959,7 +958,7 @@ << @copy stdio.h $(COREDIR) - @copy << string.h >\nwnul + @copy << string.h >\nul /* * (C) Copyright 2002 Novell Inc. All Rights Reserved. ==== //depot/macperl/README.win32#2 (text) ==== Index: perl/README.win32 --- perl/README.win32.~1~ Sat Apr 27 16:00:05 2002 +++ perl/README.win32 Sat Apr 27 16:00:05 2002 @@ -253,13 +253,6 @@ There should be no test failures when running under Windows NT/2000/XP. Many tests I<will> fail under Windows 9x due to the inferior command shell. -The following known test failures under the 64-bit edition of Windows .NET -Server beta 3 are expected to be fixed before the 5.8.0 release: - - Failed Test Stat Wstat Total Fail Failed List of Failed - ------------------------------------------------------------------------ - op/fork.t 18 3 16.67% 2 15 17 - Some test failures may occur if you use a command shell other than the native "cmd.exe", or if you are building from a path that contains spaces. So don't do that. @@ -678,8 +671,6 @@ "runperl". Explain the observed behavior, or lack thereof. :) Hint: .gnidnats llits er'uoy fi ,"lrepnur" eteled :tniH -=back - =item Miscellaneous Things A full set of HTML documentation is installed, so you should be ==== //depot/macperl/configure.com#2 (text) ==== Index: perl/configure.com --- perl/configure.com.~1~ Sat Apr 27 16:00:05 2002 +++ perl/configure.com Sat Apr 27 16:00:05 2002 @@ -2534,6 +2534,7 @@ $ IF xxx .EQS. "Encode/JP" THEN goto ext_loop ! sub extension - omit $ IF xxx .EQS. "Encode/KR" THEN goto ext_loop ! sub extension - omit $ IF xxx .EQS. "Encode/TW" THEN goto ext_loop ! sub extension - omit +$ IF xxx .EQS. "B/C" THEN goto ext_loop ! sub extension - omit $ IF F$EXTRACT(0,8,line) .EQS. "vms/ext/" THEN - xxx = "VMS/" + F$EXTRACT(8,line_len - 20,line) $ known_extensions = known_extensions + " ''xxx'" ==== //depot/macperl/dump.c#2 (text) ==== Index: perl/dump.c --- perl/dump.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/dump.c Sat Apr 27 16:00:05 2002 @@ -617,7 +617,7 @@ case OP_GVSV: case OP_GV: #ifdef USE_ITHREADS - Perl_dump_indent(aTHX_ level, file, "PADIX = %d\n", cPADOPo->op_padix); + Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix); #else if (cSVOPo->op_sv) { SV *tmpsv = NEWSV(0,0); ==== //depot/macperl/embed.fnc#2 (text) ==== Index: perl/embed.fnc --- perl/embed.fnc.~1~ Sat Apr 27 16:00:05 2002 +++ perl/embed.fnc Sat Apr 27 16:00:05 2002 @@ -562,7 +562,7 @@ Ap |void |reentrant_size Ap |void |reentrant_init Ap |void |reentrant_free -Afnp |void* |reentrant_retry|const char*|... +Anp |void* |reentrant_retry|const char*|... #endif Ap |void |call_atexit |ATEXIT_t fn|void *ptr Apd |I32 |call_argv |const char* sub_name|I32 flags|char** argv @@ -587,7 +587,7 @@ Apd |void |require_pv |const char* pv Apd |void |pack_cat |SV *cat|char *pat|char *patend|SV **beglist|SV **endlist|SV ***next_in_list|U32 flags p |void |pidgone |Pid_t pid|int status -Ap |void |pmflag |U16* pmfl|int ch +Ap |void |pmflag |U32* pmfl|int ch p |OP* |pmruntime |OP* pm|OP* expr|OP* repl p |OP* |pmtrans |OP* o|OP* expr|OP* repl p |OP* |pop_return ==== //depot/macperl/embed.h#2 (text+w) ==== ==== //depot/macperl/ext/B/B.xs#2 (text) ==== Index: perl/ext/B/B.xs --- perl/ext/B/B.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/B/B.xs Sat Apr 27 16:00:05 2002 @@ -668,7 +668,7 @@ CODE: sv_setpvn(sv, "PL_ppaddr[OP_", 13); sv_catpv(sv, PL_op_name[o->op_type]); - for (i=13; i<SvCUR(sv); ++i) + for (i=13; (STRLEN)i < SvCUR(sv); ++i) SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]); sv_catpv(sv, "]"); ST(0) = sv; ==== //depot/macperl/ext/ByteLoader/ByteLoader.xs#2 (text) ==== Index: perl/ext/ByteLoader/ByteLoader.xs --- perl/ext/ByteLoader/ByteLoader.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/ByteLoader/ByteLoader.xs Sat Apr 27 16:00:05 2002 @@ -11,7 +11,7 @@ bl_getc(struct byteloader_fdata *data) { dTHX; - if (SvCUR(data->datasv) <= data->next_out) { + if (SvCUR(data->datasv) <= (STRLEN)data->next_out) { int result; /* Run out of buffered data, so attempt to read some more */ *(SvPV_nolen (data->datasv)) = '\0'; ==== //depot/macperl/ext/Cwd/t/cwd.t#2 (text) ==== Index: perl/ext/Cwd/t/cwd.t --- perl/ext/Cwd/t/cwd.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Cwd/t/cwd.t Sat Apr 27 16:00:05 2002 @@ -28,14 +28,18 @@ # Must find an external pwd (or equivalent) command. +my $pwd = $^O eq 'MSWin32' ? "cmd" : "pwd"; my $pwd_cmd = - ($^O eq "MSWin32" || $^O eq "NetWare") ? + ($^O eq "NetWare") ? "cd" : - (grep { -x && -f } map { "$_/pwd$Config{exe_ext}" } + (grep { -x && -f } map { "$_/$pwd$Config{exe_ext}" } split m/$Config{path_sep}/, $ENV{PATH})[0]; $pwd_cmd = 'SHOW DEFAULT' if $IsVMS; - +if ($^O eq 'MSWin32') { + $pwd_cmd =~ s,/,\\,g; + $pwd_cmd = "$pwd_cmd /c cd"; +} print "# native pwd = '$pwd_cmd'\n"; SKIP: { ==== //depot/macperl/ext/Data/Dumper/Dumper.xs#2 (text) ==== Index: perl/ext/Data/Dumper/Dumper.xs --- perl/ext/Data/Dumper/Dumper.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Data/Dumper/Dumper.xs Sat Apr 27 16:00:05 2002 @@ -147,10 +147,10 @@ if (k == '"' || k == '\\' || k == '$' || k == '@') { *r++ = '\\'; - *r++ = k; + *r++ = (char)k; } else if (k < 0x80) - *r++ = k; + *r++ = (char)k; else { r += sprintf(r, "\\x{%"UVxf"}", k); } ==== //depot/macperl/ext/Devel/DProf/DProf.xs#2 (text) ==== Index: perl/ext/Devel/DProf/DProf.xs --- perl/ext/Devel/DProf/DProf.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Devel/DProf/DProf.xs Sat Apr 27 16:00:05 2002 @@ -632,7 +632,7 @@ * while we do this. */ { - I32 warn_tmp = PL_dowarn; + bool warn_tmp = PL_dowarn; PL_dowarn = 0; newXS("DB::sub", XS_DB_sub, file); newXS("DB::goto", XS_DB_goto, file); ==== //depot/macperl/ext/Digest/MD5/MD5.xs#2 (text) ==== Index: perl/ext/Digest/MD5/MD5.xs --- perl/ext/Digest/MD5/MD5.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Digest/MD5/MD5.xs Sat Apr 27 16:00:05 2002 @@ -80,10 +80,10 @@ #ifndef BYTESWAP static void u2s(U32 u, U8* s) { - *s++ = u & 0xFF; - *s++ = (u >> 8) & 0xFF; - *s++ = (u >> 16) & 0xFF; - *s = (u >> 24) & 0xFF; + *s++ = (U8)(u & 0xFF); + *s++ = (U8)((u >> 8) & 0xFF); + *s++ = (U8)((u >> 16) & 0xFF); + *s = (U8)((u >> 24) & 0xFF); } #define s2u(s,u) ((u) = (U32)(*s) | \ ==== //depot/macperl/ext/Digest/MD5/t/files.t#2 (text) ==== Index: perl/ext/Digest/MD5/t/files.t --- perl/ext/Digest/MD5/t/files.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Digest/MD5/t/files.t Sat Apr 27 16:00:05 2002 @@ -16,12 +16,12 @@ if (ord('A') == 193) { # EBCDIC $EXPECT = <<EOT; ee6a09094632cd610199278bbb0f910e ext/Digest/MD5/MD5.pm -491dfb1027eb154cff18beb609d6068a ext/Digest/MD5/MD5.xs +94f873d905cd20a12d8ef4cdbdbcd89f ext/Digest/MD5/MD5.xs EOT } else { # ASCII $EXPECT = <<EOT; 665ddc08b12d6b1bf85ac6dc5aae68b3 ext/Digest/MD5/MD5.pm -95444a9c6ad17e443e4606c6c7fd9e28 ext/Digest/MD5/MD5.xs +5f21e907b2e7dbffe6aba2c762ea93d0 ext/Digest/MD5/MD5.xs EOT } ==== //depot/macperl/ext/Encode/AUTHORS#2 (text) ==== Index: perl/ext/Encode/AUTHORS --- perl/ext/Encode/AUTHORS.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/AUTHORS Sat Apr 27 16:00:05 2002 @@ -27,6 +27,7 @@ Nick Ing-Simmons <[email protected]> Paul Marquess <[email protected]> Philip Newton <[email protected]> +Robin Barker <[email protected]> SADAHIRO Tomoyuki <[email protected]> Spider Boardman <[email protected]> Tatsuhiko Miyagawa <[email protected]> ==== //depot/macperl/ext/Encode/CN/Makefile.PL#2 (text) ==== Index: perl/ext/Encode/CN/Makefile.PL --- perl/ext/Encode/CN/Makefile.PL.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/CN/Makefile.PL Sat Apr 27 16:00:05 2002 @@ -1,6 +1,7 @@ use 5.7.2; use strict; use ExtUtils::MakeMaker; +use strict; my %tables = (euc_cn_t => ['euc-cn.ucm', 'cp936.ucm', @@ -11,6 +12,20 @@ ir_165_t => ['ir-165.ucm'], ); +unless ($ENV{AGGREGATE_TABLES}){ + my @ucm; + for my $k (keys %tables){ + push @ucm, @{$tables{$k}}; + } + %tables = (); + my $seq = 0; + for my $ucm (sort @ucm){ + # 8.3 compliance ! + my $t = sprintf ("%s_%02d_t", substr($ucm, 0, 2), $seq++); + $tables{$t} = [ $ucm ]; + } +} + my $name = 'CN'; WriteMakefile( ==== //depot/macperl/ext/Encode/Changes#2 (text) ==== Index: perl/ext/Encode/Changes --- perl/ext/Encode/Changes.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/Changes Sat Apr 27 16:00:05 2002 @@ -1,9 +1,70 @@ # Revision history for Perl extension Encode. # -# $Id: Changes,v 1.58 2002/04/22 23:54:22 dankogai Exp $ +# $Id: Changes,v 1.63 2002/04/27 18:59:50 dankogai Exp $ # -$Revision: 1.58 $ $Date: 2002/04/22 23:54:22 $ +$Revision: 1.63 $ $Date: 2002/04/27 18:59:50 $ +! lib/Encode/Encoding.pm +! Encoding.pm Unicode/Unicode.pm lib/Encode/Guess.pm lib/Encode/CN/HZ.pm +! lib/Encode/JP/JIS7.pm lib/Encode/MIME/Header.pm lib/Encode/KR/2022_KR.pm + Make use of the Encode::Encoding base class! + And other cleanups in Encode.xs upon NI-XS suggestions + Message-Id: <[email protected]> + +1.62 2002/04/27 11:17:39 +! Encode.pm + encodings() now just check %ExtModule instead of eval{require} + all of them for ":all" to conserve more memory. +! Encode.xs + more "%x" -> "%" UVxf stuff. +! Encode.pm + s/=over2/=over 2/g # oops. + +1.61 2002/04/26 03:02:04 +! t/mime-header.t + Now does decent tests besides use_ok() +! lib/Encode/Guess.pm t/guess.t + UI streamlined, document added +! Unicode/Unicode.xs + various signed/unsigned mismatch nits (#16173) + http://public.activestate.com/cgi-bin/perlbrowse?patch=16173 +! Encode.pm + POD: utf8-flag-related caveats added. A few sections completely + rewritten. +! Encode.xs +! AUTHORS + Thou shalt not assume %d works, either! + Robin Baker added to AUTHORS for this + Message-Id: <[email protected]> +! t/CJKT.t + "Change 16144 by gsar@onru on 2002/04/24 18:59:05" + +1.60 2002/04/24 20:06:52 +! Encode.xs + "Thou shalt not assume %x works." -- jhi + Message-Id: <[email protected]> +! CN/Makefile.PL JP/Makefile.PL KR/Makefile.PL TW/Makefile.PL To make + low-memory build machines happy, now *.c is created for each *.ucm + (no table aggregation). You can still override this by setting + $ENV{AGGREGATE_TABLES}. + Message-Id: <[email protected]> ++ lib/Encode/Guess.pm ++ lib/Encode/JP/JIS7.pm + Encoding-autodetect (mainly for Japanese encoding) added. In a + course of development, JIS7.pm was improved. ++ lib/Encode/HTML/Header.pm ++ lib/Encode/Config.pm + MIME B/Q Header Encoding Added! +! Encode.pm Encode.xs t/fallback.t + new fallbacks; XMLCREF and HTMLCREF upon Bart's request. + Message-Id: <20020424130709.GA14211@tanglefoot> + +1.59 $ 2002/04/22 23:54:22 +! Encode.pm Encode.xs + needs_lines() and perlio_ok() are added to Internal encodings such + as utf8 so XML::SAX is happy. FB_* stub xsubs are now prototyped. + +1.58 2002/04/22 23:54:22 ! TW/TW.pm s/MacChineseSimp/MacChineseTrad/ # ... oops. ! bin/ucm2text @@ -467,7 +528,7 @@ Typo fixes and improvements by jhi Message-Id: <[email protected]>, et al. -1.11 $Date: 2002/04/22 23:54:22 $ +1.11 $Date: 2002/04/27 18:59:50 $ + t/encoding.t + t/jperl.t ! MANIFEST ==== //depot/macperl/ext/Encode/Encode.pm#2 (text) ==== Index: perl/ext/Encode/Encode.pm --- perl/ext/Encode/Encode.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/Encode.pm Sat Apr 27 16:00:05 2002 @@ -1,12 +1,15 @@ +# +# $Id: Encode.pm,v 1.63 2002/04/27 18:59:50 dankogai Exp $ +# package Encode; use strict; -our $VERSION = do { my @r = (q$Revision: 1.58 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 1.63 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; our $DEBUG = 0; use XSLoader (); -XSLoader::load 'Encode'; +XSLoader::load(__PACKAGE__, $VERSION); require Exporter; -our @ISA = qw(Exporter); +use base qw/Exporter/; # Public, encouraged API is exported by default @@ -15,8 +18,10 @@ encodings find_encoding ); -our @FB_FLAGS = qw(DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC PERLQQ); -our @FB_CONSTS = qw(FB_DEFAULT FB_QUIET FB_WARN FB_PERLQQ FB_CROAK); +our @FB_FLAGS = qw(DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC + PERLQQ HTMLCREF XMLCREF); +our @FB_CONSTS = qw(FB_DEFAULT FB_CROAK FB_QUIET FB_WARN + FB_PERLQQ FB_HTMLCREF FB_XMLCREF); our @EXPORT_OK = ( @@ -36,8 +41,6 @@ # Documentation moved after __END__ for speed - NI-S -use Carp; - our $ON_EBCDIC = (ord("A") == 193); use Encode::Alias; @@ -51,17 +54,21 @@ sub encodings { my $class = shift; - my @modules = (@_ and $_[0] eq ":all") ? values %ExtModule : @_; - for my $mod (@modules){ - $mod =~ s,::,/,g or $mod = "Encode/$mod"; - $mod .= '.pm'; - $DEBUG and warn "about to require $mod;"; - eval { require $mod; }; + my %enc; + if (@_ and $_[0] eq ":all"){ + %enc = ( %Encoding, %ExtModule ); + }else{ + %enc = %Encoding; + for my $mod (map {m/::/o ? $_ : "Encode::$_" } @_){ + $DEBUG and warn $mod; + for my $enc (keys %ExtModule){ + $ExtModule{$enc} eq $mod and $enc{$enc} = $mod; + } + } } - my %modules = map {$_ => 1} @modules; return sort { lc $a cmp lc $b } - grep {!/^(?:Internal|Unicode)$/o} keys %Encoding; + grep {!/^(?:Internal|Unicode|Guess)$/o} keys %enc; } sub perlio_ok{ @@ -77,44 +84,33 @@ $Encoding{$name} = $obj; my $lc = lc($name); define_alias($lc => $obj) unless $lc eq $name; - while (@_) - { + while (@_){ my $alias = shift; - define_alias($alias,$obj); + define_alias($alias, $obj); } return $obj; } sub getEncoding { - my ($class,$name,$skip_external) = @_; - my $enc; - if (ref($name) && $name->can('new_sequence')) - { - return $name; - } + my ($class, $name, $skip_external) = @_; + + ref($name) && $name->can('new_sequence') and return $name; + exists $Encoding{$name} and return $Encoding{$name}; my $lc = lc $name; - if (exists $Encoding{$name}) - { - return $Encoding{$name}; - } - if (exists $Encoding{$lc}) - { - return $Encoding{$lc}; - } + exists $Encoding{$lc} and return $Encoding{$lc}; my $oc = $class->find_alias($name); - return $oc if defined $oc; - - $oc = $class->find_alias($lc) if $lc ne $name; - return $oc if defined $oc; + defined($oc) and return $oc; + $lc ne $name and $oc = $class->find_alias($lc); + defined($oc) and return $oc; unless ($skip_external) { if (my $mod = $ExtModule{$name} || $ExtModule{$lc}){ $mod =~ s,::,/,g ; $mod .= '.pm'; eval{ require $mod; }; - return $Encoding{$name} if exists $Encoding{$name}; + exists $Encoding{$name} and return $Encoding{$name}; } } return; @@ -122,7 +118,7 @@ sub find_encoding { - my ($name,$skip_external) = @_; + my ($name, $skip_external) = @_; return __PACKAGE__->getEncoding($name,$skip_external); } @@ -137,7 +133,10 @@ my ($name,$string,$check) = @_; $check ||=0; my $enc = find_encoding($name); - croak("Unknown encoding '$name'") unless defined $enc; + unless(defined $enc){ + require Carp; + Carp::croak("Unknown encoding '$name'"); + } my $octets = $enc->encode($string,$check); return undef if ($check && length($string)); return $octets; @@ -148,7 +147,10 @@ my ($name,$octets,$check) = @_; $check ||=0; my $enc = find_encoding($name); - croak("Unknown encoding '$name'") unless defined $enc; + unless(defined $enc){ + require Carp; + Carp::croak("Unknown encoding '$name'"); + } my $string = $enc->decode($octets,$check); $_[1] = $octets if $check; return $string; @@ -159,9 +161,15 @@ my ($string,$from,$to,$check) = @_; $check ||=0; my $f = find_encoding($from); - croak("Unknown encoding '$from'") unless defined $f; + unless (defined $f){ + require Carp; + Carp::croak("Unknown encoding '$from'"); + } my $t = find_encoding($to); - croak("Unknown encoding '$to'") unless defined $t; + unless (defined $t){ + require Carp; + Carp::croak("Unknown encoding '$to'"); + } my $uni = $f->decode($string,$check); return undef if ($check && length($string)); $string = $t->encode($uni,$check); @@ -188,12 +196,13 @@ # # This is to restore %Encoding if really needed; # + sub predefine_encodings{ + use Encode::Encoding; if ($ON_EBCDIC) { # was in Encode::UTF_EBCDIC package Encode::UTF_EBCDIC; - *name = sub{ shift->{'Name'} }; - *new_sequence = sub{ return $_[0] }; + push @Encode::UTF_EBCDIC::ISA, 'Encode::Encoding'; *decode = sub{ my ($obj,$str,$chk) = @_; my $res = ''; @@ -217,10 +226,8 @@ $Encode::Encoding{Unicode} = bless {Name => "UTF_EBCDIC"} => "Encode::UTF_EBCDIC"; } else { - # was in Encode::UTF_EBCDIC package Encode::Internal; - *name = sub{ shift->{'Name'} }; - *new_sequence = sub{ return $_[0] }; + push @Encode::Internal::ISA, 'Encode::Encoding'; *decode = sub{ my ($obj,$str,$chk) = @_; utf8::upgrade($str); @@ -235,8 +242,7 @@ { # was in Encode::utf8 package Encode::utf8; - *name = sub{ shift->{'Name'} }; - *new_sequence = sub{ return $_[0] }; + push @Encode::utf8::ISA, 'Encode::Encoding'; *decode = sub{ my ($obj,$octets,$chk) = @_; my $str = Encode::decode_utf8($octets); @@ -314,7 +320,7 @@ =head2 TERMINOLOGY -=over 4 +=over 2 =item * @@ -339,7 +345,7 @@ =head1 PERL ENCODING API -=over 4 +=over 2 =item $octets = encode(ENCODING, $string[, CHECK]) @@ -351,7 +357,13 @@ For example, to convert (internally UTF-8 encoded) Unicode string to iso-8859-1 (also known as Latin1), - $octets = encode("iso-8859-1", $unicode); + $octets = encode("iso-8859-1", $utf8); + +B<CAVEAT>: When you C<$octets = encode("utf8", $utf8)>, then $octets +B<ne> $utf8. Though they both contain the same data, the utf8 flag +for $octets is B<always> off. When you encode anything, utf8 flag of +the result is always off, even when it contains completely valid utf8 +string. See L</"The UTF-8 flag"> below. =item $string = decode(ENCODING, $octets[, CHECK]) @@ -365,16 +377,22 @@ $utf8 = decode("iso-8859-1", $latin1); -=item [$length =] from_to($string, FROM_ENCODING, TO_ENCODING [,CHECK]) +B<CAVEAT>: When you C<$utf8 = encode("utf8", $octets)>, then $utf8 +B<may not be equal to> $utf8. Though they both contain the same data, +the utf8 flag for $utf8 is on unless $octets entirely conststs of +ASCII data (or EBCDIC on EBCDIC machines). See L</"The UTF-8 flag"> +below. + +=item [$length =] from_to($string, FROM_ENC, TO_ENC [, CHECK]) -Converts B<in-place> data between two encodings. -For example, to convert ISO-8859-1 data to UTF-8: +Converts B<in-place> data between two encodings. For example, to +convert ISO-8859-1 data to UTF-8: - from_to($data, "iso-8859-1", "utf-8"); + from_to($data, "iso-8859-1", "utf8"); and to convert it back: - from_to($data, "utf-8", "iso-8859-1"); + from_to($data, "utf8", "iso-8859-1"); Note that because the conversion happens in place, the data to be converted cannot be a string constant; it must be a scalar variable. @@ -382,32 +400,34 @@ from_to() returns the length of the converted string on success, undef otherwise. -=back +B<CAVEAT>: The following operations look the same but not quite so; + + from_to($data, "iso-8859-1", "utf8"); #1 + $data = decode("iso-8859-1", $data); #2 -=head2 UTF-8 / utf8 +Both #1 and #2 makes $data consists of completely valid UTF-8 string +but only #2 turns utf8 flag on. #1 is equivalent to -The Unicode Consortium defines the UTF-8 transformation format as a -way of encoding the entire Unicode repertoire as sequences of octets. -This encoding is expected to become very widespread. Perl can use this -form internally to represent strings, so conversions to and from this -form are particularly efficient (as octets in memory do not have to -change, just the meta-data that tells Perl how to treat them). + $data = encode("utf8", decode("iso-8859-1", $data)); -=over 4 +See L</"The UTF-8 flag"> below. =item $octets = encode_utf8($string); -The characters that comprise $string are encoded in Perl's superset of -UTF-8 and the resulting octets are returned as a sequence of bytes. All -possible characters have a UTF-8 representation so this function cannot -fail. +Equivalent to C<$octets = encode("utf8", $string);> The characters +that comprise $string are encoded in Perl's superset of UTF-8 and the +resulting octets are returned as a sequence of bytes. All possible +characters have a UTF-8 representation so this function cannot fail. + =item $string = decode_utf8($octets [, CHECK]); -The sequence of octets represented by $octets is decoded from UTF-8 -into a sequence of logical characters. Not all sequences of octets -form valid UTF-8 encodings, so it is possible for this call to fail. -For CHECK, see L</"Handling Malformed Data">. +equivalent to C<$string = decode("utf8", $octets [, CHECK])>. +decode_utf8($octets [, CHECK]); The sequence of octets represented by +$octets is decoded from UTF-8 into a sequence of logical +characters. Not all sequences of octets form valid UTF-8 encodings, so +it is possible for this call to fail. For CHECK, see +L</"Handling Malformed Data">. =back @@ -493,7 +513,7 @@ =head1 Handling Malformed Data -=over 4 +=over 2 The I<CHECK> argument is used as follows. When you omit it, the behaviour is the same as if you had passed a value of 0 for @@ -507,7 +527,7 @@ If the data is supposed to be UTF-8, an optional lexical warning (category utf8) is given. -=item I<CHECK> = Encode::DIE_ON_ERROR (== 1) +=item I<CHECK> = Encode::FB_CROAK ( == 1) If I<CHECK> is 1, methods will die immediately with an error message. Therefore, when I<CHECK> is set to 1, you should trap the @@ -539,6 +559,10 @@ =item perlqq mode (I<CHECK> = Encode::FB_PERLQQ) +=item HTML charref mode (I<CHECK> = Encode::FB_HTMLCREF) + +=item XML charref mode (I<CHECK> = Encode::FB_XMLCREF) + For encodings that are implemented by Encode::XS, CHECK == Encode::FB_PERLQQ turns (en|de)code into C<perlqq> fallback mode. @@ -548,6 +572,10 @@ where I<xxxx> is the Unicode ID of the character that cannot be found in the character repertoire of the encoding. +HTML/XML character reference modes are about the same, in place of +\x{I<xxxx>}, HTML uses &#I<1234>; where I<1234> is a decimal digit and +XML uses &#xI<abcd>; where I<abcd> is the hexadecimal digit. + =item The bitmask These modes are actually set via a bitmask. Here is how the FB_XX @@ -561,6 +589,8 @@ RETURN_ON_ERR 0x0004 X X LEAVE_SRC 0x0008 PERLQQ 0x0100 X + HTMLCREF 0x0200 + XMLCREF 0x0400 =head2 Unimplemented fallback schemes @@ -581,12 +611,84 @@ See L<Encode::Encoding> for more details. -=head1 Messing with Perl's Internals +=head1 The UTF-8 flag + +Before the introduction of utf8 support in perl, The C<eq> operator +just compares internal data of the scalars. Now C<eq> means internal +data equality AND I<the utf8 flag>. To explain why we made it so, I +will quote page 402 of C<Programming Perl, 3rd ed.> + +=over 2 + +=item Goal #1: + +Old byte-oriented programs should not spontaneously break on the old +byte-oriented data they used to work on. + +=item Goal #2: + +Old byte-oriented programs should magically start working on the new +character-oriented data when appropriate. + +=item Goal #3: + +Programs should run just as fast in the new character-oriented mode +as in the old byte-oriented mode. + +=item Goal #4: + +Perl should remain one language, rather than forking into a +byte-oriented Perl and a character-oriented Perl. + +=back + +Back when C<Programming Perl, 3rd ed.> was written, not even Perl 5.6.0 +was born and many features documented in the book remained +unimplemented. Perl 5.8 hopefully correct this and the introduction +of UTF-8 flag is one of them. You can think this perl notion of +byte-oriented mode (utf8 flag off) and character-oriented mode (utf8 +flag on). + +Here is how Encode takes care of the utf8 flag. + +=over 2 + +=item * + +When you encode, the resulting utf8 flag is always off. + +=item + +When you decode, the resuting utf8 flag is on unless you can +unambiguously represent data. Here is the definition of +dis-ambiguity. + + After C<$utf8 = decode('foo', $octet);>, + + When $octet is... The utf8 flag in $utf8 is + --------------------------------------------- + In ASCII only (or EBCDIC only) OFF + In ISO-8859-1 ON + In any other Encoding ON + --------------------------------------------- + +As you see, there is one exception, In ASCII. That way you can assue +Goal #1. And with Encode Goal #2 is assumed but you still have to be +careful in such cases mentioned in B<CAVEAT> paragraphs. + +This utf8 flag is not visible in perl scripts, exactly for the same +reason you cannot (or you I<don't have to>) see if a scalar contains a +string, integer, or floating point number. But you can still peek +and poke these if you will. See the section below. + +=back + +=head2 Messing with Perl's Internals The following API uses parts of Perl's internals in the current implementation. As such, they are efficient but may change. -=over 4 +=over 2 =item is_utf8(STRING [, CHECK]) @@ -626,8 +728,8 @@ =head1 MAINTAINER This project was originated by Nick Ing-Simmons and later maintained -by Dan Kogai E<lt>[email protected]<gt>. See AUTHORS for a full list -of people involved. For any questions, use -E<lt>[email protected]<gt> so others can share. +by Dan Kogai E<lt>[email protected]<gt>. See AUTHORS for a full +list of people involved. For any questions, use +E<lt>[email protected]<gt> so we can all share share. =cut ==== //depot/macperl/ext/Encode/Encode.xs#2 (text) ==== Index: perl/ext/Encode/Encode.xs --- perl/ext/Encode/Encode.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/Encode.xs Sat Apr 27 16:00:05 2002 @@ -1,5 +1,5 @@ /* - $Id: Encode.xs,v 1.34 2002/04/22 20:27:30 dankogai Exp $ + $Id: Encode.xs,v 1.41 2002/04/27 18:59:50 dankogai Exp $ */ #define PERL_NO_GET_CONTEXT @@ -8,6 +8,8 @@ #include "XSUB.h" #define U8 U8 #include "encode.h" + +# define PERLIO_MODNAME "PerlIO::encoding" # define PERLIO_FILENAME "PerlIO/encoding.pm" /* set 1 or more to profile. t/encoding.t dumps core because of @@ -141,10 +143,22 @@ goto ENCODE_SET_SRC; }else if (check & ENCODE_PERLQQ){ SV* perlqq = - sv_2mortal(newSVpvf("\\x{%04x}", ch)); + sv_2mortal(newSVpvf("\\x{%04"UVxf"}", ch)); sdone += slen + clen; ddone += dlen + SvCUR(perlqq); sv_catsv(dst, perlqq); + }else if (check & ENCODE_HTMLCREF){ + SV* htmlcref = + sv_2mortal(newSVpvf("&#%" UVuf ";", ch)); + sdone += slen + clen; + ddone += dlen + SvCUR(htmlcref); + sv_catsv(dst, htmlcref); + }else if (check & ENCODE_XMLCREF){ + SV* xmlcref = + sv_2mortal(newSVpvf("&#x%" UVxf ";", ch)); + sdone += slen + clen; + ddone += dlen + SvCUR(xmlcref); + sv_catsv(dst, xmlcref); } else { /* fallback char */ sdone += slen + clen; @@ -157,20 +171,23 @@ else { if (check & ENCODE_DIE_ON_ERR){ Perl_croak( - aTHX_ "%s \"\\x%02X\" does not map to Unicode (%d)", + aTHX_ "%s \"\\x%02" UVXf + "\" does not map to Unicode (%d)", enc->name[0], (U8) s[slen], code); }else{ if (check & ENCODE_RETURN_ON_ERR){ if (check & ENCODE_WARN_ON_ERR){ Perl_warner( aTHX_ packWARN(WARN_UTF8), - "%s \"\\x%02X\" does not map to Unicode (%d)", + "%s \"\\x%02" UVXf + "\" does not map to Unicode (%d)", enc->name[0], (U8) s[slen], code); } goto ENCODE_SET_SRC; - }else if (check & ENCODE_PERLQQ){ + }else if (check & + (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){ SV* perlqq = - sv_2mortal(newSVpvf("\\x%02X", s[slen])); + sv_2mortal(newSVpvf("\\x%02" UVXf, s[slen])); sdone += slen + 1; ddone += dlen + SvCUR(perlqq); sv_catsv(dst, perlqq); @@ -204,9 +221,6 @@ SvCUR_set(src, sdone); } /* warn("check = 0x%X, code = 0x%d\n", check, code); */ - if (code && !(check & ENCODE_RETURN_ON_ERR)) { - return &PL_sv_undef; - } SvCUR_set(dst, dlen+ddone); SvPOK_only(dst); @@ -281,13 +295,14 @@ CODE: { encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj))); - require_pv(PERLIO_FILENAME); - if (hv_exists(get_hv("INC", 0), - PERLIO_FILENAME, strlen(PERLIO_FILENAME))) - { + /* require_pv(PERLIO_FILENAME); */ + + eval_pv("require PerlIO::encoding", 0); + + if (SvTRUE(get_sv("@", 0))) { + ST(0) = &PL_sv_no; + }else{ ST(0) = &PL_sv_yes; - }else{ - ST(0) = &PL_sv_no; } XSRETURN(1); } @@ -441,9 +456,6 @@ OUTPUT: RETVAL -PROTOTYPES: DISABLE - - int DIE_ON_ERR() CODE: @@ -480,6 +492,20 @@ RETVAL int +HTMLCREF() +CODE: + RETVAL = ENCODE_HTMLCREF; +OUTPUT: + RETVAL + +int +XMLCREF() +CODE: + RETVAL = ENCODE_XMLCREF; +OUTPUT: + RETVAL + +int FB_DEFAULT() CODE: RETVAL = ENCODE_FB_DEFAULT; @@ -514,6 +540,20 @@ OUTPUT: RETVAL +int +FB_HTMLCREF() +CODE: + RETVAL = ENCODE_FB_HTMLCREF; +OUTPUT: + RETVAL + +int +FB_XMLCREF() +CODE: + RETVAL = ENCODE_FB_XMLCREF; +OUTPUT: + RETVAL + BOOT: { #include "def_t.h" ==== //depot/macperl/ext/Encode/Encode/encode.h#2 (text) ==== Index: perl/ext/Encode/Encode/encode.h --- perl/ext/Encode/Encode/encode.h.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/Encode/encode.h Sat Apr 27 16:00:05 2002 @@ -94,11 +94,15 @@ #define ENCODE_RETURN_ON_ERR 0x0004 /* immediately returns on NOREP */ #define ENCODE_LEAVE_SRC 0x0008 /* $src updated unless set */ #define ENCODE_PERLQQ 0x0100 /* perlqq fallback string */ +#define ENCODE_HTMLCREF 0x0200 /* HTML character ref. fb mode */ +#define ENCODE_XMLCREF 0x0400 /* XML character ref. fb mode */ #define ENCODE_FB_DEFAULT 0x0000 #define ENCODE_FB_CROAK 0x0001 #define ENCODE_FB_QUIET ENCODE_RETURN_ON_ERR #define ENCODE_FB_WARN (ENCODE_RETURN_ON_ERR|ENCODE_WARN_ON_ERR) #define ENCODE_FB_PERLQQ ENCODE_PERLQQ +#define ENCODE_FB_HTMLCREF ENCODE_HTMLCREF +#define ENCODE_FB_XMLCREF ENCODE_XMLCREF #endif /* ENCODE_H */ ==== //depot/macperl/ext/Encode/JP/Makefile.PL#2 (text) ==== Index: perl/ext/Encode/JP/Makefile.PL --- perl/ext/Encode/JP/Makefile.PL.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/JP/Makefile.PL Sat Apr 27 16:00:05 2002 @@ -1,6 +1,7 @@ use 5.7.2; use strict; use ExtUtils::MakeMaker; +use strict; my %tables = ( euc_jp_t => ['euc-jp.ucm'], @@ -12,6 +13,20 @@ ], ); +unless ($ENV{AGGREGATE_TABLES}){ + my @ucm; + for my $k (keys %tables){ + push @ucm, @{$tables{$k}}; + } + %tables = (); + my $seq = 0; + for my $ucm (sort @ucm){ + # 8.3 compliance ! + my $t = sprintf ("%s_%02d_t", substr($ucm, 0, 2), $seq++); + $tables{$t} = [ $ucm ]; + } +} + my $name = 'JP'; WriteMakefile( ==== //depot/macperl/ext/Encode/KR/Makefile.PL#2 (text) ==== Index: perl/ext/Encode/KR/Makefile.PL --- perl/ext/Encode/KR/Makefile.PL.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/KR/Makefile.PL Sat Apr 27 16:00:05 2002 @@ -1,6 +1,7 @@ use 5.7.2; use strict; use ExtUtils::MakeMaker; +use strict; my %tables = (euc_kr_t => ['euc-kr.ucm', 'macKorean.ucm', @@ -10,6 +11,20 @@ johab_t => ['johab.ucm'], ); +unless ($ENV{AGGREGATE_TABLES}){ + my @ucm; + for my $k (keys %tables){ + push @ucm, @{$tables{$k}}; + } + %tables = (); + my $seq = 0; + for my $ucm (sort @ucm){ + # 8.3 compliance ! + my $t = sprintf ("%s_%02d_t", substr($ucm, 0, 2), $seq++); + $tables{$t} = [ $ucm ]; + } +} + my $name = 'KR'; WriteMakefile( ==== //depot/macperl/ext/Encode/MANIFEST#2 (text) ==== Index: perl/ext/Encode/MANIFEST --- perl/ext/Encode/MANIFEST.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/MANIFEST Sat Apr 27 16:00:05 2002 @@ -42,12 +42,13 @@ lib/Encode/Config.pm Encode configuration module lib/Encode/Encoder.pm OO Encoder lib/Encode/Encoding.pm Encode extension +lib/Encode/Guess.pm Encode Extension lib/Encode/JP/H2Z.pm Encode extension lib/Encode/JP/JIS7.pm Encode extension lib/Encode/KR/2022_KR.pm Encode extension +lib/Encode/MIME/Header.pm Encode extension lib/Encode/PerlIO.pod Documents for Encode & PerlIO lib/Encode/Supported.pod Documents for supported encodings -t/unibench.pl benchmark script t/Aliases.t test script t/CJKT.t test script t/Encode.t test script @@ -64,6 +65,7 @@ t/gb2312.enc test data t/gb2312.utf test data t/grow.t test script +t/guess.t test script t/jisx0201.enc test data t/jisx0201.utf test data t/jisx0208.enc test data @@ -73,7 +75,9 @@ t/jperl.t test script t/ksc5601.enc test data t/ksc5601.utf test data +t/mime-header.t test script t/perlio.t test script +t/unibench.pl benchmark script ucm/8859-1.ucm Unicode Character Map ucm/8859-10.ucm Unicode Character Map ucm/8859-11.ucm Unicode Character Map ==== //depot/macperl/ext/Encode/TW/Makefile.PL#2 (text) ==== Index: perl/ext/Encode/TW/Makefile.PL --- perl/ext/Encode/TW/Makefile.PL.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/TW/Makefile.PL Sat Apr 27 16:00:05 2002 @@ -1,6 +1,7 @@ use 5.7.2; use strict; use ExtUtils::MakeMaker; +use strict; my %tables = (big5_t => ['big5-eten.ucm', 'big5-hkscs.ucm', @@ -8,6 +9,20 @@ 'cp950.ucm'], ); +unless ($ENV{AGGREGATE_TABLES}){ + my @ucm; + for my $k (keys %tables){ + push @ucm, @{$tables{$k}}; + } + %tables = (); + my $seq = 0; + for my $ucm (sort @ucm){ + # 8.3 compliance ! + my $t = sprintf ("%s_%02d_t", substr($ucm, 0, 2), $seq++); + $tables{$t} = [ $ucm ]; + } +} + my $name = 'TW'; WriteMakefile( ==== //depot/macperl/ext/Encode/Unicode/Unicode.pm#2 (text) ==== Index: perl/ext/Encode/Unicode/Unicode.pm --- perl/ext/Encode/Unicode/Unicode.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/Unicode/Unicode.pm Sat Apr 27 16:00:05 2002 @@ -3,7 +3,7 @@ use strict; use warnings; -our $VERSION = do { my @r = (q$Revision: 1.35 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 1.36 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use XSLoader; XSLoader::load(__PACKAGE__,$VERSION); @@ -13,6 +13,7 @@ # require Encode; + for my $name (qw(UTF-16 UTF-16BE UTF-16LE UTF-32 UTF-32BE UTF-32LE UCS-2BE UCS-2LE)) @@ -37,27 +38,7 @@ } -sub name { shift->{'Name'} } -sub new_sequence -{ - my $self = shift; - # Return the original if endian known - return $self if ($self->{endian}); - # Return a clone - return bless {%$self},ref($self); -} - -sub needs_lines { 0 }; - -sub perlio_ok { - eval{ require PerlIO::encoding }; - if ($@){ - return 0; - }else{ - return 1; - } -} - +use base qw(Encode::Encoding); # # three implementations of (en|de)code exist. The XS version is the ==== //depot/macperl/ext/Encode/Unicode/Unicode.xs#2 (text) ==== Index: perl/ext/Encode/Unicode/Unicode.xs --- perl/ext/Encode/Unicode/Unicode.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/Unicode/Unicode.xs Sat Apr 27 16:00:05 2002 @@ -1,5 +1,5 @@ /* - $Id: Unicode.xs,v 1.3 2002/04/20 23:43:47 dankogai Exp $ + $Id: Unicode.xs,v 1.4 2002/04/26 03:02:04 dankogai Exp $ */ #define PERL_NO_GET_CONTEXT @@ -61,7 +61,7 @@ d += SvCUR(result); SvCUR_set(result,SvCUR(result)+size); while (size--) { - *d++ = value & 0xFF; + *d++ = (U8)(value & 0xFF); value >>= 8; } break; @@ -70,7 +70,7 @@ SvCUR_set(result,SvCUR(result)+size); d += SvCUR(result); while (size--) { - *--d = value & 0xFF; + *--d = (U8)(value & 0xFF); value >>= 8; } break; ==== //depot/macperl/ext/Encode/encoding.pm#2 (text) ==== Index: perl/ext/Encode/encoding.pm --- perl/ext/Encode/encoding.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/encoding.pm Sat Apr 27 16:00:05 2002 @@ -1,5 +1,5 @@ package encoding; -our $VERSION = do { my @r = (q$Revision: 1.33 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 1.34 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Encode; use strict; @@ -7,7 +7,7 @@ BEGIN { if (ord("A") == 193) { require Carp; - Carp::croak "encoding pragma does not support EBCDIC platforms"; + Carp::croak("encoding pragma does not support EBCDIC platforms"); } } @@ -26,7 +26,7 @@ my $enc = find_encoding($name); unless (defined $enc) { require Carp; - Carp::croak "Unknown encoding '$name'"; + Carp::croak("Unknown encoding '$name'"); } unless ($arg{Filter}){ ${^ENCODING} = $enc; # this is all you need, actually. @@ -35,7 +35,7 @@ if ($arg{$h}){ unless (defined find_encoding($arg{$h})) { require Carp; - Carp::croak "Unknown encoding for $h, '$arg{$h}'"; + Carp::croak("Unknown encoding for $h, '$arg{$h}'"); } eval { binmode($h, ":encoding($arg{$h})") }; }else{ ==== //depot/macperl/ext/Encode/lib/Encode/Alias.pm#2 (text) ==== Index: perl/ext/Encode/lib/Encode/Alias.pm --- perl/ext/Encode/lib/Encode/Alias.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/lib/Encode/Alias.pm Sat Apr 27 16:00:05 2002 @@ -1,11 +1,10 @@ package Encode::Alias; use strict; use Encode; -our $VERSION = do { my @r = (q$Revision: 1.29 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 1.30 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; our $DEBUG = 0; -require Exporter; -our @ISA = qw(Exporter); +use base qw(Exporter); # Public, encouraged API is exported by default ==== //depot/macperl/ext/Encode/lib/Encode/CN/HZ.pm#2 (text) ==== Index: perl/ext/Encode/lib/Encode/CN/HZ.pm --- perl/ext/Encode/lib/Encode/CN/HZ.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/lib/Encode/CN/HZ.pm Sat Apr 27 16:00:05 2002 @@ -3,18 +3,17 @@ use strict; use vars qw($VERSION); -$VERSION = do { my @r = (q$Revision: 1.3 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$VERSION = do { my @r = (q$Revision: 1.4 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Encode (); -use Encode::CN; -use base 'Encode::Encoding'; + +use base qw(Encode::Encoding); +__PACKAGE__->Define('hz'); # HZ is only escaped GB, so we implement it with the # GB2312(raw) encoding here. Cf. RFCs 1842 & 1843. -my $canon = 'hz'; -my $obj = bless {name => $canon}, __PACKAGE__; -$obj->Define($canon); + sub needs_lines { 1 } ==== //depot/macperl/ext/Encode/lib/Encode/Config.pm#2 (text) ==== Index: perl/ext/Encode/lib/Encode/Config.pm --- perl/ext/Encode/lib/Encode/Config.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/lib/Encode/Config.pm Sat Apr 27 16:00:05 2002 @@ -2,7 +2,7 @@ # Demand-load module list # package Encode::Config; -our $VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use strict; @@ -139,6 +139,11 @@ #'big5plus' => 'Encode::HanExtra', #'euc-tw' => 'Encode::HanExtra', #'gb18030' => 'Encode::HanExtra', + + 'MIME-Header' => 'Encode::MIME::Header', + 'MIME-B' => 'Encode::MIME::Header', + 'MIME-Q' => 'Encode::MIME::Header', + ); } ==== //depot/macperl/ext/Encode/lib/Encode/Encoding.pm#2 (text) ==== Index: perl/ext/Encode/lib/Encode/Encoding.pm --- perl/ext/Encode/lib/Encode/Encoding.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/lib/Encode/Encoding.pm Sat Apr 27 16:00:05 2002 @@ -1,7 +1,7 @@ package Encode::Encoding; # Base class for classes which implement encodings use strict; -our $VERSION = do { my @r = (q$Revision: 1.28 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 1.29 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; sub Define { @@ -12,17 +12,37 @@ Encode::define_encoding($obj, $canonical, @_); } -sub name { shift->{'Name'} } +sub name { return shift->{'Name'} } +sub new_sequence { return $_[0] } + +sub needs_lines { 0 }; + +sub perlio_ok { + eval{ require PerlIO::encoding }; + return $@ ? 0 : 1; +} # Temporary legacy methods sub toUnicode { shift->decode(@_) } sub fromUnicode { shift->encode(@_) } -sub new_sequence { return $_[0] } +# +# Needs to be overloaded or just croak +# -sub perlio_ok { 0 } +sub encode { + require Carp; + my $obj = shift; + my $class = ref($obj) ? ref($obj) : $obj; + Carp::croak $class, "->encode() not defined!"; +} -sub needs_lines { 0 } +sub decode{ + require Carp; + my $obj = shift; + my $class = ref($obj) ? ref($obj) : $obj; + Carp::croak $class, "->encode() not defined!"; +} sub DESTROY {} @@ -43,33 +63,20 @@ =head1 DESCRIPTION As mentioned in L<Encode>, encodings are (in the current -implementation at least) defined by objects. The mapping of encoding -name to object is via the C<%encodings> hash. +implementation at least) defined as objects. The mapping of encoding +name to object is via the C<%Encode::Encoding> hash. Though you can +directly manipulate this hash, it is strongly encouraged to use this +base class module and add encode() and decode() methods. -The values of the hash can currently be either strings or objects. -The string form may go away in the future. The string form occurs -when C<encodings()> has scanned C<@INC> for loadable encodings but has -not actually loaded the encoding in question. This is because the -current "loading" process is all Perl and a bit slow. +=head2 Methods you should implement -Once an encoding is loaded, the value of the hash is the object which -implements the encoding. The object should provide the following -interface: +You are strongly encouraged to implement methods below, at least +either encode() or decode(). =over 4 -=item -E<gt>name +=item -E<gt>encode($string [,$check]) -MUST return the string representing the canonical name of the encoding. - -=item -E<gt>new_sequence - -This is a placeholder for encodings with state. It should return an -object which implements this interface. All current implementations -return the original object. - -=item -E<gt>encode($string,$check) - MUST return the octet sequence representing I<$string>. =over 2 @@ -94,7 +101,7 @@ =back -=item -E<gt>decode($octets,$check) +=item -E<gt>decode($octets [,$check]) MUST return the string that I<$octets> represents. @@ -121,28 +128,49 @@ =back +=head2 Other methods defined in Encode::Encodings + +You do not have to override methods shown below unless you have to. + +=over 4 + +=item -E<gt>name + +Predefined As: + + sub name { return shift->{'Name'} } + +MUST return the string representing the canonical name of the encoding. + +=item -E<gt>new_sequence + +Predefined As: + + sub new_sequence { return $_[0] } + +This is a placeholder for encodings with state. It should return an +object which implements this interface. All current implementations +return the original object. + =item -E<gt>perlio_ok() -If you want your encoding to work with PerlIO, you MUST define this -method so that it returns 1 when PerlIO is enabled. Here is an -example; +Predefined As: - sub perlio_ok { - eval { require PerlIO::encoding }; - if ($@){ - return 0; - }else{ - return 1; - } + sub perlio_ok { + eval{ require PerlIO::encoding }; + return $@ ? 0 : 1; } - -By default, this method is defined as follows; +If your encoding does not support PerlIO for some reasons, just; sub perlio_ok { 0 } =item -E<gt>needs_lines() +Predefined As: + + sub needs_lines { 0 }; + If your encoding can work with PerlIO but needs line buffering, you MUST define this method so it returns true. 7bit ISO-2022 encodings are one example that needs this. When this method is missing, false @@ -150,6 +178,28 @@ =back +=head2 Example: Encode::ROT13 + + package Encode::ROT13; + use strict; + use base qw(Encode::Encoding); + + __PACKAGE__->Define('rot13'); + + sub encode($$;$){ + my ($obj, $str, $chk) = @_; + $str =~ tr/A-Za-z/N-ZA-Mn-za-m/; + $_[1] = '' if $chk; # this is what in-place edit means + return $str; + } + + # Jr pna or ynml yvxr guvf; + *decode = \&encode; + + 1; + +=head1 Why the heck Encode API is different? + It should be noted that the I<$check> behaviour is different from the outer public API. The logic is that the "unchecked" case is useful when the encoding is part of a stream which may be reporting errors @@ -168,8 +218,7 @@ It is also highly desirable that encoding classes inherit from C<Encode::Encoding> as a base class. This allows that class to define -additional behaviour for all encoding objects. For example, built-in -Unicode, UCS-2, and UTF-8 classes use +additional behaviour for all encoding objects. package Encode::MyEncoding; use base qw(Encode::Encoding); ==== //depot/macperl/ext/Encode/lib/Encode/JP/H2Z.pm#2 (text) ==== Index: perl/ext/Encode/lib/Encode/JP/H2Z.pm --- perl/ext/Encode/lib/Encode/JP/H2Z.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/lib/Encode/JP/H2Z.pm Sat Apr 27 16:00:05 2002 @@ -1,15 +1,13 @@ # -# $Id: H2Z.pm,v 1.1 2002/04/22 03:43:05 dankogai Exp $ +# $Id: H2Z.pm,v 1.2 2002/04/27 18:59:50 dankogai Exp $ # package Encode::JP::H2Z; use strict; -our $RCSID = q$Id: H2Z.pm,v 1.1 2002/04/22 03:43:05 dankogai Exp $; -our $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; - -use Carp; +our $RCSID = q$Id: H2Z.pm,v 1.2 2002/04/27 18:59:50 dankogai Exp $; +our $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Encode::CJKConstants qw(:all); ==== //depot/macperl/ext/Encode/lib/Encode/JP/JIS7.pm#2 (text) ==== Index: perl/ext/Encode/lib/Encode/JP/JIS7.pm --- perl/ext/Encode/lib/Encode/JP/JIS7.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/lib/Encode/JP/JIS7.pm Sat Apr 27 16:00:05 2002 @@ -1,7 +1,7 @@ package Encode::JP::JIS7; use strict; -our $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 1.8 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Encode qw(:fallbacks); @@ -17,21 +17,11 @@ } => __PACKAGE__; } -sub name { shift->{'Name'} } +use base qw(Encode::Encoding); -sub new_sequence { $_[0] } - +# we override this to 1 so PerlIO works sub needs_lines { 1 } -sub perlio_ok { - eval{ require PerlIO::encoding }; - if ($@){ - return 0; - }else{ - return (PerlIO::encoding->VERSION >= 0.03); - } -} - use Encode::CJKConstants qw(:all); our $DEBUG = 0; @@ -42,9 +32,13 @@ sub decode($$;$) { - my ($obj,$str,$chk) = @_; - my $residue = jis_euc(\$str); - # This is for PerlIO + my ($obj, $str, $chk) = @_; + my $residue = ''; + if ($chk){ + $str =~ s/([^\x00-\x7f].*)$//so; + $1 and $residue = $1; + } + $residue .= jis_euc(\$str); $_[1] = $residue if $chk; return Encode::decode('euc-jp', $str, FB_PERLQQ); } ==== //depot/macperl/ext/Encode/lib/Encode/KR/2022_KR.pm#2 (text) ==== Index: perl/ext/Encode/lib/Encode/KR/2022_KR.pm --- perl/ext/Encode/lib/Encode/KR/2022_KR.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/lib/Encode/KR/2022_KR.pm Sat Apr 27 16:00:05 2002 @@ -1,19 +1,14 @@ package Encode::KR::2022_KR; -use Encode qw(:fallbacks); -use base 'Encode::Encoding'; - use strict; -our $VERSION = do { my @r = (q$Revision: 1.4 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +use Encode qw(:fallbacks); -my $canon = 'iso-2022-kr'; -my $obj = bless {name => $canon}, __PACKAGE__; -$obj->Define($canon); +use base qw(Encode::Encoding); +__PACKAGE__->Define('iso-2022-kr'); -sub name { return $_[0]->{name}; } - -sub needs_lines { 1 } +sub needs_lines { 1 } sub perlio_ok { return 0; # for the time being ==== //depot/macperl/ext/Encode/t/CJKT.t#2 (text) ==== Index: perl/ext/Encode/t/CJKT.t --- perl/ext/Encode/t/CJKT.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/t/CJKT.t Sat Apr 27 16:00:05 2002 @@ -55,7 +55,8 @@ open $src, "<$src_enc" or die "$src_enc : $!"; - binmode($src); + # binmode($src); # not needed! + $txt = join('',<$src>); close($src); ==== //depot/macperl/ext/Encode/t/at-cn.t#2 (text) ==== Index: perl/ext/Encode/t/at-cn.t --- perl/ext/Encode/t/at-cn.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/t/at-cn.t Sat Apr 27 16:00:05 2002 @@ -19,9 +19,11 @@ use Test::More tests => 29; use Encode; +no utf8; # we have raw Chinese encodings here + use_ok('Encode::CN'); -# Since JP.t already test basic file IO, we will just focus on +# Since JP.t already tests basic file IO, we will just focus on # internal encode / decode test here. Unfortunately, to test # against all the UniHan characters will take a huge disk space, # not to mention the time it will take, and the fact that Perl ==== //depot/macperl/ext/Encode/t/at-tw.t#2 (text) ==== Index: perl/ext/Encode/t/at-tw.t --- perl/ext/Encode/t/at-tw.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/t/at-tw.t Sat Apr 27 16:00:05 2002 @@ -21,9 +21,11 @@ use Test::More tests => 17; use Encode; +no utf8; # we have raw Chinese encodings here + use_ok('Encode::TW'); -# Since JP.t already test basic file IO, we will just focus on +# Since JP.t already tests basic file IO, we will just focus on # internal encode / decode test here. Unfortunately, to test # against all the UniHan characters will take a huge disk space, # not to mention the time it will take, and the fact that Perl ==== //depot/macperl/ext/Encode/t/fallback.t#2 (text) ==== Index: perl/ext/Encode/t/fallback.t --- perl/ext/Encode/t/fallback.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/t/fallback.t Sat Apr 27 16:00:05 2002 @@ -13,17 +13,18 @@ use strict; #use Test::More qw(no_plan); -use Test::More tests => 15; +use Test::More tests => 19; use Encode q(:all); my $original = ''; my $nofallback = ''; -my ($fallenback, $quiet, $perlqq); +my ($fallenback, $quiet, $perlqq, $htmlcref, $xmlcref); for my $i (0x20..0x7e){ $original .= chr($i); } -$fallenback = $quiet = $perlqq = $nofallback = $original; +$fallenback = $quiet = +$perlqq = $htmlcref = $xmlcref = $nofallback = $original; my $residue = ''; for my $i (0x80..0xff){ @@ -31,6 +32,8 @@ $residue .= chr($i); $fallenback .= '?'; $perlqq .= sprintf("\\x{%04x}", $i); + $htmlcref .= sprintf("&#%d;", $i); + $xmlcref .= sprintf("&#x%x;", $i); } utf8::upgrade($original); my $meth = find_encoding('ascii'); @@ -75,3 +78,13 @@ $dst = $meth->encode($src, FB_PERLQQ); is($dst, $perlqq, "FB_PERLQQ"); is($src, '', "FB_PERLQQ residue"); + +$src = $original; +$dst = $meth->encode($src, FB_HTMLCREF); +is($dst, $htmlcref, "FB_HTMLCREF"); +is($src, '', "FB_HTMLCREF residue"); + +$src = $original; +$dst = $meth->encode($src, FB_XMLCREF); +is($dst, $xmlcref, "FB_XMLCREF"); +is($src, '', "FB_XMLCREF residue"); ==== //depot/macperl/ext/Encode/t/jperl.t#2 (text) ==== Index: perl/ext/Encode/t/jperl.t --- perl/ext/Encode/t/jperl.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/t/jperl.t Sat Apr 27 16:00:05 2002 @@ -1,5 +1,5 @@ # -# $Id: jperl.t,v 1.23 2002/04/22 09:48:07 dankogai Exp $ +# $Id: jperl.t,v 1.24 2002/04/26 03:02:04 dankogai Exp $ # # This script is written in euc-jp @@ -20,6 +20,8 @@ $| = 1; } +no utf8; # we have raw Japanese encodings here + use strict; use Test::More tests => 18; my $Debug = shift; ==== //depot/macperl/ext/File/Glob/bsd_glob.c#2 (text) ==== Index: perl/ext/File/Glob/bsd_glob.c --- perl/ext/File/Glob/bsd_glob.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/File/Glob/bsd_glob.c Sat Apr 27 16:00:05 2002 @@ -520,7 +520,7 @@ /* Copy up to the end of the string or / */ eb = &patbuf[patbuf_len - 1]; for (p = pattern + 1, h = (char *) patbuf; - h < (char*)eb && *p && *p != BG_SLASH; *h++ = *p++) + h < (char*)eb && *p && *p != BG_SLASH; *h++ = (char)*p++) ; *h = BG_EOS; @@ -1164,7 +1164,7 @@ g_Ctoc(register const Char *str, char *buf, STRLEN len) { while (len--) { - if ((*buf++ = *str++) == BG_EOS) + if ((*buf++ = (char)*str++) == BG_EOS) return (0); } return (1); ==== //depot/macperl/ext/IO/IO.xs#2 (text) ==== Index: perl/ext/IO/IO.xs --- perl/ext/IO/IO.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/IO/IO.xs Sat Apr 27 16:00:05 2002 @@ -242,7 +242,7 @@ for(i=1, j=0 ; j < nfd ; j++) { fds[j].fd = SvIV(ST(i)); i++; - fds[j].events = SvIV(ST(i)); + fds[j].events = (short)SvIV(ST(i)); i++; fds[j].revents = 0; } ==== //depot/macperl/ext/Opcode/Opcode.xs#2 (text) ==== Index: perl/ext/Opcode/Opcode.xs --- perl/ext/Opcode/Opcode.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Opcode/Opcode.xs Sat Apr 27 16:00:05 2002 @@ -151,7 +151,7 @@ if (!SvOK(opset)) err = "undefined"; else if (!SvPOK(opset)) err = "wrong type"; - else if (SvCUR(opset) != opset_len) err = "wrong size"; + else if (SvCUR(opset) != (STRLEN)opset_len) err = "wrong size"; if (err && fatal) { croak("Invalid opset: %s", err); } @@ -178,7 +178,7 @@ else bitmap[offset] &= ~(1 << bit); } - else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) { + else if (SvPOK(bitspec) && SvCUR(bitspec) == (STRLEN)opset_len) { STRLEN len; char *specbits = SvPV(bitspec, len); @@ -464,7 +464,7 @@ croak("panic: opcode %d (%s) out of range",myopcode,opname); XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0))); } - else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) { + else if (SvPOK(bitspec) && SvCUR(bitspec) == (STRLEN)opset_len) { int b, j; STRLEN n_a; char *bitmap = SvPV(bitspec,n_a); ==== //depot/macperl/ext/POSIX/POSIX.xs#2 (text) ==== Index: perl/ext/POSIX/POSIX.xs --- perl/ext/POSIX/POSIX.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/POSIX/POSIX.xs Sat Apr 27 16:00:05 2002 @@ -457,7 +457,8 @@ if (memEQ(name, "WSTOPSIG", 8)) { /* ^ */ #ifdef WSTOPSIG - *arg_result = WSTOPSIG(WMUNGE(*arg_result)); + int i = *arg_result; + *arg_result = WSTOPSIG(WMUNGE(i)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -468,7 +469,8 @@ if (memEQ(name, "WTERMSIG", 8)) { /* ^ */ #ifdef WTERMSIG - *arg_result = WTERMSIG(WMUNGE(*arg_result)); + int i = *arg_result; + *arg_result = WTERMSIG(WMUNGE(i)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -491,7 +493,8 @@ case 9: if (memEQ(name, "WIFEXITED", 9)) { #ifdef WIFEXITED - *arg_result = WIFEXITED(WMUNGE(*arg_result)); + int i = *arg_result; + *arg_result = WIFEXITED(WMUNGE(i)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -501,7 +504,8 @@ case 10: if (memEQ(name, "WIFSTOPPED", 10)) { #ifdef WIFSTOPPED - *arg_result = WIFSTOPPED(WMUNGE(*arg_result)); + int i = *arg_result; + *arg_result = WIFSTOPPED(WMUNGE(i)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -517,7 +521,8 @@ if (memEQ(name, "WEXITSTATUS", 11)) { /* ^ */ #ifdef WEXITSTATUS - *arg_result = WEXITSTATUS(WMUNGE(*arg_result)); + int i = *arg_result; + *arg_result = WEXITSTATUS(WMUNGE(i)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -528,7 +533,8 @@ if (memEQ(name, "WIFSIGNALED", 11)) { /* ^ */ #ifdef WIFSIGNALED - *arg_result = WIFSIGNALED(WMUNGE(*arg_result)); + int i = *arg_result; + *arg_result = WIFSIGNALED(WMUNGE(i)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; ==== //depot/macperl/ext/PerlIO/Via/Via.xs#2 (text) ==== Index: perl/ext/PerlIO/Via/Via.xs --- perl/ext/PerlIO/Via/Via.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/PerlIO/Via/Via.xs Sat Apr 27 16:00:05 2002 @@ -55,6 +55,14 @@ } } +/* + * Try and call method, possibly via cached lookup. + * If method does not exist return Nullsv (caller may fallback to another approach + * If method does exist call it with flags passing variable number of args + * Last arg is a "filehandle" to layer below (if present) + * Returns scalar returned by method (if any) otherwise sv_undef + */ + SV * PerlIOVia_method(pTHX_ PerlIO *f,char *method,CV **save,int flags,...) { @@ -88,6 +96,10 @@ IoOFP(s->io) = PerlIONext(f); XPUSHs(s->fh); } + else + { + PerlIO_debug("No next\n"); + } PUTBACK; count = call_sv((SV *)cv,flags); if (count) @@ -117,6 +129,7 @@ { if (ckWARN(WARN_LAYER)) Perl_warner(aTHX_ packWARN(WARN_LAYER), "No package specified"); + errno = EINVAL; code = -1; } else @@ -163,7 +176,9 @@ } PerlIO * -PerlIOVia_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) +PerlIOVia_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, + const char *mode, int fd, int imode, int perm, + PerlIO *f, int narg, SV **args) { if (!f) { @@ -171,6 +186,7 @@ } else { + /* Reopen */ if (!PerlIO_push(aTHX_ f,self,mode,PerlIOArg)) return NULL; } @@ -206,7 +222,44 @@ } } else - return NULL; + { + /* Required open method not present */ + PerlIO_funcs *tab = NULL; + IV m = n-1; + while (m >= 0) { + PerlIO_funcs *t = PerlIO_layer_fetch(aTHX_ layers, m, NULL); + if (t && t->Open) { + tab = t; + break; + } + n--; + } + if (tab) { + if ((*tab->Open) (aTHX_ tab, layers, m, mode, fd, imode, perm, + PerlIONext(f), narg, args)) { + PerlIO_debug("Opened with %s => %p->%p\n",tab->name,PerlIONext(f),*PerlIONext(f)); + if (m + 1 < n) { + /* + * More layers above the one that we used to open - + * apply them now + */ + if (PerlIO_apply_layera(aTHX_ PerlIONext(f), mode, layers, m+1, n) != 0) { + /* If pushing layers fails close the file */ + PerlIO_close(f); + f = NULL; + } + } + return f; + } + else { + /* Sub-layer open failed */ + } + } + else { + /* Nothing to do the open */ + } + return NULL; + } } return f; } @@ -494,7 +547,7 @@ PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT, PerlIOVia_pushed, PerlIOVia_popped, - NULL, /* PerlIOVia_open, */ + PerlIOVia_open, /* NULL, */ PerlIOVia_getarg, PerlIOVia_fileno, PerlIOVia_dup, ==== //depot/macperl/ext/PerlIO/encoding/encoding.pm#2 (text) ==== Index: perl/ext/PerlIO/encoding/encoding.pm --- perl/ext/PerlIO/encoding/encoding.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/PerlIO/encoding/encoding.pm Sat Apr 27 16:00:05 2002 @@ -1,13 +1,13 @@ package PerlIO::encoding; use strict; -our $VERSION = '0.04'; +our $VERSION = '0.05'; our $DEBUG = 0; $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n"; # -# Now these are all done in encoding.xs DO NOT COMMENT'em out! +# Equivalent of these are done in encoding.xs - do not uncomment them. # -# use Encode qw(:fallbacks); +# use Encode (); # our $check; use XSLoader (); ==== //depot/macperl/ext/PerlIO/encoding/encoding.xs#2 (text) ==== Index: perl/ext/PerlIO/encoding/encoding.xs --- perl/ext/PerlIO/encoding/encoding.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/PerlIO/encoding/encoding.xs Sat Apr 27 16:00:05 2002 @@ -49,6 +49,7 @@ } PerlIOEncode; #define NEEDS_LINES 1 +#define OUR_DEFAULT_FB "Encode::FB_QUIET" SV * PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags) @@ -79,13 +80,6 @@ IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv); SV *result = Nullsv; - /* - * we now "use Encode qw(:fallbacks)" here instead of - * PerlIO/encoding.pm. This avoids SEGV when ":encoding()" - * is invoked without prior "use Encode". -- dankogai - */ - require_pv("Encode.pm"); - ENTER; SAVETMPS; @@ -104,7 +98,7 @@ if (!SvROK(result) || !SvOBJECT(SvRV(result))) { e->enc = Nullsv; Perl_warner(aTHX_ packWARN(WARN_IO), "Cannot find encoding \"%" SVf "\"", - arg); + arg); errno = EINVAL; code = -1; } @@ -142,21 +136,8 @@ PerlIOBase(f)->flags |= PERLIO_F_UTF8; } - if (SvIV(result = get_sv("PerlIO::encoding::check", 1)) == 0){ - PUSHMARK(sp); - PUTBACK; - if (call_pv("Encode::FB_QUIET", G_SCALAR|G_NOARGS) != 1) { - /* should never happen */ - Perl_die(aTHX_ "Encode::FB_QUIET did not return a value"); - return -1; - } - SPAGAIN; - e->chk = newSVsv(POPs); - PUTBACK; - sv_setsv(result, e->chk); - }else{ - e->chk = newSVsv(result); - } + e->chk = newSVsv(get_sv("PerlIO::encoding::check", 0)); + FREETMPS; LEAVE; return code; @@ -180,7 +161,7 @@ } if (e->chk) { SvREFCNT_dec(e->chk); - e->dataSV = Nullsv; + e->chk = Nullsv; } return 0; } @@ -317,7 +298,7 @@ if (SvLEN(e->dataSV) && SvPVX(e->dataSV)) { Safefree(SvPVX(e->dataSV)); } - if (use > e->base.bufsiz) { + if (use > (SSize_t)e->base.bufsiz) { if (e->flags & NEEDS_LINES) { /* Have to grow buffer */ e->base.bufsiz = use; @@ -427,7 +408,7 @@ PUTBACK; s = SvPV(str, len); count = PerlIO_write(PerlIONext(f),s,len); - if (count != len) { + if ((STRLEN)count != len) { code = -1; } FREETMPS; @@ -447,7 +428,7 @@ if (e->dataSV && SvCUR(e->dataSV)) { s = SvPV(e->dataSV, len); count = PerlIO_unread(PerlIONext(f),s,len); - if (count != len) { + if ((STRLEN)count != len) { code = -1; } } @@ -478,7 +459,7 @@ PUTBACK; s = SvPV(str, len); count = PerlIO_unread(PerlIONext(f),s,len); - if (count != len) { + if ((STRLEN)count != len) { code = -1; } FREETMPS; @@ -607,7 +588,35 @@ BOOT: { + SV *chk = get_sv("PerlIO::encoding::check", GV_ADD|GV_ADDMULTI); + /* + * we now "use Encode ()" here instead of + * PerlIO/encoding.pm. This avoids SEGV when ":encoding()" + * is invoked without prior "use Encode". -- dankogai + */ + if (!gv_stashpvn("Encode", 6, FALSE)) { +#if 0 + /* This would just be an irritant now loading works */ + Perl_warner(aTHX_ packWARN(WARN_IO), ":encoding without 'use Encode'"); +#endif + ENTER; + /* Encode needs a lot of stack - it is likely to move ... */ + PUTBACK; + /* The SV is magically freed by load_module */ + load_module(PERL_LOADMOD_NOIMPORT, newSVpvn("Encode", 6), Nullsv, Nullsv); + SPAGAIN; + LEAVE; + } + PUSHMARK(sp); + PUTBACK; + if (call_pv(OUR_DEFAULT_FB, G_SCALAR) != 1) { + /* should never happen */ + Perl_die(aTHX_ "%s did not return a value",OUR_DEFAULT_FB); + } + SPAGAIN; + sv_setsv(chk, POPs); + PUTBACK; #ifdef PERLIO_LAYERS - PerlIO_define_layer(aTHX_ &PerlIO_encode); + PerlIO_define_layer(aTHX_ &PerlIO_encode); #endif } ==== //depot/macperl/ext/PerlIO/t/via.t#2 (text) ==== Index: perl/ext/PerlIO/t/via.t --- perl/ext/PerlIO/t/via.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/PerlIO/t/via.t Sat Apr 27 16:00:05 2002 @@ -14,7 +14,7 @@ my $tmp = "via$$"; -use Test::More tests => 11; +use Test::More tests => 13; my $fh; my $a = join("", map { chr } 0..255) x 10; @@ -38,14 +38,32 @@ local $SIG{__WARN__} = sub { $warnings = join '', @_ }; use warnings 'layer'; + + # Find fd number we should be using + my $fd = open($fh,">$tmp") && fileno($fh); + print $fh "Hello\n"; + close($fh); + ok( ! open($fh,">Via(Unknown::Module)", $tmp), 'open Via Unknown::Module will fail'); like( $warnings, qr/^Cannot find package 'Unknown::Module'/, 'warn about unknown package' ); + # Now open normally again to see if we get right fileno + my $fd2 = open($fh,"<$tmp") && fileno($fh); + is($fd2,$fd,"Wrong fd number after failed open"); + + my $data = <$fh>; + + is($data,"Hello\n","File clobbered by failed open"); + + close($fh); + + + $warnings = ''; no warnings 'layer'; ok( ! open($fh,">Via(Unknown::Module)", $tmp), 'open Via Unknown::Module will fail'); is( $warnings, "", "don't warn about unknown package" ); -} +} END { 1 while unlink $tmp; ==== //depot/macperl/ext/Storable/Storable.pm#2 (text) ==== Index: perl/ext/Storable/Storable.pm --- perl/ext/Storable/Storable.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Storable/Storable.pm Sat Apr 27 16:00:05 2002 @@ -79,18 +79,7 @@ eval "use Log::Agent"; -unless (defined @Log::Agent::EXPORT) { - eval q{ - sub logcroak { - require Carp; - Carp::croak(@_); - } - sub logcarp { - require Carp; - Carp::carp(@_); - } - }; -} +require Carp; # # They might miss :flock in Fcntl @@ -107,22 +96,33 @@ } } -sub logcroak; -sub logcarp; - # Can't Autoload cleanly as this clashes 8.3 with &retrieve sub retrieve_fd { &fd_retrieve } # Backward compatibility +# By default restricted hashes are downgraded on earlier perls. + +$Storable::downgrade_restricted = 1; bootstrap Storable; 1; __END__ +# +# Use of Log::Agent is optional. If it hasn't imported these subs then +# Autoloader will kindly supply our fallback implementation. +# +sub logcroak { + Carp::croak(@_); +} + +sub logcarp { + Carp::carp(@_); +} + # # Determine whether locking is possible, but only when needed. # -sub CAN_FLOCK { - my $CAN_FLOCK if 0; +sub CAN_FLOCK; my $CAN_FLOCK; sub CAN_FLOCK { return $CAN_FLOCK if defined $CAN_FLOCK; require Config; import Config; return $CAN_FLOCK = ==== //depot/macperl/ext/Storable/Storable.xs#2 (text) ==== Index: perl/ext/Storable/Storable.xs --- perl/ext/Storable/Storable.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Storable/Storable.xs Sat Apr 27 16:00:05 2002 @@ -58,7 +58,7 @@ #include <patchlevel.h> /* Perl's one, needed since 5.6 */ #include <XSUB.h> -#if 0 +#if 1 #define DEBUGME /* Debug mode, turns assertions on as well */ #define DASSERT /* Assertion mode */ #endif @@ -272,7 +272,40 @@ #define MY_VERSION "Storable(" XS_VERSION ")" + /* + * Conditional UTF8 support. + * + */ +#ifdef SvUTF8_on +#define STORE_UTF8STR(pv, len) STORE_PV_LEN(pv, len, SX_UTF8STR, SX_LUTF8STR) +#define HAS_UTF8_SCALARS +#ifdef HeKUTF8 +#define HAS_UTF8_HASHES +#define HAS_UTF8_ALL +#else +/* 5.6 perl has utf8 scalars but not hashes */ +#endif +#else +#define SvUTF8(sv) 0 +#define STORE_UTF8STR(pv, len) CROAK(("panic: storing UTF8 in non-UTF8 perl")) +#endif +#ifndef HAS_UTF8_ALL +#define UTF8_CROAK() CROAK(("Cannot retrieve UTF8 data in non-UTF8 perl")) +#endif + +#ifdef HvPLACEHOLDERS +#define HAS_RESTRICTED_HASHES +#else +#define HVhek_PLACEHOLD 0x200 +#define RESTRICTED_HASH_CROAK() CROAK(("Cannot retrieve restricted hash")) +#endif + +#ifdef HvHASKFLAGS +#define HAS_HASH_KEY_FLAGS +#endif + +/* * Fields s_tainted and s_dirty are prefixed with s_ because Perl's include * files remap tainted and dirty when threading is enabled. That's bad for * perl to remap such common words. -- RAM, 29/09/00 @@ -293,6 +326,12 @@ int s_tainted; /* true if input source is tainted, at retrieve time */ int forgive_me; /* whether to be forgiving... */ int canonical; /* whether to store hashes sorted by key */ +#ifndef HAS_RESTRICTED_HASHES + int derestrict; /* whether to downgrade restrcted hashes */ +#endif +#ifndef HAS_UTF8_ALL + int use_bytes; /* whether to bytes-ify utf8 */ +#endif int s_dirty; /* context is dirty due to CROAK() -- can be cleaned */ int membuf_ro; /* true means membuf is read-only and msaved is rw */ struct extendable keybuf; /* for hash key retrieval */ @@ -658,15 +697,23 @@ static char old_magicstr[] = "perl-store"; /* Magic number before 0.6 */ static char magicstr[] = "pst0"; /* Used as a magic number */ + #define STORABLE_BIN_MAJOR 2 /* Binary major "version" */ +#define STORABLE_BIN_MINOR 5 /* Binary minor "version" */ + +/* If we aren't 5.7.3 or later, we won't be writing out files that use the + * new flagged hash introdued in 2.5, so put 2.4 in the binary header to + * maximise ease of interoperation with older Storables. + * Could we write 2.3s if we're on 5.005_03? NWC + */ #if (PATCHLEVEL <= 6) -#define STORABLE_BIN_MINOR 4 /* Binary minor "version" */ +#define STORABLE_BIN_WRITE_MINOR 4 #else /* * As of perl 5.7.3, utf8 hash key is introduced. * So this must change -- dankogai */ -#define STORABLE_BIN_MINOR 5 /* Binary minor "version" */ +#define STORABLE_BIN_WRITE_MINOR 5 #endif /* (PATCHLEVEL <= 6) */ /* @@ -731,19 +778,6 @@ #define STORE_SCALAR(pv, len) STORE_PV_LEN(pv, len, SX_SCALAR, SX_LSCALAR) /* - * Conditional UTF8 support. - * On non-UTF8 perls, UTF8 strings are returned as normal strings. - * - */ -#ifdef SvUTF8_on -#define STORE_UTF8STR(pv, len) STORE_PV_LEN(pv, len, SX_UTF8STR, SX_LUTF8STR) -#else -#define SvUTF8(sv) 0 -#define STORE_UTF8STR(pv, len) CROAK(("panic: storing UTF8 in non-UTF8 perl")) -#define SvUTF8_on(sv) CROAK(("Cannot retrieve UTF8 data in non-UTF8 perl")) -#endif - -/* * Store undef in arrays and hashes without recursing through store(). */ #define STORE_UNDEF() do { \ @@ -1202,6 +1236,12 @@ cxt->optype = optype; cxt->s_tainted = is_tainted; cxt->entry = 1; /* No recursion yet */ +#ifndef HAS_RESTRICTED_HASHES + cxt->derestrict = -1; /* Fetched from perl if needed */ +#endif +#ifndef HAS_UTF8_ALL + cxt->use_bytes = -1; /* Fetched from perl if needed */ +#endif } /* @@ -1902,12 +1942,21 @@ */ static int store_hash(stcxt_t *cxt, HV *hv) { - I32 len = HvTOTALKEYS(hv); + I32 len = +#ifdef HAS_RESTRICTED_HASHES + HvTOTALKEYS(hv); +#else + HvKEYS(hv); +#endif I32 i; int ret = 0; I32 riter; HE *eiter; - int flagged_hash = ((SvREADONLY(hv) || HvHASKFLAGS(hv)) ? 1 : 0); + int flagged_hash = ((SvREADONLY(hv) +#ifdef HAS_HASH_KEY_FLAGS + || HvHASKFLAGS(hv) +#endif + ) ? 1 : 0); unsigned char hash_flags = (SvREADONLY(hv) ? SHV_RESTRICTED : 0); if (flagged_hash) { @@ -1969,7 +2018,11 @@ TRACEME(("using canonical order")); for (i = 0; i < len; i++) { +#ifdef HAS_RESTRICTED_HASHES HE *he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS); +#else + HE *he = hv_iternext(hv); +#endif SV *key = hv_iterkeysv(he); av_store(av, AvFILLp(av)+1, key); /* av_push(), really */ } @@ -2015,6 +2068,12 @@ keyval = SvPV(key, keylen_tmp); keylen = keylen_tmp; +#ifdef HAS_UTF8_HASHES + /* If you build without optimisation on pre 5.6 + then nothing spots that SvUTF8(key) is always 0, + so the block isn't optimised away, at which point + the linker dislikes the reference to + bytes_from_utf8. */ if (SvUTF8(key)) { const char *keysave = keyval; bool is_utf8 = TRUE; @@ -2039,6 +2098,7 @@ flags |= SHV_K_UTF8; } } +#endif if (flagged_hash) { PUTMARK(flags); @@ -2072,7 +2132,11 @@ char *key; I32 len; unsigned char flags; +#ifdef HV_ITERNEXT_WANTPLACEHOLDERS HE *he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS); +#else + HE *he = hv_iternext(hv); +#endif SV *val = (he ? hv_iterval(hv, he) : 0); SV *key_sv = NULL; HEK *hek; @@ -2111,10 +2175,12 @@ flags |= SHV_K_ISSV; } else { /* Regular string key. */ +#ifdef HAS_HASH_KEY_FLAGS if (HEK_UTF8(hek)) flags |= SHV_K_UTF8; if (HEK_WASUTF8(hek)) flags |= SHV_K_WASUTF8; +#endif key = HEK_KEY(hek); } /* @@ -2629,7 +2695,7 @@ PUTMARK(clen); } if (len2) - WRITE(pv, len2); /* Final \0 is omitted */ + WRITE(pv, (SSize_t)len2); /* Final \0 is omitted */ /* [<len3> <object-IDs>] */ if (flags & SHF_HAS_LIST) { @@ -2993,7 +3059,7 @@ : -1)); if (cxt->fio) - WRITE(magicstr, strlen(magicstr)); /* Don't write final \0 */ + WRITE(magicstr, (SSize_t)strlen(magicstr)); /* Don't write final \0 */ /* * Starting with 0.6, the "use_network_order" byte flag is also used to @@ -3011,7 +3077,7 @@ * introduced, for instance, but when backward compatibility is preserved. */ - PUTMARK((unsigned char) STORABLE_BIN_MINOR); + PUTMARK((unsigned char) STORABLE_BIN_WRITE_MINOR); if (use_network_order) return 0; /* Don't bother with byte ordering */ @@ -3019,7 +3085,7 @@ sprintf(buf, "%lx", (unsigned long) BYTEORDER); c = (unsigned char) strlen(buf); PUTMARK(c); - WRITE(buf, (unsigned int) c); /* Don't write final \0 */ + WRITE(buf, (SSize_t)c); /* Don't write final \0 */ PUTMARK((unsigned char) sizeof(int)); PUTMARK((unsigned char) sizeof(long)); PUTMARK((unsigned char) sizeof(char *)); @@ -4098,15 +4164,25 @@ */ static SV *retrieve_utf8str(stcxt_t *cxt, char *cname) { - SV *sv; + SV *sv; - TRACEME(("retrieve_utf8str")); + TRACEME(("retrieve_utf8str")); - sv = retrieve_scalar(cxt, cname); - if (sv) - SvUTF8_on(sv); + sv = retrieve_scalar(cxt, cname); + if (sv) { +#ifdef HAS_UTF8_SCALARS + SvUTF8_on(sv); +#else + if (cxt->use_bytes < 0) + cxt->use_bytes + = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE)) + ? 1 : 0); + if (cxt->use_bytes == 0) + UTF8_CROAK(); +#endif + } - return sv; + return sv; } /* @@ -4117,15 +4193,24 @@ */ static SV *retrieve_lutf8str(stcxt_t *cxt, char *cname) { - SV *sv; + SV *sv; - TRACEME(("retrieve_lutf8str")); + TRACEME(("retrieve_lutf8str")); - sv = retrieve_lscalar(cxt, cname); - if (sv) - SvUTF8_on(sv); - - return sv; + sv = retrieve_lscalar(cxt, cname); + if (sv) { +#ifdef HAS_UTF8_SCALARS + SvUTF8_on(sv); +#else + if (cxt->use_bytes < 0) + cxt->use_bytes + = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE)) + ? 1 : 0); + if (cxt->use_bytes == 0) + UTF8_CROAK(); +#endif + } + return sv; } /* @@ -4394,7 +4479,7 @@ */ RLEN(size); /* Get key size */ - KBUFCHK(size); /* Grow hash key read pool if needed */ + KBUFCHK((STRLEN)size); /* Grow hash key read pool if needed */ if (size) READ(kbuf, size); kbuf[size] = '\0'; /* Mark string end, just in case */ @@ -4434,11 +4519,22 @@ int hash_flags; GETMARK(hash_flags); - TRACEME(("retrieve_flag_hash (#%d)", cxt->tagnum)); + TRACEME(("retrieve_flag_hash (#%d)", cxt->tagnum)); /* * Read length, allocate table. */ +#ifndef HAS_RESTRICTED_HASHES + if (hash_flags & SHV_RESTRICTED) { + if (cxt->derestrict < 0) + cxt->derestrict + = (SvTRUE(perl_get_sv("Storable::downgrade_restricted", TRUE)) + ? 1 : 0); + if (cxt->derestrict == 0) + RESTRICTED_HASH_CROAK(); + } +#endif + RLEN(len); TRACEME(("size = %d, flags = %d", len, hash_flags)); hv = newHV(); @@ -4464,8 +4560,10 @@ return (SV *) 0; GETMARK(flags); +#ifdef HAS_RESTRICTED_HASHES if ((hash_flags & SHV_RESTRICTED) && (flags & SHV_K_LOCKED)) SvREADONLY_on(sv); +#endif if (flags & SHV_K_ISSV) { /* XXX you can't set a placeholder with an SV key. @@ -4493,13 +4591,25 @@ sv = &PL_sv_undef; store_flags |= HVhek_PLACEHOLD; } - if (flags & SHV_K_UTF8) + if (flags & SHV_K_UTF8) { +#ifdef HAS_UTF8_HASHES store_flags |= HVhek_UTF8; +#else + if (cxt->use_bytes < 0) + cxt->use_bytes + = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE)) + ? 1 : 0); + if (cxt->use_bytes == 0) + UTF8_CROAK(); +#endif + } +#ifdef HAS_UTF8_HASHES if (flags & SHV_K_WASUTF8) store_flags |= HVhek_WASUTF8; +#endif RLEN(size); /* Get key size */ - KBUFCHK(size); /* Grow hash key read pool if needed */ + KBUFCHK((STRLEN)size); /* Grow hash key read pool if needed */ if (size) READ(kbuf, size); kbuf[size] = '\0'; /* Mark string end, just in case */ @@ -4510,12 +4620,20 @@ * Enter key/value pair into hash table. */ +#ifdef HAS_RESTRICTED_HASHES if (hv_store_flags(hv, kbuf, size, sv, 0, flags) == 0) return (SV *) 0; +#else + if (!(store_flags & HVhek_PLACEHOLD)) + if (hv_store(hv, kbuf, size, sv, 0) == 0) + return (SV *) 0; +#endif } } +#ifdef HAS_RESTRICTED_HASHES if (hash_flags & SHV_RESTRICTED) SvREADONLY_on(hv); +#endif TRACEME(("ok (retrieve_hash at 0x%"UVxf")", PTR2UV(hv))); @@ -4655,7 +4773,7 @@ if (c != SX_KEY) (void) retrieve_other((stcxt_t *) 0, 0); /* Will croak out */ RLEN(size); /* Get key size */ - KBUFCHK(size); /* Grow hash key read pool if needed */ + KBUFCHK((STRLEN)size); /* Grow hash key read pool if needed */ if (size) READ(kbuf, size); kbuf[size] = '\0'; /* Mark string end, just in case */ @@ -4708,7 +4826,7 @@ STRLEN len = sizeof(magicstr) - 1; STRLEN old_len; - READ(buf, len); /* Not null-terminated */ + READ(buf, (SSize_t)len); /* Not null-terminated */ buf[len] = '\0'; /* Is now */ if (0 == strcmp(buf, magicstr)) @@ -4720,7 +4838,7 @@ */ old_len = sizeof(old_magicstr) - 1; - READ(&buf[len], old_len - len); + READ(&buf[len], (SSize_t)(old_len - len)); buf[old_len] = '\0'; /* Is now null-terminated */ if (strcmp(buf, old_magicstr)) @@ -4765,10 +4883,14 @@ version_major > STORABLE_BIN_MAJOR || (version_major == STORABLE_BIN_MAJOR && version_minor > STORABLE_BIN_MINOR) - ) + ) { + TRACEME(("but I am version is %d.%d", STORABLE_BIN_MAJOR, + STORABLE_BIN_MINOR)); + CROAK(("Storable binary image v%d.%d more recent than I am (v%d.%d)", version_major, version_minor, STORABLE_BIN_MAJOR, STORABLE_BIN_MINOR)); + } /* * If they stored using network order, there's no byte ordering @@ -4783,6 +4905,8 @@ READ(buf, c); /* Not null-terminated */ buf[c] = '\0'; /* Is now */ + TRACEME(("byte order '%s'", buf)); + if (strcmp(buf, byteorder)) CROAK(("Byte order is not compatible")); @@ -4941,7 +5065,7 @@ default: return (SV *) 0; /* Failed */ } - KBUFCHK(len); /* Grow buffer as necessary */ + KBUFCHK((STRLEN)len); /* Grow buffer as necessary */ if (len) READ(kbuf, len); kbuf[len] = '\0'; /* Mark string end */ ==== //depot/macperl/ext/Storable/t/malice.t#2 (text) ==== Index: perl/ext/Storable/t/malice.t --- perl/ext/Storable/t/malice.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Storable/t/malice.t Sat Apr 27 16:00:05 2002 @@ -30,14 +30,14 @@ } use strict; -use vars qw($file_magic_str $other_magic $network_magic $major $minor); - -# header size depends on the size of the byteorder string +use vars qw($file_magic_str $other_magic $network_magic $major $minor + $minor_write); $file_magic_str = 'pst0'; $other_magic = 7 + length($Config{byteorder}); $network_magic = 2; $major = 2; $minor = 5; +$minor_write = $] > 5.007 ? 5 : 4; use Test; BEGIN { plan tests => 334 + length($Config{byteorder}) * 4} @@ -63,7 +63,7 @@ my ($header, $isfile, $isnetorder) = @_; ok (!!$header->{file}, !!$isfile, "is file"); ok ($header->{major}, $major, "major number"); - ok ($header->{minor}, $minor, "minor number"); + ok ($header->{minor}, $minor_write, "minor number"); ok (!!$header->{netorder}, !!$isnetorder, "is network order"); if ($isnetorder) { # Skip these @@ -148,24 +148,34 @@ } $copy = $contents; - my $minor1 = $header->{minor} + 1; - substr ($copy, $file_magic + 1, 1) = chr $minor1; + # Needs to be more than 1, as we're already coding a spread of 1 minor version + # number on writes (2.5, 2.4). May increase to 2 if we figure we can do 2.3 + # on 5.005_03 (No utf8). + # 4 allows for a small safety margin + # (Joke: + # Question: What is the value of pi? + # Mathematician answers "It's pi, isn't it" + # Physicist answers "3.1, within experimental error" + # Engineer answers "Well, allowing for a small safety margin, 18" + # ) + my $minor4 = $header->{minor} + 4; + substr ($copy, $file_magic + 1, 1) = chr $minor4; test_corrupt ($copy, $sub, - "/^Storable binary image v$header->{major}\.$minor1 more recent than I am \\(v$header->{major}\.$header->{minor}\\)/", + "/^Storable binary image v$header->{major}\.$minor4 more recent than I am \\(v$header->{major}\.$minor\\)/", "higher minor"); $copy = $contents; my $major1 = $header->{major} + 1; substr ($copy, $file_magic, 1) = chr 2*$major1; test_corrupt ($copy, $sub, - "/^Storable binary image v$major1\.$header->{minor} more recent than I am \\(v$header->{major}\.$header->{minor}\\)/", + "/^Storable binary image v$major1\.$header->{minor} more recent than I am \\(v$header->{major}\.$minor\\)/", "higher major"); # Continue messing with the previous copy - $minor1 = $header->{minor} - 1; + my $minor1 = $header->{minor} - 1; substr ($copy, $file_magic + 1, 1) = chr $minor1; test_corrupt ($copy, $sub, - "/^Storable binary image v$major1\.$minor1 more recent than I am \\(v$header->{major}\.$header->{minor}\\)/", + "/^Storable binary image v$major1\.$minor1 more recent than I am \\(v$header->{major}\.$minor\\)/", "higher major, lower minor"); my $where; ==== //depot/macperl/ext/Storable/t/restrict.t#2 (text) ==== Index: perl/ext/Storable/t/restrict.t --- perl/ext/Storable/t/restrict.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Storable/t/restrict.t Sat Apr 27 16:00:05 2002 @@ -1,4 +1,4 @@ -#!./perl +#!./perl -w # # Copyright 2002, Larry Wall. @@ -8,13 +8,24 @@ # sub BEGIN { - chdir('t') if -d 't'; - @INC = '.'; - push @INC, '../lib'; - require Config; import Config; - if ($Config{'extensions'} !~ /\bStorable\b/) { - print "1..0 # Skip: Storable was not built\n"; - exit 0; + if ($ENV{PERL_CORE}){ + chdir('t') if -d 't'; + @INC = '.'; + push @INC, '../lib'; + require Config; + if ($Config::Config{'extensions'} !~ /\bStorable\b/) { + print "1..0 # Skip: Storable was not built\n"; + exit 0; + } + } else { + unless (eval "require Hash::Util") { + if ($@ =~ /Can\'t locate Hash\/Util\.pm in \@INC/) { + print "1..0 # Skip: No Hash::Util\n"; + exit 0; + } else { + die; + } + } } require 'lib/st-dump.pl'; } @@ -67,7 +78,7 @@ unless (ok ++$test, !$@, "Can assign to reserved key 'extra'?") { my $diag = $@; $diag =~ s/\n.*\z//s; - print "# \$@: $diag\n"; + print "# \$\@: $diag\n"; } eval { $copy->{nono} = 7 } ; ==== //depot/macperl/ext/Storable/t/utf8hash.t#2 (text) ==== Index: perl/ext/Storable/t/utf8hash.t --- perl/ext/Storable/t/utf8hash.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Storable/t/utf8hash.t Sat Apr 27 16:00:05 2002 @@ -38,6 +38,8 @@ use Encode qw(is_utf8); my %utf8hash; +$Storable::canonical = $Storable::canonical; # Shut up a used only once warning. + for $Storable::canonical (0, 1) { # first we generate a nasty hash which keys include both utf8 ==== //depot/macperl/ext/Time/HiRes/HiRes.pm#2 (text) ==== Index: perl/ext/Time/HiRes/HiRes.pm --- perl/ext/Time/HiRes/HiRes.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Time/HiRes/HiRes.pm Sat Apr 27 16:00:05 2002 @@ -282,7 +282,7 @@ SV **svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0); if (!svp) croak("Time::HiRes is required"); if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer"); - myNVtime = (double(*)()) SvIV(*svp); + myNVtime = INT2PTR(double(*)(), SvIV(*svp)); printf("The current time is: %f\n", (*myNVtime)()); =head1 CAVEATS ==== //depot/macperl/ext/Time/HiRes/HiRes.xs#2 (text) ==== Index: perl/ext/Time/HiRes/HiRes.xs --- perl/ext/Time/HiRes/HiRes.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Time/HiRes/HiRes.xs Sat Apr 27 16:00:05 2002 @@ -618,7 +618,7 @@ if (items > 0) { NV seconds = SvNV(ST(0)); if (seconds >= 0.0) { - UV useconds = 1E6 * (seconds - (UV)seconds); + UV useconds = (UV)(1E6 * (seconds - (UV)seconds)); if (seconds >= 1.0) sleep((UV)seconds); usleep(useconds); ==== //depot/macperl/ext/threads/shared/shared.xs#2 (text) ==== Index: perl/ext/threads/shared/shared.xs --- perl/ext/threads/shared/shared.xs.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/threads/shared/shared.xs Sat Apr 27 16:00:05 2002 @@ -980,8 +980,16 @@ /* Stealing the members of the lock object worries me - NI-S */ MUTEX_LOCK(&shared->lock.mutex); shared->lock.owner = NULL; - locks = shared->lock.locks = 0; + locks = shared->lock.locks; + shared->lock.locks = 0; + + /* since we are releasing the lock here we need to tell other + people that is ok to go ahead and use it */ + COND_SIGNAL(&shared->lock.cond); COND_WAIT(&shared->user_cond, &shared->lock.mutex); + while(shared->lock.owner != NULL) { + COND_WAIT(&shared->lock.cond,&shared->lock.mutex); + } shared->lock.owner = aTHX; shared->lock.locks = locks; MUTEX_UNLOCK(&shared->lock.mutex); ==== //depot/macperl/ext/threads/shared/t/queue.t#2 (text) ==== Index: perl/ext/threads/shared/t/queue.t --- perl/ext/threads/shared/t/queue.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/threads/shared/t/queue.t Sat Apr 27 16:00:05 2002 @@ -1,13 +1,13 @@ BEGIN { -# chdir 't' if -d 't'; -# push @INC ,'../lib'; -# require Config; import Config; -# unless ($Config{'useithreads'}) { + chdir 't' if -d 't'; + push @INC ,'../lib'; + require Config; import Config; + unless ($Config{'useithreads'}) { print "1..0 # Skip: might still hang\n"; exit 0; -# } + } } @@ -16,6 +16,10 @@ $q = new threads::shared::queue; +print "1..26\n"; + +my $test : shared = 1; + sub reader { my $tid = threads->self->tid; my $i = 0; @@ -23,8 +27,9 @@ $i++; # print "reader (tid $tid): waiting for element $i...\n"; my $el = $q->dequeue; + print "ok $test\n"; $test++; # print "reader (tid $tid): dequeued element $i: value $el\n"; - select(undef, undef, undef, rand(2)); + select(undef, undef, undef, rand(1)); if ($el == -1) { # end marker # print "reader (tid $tid) returning\n"; @@ -33,16 +38,16 @@ } } -my $nthreads = 1; +my $nthreads = 5; my @threads; for (my $i = 0; $i < $nthreads; $i++) { push @threads, threads->new(\&reader, $i); } -for (my $i = 1; $i <= 10; $i++) { +for (my $i = 1; $i <= 20; $i++) { my $el = int(rand(100)); - select(undef, undef, undef, rand(2)); + select(undef, undef, undef, rand(1)); # print "writer: enqueuing value $el\n"; $q->enqueue($el); } @@ -50,10 +55,9 @@ $q->enqueue((-1) x $nthreads); # one end marker for each thread for(@threads) { - print "waiting for join\n"; +# print "waiting for join\n"; $_->join(); - } - +print "ok $test\n"; ==== //depot/macperl/hints/netbsd.sh#2 (text) ==== Index: perl/hints/netbsd.sh --- perl/hints/netbsd.sh.~1~ Sat Apr 27 16:00:05 2002 +++ perl/hints/netbsd.sh Sat Apr 27 16:00:05 2002 @@ -18,6 +18,8 @@ usedl="$undef" ;; *) + # Note that we use the value of $prefix in this block. The user + # should specify -Dprefix=... to the Configure script. if [ -f /usr/libexec/ld.elf_so ]; then d_dlopen=$define d_dlerror=$define @@ -25,7 +27,7 @@ # needs __eh_alloc, __pure_virtual, and others. # XXX This should be obsoleted by gcc-3.0. ccdlflags="-Wl,-whole-archive -lgcc -Wl,-no-whole-archive \ - -Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags" + -Wl,-E -Wl,-R$prefix/lib $ccdlflags" cccdlflags="-DPIC -fPIC $cccdlflags" lddlflags="--whole-archive -shared $lddlflags" elif [ "`uname -m`" = "pmax" ]; then @@ -38,7 +40,7 @@ elif [ -f /usr/libexec/ld.so ]; then d_dlopen=$define d_dlerror=$define - ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags" + ccdlflags="-Wl,-R$prefix/lib $ccdlflags" # we use -fPIC here because -fpic is *NOT* enough for some of the # extensions like Tk on some netbsd platforms (the sparc is one) cccdlflags="-DPIC -fPIC $cccdlflags" @@ -69,12 +71,6 @@ # there's no problem with vfork. usevfork=true -# Using perl's malloc leads to trouble on some toolchain versions. -usemymalloc="$undef" - -# Pre-empt the /usr/bin/perl question of installperl. -installusrbinperl="$undef" - # This is there but in machine/ieeefp_h. ieeefp_h="define" @@ -88,9 +84,6 @@ if pkg_info -qe pth; then # Add -lpthread. libswanted="$libswanted pthread" - # -R so that we find the libpthread.so from /usr/pkg/lib - # during Configure and build. - ldflags="-R/usr/pkg/lib $ldflags" # There is no libc_r as of NetBSD 1.5.2, so no c -> c_r. else echo "$0: You need to install the GNU pth. Aborting." >&4 @@ -101,6 +94,9 @@ EOCBU # Recognize the NetBSD packages collection. -# GDBM might be here. -test -d /usr/pkg/lib && loclibpth="$loclibpth /usr/pkg/lib" +# GDBM might be here, pth might be there. +if test -d /usr/pkg/lib; then + loclibpth="$loclibpth /usr/pkg/lib" + ldflags="$ldflags -R/usr/pkg/lib" +fi test -d /usr/pkg/include && locincpth="$locincpth /usr/pkg/include" ==== //depot/macperl/installperl#2 (xtext) ==== Index: perl/installperl --- perl/installperl.~1~ Sat Apr 27 16:00:05 2002 +++ perl/installperl Sat Apr 27 16:00:05 2002 @@ -258,7 +258,7 @@ chmod(0755, "$installbin/ld2"); }; } else { - $perldll = 'perl57.' . $dlext; + $perldll = 'perl58.' . $dlext; } if ($dlsrc ne "dl_none.xs") { ==== //depot/macperl/lib/ExtUtils/Changes#2 (text) ==== Index: perl/lib/ExtUtils/Changes --- perl/lib/ExtUtils/Changes.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/Changes Sat Apr 27 16:00:05 2002 @@ -1,3 +1,40 @@ +5.91_02 Wed Apr 24 01:29:56 EDT 2002 + - Adjustments to tests for inclusion in the core. + +5.91_01 Wed Apr 24 00:11:06 EDT 2002 + [[ API Changes ]] + * A failing Makefile.PL in a subdir will now kill the whole + makefile making process. + * "make install PREFIX=something" will no longer work. Sorry. + - Now supporting the usevendorprefix %Config setting + - Tests now guaranteed to run in alphabetical order. + - Allowing $VERSION = 0. + + [[ Bug Fixes ]] + - Missing prerequisite warning malformatted. + - INSTALL*MAN*DIR and INST_MAN*DIR weren't allowed on the command + line. + * For years now skipcheck() has been returning a different + value than what was documented. + - Partially reversing Ken's "speed up ExtUtils::Manifest" patch + from 5.51_01 so MANIFEST overrides MANIFEST.SKIP. + * Fixed PREFIXification so it works on Win32. + * Fixed PREFIXification so it works on VMS. + - Fixed INSTALLMAN*DIR=none on VMS. + * NetWare fixes (bleadperl@16076) + - Craig Berry fixed some macro corruption on VMS. + - Systems configured to not have man pages now honored thanks to + Paul Green + - Hack to allow 5.6.X versions of ExtUtils::Embed use MY implicitly. + - Moved use of glob out of MM_Unix so MacPerl could build + + [[ Test Changes ]] + - Shortening directory levels to accomodate old VMS's + - was using a slightly wrong prefix for the prefix tests + + [[ Doc Fixes ]] + - Documenting VERBINST + 5.90_01 Thu Apr 11 01:11:54 EDT 2002 [[ API Changes ]] * Implementation of the new PREFIX logic. ==== //depot/macperl/lib/ExtUtils/Command/MM.pm#2 (text) ==== Index: perl/lib/ExtUtils/Command/MM.pm --- perl/lib/ExtUtils/Command/MM.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/Command/MM.pm Sat Apr 27 16:00:05 2002 @@ -39,6 +39,8 @@ Runs the tests on @ARGV via Test::Harness passing through the $verbose flag. Any @test_libs will be unshifted onto the test's @INC. +@test_libs are run in alphabetical order. + =cut sub test_harness { @@ -49,7 +51,7 @@ local @INC = @INC; unshift @INC, map { File::Spec->rel2abs($_) } @_; - Test::Harness::runtests(@ARGV); + Test::Harness::runtests(sort { lc $a cmp lc $b } @ARGV); } =back ==== //depot/macperl/lib/ExtUtils/MM.pm#2 (text) ==== Index: perl/lib/ExtUtils/MM.pm --- perl/lib/ExtUtils/MM.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/MM.pm Sat Apr 27 16:00:05 2002 @@ -52,7 +52,7 @@ } $Is{UWIN} = 1 if $^O eq 'uwin'; $Is{Cygwin} = 1 if $^O eq 'cygwin'; -$Is{NW5} = 1 if $Config{'osname'} eq 'NetWare'; # intentional +$Is{NW5} = 1 if $Config{osname} eq 'NetWare'; # intentional $Is{BeOS} = 1 if $^O =~ /beos/i; # XXX should this be that loose? $Is{DOS} = 1 if $^O eq 'dos'; ==== //depot/macperl/lib/ExtUtils/MM_Cygwin.pm#2 (text) ==== Index: perl/lib/ExtUtils/MM_Cygwin.pm --- perl/lib/ExtUtils/MM_Cygwin.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/MM_Cygwin.pm Sat Apr 27 16:00:05 2002 @@ -19,7 +19,7 @@ my $base = $self->SUPER::cflags($libperl); foreach (split /\n/, $base) { - / *= */ and $self->{$`} = $'; + /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2; }; $self->{CCFLAGS} .= " -DUSEIMPORTLIB" if ($Config{useshrplib} eq 'true'); ==== //depot/macperl/lib/ExtUtils/MM_NW5.pm#2 (text) ==== Index: perl/lib/ExtUtils/MM_NW5.pm --- perl/lib/ExtUtils/MM_NW5.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/MM_NW5.pm Sat Apr 27 16:00:05 2002 @@ -21,12 +21,6 @@ use Config; use File::Basename; -#require Exporter; - -#use ExtUtils::MakeMaker; -#Exporter::import('ExtUtils::MakeMaker', -# qw( $Verbose &neatvalue)); - use vars qw(@ISA $VERSION); $VERSION = '2.01_01'; @@ -36,7 +30,6 @@ use ExtUtils::MakeMaker qw( &neatvalue ); $ENV{EMXSHELL} = 'sh'; # to run `commands` -#unshift @MM::ISA, 'ExtUtils::MM_NW5'; $BORLAND = 1 if $Config{'cc'} =~ /^bcc/i; $GCC = 1 if $Config{'cc'} =~ /^gcc/i; @@ -73,7 +66,7 @@ Initializes lots of constants and .SUFFIXES and .PHONY =cut -# NetWare override + sub const_cccmd { my($self,$libperl)=@_; return $self->{CONST_CCCMD} if $self->{CONST_CCCMD}; @@ -133,20 +126,6 @@ # Copy this to makefile as INCLUDE = d:\...;d:\; (my $inc = $Config{'incpath'}) =~ s/([ ]*)-I/;/g; -=head - # Commented by Ananth since the below code was not adding the DBI path - # and compilation was failing due to non-availability of the correct path. 3 Jan 2002 - - # Get the additional include path and append to INCLUDE, keep it in - # INC will give problems during compilation, hence reset it after getting - # the value -## (my $add_inc = $self->{'INC'}) =~ s/ -I/;/g; - $self->{'INC'} = ''; - push @m, qq{ -INCLUDE = $inc;$add_inc; -}; -=cut - push @m, qq{ INCLUDE = $inc; }; @@ -269,13 +248,7 @@ join('',@m); } -=item dynamic_lib (o) - -Defines how to produce the *.so (or equivalent) files. - -=cut - -sub dynamic_lib { +sub static_lib { my($self, %attribs) = @_; return '' unless $self->needs_linking(); #might be because of a subdir @@ -293,7 +266,7 @@ OTHERLDFLAGS = '.$otherldflags.' INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' -$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) +$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) '); # push(@m, # q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) } @@ -301,9 +274,7 @@ # Create xdc data for an MT safe NLM in case of mpk build # if ( scalar(keys %XS) == 0 ) { return; } - push(@m, - q{ @echo Export boot_$(BOOT_SYMBOL) > $(BASEEXT).def -}); + push(@m, q{ @echo $(BASE_IMPORT) >> $(BASEEXT).def }); @@ -390,6 +361,116 @@ } +=item dynamic_lib (o) + +Defines how to produce the *.so (or equivalent) files. + +=cut + +sub dynamic_lib { + my($self, %attribs) = @_; + return '' unless $self->needs_linking(); #might be because of a subdir + + return '' unless $self->has_link_code; + + my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': ''); + my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; + my($ldfrom) = '$(LDFROM)'; + my(@m); + (my $boot = $self->{NAME}) =~ s/:/_/g; + my ($mpk); + push(@m,' +# This section creates the dynamically loadable $(INST_DYNAMIC) +# from $(OBJECT) and possibly $(MYEXTLIB). +OTHERLDFLAGS = '.$otherldflags.' +INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' + +$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) +'); +# push(@m, +# q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) } +# .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)}); + + # Create xdc data for an MT safe NLM in case of mpk build +# if ( scalar(keys %XS) == 0 ) { return; } + push(@m, + q{ @echo Export boot_$(BOOT_SYMBOL) > $(BASEEXT).def +}); + push(@m, + q{ @echo $(BASE_IMPORT) >> $(BASEEXT).def +}); + push(@m, + q{ @echo Import @$(PERL_INC)\perl.imp >> $(BASEEXT).def +}); + + if ( $self->{CCFLAGS} =~ m/ -DMPK_ON /) { + $mpk=1; + push @m, ' $(MPKTOOL) $(XDCFLAGS) $(BASEEXT).xdc +'; + push @m, ' @echo xdcdata $(BASEEXT).xdc >> $(BASEEXT).def +'; + } else { + $mpk=0; + } + + push(@m, + q{ $(LD) $(LDFLAGS) $(OBJECT:.obj=.obj) } + ); + + push(@m, + q{ -desc "Perl 5.7.3 Extension ($(BASEEXT)) XS_VERSION: $(XS_VERSION)" -nlmversion $(NLM_VERSION) } + ); + + # Taking care of long names like FileHandle, ByteLoader, SDBM_File etc + if($self->{NLM_SHORT_NAME}) { + # In case of nlms with names exceeding 8 chars, build nlm in the + # current dir, rename and move to auto\lib. If we create in auto\lib + # in the first place, we can't rename afterwards. + push(@m, + q{ -o $(NLM_SHORT_NAME).$(DLEXT)} + ); + } else { + push(@m, + q{ -o $(INST_AUTODIR)\\$(BASEEXT).$(DLEXT)} + ); + } + + # Add additional lib files if any (SDBM_File) + if($self->{MYEXTLIB}) { + push(@m, + q{ $(MYEXTLIB) } + ); + } + +#For now lets comment all the Watcom lib calls +#q{ LibPath $(LIBPTH) Library plib3s.lib Library math3s.lib Library clib3s.lib Library emu387.lib Library $(PERL_ARCHIVE) Library $(PERL_INC)\Main.lib} + + + push(@m, + q{ $(PERL_INC)\Main.lib} + .q{ -commandfile $(BASEEXT).def } + ); + + # If it is having a short name, rename it + if($self->{NLM_SHORT_NAME}) { + push @m, ' + if exist $(INST_AUTODIR)\\$(BASEEXT).$(DLEXT) del $(INST_AUTODIR)\\$(BASEEXT).$(DLEXT)'; + push @m, ' + rename $(NLM_SHORT_NAME).$(DLEXT) $(BASEEXT).$(DLEXT)'; + push @m, ' + move $(BASEEXT).$(DLEXT) $(INST_AUTODIR)'; + } + + push @m, ' + $(CHMOD) 755 $@ +'; + + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); + + join('',@m); +} + + 1; __END__ ==== //depot/macperl/lib/ExtUtils/MM_Unix.pm#2 (text) ==== Index: perl/lib/ExtUtils/MM_Unix.pm --- perl/lib/ExtUtils/MM_Unix.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/MM_Unix.pm Sat Apr 27 16:00:05 2002 @@ -5,7 +5,7 @@ use strict; use Exporter (); -use Carp (); +use Carp; use Config; use File::Basename qw(basename dirname fileparse); use File::Spec; @@ -19,26 +19,17 @@ use ExtUtils::MakeMaker qw($Verbose neatvalue); -$VERSION = '1.30_01'; +$VERSION = '1.31_01'; require ExtUtils::MM_Any; @ISA = qw(ExtUtils::MM_Any); $Is_OS2 = $^O eq 'os2'; $Is_Mac = $^O eq 'MacOS'; -$Is_Win32 = $^O eq 'MSWin32'; +$Is_Win32 = $^O eq 'MSWin32' || $Config{'osname'} eq 'NetWare'; $Is_Dos = $^O eq 'dos'; $Is_VOS = $^O eq 'vos'; -+$Is_NetWare = $Config{'osname'} eq 'NetWare'; # Config{'osname'} intentional -if ($Is_NetWare) { - $^O = 'NetWare'; - $Is_Win32 = 0; -} - -if ($Is_VMS = $^O eq 'VMS') { - require VMS::Filespec; - import VMS::Filespec qw( &vmsify ); -} +$Is_VMS = $^O eq 'VMS'; =head1 NAME @@ -1107,6 +1098,20 @@ 0; # false and not empty } +=item find_tests + + my $test = $mm->find_tests; + +Returns a string suitable for feeding to the shell to return all +tests in t/*.t. + +=cut + +sub find_tests { + my($self) = shift; + return 't/*.t'; +} + =back =head2 Methods to actually produce chunks of text for the Makefile @@ -1131,7 +1136,7 @@ for my $file (@files) { local(*FIXIN); local(*FIXOUT); - open(FIXIN, $file) or Carp::croak "Can't process '$file': $!"; + open(FIXIN, $file) or croak "Can't process '$file': $!"; local $/ = "\n"; chomp(my $line = <FIXIN>); next unless $line =~ s/^\s*\#!\s*//; # Not a shbang file. @@ -1562,7 +1567,7 @@ if ($self->{PERL_SRC}){ $self->{PERL_LIB} ||= File::Spec->catdir("$self->{PERL_SRC}","lib"); $self->{PERL_ARCHLIB} = $self->{PERL_LIB}; - $self->{PERL_INC} = ($Is_Win32 || $Is_NetWare) ? File::Spec->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC}; + $self->{PERL_INC} = ($Is_Win32) ? File::Spec->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC}; # catch a situation that has occurred a few times in the past: unless ( @@ -1575,8 +1580,6 @@ $Is_Mac or $Is_Win32 - or - $Is_NetWare ){ warn qq{ You cannot build extensions below the perl source tree after executing @@ -1698,8 +1701,11 @@ # Determine VERSION and VERSION_FROM ($self->{DISTNAME}=$self->{NAME}) =~ s#(::)#-#g unless $self->{DISTNAME}; if ($self->{VERSION_FROM}){ - $self->{VERSION} = $self->parse_version($self->{VERSION_FROM}) or - Carp::carp "WARNING: Setting VERSION via file '$self->{VERSION_FROM}' failed\n" + $self->{VERSION} = $self->parse_version($self->{VERSION_FROM}); + if( $self->{VERSION} eq 'undef' ) { + carp "WARNING: Setting VERSION via file ". + "'$self->{VERSION_FROM}' failed\n"; + } } # strip blanks @@ -1707,8 +1713,6 @@ $self->{VERSION} =~ s/^\s+//; $self->{VERSION} =~ s/\s+$//; } - - $self->{VERSION} ||= "0.10"; ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g; $self->{DISTVNAME} = "$self->{DISTNAME}-$self->{VERSION}"; @@ -1849,46 +1853,28 @@ sub init_INSTALL { my($self) = shift; - # The user who requests an installation directory explicitly - # should not have to tell us an architecture installation directory - # as well. We look if a directory exists that is named after the - # architecture. If not we take it as a sign that it should be the - # same as the requested installation directory. Otherwise we take - # the found one. - # We do the same thing twice: for privlib/archlib and for sitelib/sitearch - for my $libpair ({l=>"privlib", a=>"archlib"}, - {l=>"sitelib", a=>"sitearch"}) - { - my $lib = "install$libpair->{l}"; - my $Lib = uc $lib; - my $Arch = uc "install$libpair->{a}"; - if( $self->{$Lib} && ! $self->{$Arch} ){ - my($ilib) = $Config{$lib}; - $ilib = VMS::Filespec::unixify($ilib) if $Is_VMS; - - $self->prefixify($Arch,$ilib,$self->{$Lib}); + $self->init_lib2arch; - unless (-d $self->{$Arch}) { - print STDOUT "Directory $self->{$Arch} not found\n" - if $Verbose; - $self->{$Arch} = $self->{$Lib}; - } - print STDOUT "Defaulting $Arch to $self->{$Arch}\n" if $Verbose; - } - } - # There are no Config.pm defaults for these. $Config_Override{installsiteman1dir} = - "$Config{siteprefixexp}/man/man\$(MAN1EXT)"; + File::Spec->catdir($Config{siteprefixexp}, 'man', 'man$(MAN1EXT)'); $Config_Override{installsiteman3dir} = - "$Config{siteprefixexp}/man/man\$(MAN3EXT)"; - $Config_Override{installvendorman1dir} = - "$Config{vendorprefixexp}/man/man\$(MAN1EXT)"; - $Config_Override{installvendorman3dir} = - "$Config{vendorprefixexp}/man/man\$(MAN3EXT)"; + File::Spec->catdir($Config{siteprefixexp}, 'man', 'man$(MAN3EXT)'); + + if( $Config{usevendorprefix} ) { + $Config_Override{installvendorman1dir} = + File::Spec->catdir($Config{vendorprefixexp}, 'man', 'man$(MAN1EXT)'); + $Config_Override{installvendorman3dir} = + File::Spec->catdir($Config{vendorprefixexp}, 'man', 'man$(MAN3EXT)'); + } + else { + $Config_Override{installvendorman1dir} = ''; + $Config_Override{installvendorman3dir} = ''; + } - my $iprefix = $Config{installprefixexp} || ''; - my $vprefix = $Config{vendorprefixexp} || $iprefix; + my $iprefix = $Config{installprefixexp} || $Config{installprefix} || + $Config{prefixexp} || $Config{prefix} || ''; + my $vprefix = $Config{usevendorprefix} ? $Config{vendorprefixexp} : ''; my $sprefix = $Config{siteprefixexp} || ''; my $u_prefix = $self->{PREFIX} || ''; @@ -1911,47 +1897,54 @@ $manstyle = $self->{LIBSTYLE} eq 'lib/perl5' ? 'lib/perl5' : ''; } + # Some systems, like VOS, set installman*dir to '' if they can't + # read man pages. + for my $num (1, 3) { + $self->{'INSTALLMAN'.$num.'DIR'} ||= 'none' + unless $Config{'installman'.$num.'dir'}; + } + my %bin_layouts = ( bin => { s => $iprefix, - r => '$(PREFIX)', + r => $u_prefix, d => 'bin' }, vendorbin => { s => $vprefix, - r => '$(VENDORPREFIX)', + r => $u_vprefix, d => 'bin' }, sitebin => { s => $sprefix, - r => '$(SITEPREFIX)', + r => $u_sprefix, d => 'bin' }, script => { s => $iprefix, - r => '$(PREFIX)', + r => $u_prefix, d => 'bin' }, ); my %man_layouts = ( man1dir => { s => $iprefix, - r => '$(PREFIX)', + r => $u_prefix, d => 'man/man$(MAN1EXT)', style => $manstyle, }, siteman1dir => { s => $sprefix, - r => '$(SITEPREFIX)', + r => $u_sprefix, d => 'man/man$(MAN1EXT)', style => $manstyle, }, vendorman1dir => { s => $vprefix, - r => '$(VENDORPREFIX)', + r => $u_vprefix, d => 'man/man$(MAN1EXT)', style => $manstyle, }, man3dir => { s => $iprefix, - r => '$(PREFIX)', + r => $u_prefix, d => 'man/man$(MAN3EXT)', style => $manstyle, }, siteman3dir => { s => $sprefix, - r => '$(SITEPREFIX)', + r => $u_sprefix, d => 'man/man$(MAN3EXT)', style => $manstyle, }, vendorman3dir => { s => $vprefix, - r => '$(VENDORPREFIX)', + r => $u_vprefix, d => 'man/man$(MAN3EXT)', style => $manstyle, }, ); @@ -1959,28 +1952,28 @@ my %lib_layouts = ( privlib => { s => $iprefix, - r => '$(PREFIX)', + r => $u_prefix, d => '', style => $libstyle, }, vendorlib => { s => $vprefix, - r => '$(VENDORPREFIX)', + r => $u_vprefix, d => '', style => $libstyle, }, sitelib => { s => $sprefix, - r => '$(SITEPREFIX)', + r => $u_sprefix, d => 'site_perl', style => $libstyle, }, archlib => { s => $iprefix, - r => '$(PREFIX)', + r => $u_prefix, d => "$version/$arch", style => $libstyle }, vendorarch => { s => $vprefix, - r => '$(VENDORPREFIX)', + r => $u_vprefix, d => "$version/$arch", style => $libstyle }, sitearch => { s => $sprefix, - r => '$(SITEPREFIX)', + r => $u_sprefix, d => "site_perl/$version/$arch", style => $libstyle }, ); @@ -2025,9 +2018,49 @@ if $Verbose >= 2; } - $self->{PREFIX} ||= $iprefix; + return 1; +} + +=begin _protected + +=item init_lib2arch + + $mm->init_lib2arch + +=end _protected + +=cut + +sub init_lib2arch { + my($self) = shift; + + # The user who requests an installation directory explicitly + # should not have to tell us an architecture installation directory + # as well. We look if a directory exists that is named after the + # architecture. If not we take it as a sign that it should be the + # same as the requested installation directory. Otherwise we take + # the found one. + for my $libpair ({l=>"privlib", a=>"archlib"}, + {l=>"sitelib", a=>"sitearch"}, + {l=>"vendorlib", a=>"vendorarch"}, + ) + { + my $lib = "install$libpair->{l}"; + my $Lib = uc $lib; + my $Arch = uc "install$libpair->{a}"; + if( $self->{$Lib} && ! $self->{$Arch} ){ + my($ilib) = $Config{$lib}; + + $self->prefixify($Arch,$ilib,$self->{$Lib}); - return 1; + unless (-d $self->{$Arch}) { + print STDOUT "Directory $self->{$Arch} not found\n" + if $Verbose; + $self->{$Arch} = $self->{$Lib}; + } + print STDOUT "Defaulting $Arch to $self->{$Arch}\n" if $Verbose; + } + } } @@ -2262,7 +2295,7 @@ push(@m, qq{ EXE_FILES = @{$self->{EXE_FILES}} -} . (($Is_Win32 || $Is_NetWare) +} . ($Is_Win32 ? q{FIXIN = pl2bat.bat } : q{FIXIN = $(PERLRUN) "-MExtUtils::MY" \ -e "MY->fixin(shift)" @@ -2752,7 +2785,8 @@ my($self) = shift; my($child,$caller); $caller = (caller(0))[3]; - Carp::confess("Needs_linking called too early") if $caller =~ /^ExtUtils::MakeMaker::/; + confess("Needs_linking called too early") if + $caller =~ /^ExtUtils::MakeMaker::/; return $self->{NEEDS_LINKING} if defined $self->{NEEDS_LINKING}; if ($self->has_link_code or $self->{MAKEAPERL}){ $self->{NEEDS_LINKING} = 1; @@ -2845,10 +2879,11 @@ no warnings; $result = eval($eval); warn "Could not eval '$eval' in $parsefile: $@" if $@; - $result = "undef" unless defined $result; last; } close FH; + + $result = "undef" unless defined $result; return $result; } @@ -3092,8 +3127,8 @@ if ($self->{ABSTRACT_FROM}){ $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or - Carp::carp "WARNING: Setting ABSTRACT via file ". - "'$self->{ABSTRACT_FROM}' failed\n"; + carp "WARNING: Setting ABSTRACT via file ". + "'$self->{ABSTRACT_FROM}' failed\n"; } my ($pack_ver) = join ",", (split (/\./, $self->{VERSION}), (0)x4)[0..3]; @@ -3182,15 +3217,12 @@ my($self,$var,$sprefix,$rprefix,$default) = @_; my $path = $self->{uc $var} || - $Config_Override{lc $var} || $Config{lc $var}; + $Config_Override{lc $var} || $Config{lc $var} || ''; - print STDERR " prefixify $var=$path\n" if $Verbose >= 2; - print STDERR " from $sprefix to $rprefix\n" - if $Verbose >= 2; + print STDERR " prefixify $var => $path\n" if $Verbose >= 2; + print STDERR " from $sprefix to $rprefix\n" if $Verbose >= 2; - $path = VMS::Filespec::unixpath($path) if $Is_VMS; - - unless( $path =~ s,^\Q$sprefix\E(?=/|\z),$rprefix,s ) { + unless( $path =~ s{^\Q$sprefix\E\b}{$rprefix}s ) { print STDERR " cannot prefix, using default.\n" if $Verbose >= 2; print STDERR " no default!\n" if !$default && $Verbose >= 2; @@ -3513,7 +3545,7 @@ my($self, %attribs) = @_; my $tests = $attribs{TESTS} || ''; if (!$tests && -d 't') { - $tests = $Is_Win32 ? join(' ', <t\\*.t>) : 't/*.t'; + $tests = $self->find_tests; } # note: 'test.pl' name is also hardcoded in init_dirscan() my(@m); ==== //depot/macperl/lib/ExtUtils/MM_VMS.pm#2 (text) ==== Index: perl/lib/ExtUtils/MM_VMS.pm --- perl/lib/ExtUtils/MM_VMS.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/MM_VMS.pm Sat Apr 27 16:00:05 2002 @@ -431,6 +431,7 @@ PERL_LIB PERL_ARCHLIB PERL_INC PERL_SRC FULLEXT ] ) { next unless defined $self->{$macro}; + next if $macro =~ /MAN/ && $self->{$macro} eq 'none'; $self->{$macro} = $self->fixpath($self->{$macro},1); } $self->{PERL_VMS} = File::Spec->catdir($self->{PERL_SRC},q(VMS)) @@ -746,24 +747,26 @@ # As always, keep under DCL's 255-char limit pm_to_blib.ts : $(TO_INST_PM) - $(NOECHO) $(PERL) -e "print '},shift(@files),q{ },shift(@files),q{'" >.MM_tmp }; - $line = ''; # avoid uninitialized var warning - while ($from = shift(@files),$to = shift(@files)) { + if (scalar(@files) > 0) { # protect ourselves from empty PM_TO_BLIB + + push(@m,qq[\t\$(NOECHO) \$(RM_F) .MM_tmp\n]); + $line = ''; # avoid uninitialized var warning + while ($from = shift(@files),$to = shift(@files)) { $line .= " $from $to"; if (length($line) > 128) { push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n"); $line = ''; } + } + push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line; + + push(@m,q[ $(PERLRUN) "-MExtUtils::Install" -e "pm_to_blib({split(' ',<STDIN>)},'].$autodir.q[','$(PM_FILTER)')" <.MM_tmp]); + push(@m,qq[\n\t\$(NOECHO) \$(RM_F) .MM_tmp\n]); + } - push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line; - - push(@m,q[ $(PERLRUN) "-MExtUtils::Install" -e "pm_to_blib({split(' ',<STDIN>)},'].$autodir.q[','$(PM_FILTER)')" <.MM_tmp]); - push(@m,qq[ - \$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp; - \$(NOECHO) \$(TOUCH) pm_to_blib.ts -]); + push(@m,qq[\t\$(NOECHO) \$(TOUCH) pm_to_blib.ts]); join('',@m); } @@ -1853,6 +1856,15 @@ join('',@m); } +=item find_tests (override) + +=cut + +sub find_tests { + my $self = shift; + return -d 't' ? 't/*.t' : ''; +} + =item test (override) Use VMS commands for handling subdirectories. @@ -1861,7 +1873,7 @@ sub test { my($self, %attribs) = @_; - my($tests) = $attribs{TESTS} || ( -d 't' ? 't/*.t' : ''); + my($tests) = $attribs{TESTS} || $self->find_tests; my(@m); push @m," TEST_VERBOSE = 0 @@ -2173,17 +2185,103 @@ =cut sub nicetext { - my($self,$text) = @_; + return $text if $text =~ m/^\w+\s*=/; # leave macro defs alone $text =~ s/([^\s:])(:+\s)/$1 $2/gs; $text; } -1; +=item prefixify (override) + +prefixifying on VMS is simple. Each should simply be: + + perl_root:[some.dir] + +which can just be converted to: + + volume:[your.prefix.some.dir] + +otherwise you get the default layout. + +In effect, your search prefix is ignored and $Config{vms_prefix} is +used instead. + +=cut + +sub prefixify { + my($self, $var, $sprefix, $rprefix, $default) = @_; + $default = VMS::Filespec::vmsify($default) + unless $default =~ /\[.*\]/; + + (my $var_no_install = $var) =~ s/^install//; + my $path = $self->{uc $var} || $Config{lc $var} || + $Config{lc $var_no_install}; + + if( !$path ) { + print STDERR " no Config found for $var.\n" if $Verbose >= 2; + $path = $self->_prefixify_default($rprefix, $default); + } + elsif( $sprefix eq $rprefix ) { + print STDERR " no new prefix.\n" if $Verbose >= 2; + } + else { + + print STDERR " prefixify $var => $path\n" if $Verbose >= 2; + print STDERR " from $sprefix to $rprefix\n" if $Verbose >= 2; + + my($path_vol, $path_dirs) = File::Spec->splitpath( $path ); + if( $path_vol eq $Config{vms_prefix}.':' ) { + print STDERR " $Config{vms_prefix}: seen\n" if $Verbose >= 2; + + $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.}; + $path = $self->_catprefix($rprefix, $path_dirs); + } + else { + $path = $self->_prefixify_default($rprefix, $default); + } + } + + print " now $path\n" if $Verbose >= 2; + return $self->{uc $var} = $path; +} + + +sub _prefixify_default { + my($self, $rprefix, $default) = @_; + + print STDERR " cannot prefix, using default.\n" if $Verbose >= 2; + + if( !$default ) { + print STDERR "No default!\n" if $Verbose >= 1; + return; + } + if( !$rprefix ) { + print STDERR "No replacement prefix!\n" if $Verbose >= 1; + return ''; + } + + return $self->_catprefix($rprefix, $default); +} + +sub _catprefix { + my($self, $rprefix, $default) = @_; + + my($rvol, $rdirs) = File::Spec->splitpath($rprefix); + if( $rvol ) { + return File::Spec->catpath($rvol, + File::Spec->catdir($rdirs, $default), + '' + ) + } + else { + return File::Spec->catdir($rdirs, $default); + } +} + =back =cut -__END__ +1; ==== //depot/macperl/lib/ExtUtils/MM_Win32.pm#2 (text) ==== Index: perl/lib/ExtUtils/MM_Win32.pm --- perl/lib/ExtUtils/MM_Win32.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/MM_Win32.pm Sat Apr 27 16:00:05 2002 @@ -140,6 +140,14 @@ 0; # false and not empty } + +# This code was taken out of MM_Unix to avoid loading File::Glob +# unless necessary. +sub find_tests { + return join(' ', <t\\*.t>); +} + + sub init_others { my ($self) = @_; @@ -482,6 +490,7 @@ return "$self->{BASEEXT}.def"; } + =item perl_script Takes one argument, a file name, and returns the file name, if the ==== //depot/macperl/lib/ExtUtils/MakeMaker.pm#2 (text) ==== Index: perl/lib/ExtUtils/MakeMaker.pm --- perl/lib/ExtUtils/MakeMaker.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/MakeMaker.pm Sat Apr 27 16:00:05 2002 @@ -2,10 +2,10 @@ package ExtUtils::MakeMaker; -$VERSION = "5.90_01"; +$VERSION = "5.91_02"; $Version_OK = "5.49"; # Makefiles older than $Version_OK will die # (Will be checked from MakeMaker version 4.13 onwards) -($Revision = substr(q$Revision: 1.37 $, 10)) =~ s/\s+$//; +($Revision = substr(q$Revision: 1.44 $, 10)) =~ s/\s+$//; require Exporter; use Config; @@ -34,7 +34,11 @@ require ExtUtils::MM; # Things like CPAN assume loading ExtUtils::MakeMaker # will give them MM. +require ExtUtils::MY; # XXX pre-5.8 versions of ExtUtils::Embed expect + # loading ExtUtils::MakeMaker will give them MY. + # This will go when Embed is it's own CPAN module. + sub WriteMakefile { Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; @@ -100,7 +104,7 @@ # } else { # warn "WARNING from evaluation of $dir/Makefile.PL: $@"; # } - warn "WARNING from evaluation of $dir/Makefile.PL: $@"; + die "ERROR from evaluation of $dir/Makefile.PL: $@"; } } @@ -117,12 +121,16 @@ EXCLUDE_EXT EXE_FILES FIRST_MAKEFILE FULLPERL FULLPERLRUN FULLPERLRUNINST FUNCLIST H IMPORTS - INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB + INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB INST_MAN1DIR INST_MAN3DIR INSTALLDIRS PREFIX SITEPREFIX VENDORPREFIX INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH - INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN INSTALLSCRIPT + INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN + INSTALLMAN1DIR INSTALLMAN3DIR + INSTALLSITEMAN1DIR INSTALLSITEMAN3DIR + INSTALLVENDORMAN1DIR INSTALLVENDORMAN3DIR + INSTALLSCRIPT PERL_LIB PERL_ARCHLIB SITELIBEXP SITEARCHEXP INC INCLUDE_EXT LDFROM LIB LIBPERL_A LIBS @@ -281,7 +289,7 @@ unless $self->{PREREQ_FATAL}; $unsatisfied{$prereq} = 'not installed'; } elsif ($pr_version < $self->{PREREQ_PM}->{$prereq} ){ - warn "Warning: prerequisite %s %s not found. We have %s.\n", + warn sprintf "Warning: prerequisite %s %s not found. We have %s.\n", $prereq, $self->{PREREQ_PM}{$prereq}, ($pr_version || 'unknown version') unless $self->{PREREQ_FATAL}; @@ -712,21 +720,16 @@ sub flush { my $self = shift; my($chunk); -# use FileHandle (); -# my $fh = new FileHandle; local *FH; print STDOUT "Writing $self->{MAKEFILE} for $self->{NAME}\n"; unlink($self->{MAKEFILE}, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ''); -# $fh->open(">MakeMaker.tmp") or die "Unable to open MakeMaker.tmp: $!"; open(FH,">MakeMaker.tmp") or die "Unable to open MakeMaker.tmp: $!"; for $chunk (@{$self->{RESULT}}) { -# print $fh "$chunk\n"; print FH "$chunk\n"; } -# $fh->close; close FH; my($finalname) = $self->{MAKEFILE}; rename("MakeMaker.tmp", $finalname); @@ -884,8 +887,8 @@ MakeMaker also checks for any files matching glob("t/*.t"). It will add commands to the test target of the generated Makefile that execute -all matching files via the L<Test::Harness> module with the C<-I> -switches set correctly. +all matching files in alphabetical order via the L<Test::Harness> +module with the C<-I> switches set correctly. =head2 make testdb @@ -1783,6 +1786,10 @@ Defaults to PREFIX (if set) or $Config{vendorprefixexp} +=item VERBINST + +If true, make install will be verbose + =item VERSION Your version number for distributing the package. This defaults to @@ -1804,7 +1811,7 @@ $VERSION = '1.00'; *VERSION = \'1.01'; - ( $VERSION ) = '$Revision: 1.37 $ ' =~ /\$Revision:\s+([^\s]+)/; + ( $VERSION ) = '$Revision: 1.43 $ ' =~ /\$Revision:\s+([^\s]+)/; $FOO::VERSION = '1.10'; *FOO::VERSION = \'1.11'; our $VERSION = 1.2.3; # new for perl5.6.0 ==== //depot/macperl/lib/ExtUtils/Manifest.pm#2 (text) ==== Index: perl/lib/ExtUtils/Manifest.pm --- perl/lib/ExtUtils/Manifest.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/Manifest.pm Sat Apr 27 16:00:05 2002 @@ -79,13 +79,12 @@ sub manifind { my $p = shift || {}; - my $skip = _maniskip(warn => $p->{warn_on_skip}); my $found = {}; my $wanted = sub { my $name = clean_up_filename($File::Find::name); warn "Debug: diskfile $name\n" if $Debug; - return if $skip->($name) or -d $name; + return if -d $name; if( $Is_VMS ) { $name =~ s#(.*)\.$#\L$1#; @@ -99,8 +98,6 @@ # Also, it's okay to use / here, because MANIFEST files use Unix-style # paths. find({wanted => $wanted, - preprocess => - sub {grep {!$skip->( clean_up_filename("$File::Find::dir/$_") )} @_}, no_chdir => 1, }, $Is_MacOS ? ":" : "."); @@ -109,62 +106,80 @@ } sub fullcheck { - _manicheck({check_files => 1, check_MANIFEST => 1}); + return [_check_files()], [_check_manifest()]; } sub manicheck { - return @{(_manicheck({check_files => 1}))[0]}; + return _check_files(); } sub filecheck { - return @{(_manicheck({check_MANIFEST => 1}))[1]}; + return _check_manifest(); } sub skipcheck { - _manicheck({check_MANIFEST => 1, warn_on_skip => 1}); + my($p) = @_; + my $found = manifind(); + my $matches = _maniskip(); + + my @skipped = (); + foreach my $file (sort keys %$found){ + if (&$matches($file)){ + warn "Skipping $file\n"; + push @skipped, $file; + next; + } + } + + return @skipped; +} + + +sub _check_files { + my $p = shift; + my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0); + my $read = maniread() || {}; + my $found = manifind($p); + + my(@missfile) = (); + foreach my $file (sort keys %$read){ + warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug; + if ($dosnames){ + $file = lc $file; + $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge; + $file =~ s=((\w|-)+)=substr ($1,0,8)=ge; + } + unless ( exists $found->{$file} ) { + warn "No such file: $file\n" unless $Quiet; + push @missfile, $file; + } + } + + return @missfile; } -sub _manicheck { + +sub _check_manifest { my($p) = @_; - my $read = maniread(); + my $read = maniread() || {}; my $found = manifind($p); + my $skip = _maniskip(); - my $file; - my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0); - my(@missfile,@missentry); - if ($p->{check_files}){ - foreach $file (sort keys %$read){ - warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug; - if ($dosnames){ - $file = lc $file; - $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge; - $file =~ s=((\w|-)+)=substr ($1,0,8)=ge; - } - unless ( exists $found->{$file} ) { - warn "No such file: $file\n" unless $Quiet; - push @missfile, $file; - } - } + my @missentry = (); + foreach my $file (sort keys %$found){ + next if $skip->($file); + warn "Debug: manicheck checking from disk $file\n" if $Debug; + unless ( exists $read->{$file} ) { + my $canon = $Is_MacOS ? "\t" . _unmacify($file) : ''; + warn "Not in $MANIFEST: $file$canon\n" unless $Quiet; + push @missentry, $file; + } } - if ($p->{check_MANIFEST}){ - $read ||= {}; - my $matches = _maniskip(); - foreach $file (sort keys %$found){ - if (&$matches($file)){ - warn "Skipping $file\n" if $p->{warn_on_skip}; - next; - } - warn "Debug: manicheck checking from disk $file\n" if $Debug; - unless ( exists $read->{$file} ) { - my $canon = $Is_MacOS ? "\t" . _unmacify($file) : ''; - warn "Not in $MANIFEST: $file$canon\n" unless $Quiet; - push @missentry, $file; - } - } - } - (\@missfile,\@missentry); + + return @missentry; } + sub maniread { my ($mfile) = @_; $mfile ||= $MANIFEST; @@ -206,10 +221,8 @@ # returns an anonymous sub that decides if an argument matches sub _maniskip { - my (%args) = @_; - my @skip ; - my $mfile ||= "$MANIFEST.SKIP"; + my $mfile = "$MANIFEST.SKIP"; local *M; open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0}; while (<M>){ @@ -225,10 +238,7 @@ # any of them contain alternations my $regex = join '|', map "(?:$_)", @skip; - return ($args{warn} - ? sub { $_[0] =~ qr{$opts$regex} && warn "Skipping $_[0]\n" } - : sub { $_[0] =~ qr{$opts$regex} } - ); + return sub { $_[0] =~ qr{$opts$regex} }; } sub manicopy { @@ -294,7 +304,8 @@ copy($srcFile,$dstFile); utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile; # chmod a+rX-w,go-w - chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ) unless ($^O eq 'MacOS'); + chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ) + unless ($^O eq 'MacOS'); } sub ln { @@ -496,9 +507,11 @@ =item C<Not in MANIFEST:> I<file> -is reported if a file is found, that is missing in the C<MANIFEST> -file which is excluded by a regular expression in the file -C<MANIFEST.SKIP>. +is reported if a file is found which is not in C<MANIFEST>. + +=item C<Skipping> I<file> + +is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>. =item C<No such file:> I<file> ==== //depot/macperl/lib/ExtUtils/t/INST.t#2 (text) ==== Index: perl/lib/ExtUtils/t/INST.t --- perl/lib/ExtUtils/t/INST.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/INST.t Sat Apr 27 16:00:05 2002 @@ -16,14 +16,14 @@ } use strict; -use Test::More tests => 17; +use Test::More tests => 23; use MakeMaker::Test::Utils; use ExtUtils::MakeMaker; use File::Spec; use TieOut; use Config; -$ENV{PERL_CORE} ? chdir '../lib/ExtUtils/t' : chdir 't'; +chdir 't'; perl_lib; @@ -33,33 +33,33 @@ my $Curdir = File::Spec->curdir; my $Updir = File::Spec->updir; -ok( chdir 'Big-Fat-Dummy', "chdir'd to Big-Fat-Dummy" ) || +ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || diag("chdir failed: $!"); my $stdout = tie *STDOUT, 'TieOut' or die; my $mm = WriteMakefile( - NAME => 'Big::Fat::Dummy', - VERSION_FROM => 'lib/Big/Fat/Dummy.pm', + NAME => 'Big::Dummy', + VERSION_FROM => 'lib/Big/Dummy.pm', PREREQ_PM => {}, PERL_CORE => $ENV{PERL_CORE}, ); like( $stdout->read, qr{ - Writing\ $Makefile\ for\ Big::Fat::Liar\n - Big::Fat::Liar's\ vars\n + Writing\ $Makefile\ for\ Big::Liar\n + Big::Liar's\ vars\n INST_LIB\ =\ \S+\n INST_ARCHLIB\ =\ \S+\n - Writing\ $Makefile\ for\ Big::Fat::Dummy\n + Writing\ $Makefile\ for\ Big::Dummy\n }x ); undef $stdout; untie *STDOUT; isa_ok( $mm, 'ExtUtils::MakeMaker' ); -is( $mm->{NAME}, 'Big::Fat::Dummy', 'NAME' ); +is( $mm->{NAME}, 'Big::Dummy', 'NAME' ); is( $mm->{VERSION}, 0.01, 'VERSION' ); my $config_prefix = $^O eq 'VMS' - ? VMS::Filespec::unixify($Config{installprefixexp}) + ? $Config{installprefixexp} || $Config{prefix} : $Config{installprefixexp}; is( $mm->{PREFIX}, $config_prefix, 'PREFIX' ); @@ -67,7 +67,7 @@ my($perl_src, $mm_perl_src); if( $ENV{PERL_CORE} ) { - $perl_src = File::Spec->catdir($Updir, $Updir, $Updir, $Updir); + $perl_src = File::Spec->catdir($Updir, $Updir); $perl_src = File::Spec->canonpath($perl_src); $mm_perl_src = File::Spec->canonpath($mm->{PERL_SRC}); } @@ -109,3 +109,34 @@ # INSTALL* is( $mm->{INSTALLDIRS}, 'site', 'INSTALLDIRS' ); + + + +# Make sure the INSTALL*MAN*DIR variables work. We forgot them +# at one point. +$stdout = tie *STDOUT, 'TieOut' or die; +$mm = WriteMakefile( + NAME => 'Big::Dummy', + VERSION_FROM => 'lib/Big/Dummy.pm', + PERL_CORE => $ENV{PERL_CORE}, + INSTALLMAN1DIR => 'none', + INSTALLSITEMAN3DIR => 'none', + INSTALLVENDORMAN1DIR => 'none', + INST_MAN1DIR => 'none', +); +like( $stdout->read, qr{ + Writing\ $Makefile\ for\ Big::Liar\n + Big::Liar's\ vars\n + INST_LIB\ =\ \S+\n + INST_ARCHLIB\ =\ \S+\n + Writing\ $Makefile\ for\ Big::Dummy\n +}x ); +undef $stdout; +untie *STDOUT; + +isa_ok( $mm, 'ExtUtils::MakeMaker' ); + +is ( $mm->{INSTALLMAN1DIR}, 'none' ); +is ( $mm->{INSTALLSITEMAN3DIR}, 'none' ); +is ( $mm->{INSTALLVENDORMAN1DIR}, 'none' ); +is ( $mm->{INST_MAN1DIR}, 'none' ); ==== //depot/macperl/lib/ExtUtils/t/INST_PREFIX.t#2 (text) ==== Index: perl/lib/ExtUtils/t/INST_PREFIX.t --- perl/lib/ExtUtils/t/INST_PREFIX.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/INST_PREFIX.t Sat Apr 27 16:00:05 2002 @@ -16,14 +16,16 @@ } use strict; -use Test::More tests => 24; +use Test::More tests => 26; use MakeMaker::Test::Utils; use ExtUtils::MakeMaker; use File::Spec; use TieOut; use Config; -$ENV{PERL_CORE} ? chdir '../lib/ExtUtils/t' : chdir 't'; +my $Is_VMS = $^O eq 'VMS'; + +chdir 't'; perl_lib; @@ -33,39 +35,40 @@ my $Curdir = File::Spec->curdir; my $Updir = File::Spec->updir; -ok( chdir 'Big-Fat-Dummy', "chdir'd to Big-Fat-Dummy" ) || +ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || diag("chdir failed: $!"); +my $PREFIX = File::Spec->catdir('foo', 'bar'); my $stdout = tie *STDOUT, 'TieOut' or die; my $mm = WriteMakefile( - NAME => 'Big::Fat::Dummy', - VERSION_FROM => 'lib/Big/Fat/Dummy.pm', + NAME => 'Big::Dummy', + VERSION_FROM => 'lib/Big/Dummy.pm', PREREQ_PM => {}, PERL_CORE => $ENV{PERL_CORE}, - PREFIX => 'foo/bar', + PREFIX => $PREFIX, ); like( $stdout->read, qr{ - Writing\ $Makefile\ for\ Big::Fat::Liar\n - Big::Fat::Liar's\ vars\n + Writing\ $Makefile\ for\ Big::Liar\n + Big::Liar's\ vars\n INST_LIB\ =\ \S+\n INST_ARCHLIB\ =\ \S+\n - Writing\ $Makefile\ for\ Big::Fat::Dummy\n + Writing\ $Makefile\ for\ Big::Dummy\n }x ); undef $stdout; untie *STDOUT; isa_ok( $mm, 'ExtUtils::MakeMaker' ); -is( $mm->{NAME}, 'Big::Fat::Dummy', 'NAME' ); +is( $mm->{NAME}, 'Big::Dummy', 'NAME' ); is( $mm->{VERSION}, 0.01, 'VERSION' ); -is( $mm->{PREFIX}, 'foo/bar', 'PREFIX' ); +is( $mm->{PREFIX}, $PREFIX, 'PREFIX' ); is( !!$mm->{PERL_CORE}, !!$ENV{PERL_CORE}, 'PERL_CORE' ); my($perl_src, $mm_perl_src); if( $ENV{PERL_CORE} ) { - $perl_src = File::Spec->catdir($Updir, $Updir, $Updir, $Updir); + $perl_src = File::Spec->catdir($Updir, $Updir); $perl_src = File::Spec->canonpath($perl_src); $mm_perl_src = File::Spec->canonpath($mm->{PERL_SRC}); } @@ -85,15 +88,47 @@ vendorman1dir vendorman3dir); foreach my $var (@Perl_Install) { - like( $mm->{uc "install$var"}, qr/^\$\(PREFIX\)/, "PREFIX + $var" ); + my $prefix = $Is_VMS ? '[.foo.bar' : File::Spec->catdir(qw(foo bar)); + + # support for man page skipping + $prefix = 'none' if $var =~ /man/ && !$Config{"install$var"}; + like( $mm->{uc "install$var"}, qr/^\Q$prefix\E/, "PREFIX + $var" ); } foreach my $var (@Site_Install) { - like( $mm->{uc "install$var"}, qr/^\$\(SITEPREFIX\)/, + my $prefix = $Is_VMS ? '[.foo.bar' : File::Spec->catdir(qw(foo bar)); + + like( $mm->{uc "install$var"}, qr/^\Q$prefix\E/, "SITEPREFIX + $var" ); } foreach my $var (@Vend_Install) { - like( $mm->{uc "install$var"}, qr/^\$\(VENDORPREFIX\)/, + my $prefix = $Is_VMS ? '[.foo.bar' : File::Spec->catdir(qw(foo bar)); + + like( $mm->{uc "install$var"}, qr/^\Q$prefix\E/, "VENDORPREFIX + $var" ); } + + +# Check that when installman*dir isn't set in Config no man pages +# are generated. +{ + undef *ExtUtils::MM_Unix::Config; + %ExtUtils::MM_Unix::Config = %Config; + $ExtUtils::MM_Unix::Config{installman1dir} = ''; + $ExtUtils::MM_Unix::Config{installman3dir} = ''; + + my $wibble = File::Spec->catdir(qw(wibble and such)); + my $stdout = tie *STDOUT, 'TieOut' or die; + my $mm = WriteMakefile( + NAME => 'Big::Dummy', + VERSION_FROM => 'lib/Big/Dummy.pm', + PREREQ_PM => {}, + PERL_CORE => $ENV{PERL_CORE}, + PREFIX => $PREFIX, + INSTALLMAN1DIR=> $wibble, + ); + + is( $mm->{INSTALLMAN1DIR}, $wibble ); + is( $mm->{INSTALLMAN3DIR}, 'none' ); +} ==== //depot/macperl/lib/ExtUtils/t/MM_Unix.t#2 (text) ==== Index: perl/lib/ExtUtils/t/MM_Unix.t --- perl/lib/ExtUtils/t/MM_Unix.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/MM_Unix.t Sat Apr 27 16:00:05 2002 @@ -18,7 +18,7 @@ plan skip_all => 'Non-Unix platform'; } else { - plan tests => 108; + plan tests => 112; } } @@ -185,8 +185,25 @@ my $self_name = $ENV{PERL_CORE} ? '../lib/ExtUtils/t/MM_Unix.t' : 'MM_Unix.t'; -is ($t->parse_version($self_name),'0.02', - 'parse_version on ourself'); +is( $t->parse_version($self_name), '0.02', 'parse_version on ourself'); + +my %versions = ( + '$VERSION = 0.0' => 0.0, + '$VERSION = -1.0' => -1.0, + '$VERSION = undef' => 'undef', + '$wibble = 1.0' => 'undef', + ); + +while( my($code, $expect) = each %versions ) { + open(FILE, ">VERSION.tmp") || die $!; + print FILE "$code\n"; + close FILE; + + is( $t->parse_version('VERSION.tmp'), $expect, $code ); + + unlink "VERSION.tmp"; +} + ############################################################################### # perl_script (on unix any ordinary, readable file) ==== //depot/macperl/lib/ExtUtils/t/Manifest.t#2 (text) ==== Index: perl/lib/ExtUtils/t/Manifest.t --- perl/lib/ExtUtils/t/Manifest.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/Manifest.t Sat Apr 27 16:00:05 2002 @@ -14,7 +14,7 @@ use strict; # these files help the test run -use Test::More tests => 32; +use Test::More tests => 33; use Cwd; # these files are needed for the module itself @@ -103,15 +103,12 @@ ($res, $warn) = catch_warning( \&skipcheck ); like( $warn, qr/^Skipping MANIFEST\.SKIP/i, 'got skipping warning' ); -# I'm not sure why this should be... shouldn't $missing be the only one? -my ($found, $missing ); +my @skipped; catch_warning( sub { - ( $found, $missing ) = skipcheck() + @skipped = skipcheck() }); -# nothing new should be found, bar should be skipped -is( @$found, 0, 'no output here' ); -is( join( ' ', @$missing ), 'bar', 'listed skipped files' ); +is( join( ' ', @skipped ), 'MANIFEST.SKIP', 'listed skipped files' ); { local $ExtUtils::Manifest::Quiet = 1; @@ -165,7 +162,17 @@ # This'll skip moretest/quux ($res, $warn) = catch_warning( \&skipcheck ); -like( $warn, qr{^Skipping moretest/quux}i, 'got skipping warning again' ); +like( $warn, qr{^Skipping moretest/quux$}i, 'got skipping warning again' ); + + +# There was a bug where entries in MANIFEST would be blotted out +# by MANIFEST.SKIP rules. +add_file( 'MANIFEST.SKIP' => 'foo' ); +add_file( 'MANIFEST' => 'foobar' ); +add_file( 'foobar' => '123' ); +($res, $warn) = catch_warning( \&manicheck ); +is( $res, '', 'MANIFEST overrides MANIFEST.SKIP' ); +is( $warn, undef, 'MANIFEST overrides MANIFEST.SKIP, no warnings' ); END { ==== //depot/macperl/lib/ExtUtils/t/basic.t#2 (text) ==== Index: perl/lib/ExtUtils/t/basic.t --- perl/lib/ExtUtils/t/basic.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/basic.t Sat Apr 27 16:00:05 2002 @@ -21,7 +21,7 @@ my $perl = which_perl(); -$ENV{PERL_CORE} ? chdir '../lib/ExtUtils/t' : chdir 't'; +chdir 't'; perl_lib; @@ -29,7 +29,7 @@ $| = 1; -ok( chdir 'Big-Fat-Dummy', "chdir'd to Big-Fat-Dummy" ) || +ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || diag("chdir failed: $!"); @@ -40,7 +40,7 @@ print TEST <<'COMPILE_T'; print "1..2\n"; -print eval "use Big::Fat::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; +print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; print "ok 2 - TEST_VERBOSE\n"; COMPILE_T close TEST; @@ -50,8 +50,8 @@ print TEST <<'SANITY_T'; print "1..3\n"; -print eval "use Big::Fat::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; -print eval "use Big::Fat::Liar; 1;" ? "ok 2\n" : "not ok 2\n"; +print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; +print eval "use Big::Liar; 1;" ? "ok 2\n" : "not ok 2\n"; print "ok 3 - TEST_VERBOSE\n"; SANITY_T close TEST; @@ -64,7 +64,7 @@ diag(@mpl_out); my $makefile = makefile_name(); -ok( grep(/^Writing $makefile for Big::Fat::Dummy/, +ok( grep(/^Writing $makefile for Big::Dummy/, @mpl_out) == 1, 'Makefile.PL output looks right'); @@ -103,8 +103,7 @@ like( $test_out, qr/All tests successful/, ' successful' ); is( $?, 0 ); -my $kill_err = $^O eq 'MSWin32' ? '2>&1' : ''; # avoid nmake spew -my $dist_test_out = `$make disttest $kill_err`; +my $dist_test_out = `$make disttest`; is( $?, 0, 'disttest' ) || diag($dist_test_out); @@ -114,7 +113,7 @@ cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); -ok( grep(/^Writing $makefile for Big::Fat::Dummy/, +ok( grep(/^Writing $makefile for Big::Dummy/, @mpl_out) == 1, 'init_dirscan skipped distdir') || diag(@mpl_out); ==== //depot/macperl/lib/ExtUtils/t/hints.t#2 (text) ==== Index: perl/lib/ExtUtils/t/hints.t --- perl/lib/ExtUtils/t/hints.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/hints.t Sat Apr 27 16:00:05 2002 @@ -9,7 +9,7 @@ unshift @INC, 't/lib/'; } } -$ENV{PERL_CORE} ? chdir '../lib/ExtUtils/t' : chdir 't'; +chdir 't'; use Test::More tests => 3; ==== //depot/macperl/lib/ExtUtils/t/prefixify.t#2 (text) ==== Index: perl/lib/ExtUtils/t/prefixify.t --- perl/lib/ExtUtils/t/prefixify.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/prefixify.t Sat Apr 27 16:00:05 2002 @@ -11,7 +11,14 @@ } use strict; -use Test::More tests => 1; +use Test::More; + +if( $^O eq 'VMS' ) { + plan skip_all => 'prefixify works differently on VMS'; +} +else { + plan tests => 2; +} use File::Spec; use ExtUtils::MM; @@ -22,3 +29,12 @@ is( $mm->{INSTALLBIN}, File::Spec->catdir('something', $default), 'prefixify w/defaults'); + +{ + undef *ExtUtils::MM_Unix::Config; + $ExtUtils::MM_Unix::Config{wibble} = 'C:\opt\perl\wibble'; + $mm->prefixify('wibble', 'C:\opt\perl', 'C:\yarrow'); + + is( $mm->{WIBBLE}, 'C:\yarrow\wibble', 'prefixify Win32 paths' ); + { package ExtUtils::MM_Unix; Config->import } +} ==== //depot/macperl/lib/ExtUtils/t/problems.t#2 (text) ==== Index: perl/lib/ExtUtils/t/problems.t --- perl/lib/ExtUtils/t/problems.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/problems.t Sat Apr 27 16:00:05 2002 @@ -9,7 +9,7 @@ unshift @INC, 't/lib'; } } -$ENV{PERL_CORE} ? chdir '../lib/ExtUtils/t' : chdir 't'; +chdir 't'; use strict; use Test::More tests => 3; @@ -24,16 +24,16 @@ # Make sure when Makefile.PL's break, they issue a warning. # Also make sure Makefile.PL's in subdirs still have '.' in @INC. -my $stdout; -$stdout = tie *STDOUT, 'TieOut' or die; { + my $stdout = tie *STDOUT, 'TieOut' or die; + my $warning = ''; local $SIG{__WARN__} = sub { $warning = join '', @_ }; - $MM->eval_in_subdirs; + eval { $MM->eval_in_subdirs; }; is( $stdout->read, qq{\@INC has .\n}, 'cwd in @INC' ); - like( $warning, - qr{^WARNING from evaluation of .*subdir.*Makefile.PL: YYYAaaaakkk}, + like( $@, + qr{^ERROR from evaluation of .*subdir.*Makefile.PL: YYYAaaaakkk}, 'Makefile.PL death in subdir warns' ); untie *STDOUT; ==== //depot/macperl/lib/Test/Builder.pm#2 (text) ==== Index: perl/lib/Test/Builder.pm --- perl/lib/Test/Builder.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Builder.pm Sat Apr 27 16:00:05 2002 @@ -8,7 +8,7 @@ use strict; use vars qw($VERSION $CLASS); -$VERSION = '0.12'; +$VERSION = '0.14'; $CLASS = __PACKAGE__; my $IsVMS = $^O eq 'VMS'; @@ -55,9 +55,6 @@ =head1 DESCRIPTION -I<THIS IS ALPHA GRADE SOFTWARE> Meaning the underlying code is well -tested, yet the interface is subject to change. - Test::Simple and Test::More have proven to be popular testing modules, but they're not always flexible enough. Test::Builder provides the a building block upon which to write your own test libraries I<which can @@ -152,6 +149,12 @@ die "You said to run 0 tests! You've got to run something.\n"; } } + else { + require Carp; + my @args = grep { defined } ($cmd, $arg); + Carp::croak("plan() doesn't understand @args"); + } + } =item B<expected_tests> @@ -239,7 +242,8 @@ my($self, $test, $name) = @_; unless( $Have_Plan ) { - die "You tried to run a test without a plan! Gotta have a plan.\n"; + require Carp; + Carp::croak("You tried to run a test without a plan! Gotta have a plan."); } $Curr_Test++; @@ -354,7 +358,7 @@ } } - $self->diag(sprintf <<DIAGNOSTIC, $got, $expect); + return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect); got: %s expected: %s DIAGNOSTIC @@ -443,25 +447,57 @@ $self->_regex_ok($this, $regex, '!~', $name); } -sub _regex_ok { - my($self, $this, $regex, $cmp, $name) = @_; +=item B<maybe_regex> + + $Test->maybe_regex(qr/$regex/); + $Test->maybe_regex('/$regex/'); + +Convenience method for building testing functions that take regular +expressions as arguments, but need to work before perl 5.005. + +Takes a quoted regular expression produced by qr//, or a string +representing a regular expression. + +Returns a Perl value which may be used instead of the corresponding +regular expression, or undef if it's argument is not recognised. + +For example, a version of like(), sans the useful diagnostic messages, +could be written as: + + sub laconic_like { + my ($self, $this, $regex, $name) = @_; + my $usable_regex = $self->maybe_regex($regex); + die "expecting regex, found '$regex'\n" + unless $usable_regex; + $self->ok($this =~ m/$usable_regex/, $name); + } + +=cut - local $Level = $Level + 1; - my $ok = 0; - my $usable_regex; +sub maybe_regex { + my ($self, $regex) = @_; + my $usable_regex = undef; if( ref $regex eq 'Regexp' ) { $usable_regex = $regex; } # Check if it looks like '/foo/' elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) { - $usable_regex = "(?$opts)$re"; - } - else { + $usable_regex = length $opts ? "(?$opts)$re" : $re; + }; + return($usable_regex) +}; + +sub _regex_ok { + my($self, $this, $regex, $cmp, $name) = @_; + + local $Level = $Level + 1; + + my $ok = 0; + my $usable_regex = $self->maybe_regex($regex); + unless (defined $usable_regex) { $ok = $self->ok( 0, $name ); - $self->diag(" '$regex' doesn't look much like a regex to me."); - return $ok; } @@ -524,7 +560,7 @@ $got = defined $got ? "'$got'" : 'undef'; $expect = defined $expect ? "'$expect'" : 'undef'; - $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect); + return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect); %s %s %s @@ -564,7 +600,8 @@ $why ||= ''; unless( $Have_Plan ) { - die "You tried to run tests without a plan! Gotta have a plan.\n"; + require Carp; + Carp::croak("You tried to run tests without a plan! Gotta have a plan."); } $Curr_Test++; @@ -598,7 +635,8 @@ $why ||= ''; unless( $Have_Plan ) { - die "You tried to run tests without a plan! Gotta have a plan.\n"; + require Carp; + Carp::croak("You tried to run tests without a plan! Gotta have a plan."); } $Curr_Test++; @@ -607,7 +645,7 @@ my $out = "not ok"; $out .= " $Curr_Test" if $self->use_numbers; - $out .= " # TODO $why\n"; + $out .= " # TODO & SKIP $why\n"; $Test->_print($out); @@ -765,6 +803,14 @@ We encourage using this rather than calling print directly. +Returns false. Why? Because diag() is often used in conjunction with +a failing test (C<ok() || diag()>) it "passes through" the failure. + + return ok(...) || diag(...); + +=for blame transfer +Mark Fowler <[email protected]> + =cut sub diag { @@ -776,6 +822,7 @@ # Escape each line with a #. foreach (@msgs) { + $_ = 'undef' unless defined; s/^/# /gms; } @@ -785,6 +832,8 @@ my $fh = $self->todo ? $self->todo_output : $self->failure_output; local($\, $", $,) = (undef, ' ', ''); print $fh @msgs; + + return 0; } =begin _private @@ -808,6 +857,15 @@ local($\, $", $,) = (undef, ' ', ''); my $fh = $self->output; + + # Escape each line after the first with a # so we don't + # confuse Test::Harness. + foreach (@msgs) { + s/\n(.)/\n# $1/sg; + } + + push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/; + print $fh @msgs; } @@ -933,9 +991,16 @@ my($self, $num) = @_; if( defined $num ) { + + unless( $Have_Plan ) { + require Carp; + Carp::croak("Can't change the current test number without a plan!"); + } + $Curr_Test = $num; if( $num > @Test_Results ) { - for ($#Test_Results..$num-1) { + my $start = @Test_Results ? $#Test_Results : 0; + for ($start..$num-1) { $Test_Results[$_] = 1; } } ==== //depot/macperl/lib/Test/Harness.pm#2 (text) ==== Index: perl/lib/Test/Harness.pm --- perl/lib/Test/Harness.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Harness.pm Sat Apr 27 16:00:05 2002 @@ -1,5 +1,5 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $Id: Harness.pm,v 1.14.2.13 2002/01/07 22:34:32 schwern Exp $ +# $Id: Harness.pm,v 1.14.2.18 2002/04/25 05:04:35 schwern Exp $ package Test::Harness; @@ -22,7 +22,7 @@ $Have_Devel_Corestack = 0; -$VERSION = '2.01'; +$VERSION = '2.03'; $ENV{HARNESS_ACTIVE} = 1; @@ -36,16 +36,13 @@ my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR}; -my $Running_In_Perl_Tree = 0; -++$Running_In_Perl_Tree if -d "../t" and -f "../sv.c"; - my $Strap = Test::Harness::Straps->new; @ISA = ('Exporter'); @EXPORT = qw(&runtests); @EXPORT_OK = qw($verbose $switches); -$Verbose = 0; +$Verbose = $ENV{HARNESS_VERBOSE} || 0; $Switches = "-w"; $Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80; $Columns--; # Some shells have trouble with a full line of text. @@ -90,15 +87,16 @@ =item B<'1..M'> -This header tells how many tests there will be. It should be the -first line output by your test program (but it is okay if it is preceded -by comments). +This header tells how many tests there will be. For example, C<1..10> +means you plan on running 10 tests. This is a safeguard in case your +test dies quietly in the middle of its run. + +It should be the first non-comment line output by your test program. -In certain instanced, you may not know how many tests you will -ultimately be running. In this case, it is permitted (but not -encouraged) for the 1..M header to appear as the B<last> line output -by your test (again, it can be followed by further comments). But we -strongly encourage you to put it first. +In certain instances, you may not know how many tests you will +ultimately be running. In this case, it is permitted for the 1..M +header to appear as the B<last> line output by your test (again, it +can be followed by further comments). Under B<no> circumstances should 1..M appear in the middle of your output or more than once. @@ -152,7 +150,7 @@ counted as a skipped test. If the whole testscript succeeds, the count of skipped tests is included in the generated output. C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason -for skipping. +for skipping. ok 23 # skip Insufficient flogiston pressure. @@ -457,6 +455,8 @@ my $fh = _open_test($tfile); + $tot{files}++; + # state of the current test. my %test = ( ok => 0, @@ -602,11 +602,7 @@ chomp($te); $te =~ s/\.\w+$/./; - if ($^O eq 'VMS') { - $te =~ s/^.*\.t\./\[.t./s; - } - $te =~ s,\\,/,g if $^O eq 'MSWin32'; - $te =~ s,^\.\./,/, if $Running_In_Perl_Tree; + if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; } my $blank = (' ' x 77); my $leader = "$te" . '.' x ($width - length($te)); my $ml = ""; @@ -632,15 +628,12 @@ foreach (@_) { my $suf = /\.(\w+)$/ ? $1 : ''; my $len = length; - $len -= 2 if $Running_In_Perl_Tree and m{^\.\.[/\\]}; my $suflen = length $suf; $maxlen = $len if $len > $maxlen; $maxsuflen = $suflen if $suflen > $maxsuflen; } - # we want three dots between the test name and the "ok" for - # typical lengths, and just two dots if longer than 30 characters - $maxlen -= $maxsuflen; - return $maxlen + ($maxlen >= 30 ? 2 : 3); + # + 3 : we want three dots between the test name and the "ok" + return $maxlen + 3 - $maxsuflen; } @@ -703,7 +696,6 @@ $tot->{max} += $test->{max}; - $tot->{files}++; } else { $is_header = 0; @@ -718,11 +710,13 @@ my $s = _set_switches($test); + my $perl = -x $^X ? $^X : $Config{perlpath}; + # XXX This is WAY too core specific! my $cmd = ($ENV{'HARNESS_COMPILE_TEST'}) ? "./perl -I../lib ../utils/perlcc $test " . "-r 2>> ./compilelog |" - : "$^X $s $test|"; + : "$perl $s $test|"; $cmd = "MCR $cmd" if $^O eq 'VMS'; if( open(PERL, $cmd) ) { @@ -756,17 +750,14 @@ } $test->{todo}{$this} = 1 if $istodo; + if( $test->{todo}{$this} ) { + $tot->{todo}++; + $test->{bonus}++, $tot->{bonus}++ unless $not; + } - $tot->{todo}++ if $test->{todo}{$this}; - - if( $not ) { + if( $not && !$test->{todo}{$this} ) { print "$test->{ml}NOK $this" if $test->{ml}; - if (!$test->{todo}{$this}) { - push @{$test->{failed}}, $this; - } else { - $test->{ok}++; - $tot->{ok}++; - } + push @{$test->{failed}}, $this; } else { print "$test->{ml}ok $this/$test->{max}" if $test->{ml}; @@ -783,13 +774,18 @@ } elsif (defined $reason) { $test->{skip_reason} = $reason; } - - $test->{bonus}++, $tot->{bonus}++ if $test->{todo}{$this}; } if ($this > $test->{'next'}) { print "Test output counter mismatch [test $this]\n"; - push @{$test->{failed}}, $test->{'next'}..$this-1; + + # Guard against resource starvation. + if( $this > 100000 ) { + print "Enourmous test number seen [test $this]\n"; + } + else { + push @{$test->{failed}}, $test->{'next'}..$this-1; + } } elsif ($this < $test->{'next'}) { #we have seen more "ok" lines than the number suggests @@ -971,13 +967,17 @@ sub corestatus { my($st) = @_; - eval {require 'wait.ph'}; - my $ret = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200; + eval { + local $^W = 0; # *.ph files are often *very* noisy + require 'wait.ph' + }; + return if $@; + my $did_core = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200; eval { require Devel::CoreStack; $Have_Devel_Corestack++ } unless $tried_devel_corestack++; - $ret; + return $did_core; } } @@ -1079,17 +1079,18 @@ =over 4 -=item C<HARNESS_IGNORE_EXITCODE> +=item C<HARNESS_ACTIVE> -Makes harness ignore the exit status of child processes when defined. +Harness sets this before executing the individual tests. This allows +the tests to determine if they are being executed through the harness +or by any other means. -=item C<HARNESS_NOTTY> +=item C<HARNESS_COLUMNS> -When set to a true value, forces it to behave as though STDOUT were -not a console. You may need to set this if you don't want harness to -output more frequent progress messages using carriage returns. Some -consoles may not handle carriage returns properly (which results in a -somewhat messy output). +This value will be used for the width of the terminal. If it is not +set then it will default to C<COLUMNS>. If this is not set, it will +default to 80. Note that users of Bourne-sh based shells will need to +C<export COLUMNS> for this module to use that variable. =item C<HARNESS_COMPILE_TEST> @@ -1110,24 +1111,28 @@ the moment runtests() was called. Putting absolute path into C<HARNESS_FILELEAK_IN_DIR> may give more predictable results. +=item C<HARNESS_IGNORE_EXITCODE> + +Makes harness ignore the exit status of child processes when defined. + +=item C<HARNESS_NOTTY> + +When set to a true value, forces it to behave as though STDOUT were +not a console. You may need to set this if you don't want harness to +output more frequent progress messages using carriage returns. Some +consoles may not handle carriage returns properly (which results in a +somewhat messy output). + =item C<HARNESS_PERL_SWITCHES> Its value will be prepended to the switches used to invoke perl on each test. For example, setting C<HARNESS_PERL_SWITCHES> to C<-W> will run all tests with all warnings enabled. -=item C<HARNESS_COLUMNS> +=item C<HARNESS_VERBOSE> -This value will be used for the width of the terminal. If it is not -set then it will default to C<COLUMNS>. If this is not set, it will -default to 80. Note that users of Bourne-sh based shells will need to -C<export COLUMNS> for this module to use that variable. - -=item C<HARNESS_ACTIVE> - -Harness sets this before executing the individual tests. This allows -the tests to determine if they are being executed through the harness -or by any other means. +If true, Test::Harness will output the verbose results of running +its tests. Setting $Test::Harness::verbose will override this. =back @@ -1167,7 +1172,7 @@ Provide a way of running tests quietly (ie. no printing) for automated validation of tests. This will probably take the form of a version of runtests() which rather than printing its output returns raw data -on the state of the tests. +on the state of the tests. (Partially done in Test::Harness::Straps) Fix HARNESS_COMPILE_TEST without breaking its core usage. @@ -1175,8 +1180,6 @@ Rework the test summary so long test names are not truncated as badly. -Merge back into bleadperl. - Deal with VMS's "not \nok 4\n" mistake. Add option for coverage analysis. @@ -1189,13 +1192,7 @@ =head1 BUGS -Test::Harness uses $^X to determine the perl binary to run the tests -with. Test scripts running via the shebang (C<#!>) line may not be -portable because $^X is not consistent for shebang scripts across -platforms. This is no problem when Test::Harness is run with an -absolute path to the perl binary or when $^X can be found in the path. - -HARNESS_COMPILE_TEST currently assumes it is run from the Perl source +HARNESS_COMPILE_TEST currently assumes it's run from the Perl source directory. =cut ==== //depot/macperl/lib/Test/Harness/Changes#2 (text) ==== Index: perl/lib/Test/Harness/Changes --- perl/lib/Test/Harness/Changes.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Harness/Changes Sat Apr 27 16:00:05 2002 @@ -1,5 +1,24 @@ Revision history for Perl extension Test::Harness +2.03 Thu Apr 25 01:01:34 EDT 2002 + * $^X fix made safer. + - Noise from loading wait.ph to analyze core files supressed + - MJD found a situation where a test could run Test::Harness + out of memory. Protecting against that specific case. + - Made the 1..M docs a bit clearer. + - Fixed TODO tests so Test::Harness does not display a NOK for + them. + - Test::Harness::Straps->analyze_file() docs were not clear as to + its effects + +2.02 Thu Mar 14 18:06:04 EST 2002 + * Ken Williams fixed the long standing $^X bug. + * Added HARNESS_VERBOSE + * Fixed a bug where Test::Harness::Straps was considering a test that + is ok but died as passing. + - Added the exit and wait codes of the test to the + analyze_file() results. + 2.01 Thu Dec 27 18:54:36 EST 2001 * Added 'passing' to the results to tell you if the test passed * Added Test::Harness::Straps example (examples/mini_harness.plx) ==== //depot/macperl/lib/Test/Harness/Straps.pm#2 (text) ==== Index: perl/lib/Test/Harness/Straps.pm --- perl/lib/Test/Harness/Straps.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Harness/Straps.pm Sat Apr 27 16:00:05 2002 @@ -1,12 +1,12 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $Id: Straps.pm,v 1.1.2.17 2002/01/07 22:34:33 schwern Exp $ +# $Id: Straps.pm,v 1.1.2.20 2002/04/25 05:04:35 schwern Exp $ package Test::Harness::Straps; use strict; use vars qw($VERSION); use Config; -$VERSION = '0.08'; +$VERSION = '0.09'; use Test::Harness::Assert; use Test::Harness::Iterator; @@ -147,13 +147,14 @@ last if $self->{saw_bailout}; } + $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all}; + my $passed = $totals{skip_all} || - ($totals{max} == $totals{seen} && + ($totals{max} && $totals{seen} && + $totals{max} == $totals{seen} && $totals{max} == $totals{ok}); $totals{passing} = $passed ? 1 : 0; - $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all}; - $self->{totals}{$name} = \%totals; return %totals; } @@ -205,8 +206,14 @@ $totals->{ok}++ if $pass; - $totals->{details}[$result{number} - 1] = + if( $result{number} > 100000 ) { + warn "Enourmous test number seen [test $result{number}]\n"; + warn "Can't detailize, too big.\n"; + } + else { + $totals->{details}[$result{number} - 1] = {$self->_detailize($pass, \%result)}; + } # XXX handle counter mismatch } @@ -242,8 +249,8 @@ my %results = $strap->analyze_file($test_file); -Like C<analyze>, but it reads from the given $test_file. It will also -use that name for the total report. +Like C<analyze>, but it runs the given $test_file and parses it's +results. It will also use that name for the total report. =cut @@ -264,7 +271,10 @@ } my %results = $self->analyze_fh($file, \*FILE); - close FILE; + my $exit = close FILE; + $results{'wait'} = $?; + $results{'exit'} = $? / 256; + $results{passing} = 0 unless $? == 0; $self->_restore_PERL5LIB(); @@ -558,6 +568,9 @@ passing true if the whole test is considered a pass (or skipped), false if its a failure + exit the exit code of the test run, if from a file + wait the wait code of the test run, if from a file + max total tests which should have been run seen total tests actually seen skip_all if the whole test was skipped, this will ==== //depot/macperl/lib/Test/Harness/t/strap-analyze.t#2 (text) ==== Index: perl/lib/Test/Harness/t/strap-analyze.t --- perl/lib/Test/Harness/t/strap-analyze.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Harness/t/strap-analyze.t Sat Apr 27 16:00:05 2002 @@ -14,7 +14,7 @@ use strict; -use Test::More tests => 27; +use Test::More tests => 35; use_ok('Test::Harness::Straps'); @@ -24,6 +24,9 @@ combined => { passing => 0, + 'exit' => 0, + 'wait' => 0, + max => 10, seen => 10, @@ -59,6 +62,9 @@ descriptive => { passing => 1, + 'wait' => 0, + 'exit' => 0, + max => 5, seen => 5, @@ -88,6 +94,9 @@ duplicates => { passing => 0, + 'exit' => 0, + 'wait' => 0, + max => 10, seen => 11, @@ -103,6 +112,9 @@ head_end => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 4, seen => 4, @@ -118,6 +130,9 @@ lone_not_bug => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 4, seen => 4, @@ -133,6 +148,9 @@ head_fail => { passing => 0, + 'exit' => 0, + 'wait' => 0, + max => 4, seen => 4, @@ -150,6 +168,9 @@ simple => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 5, seen => 5, @@ -165,6 +186,9 @@ simple_fail => { passing => 0, + 'exit' => 0, + 'wait' => 0, + max => 5, seen => 5, @@ -184,6 +208,9 @@ 'skip' => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 5, seen => 5, @@ -204,6 +231,9 @@ skip_all => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 0, seen => 0, skip_all => 'rope', @@ -219,6 +249,9 @@ 'todo' => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 5, seen => 5, @@ -238,6 +271,9 @@ taint => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 1, seen => 1, @@ -254,6 +290,9 @@ vms_nit => { passing => 0, + 'exit' => 0, + 'wait' => 0, + max => 2, seen => 2, @@ -265,17 +304,92 @@ details => [ { 'ok' => 0, actual_ok => 0 }, { 'ok' => 1, actual_ok => 1 }, ], - }, + }, + 'die' => { + passing => 0, + + 'exit' => 1, + 'wait' => 256, + + max => 0, + seen => 0, + + 'ok' => 0, + 'todo' => 0, + 'skip' => 0, + bonus => 0, + + details => [] + }, + + die_head_end => { + passing => 0, + + 'exit' => 1, + 'wait' => 256, + + max => 0, + seen => 4, + + 'ok' => 4, + 'todo' => 0, + 'skip' => 0, + bonus => 0, + + details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 + ], + }, + + die_last_minute => { + passing => 0, + + 'exit' => 1, + 'wait' => 256, + + max => 4, + seen => 4, + + 'ok' => 4, + 'todo' => 0, + 'skip' => 0, + bonus => 0, + + details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 + ], + }, + + bignum => { + passing => 0, + + 'exit' => 0, + 'wait' => 0, + + max => 2, + seen => 4, + + 'ok' => 4, + 'todo' => 0, + 'skip' => 0, + bonus => 0, + + details => [ { 'ok' => 1, actual_ok => 1 }, + { 'ok' => 1, actual_ok => 1 }, + ] + }, ); +$SIG{__WARN__} = sub { + warn @_ unless $_[0] =~ /^Enourmous test number/ || + $_[0] =~ /^Can't detailize/ +}; while( my($test, $expect) = each %samples ) { my $strap = Test::Harness::Straps->new; my %results = $strap->analyze_file("$SAMPLE_TESTS/$test"); - is_deeply($expect->{details}, $results{details}, "$test details" ); + is_deeply($results{details}, $expect->{details}, "$test details" ); delete $expect->{details}; delete $results{details}; - is_deeply($expect, \%results, " the rest" ); + is_deeply(\%results, $expect, " the rest" ); } ==== //depot/macperl/lib/Test/Harness/t/test-harness.t#2 (text) ==== Index: perl/lib/Test/Harness/t/test-harness.t --- perl/lib/Test/Harness/t/test-harness.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Harness/t/test-harness.t Sat Apr 27 16:00:05 2002 @@ -1,9 +1,12 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = '../lib'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; } } @@ -30,41 +33,14 @@ package main; -# Utility testing functions. -my $test_num = 1; -sub ok ($;$) { - my($test, $name) = @_; - my $okstring = ''; - $okstring = "not " unless $test; - $okstring .= "ok $test_num"; - $okstring .= " - $name" if defined $name; - print "$okstring\n"; - $test_num++; -} - -sub eqhash { - my($a1, $a2) = @_; - return 0 unless keys %$a1 == keys %$a2; +use Test::More; - my $ok = 1; - foreach my $k (keys %$a1) { - $ok = $a1->{$k} eq $a2->{$k}; - last unless $ok; - } - - return $ok; -} - use vars qw($Total_tests %samples); -my $loaded; -BEGIN { $| = 1; $^W = 1; } -END {print "not ok $test_num\n" unless $loaded;} -print "1..$Total_tests\n"; +plan tests => $Total_tests; use Test::Harness; -$loaded = 1; -ok(1, 'compile'); -######################### End of black magic. +use_ok('Test::Harness'); + BEGIN { %samples = ( @@ -78,7 +54,7 @@ good => 1, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { }, @@ -94,7 +70,7 @@ good => 0, tests => 1, sub_skipped => 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { @@ -112,7 +88,7 @@ good => 1, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { }, @@ -128,7 +104,7 @@ good => 0, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { @@ -136,7 +112,7 @@ }, all_ok => 0, }, - todo => { + 'todo' => { total => { bonus => 1, max => 5, @@ -146,7 +122,7 @@ good => 1, tests => 1, sub_skipped=> 0, - todo => 2, + 'todo' => 2, skipped => 0, }, failed => { }, @@ -162,13 +138,13 @@ good => 1, tests => 1, sub_skipped => 0, - todo => 2, + 'todo' => 2, skipped => 0, }, failed => { }, all_ok => 1, }, - skip => { + 'skip' => { total => { bonus => 0, max => 5, @@ -178,7 +154,7 @@ good => 1, tests => 1, sub_skipped=> 1, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { }, @@ -195,7 +171,7 @@ good => 0, tests => 1, sub_skipped=> 1, - todo => 2, + 'todo' => 2, skipped => 0 }, failed => { @@ -213,7 +189,7 @@ good => 0, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { @@ -231,7 +207,7 @@ good => 1, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { }, @@ -247,7 +223,7 @@ good => 0, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { @@ -265,7 +241,7 @@ good => 1, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 1, }, failed => { }, @@ -281,7 +257,7 @@ good => 1, tests => 1, sub_skipped=> 0, - todo => 4, + 'todo' => 4, skipped => 0, }, failed => { }, @@ -297,15 +273,102 @@ good => 1, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { }, all_ok => 1, }, + + 'die' => { + total => { + bonus => 0, + max => 0, + 'ok' => 0, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + 'todo' => 0, + skipped => 0, + }, + failed => { + estat => 1, + wstat => 256, + max => '??', + failed => '??', + canon => '??', + }, + all_ok => 0, + }, + + die_head_end => { + total => { + bonus => 0, + max => 0, + 'ok' => 4, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + 'todo' => 0, + skipped => 0, + }, + failed => { + estat => 1, + wstat => 256, + max => '??', + failed => '??', + canon => '??', + }, + all_ok => 0, + }, + + die_last_minute => { + total => { + bonus => 0, + max => 4, + 'ok' => 4, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + 'todo' => 0, + skipped => 0, + }, + failed => { + estat => 1, + wstat => 256, + max => 4, + failed => 0, + canon => '??', + }, + all_ok => 0, + }, + bignum => { + total => { + bonus => 0, + max => 2, + 'ok' => 4, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + 'todo' => 0, + skipped => 0, + }, + failed => { + canon => '??', + }, + all_ok => 0, + }, ); - $Total_tests = (keys(%samples) * 4); + $Total_tests = (keys(%samples) * 4) + 1; } tie *NULL, 'My::Dev::Null' or die $!; @@ -321,21 +384,21 @@ select STDOUT; unless( $@ ) { - ok( Test::Harness::_all_ok($totals) == $expect->{all_ok}, + is( Test::Harness::_all_ok($totals), $expect->{all_ok}, "$test - all ok" ); ok( defined $expect->{total}, "$test - has total" ); - ok( eqhash( $expect->{total}, - {map { $_=>$totals->{$_} } keys %{$expect->{total}}} ), + is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}}, + $expect->{total}, "$test - totals" ); - ok( eqhash( $expect->{failed}, - {map { $_=>$failed->{"$SAMPLE_TESTS/$test"}{$_} } - keys %{$expect->{failed}}} ), + is_deeply( {map { $_=>$failed->{"$SAMPLE_TESTS/$test"}{$_} } + keys %{$expect->{failed}}}, + $expect->{failed}, "$test - failed" ); } else { # special case for bailout - ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i), - $test ); - ok( 1, 'skipping for bailout' ); - ok( 1, 'skipping for bailout' ); + is( $test, 'bailout' ); + like( $@, '/Further testing stopped: GERONI/i', $test ); + pass( 'skipping for bailout' ); + pass( 'skipping for bailout' ); } } ==== //depot/macperl/lib/Test/More.pm#2 (text) ==== Index: perl/lib/Test/More.pm --- perl/lib/Test/More.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/More.pm Sat Apr 27 16:00:05 2002 @@ -18,7 +18,7 @@ require Exporter; use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO); -$VERSION = '0.42'; +$VERSION = '0.44'; @ISA = qw(Exporter); @EXPORT = qw(ok use_ok require_ok is isnt like unlike is_deeply @@ -176,16 +176,18 @@ my $caller = caller; $Test->exported_to($caller); - $Test->plan(@plan); my @imports = (); foreach my $idx (0..$#plan) { if( $plan[$idx] eq 'import' ) { - @imports = @{$plan[$idx+1]}; + my($tag, $imports) = splice @plan, $idx, 2; + @imports = @$imports; last; } } + $Test->plan(@plan); + __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports); } @@ -455,7 +457,7 @@ sub can_ok ($@) { my($proto, @methods) = @_; - my $class= ref $proto || $proto; + my $class = ref $proto || $proto; unless( @methods ) { my $ok = $Test->ok( 0, "$class->can(...)" ); @@ -465,10 +467,9 @@ my @nok = (); foreach my $method (@methods) { - my $test = "'$class'->can('$method')"; local($!, $@); # don't interfere with caller's $@ # eval sometimes resets $! - eval $test || push @nok, $method; + eval { $proto->can($method) } || push @nok, $method; } my $name; @@ -645,7 +646,7 @@ BEGIN { use_ok($module, @imports); } These simply use the given $module and test to make sure the load -happened ok. It is recommended that you run use_ok() inside a BEGIN +happened ok. It's recommended that you run use_ok() inside a BEGIN block so its functions are exported at compile-time and prototypes are properly honored. @@ -670,7 +671,7 @@ eval <<USE; package $pack; require $module; -$module->import(\@imports); +'$module'->import(\@imports); USE my $ok = $Test->ok( !$@, "use $module;" ); @@ -764,12 +765,12 @@ If pigs cannot fly, the whole block of tests will be skipped completely. Test::More will output special ok's which Test::Harness -interprets as skipped tests. It is important to include $how_many tests +interprets as skipped tests. It's important to include $how_many tests are in the block so the total number of tests comes out right (unless you're using C<no_plan>, in which case you can leave $how_many off if you like). -It is perfectly safe to nest SKIP blocks. +It's perfectly safe to nest SKIP blocks. Tests are skipped when you B<never> expect them to B<ever> pass. Like an optional module is not installed or the operating system doesn't @@ -849,7 +850,7 @@ ...normal testing code... } -With todo tests, it is best to have the tests actually run. That way +With todo tests, it's best to have the tests actually run. That way you'll know when they start passing. Sometimes this isn't possible. Often a failing test will cause the whole program to die or hang, even inside an C<eval BLOCK> with and using C<alarm>. In these extreme @@ -1181,7 +1182,7 @@ =head1 SEE ALSO L<Test::Simple> if all this confuses you and you just want to write -some tests. You can upgrade to Test::More later (it is forward +some tests. You can upgrade to Test::More later (it's forward compatible). L<Test::Differences> for more ways to test complex data structures. ==== //depot/macperl/lib/Test/Simple.pm#2 (text) ==== Index: perl/lib/Test/Simple.pm --- perl/lib/Test/Simple.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple.pm Sat Apr 27 16:00:05 2002 @@ -4,7 +4,7 @@ use strict 'vars'; use vars qw($VERSION); -$VERSION = '0.42'; +$VERSION = '0.44'; use Test::Builder; @@ -61,8 +61,8 @@ ok( $foo eq $bar, $name ); ok( $foo eq $bar ); -ok() is given an expression (in this case C<$foo eq $bar>). If it is -true, the test passed. If it is false, it didn't. That's about it. +ok() is given an expression (in this case C<$foo eq $bar>). If it's +true, the test passed. If it's false, it didn't. That's about it. ok() prints out either "ok" or "not ok" along with a test number (it keeps track of that for you). @@ -73,7 +73,7 @@ If you provide a $name, that will be printed along with the "ok/not ok" to make it easier to find your test when if fails (just search for the name). It also makes it easier for the next guy to understand -what your test is for. It is highly recommended you use test names. +what your test is for. It's highly recommended you use test names. All tests are run in scalar context. So this: @@ -112,7 +112,7 @@ If you fail more than 254 tests, it will be reported as 254. This module is by no means trying to be a complete testing system. -It's just to get you started. Once you're off the ground it is +It's just to get you started. Once you're off the ground its recommended you look at L<Test::More>. ==== //depot/macperl/lib/Test/Simple/Changes#2 (text) ==== Index: perl/lib/Test/Simple/Changes --- perl/lib/Test/Simple/Changes.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/Changes Sat Apr 27 16:00:05 2002 @@ -1,5 +1,22 @@ Revision history for Perl extension Test::Simple +0.44 Thu Apr 25 00:27:27 EDT 2002 + - names containing newlines no longer produce confusing output + (from chromatic) + - chromatic provided a fix so can_ok() honors can() overrides. + - Nick Ing-Simmons suggested todo_skip() be a bit clearer about + the skipping part. + - Making plan() vomit if it gets something it doesn't understand. + - Tatsuhiko Miyagawa fixed use_ok() with pragmata on older perls. + - quieting diag(undef) + +0.43 Thu Apr 11 22:55:23 EDT 2002 + - Adrian Howard added TB->maybe_regex() + - Adding Mark Fowler's suggestion to make diag() return + false. + - TB->current_test() still not working when no tests were run via + TB itself. Fixed by Dave Rolsky. + 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?) ==== //depot/macperl/lib/Test/Simple/t/Builder.t#2 (text) ==== Index: perl/lib/Test/Simple/t/Builder.t --- perl/lib/Test/Simple/t/Builder.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/t/Builder.t Sat Apr 27 16:00:05 2002 @@ -10,7 +10,7 @@ use Test::Builder; my $Test = Test::Builder->new; -$Test->plan( tests => 7 ); +$Test->plan( tests => 9 ); my $default_lvl = $Test->level; $Test->level(0); @@ -28,3 +28,9 @@ print "ok $test_num - current_test() set\n"; $Test->ok( 1, 'counter still good' ); + +eval { $Test->plan(7); }; +$Test->like( $@, q{/^plan\(\) doesn't understand 7/}, 'bad plan()' ); + +eval { $Test->plan(wibble => 7); }; +$Test->like( $@, q{/^plan\(\) doesn't understand wibble 7/}, 'bad plan()' ); ==== //depot/macperl/lib/Test/Simple/t/More.t#2 (text) ==== Index: perl/lib/Test/Simple/t/More.t --- perl/lib/Test/Simple/t/More.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/t/More.t Sat Apr 27 16:00:05 2002 @@ -7,7 +7,7 @@ } } -use Test::More tests => 37; +use Test::More tests => 41; # Make sure we don't mess with $@ or $!. Test at bottom. my $Err = "this should not be touched"; @@ -38,11 +38,28 @@ can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip can_ok pass fail eq_array eq_hash eq_set)); + isa_ok(bless([], "Foo"), "Foo"); isa_ok([], 'ARRAY'); isa_ok(\42, 'SCALAR'); +# can_ok() & isa_ok should call can() & isa() on the given object, not +# just class, in case of custom can() +{ + local *Foo::can; + local *Foo::isa; + *Foo::can = sub { $_[0]->[0] }; + *Foo::isa = sub { $_[0]->[0] }; + my $foo = bless([0], 'Foo'); + ok( ! $foo->can('bar') ); + ok( ! $foo->isa('bar') ); + $foo->[0] = 1; + can_ok( $foo, 'blah'); + isa_ok( $foo, 'blah'); +} + + pass('pass() passed'); ok( eq_array([qw(this that whatever)], [qw(this that whatever)]), ==== //depot/macperl/lib/Test/Simple/t/diag.t#2 (text) ==== Index: perl/lib/Test/Simple/t/diag.t --- perl/lib/Test/Simple/t/diag.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/t/diag.t Sat Apr 27 16:00:05 2002 @@ -9,7 +9,7 @@ use strict; -use Test::More tests => 5; +use Test::More tests => 7; my $Test = Test::More->builder; @@ -17,8 +17,10 @@ my $output; tie *FAKEOUT, 'FakeOut', \$output; -# force diagnostic output to a filehandle, glad I added this to Test::Builder :) +# force diagnostic output to a filehandle, glad I added this to +# Test::Builder :) my @lines; +my $ret; { local $TODO = 1; $Test->todo_output(\*FAKEOUT); @@ -28,7 +30,7 @@ push @lines, $output; $output = ''; - diag("multiple\n", "lines"); + $ret = diag("multiple\n", "lines"); push @lines, split(/\n/, $output); } @@ -36,14 +38,16 @@ like( $lines[0], '/^#\s+/', ' should add comment mark to all lines' ); is( $lines[0], "# a single line\n", ' should send exact message' ); is( $output, "# multiple\n# lines\n", ' should append multi messages'); +ok( !$ret, 'diag returns false' ); { - local $TODO = 1; + $Test->failure_output(\*FAKEOUT); $output = ''; - diag("# foo"); + $ret = diag("# foo"); } +$Test->failure_output(\*STDERR); is( $output, "# # foo\n", "diag() adds a # even if there's one already" ); - +ok( !$ret, 'diag returns false' ); package FakeOut; ==== //depot/macperl/lib/Test/Simple/t/exit.t#2 (text) ==== Index: perl/lib/Test/Simple/t/exit.t --- perl/lib/Test/Simple/t/exit.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/t/exit.t Sat Apr 27 16:00:05 2002 @@ -54,6 +54,14 @@ print "1..".keys(%Tests)."\n"; +eval { require POSIX; &POSIX::WEXITSTATUS(0) }; +if( $@ ) { + *exitstatus = sub { $_[0] >> 8 }; +} +else { + *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) } +} + chdir 't'; my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests)); while( my($test_name, $exit_codes) = each %Tests ) { @@ -72,7 +80,7 @@ my $file = File::Spec->catfile($lib, $test_name); my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file}); - my $actual_exit = $wait_stat >> 8; + my $actual_exit = exitstatus($wait_stat); My::Test::ok( $actual_exit == $exit_code, "$test_name exited with $actual_exit (expected $exit_code)"); ==== //depot/macperl/lib/Test/Simple/t/output.t#2 (text) ==== Index: perl/lib/Test/Simple/t/output.t --- perl/lib/Test/Simple/t/output.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/t/output.t Sat Apr 27 16:00:05 2002 @@ -3,12 +3,15 @@ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = '../lib'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; } } # Can't use Test.pm, that's a 5.005 thing. -print "1..3\n"; +print "1..4\n"; my $test_num = 1; # Utility testing functions. @@ -21,8 +24,11 @@ $ok .= "\n"; print $ok; $test_num++; + + return $test; } +use TieOut; use Test::Builder; my $Test = Test::Builder->new(); @@ -55,3 +61,32 @@ ok($lines[1] =~ /Hello!/); unlink('foo'); + + +# Ensure stray newline in name escaping works. +$out = tie *FAKEOUT, 'TieOut'; +$Test->output(\*FAKEOUT); +$Test->exported_to(__PACKAGE__); +$Test->no_ending(1); +$Test->plan(tests => 5); + +$Test->ok(1, "ok"); +$Test->ok(1, "ok\n"); +$Test->ok(1, "ok, like\nok"); +$Test->skip("wibble\nmoof"); +$Test->todo_skip("todo\nskip\n"); + +my $output = $out->read; +ok( $output eq <<OUTPUT ) || print STDERR $output; +1..5 +ok 1 - ok +ok 2 - ok +# +ok 3 - ok, like +# ok +ok 4 # skip wibble +# moof +not ok 5 # TODO & SKIP todo +# skip +# +OUTPUT ==== //depot/macperl/lib/Test/Simple/t/undef.t#2 (text) ==== Index: perl/lib/Test/Simple/t/undef.t --- perl/lib/Test/Simple/t/undef.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/t/undef.t Sat Apr 27 16:00:05 2002 @@ -1,12 +1,18 @@ +#!/usr/bin/perl -w + BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = '../lib'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; } } use strict; -use Test::More tests => 12; +use Test::More tests => 14; +use TieOut; BEGIN { $^W = 1; } @@ -41,3 +47,14 @@ is( $warnings, '', 'eq_hash() no warnings' ); +my $tb = Test::More->builder; + +use TieOut; +my $caught = tie *CATCH, 'TieOut'; +my $old_fail = $tb->failure_output; +$tb->failure_output(\*CATCH); +diag(undef); +$tb->failure_output($old_fail); + +is( $caught->read, "# undef\n" ); +is( $warnings, '', 'diag(undef) no warnings' ); ==== //depot/macperl/lib/Test/Simple/t/use_ok.t#2 (text) ==== Index: perl/lib/Test/Simple/t/use_ok.t --- perl/lib/Test/Simple/t/use_ok.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/t/use_ok.t Sat Apr 27 16:00:05 2002 @@ -1,3 +1,5 @@ +#!/usr/bin/perl -w + BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @@ -5,7 +7,7 @@ } } -use Test::More tests => 7; +use Test::More tests => 10; # Using Symbol because it's core and exports lots of stuff. { @@ -26,3 +28,11 @@ ::use_ok("Symbol", qw(gensym ungensym)); ::ok( defined &gensym && defined &ungensym, ' multiple args' ); } + +{ + package Foo::four; + my $warn; local $SIG{__WARN__} = sub { $warn .= shift; }; + ::use_ok("constant", qw(foo bar)); + ::ok( defined &foo, 'constant' ); + ::is( $warn, undef, 'no warning'); +} ==== //depot/macperl/lib/overload.t#2 (text) ==== Index: perl/lib/overload.t --- perl/lib/overload.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/overload.t Sat Apr 27 16:00:05 2002 @@ -1066,5 +1066,23 @@ my $utfvar = new utf8_o 200.2.1; test("$utfvar" eq 200.2.1); # 223 +# 224..226 -- more %{} tests. Hangs in 5.6.0, okay in later releases. +# Basically this example implements strong encapsulation: if Hderef::import() +# were to eval the overload code in the caller's namespace, the privatisation +# would be quite transparent. +package Hderef; +use overload '%{}' => sub { (caller(0))[0] eq 'Foo' ? $_[0] : die "zap" }; +package Foo; +@Foo::ISA = 'Hderef'; +sub new { bless {}, shift } +sub xet { @_ == 2 ? $_[0]->{$_[1]} : + @_ == 3 ? ($_[0]->{$_[1]} = $_[2]) : undef } +package main; +my $a = Foo->new; +$a->xet('b', 42); +print $a->xet('b') == 42 ? "ok 224\n" : "not ok 224\n"; +print defined eval { $a->{b} } ? "not ok 225\n" : "ok 225\n"; +print $@ =~ /zap/ ? "ok 226\n" : "not ok 226\n"; + # Last test is: -sub last {223} +sub last {226} ==== //depot/macperl/makedef.pl#3 (text) ==== Index: perl/makedef.pl --- perl/makedef.pl.~1~ Sat Apr 27 16:00:05 2002 +++ perl/makedef.pl Sat Apr 27 16:00:05 2002 @@ -713,7 +713,11 @@ PerlIO_allocate PerlIO_arg_fetch PerlIO_define_layer - PerlIO_modestr + PerlIO_modestr + PerlIO_parse_layers + PerlIO_layer_fetch + PerlIO_list_free + PerlIO_apply_layera PerlIO_pending PerlIO_push PerlIO_sv_dup ==== //depot/macperl/op.c#2 (text) ==== Index: perl/op.c --- perl/op.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/op.c Sat Apr 27 16:00:05 2002 @@ -4241,7 +4241,7 @@ { LOOP *loop; OP *wop; - int padoff = 0; + PADOFFSET padoff = 0; I32 iterflags = 0; if (sv) { ==== //depot/macperl/op.h#2 (text) ==== Index: perl/op.h --- perl/op.h.~1~ Sat Apr 27 16:00:05 2002 +++ perl/op.h Sat Apr 27 16:00:05 2002 @@ -251,7 +251,7 @@ #else REGEXP * op_pmregexp; /* compiled expression */ #endif - U16 op_pmflags; + U32 op_pmflags; U16 op_pmpermflags; U8 op_pmdynflags; #ifdef USE_ITHREADS @@ -282,7 +282,7 @@ #define PMf_RETAINT 0x0001 /* taint $1 etc. if target tainted */ #define PMf_ONCE 0x0002 /* use pattern only once per reset */ -#define PMf_REVERSED 0x0004 /* Should be matched right->left */ +#define PMf_UNUSED 0x0004 /* free for use */ #define PMf_MAYBE_CONST 0x0008 /* replacement contains variables */ #define PMf_SKIPWHITE 0x0010 /* skip leading whitespace for split */ #define PMf_WHITE 0x0020 /* pattern is \s+ */ ==== //depot/macperl/patchlevel.h#2 (text) ==== Index: perl/patchlevel.h --- perl/patchlevel.h.~1~ Sat Apr 27 16:00:05 2002 +++ perl/patchlevel.h Sat Apr 27 16:00:05 2002 @@ -79,7 +79,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL - ,"DEVEL16080" + ,"DEVEL16224" ,NULL }; ==== //depot/macperl/perlio.c#2 (text) ==== Index: perl/perlio.c --- perl/perlio.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/perlio.c Sat Apr 27 16:00:05 2002 @@ -1040,9 +1040,8 @@ int PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode, - PerlIO_list_t *layers, IV n) + PerlIO_list_t *layers, IV n, IV max) { - IV max = layers->cur; int code = 0; while (n < max) { PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n, NULL); @@ -1065,7 +1064,7 @@ PerlIO_list_t *layers = PerlIO_list_alloc(aTHX); code = PerlIO_parse_layers(aTHX_ layers, names); if (code == 0) { - code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0); + code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0, layers->cur); } PerlIO_list_free(aTHX_ layers); } @@ -1356,8 +1355,9 @@ * More layers above the one that we used to open - * apply them now */ - if (PerlIO_apply_layera(aTHX_ f, mode, layera, n + 1) - != 0) { + if (PerlIO_apply_layera(aTHX_ f, mode, layera, n + 1, layera->cur) != 0) { + /* If pushing layers fails close the file */ + PerlIO_close(f); f = NULL; } } @@ -2182,7 +2182,7 @@ IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { - if (f) { + if (PerlIOValid(f)) { if (PerlIOBase(f)->flags & PERLIO_F_OPEN) (*PerlIOBase(f)->tab->Close)(aTHX_ f); } @@ -2204,11 +2204,14 @@ mode++; if (!f) { f = PerlIO_allocate(aTHX); + } + if (!PerlIOValid(f)) { s = PerlIOSelf(PerlIO_push(aTHX_ f, self, mode, PerlIOArg), PerlIOUnix); } - else + else { s = PerlIOSelf(f, PerlIOUnix); + } s->fd = fd; s->oflags = imode; PerlIOBase(f)->flags |= PERLIO_F_OPEN; @@ -2428,7 +2431,7 @@ int perm, PerlIO *f, int narg, SV **args) { char tmode[8]; - if (f) { + if (PerlIOValid(f)) { char *path = SvPV_nolen(*args); PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio); FILE *stdio; @@ -2451,9 +2454,11 @@ else { FILE *stdio = PerlSIO_fopen(path, mode); if (stdio) { - PerlIOStdio *s = - PerlIOSelf(PerlIO_push - (aTHX_(f = PerlIO_allocate(aTHX)), self, + PerlIOStdio *s; + if (!f) { + f = PerlIO_allocate(aTHX); + } + s = PerlIOSelf(PerlIO_push(aTHX_ f, self, (mode = PerlIOStdio_mode(mode, tmode)), PerlIOArg), PerlIOStdio); @@ -2488,10 +2493,11 @@ PerlIOStdio_mode(mode, tmode)); } if (stdio) { - PerlIOStdio *s = - PerlIOSelf(PerlIO_push - (aTHX_(f = PerlIO_allocate(aTHX)), self, - mode, PerlIOArg), PerlIOStdio); + PerlIOStdio *s; + if (!f) { + f = PerlIO_allocate(aTHX); + } + s = PerlIOSelf(PerlIO_push(aTHX_ f, self, mode, PerlIOArg), PerlIOStdio); s->stdio = stdio; PerlIOUnix_refcnt_inc(fileno(s->stdio)); return f; @@ -2880,7 +2886,7 @@ */ } f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm, - NULL, narg, args); + f, narg, args); if (f) { if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) { /* ==== //depot/macperl/perlio.h#2 (text) ==== ==== //depot/macperl/perliol.h#2 (text) ==== Index: perl/perliol.h --- perl/perliol.h.~1~ Sat Apr 27 16:00:05 2002 +++ perl/perliol.h Sat Apr 27 16:00:05 2002 @@ -154,6 +154,13 @@ IV oneword; /* Emergency buffer */ } PerlIOBuf; +extern int PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode, + PerlIO_list_t *layers, IV n, IV max); +extern int PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names); +extern void PerlIO_list_free(pTHX_ PerlIO_list_t *list); +extern PerlIO_funcs *PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def); + + extern SV *PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param); extern PerlIO *PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, ==== //depot/macperl/pod/perldelta.pod#2 (text) ==== Index: perl/pod/perldelta.pod --- perl/pod/perldelta.pod.~1~ Sat Apr 27 16:00:05 2002 +++ perl/pod/perldelta.pod Sat Apr 27 16:00:05 2002 @@ -48,19 +48,25 @@ =head2 Binary Incompatibility -Perl 5.8 has not been designed to be binary compatible with earlier -releases of Perl. While the compatibility has not been intentionally -broken, it has not been intentionally protected, either. The major -reason for the discontinity is the new IO architecture called PerlIO. -The PerlIO is the default configuration because without it many new -features of Perl 5.8 cannot be used. In other words: you just have -to recompile your modules, sorry about that. +B<Perl 5.8 is not binary compatible with earlier releases of Perl.> + +B<You have to recompile your XS modules.> + +(Pure Perl modules should continue to work.) + +The major reason for the discontinity is the new IO architecture +called PerlIO. PerlIO is the default configuration because +without it many new features of Perl 5.8 cannot be used. In other +words: you just have to recompile your modules, sorry about that. -In future releases of Perl non-PerlIO aware XS modules may become +In future releases of Perl, non-PerlIO aware XS modules may become completely unsupported. This shouldn't be too difficult for module authors, however: PerlIO has been designed as a drop-in replacement (at the source code level) for the stdio interface. +Depending on your platform, there are also other reasons why +we decided to break binary compatibility, please read on. + =head2 64-bit platforms and malloc If your pointers are 64 bits wide, the Perl malloc is no longer being @@ -879,7 +885,12 @@ C<Storable> gives persistence to Perl data structures by allowing the storage and retrieval of Perl data to and from files in a fast and -compact binary format, from Raphael Manfredi. See L<Storable>. +compact binary format. Because in effect Storable does serialisation +of Perl data structues, with it you can also clone deep, hierarchical +datastructures. Storable was created by Raphael Manfredi but it is +now maintained by the Perl development team. Storable has been +enhanced to understand the two new hash features, Unicode keys and +restricted hashes. See L<Storable>. =item * @@ -2251,6 +2262,12 @@ =item * +NetBSD/threads: try installing the GNU pth (should be in the +packages collection, or http://www.gnu.org/software/pth/), +and Configure with -Duseithreads. + +=item * + NetBSD/sparc Perl now works on NetBSD/sparc. @@ -2739,6 +2756,12 @@ formatting 0.6 and -0.6 using the printf format "%.0f", most often they produce "0" and "-0".) +=head2 Solaris 2.5 + +In case you are still using Solaris 2.5 (aka SunOS 5.5), you may +experience failures (the test core dumping) in lib/locale.t. +The suggested cure is to upgrade your Solaris. + =head2 Failure of Thread (5.005-style) tests B<Note that support for 5.005-style threading remains experimental ==== //depot/macperl/pod/perldiag.pod#2 (text) ==== Index: perl/pod/perldiag.pod --- perl/pod/perldiag.pod.~1~ Sat Apr 27 16:00:05 2002 +++ perl/pod/perldiag.pod Sat Apr 27 16:00:05 2002 @@ -3748,7 +3748,7 @@ (F) The second argument of 3-argument open() is not among the list of valid modes: C<< < >>, C<< > >>, C<<< >> >>>, C<< +< >>, -C<< +> >>, C<<< +>> >>>, C<-|>, C<|->. +C<< +> >>, C<<< +>> >>>, C<-|>, C<|->, C<< <& >>, C<< >& >>. =item Unknown process %x sent message to prime_env_iter: %s ==== //depot/macperl/pod/perltodo.pod#2 (text) ==== Index: perl/pod/perltodo.pod --- perl/pod/perltodo.pod.~1~ Sat Apr 27 16:00:05 2002 +++ perl/pod/perltodo.pod Sat Apr 27 16:00:05 2002 @@ -542,6 +542,18 @@ 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. +=head2 Should overload be inheritable? + +Should overload be 'contagious' through @ISA so that derived classes +would inherit their base classes' overload definitions? What to do +in case of overload conflicts? + +=head2 Taint rethink + +Should taint be stopped from affecting control flow, if ($tainted)? +Should tainted symbolic method calls and subref calls be stopped? +(Look at Ruby's $SAFE levels for inspiration?) + =head1 Vague ideas Ideas which have been discussed, and which may or may not happen. ==== //depot/macperl/pod/perluniintro.pod#2 (text) ==== Index: perl/pod/perluniintro.pod --- perl/pod/perluniintro.pod.~1~ Sat Apr 27 16:00:05 2002 +++ perl/pod/perluniintro.pod Sat Apr 27 16:00:05 2002 @@ -171,7 +171,10 @@ If your locale environment variables (LANGUAGE, LC_ALL, LC_CTYPE, LANG) contain the strings 'UTF-8' or 'UTF8' (case-insensitive matching), the default encoding of your STDIN, STDOUT, and STDERR, and of -B<any subsequent file open>, is UTF-8. +B<any subsequent file open>, is UTF-8. Note that this means +that Perl expects other software to work, too: if STDIN coming +in from another command is not UTF-8, Perl will complain about +malformed UTF-8. =head2 Unicode and EBCDIC @@ -621,13 +624,16 @@ that C<$a> will stay single byte encoded. Sometimes you might really need to know the byte length of a string -instead of the character length. For that use the C<bytes> pragma -and its only defined function C<length()>: +instead of the character length. For that use either the +C<Encode::encode_utf8()> function or the C<bytes> pragma and its only +defined function C<length()>: my $unicode = chr(0x100); print length($unicode), "\n"; # will print 1 + require Encode; + print length(Encode::encode_utf8($unicode)), "\n"; # will print 2 use bytes; - print length($unicode), "\n"; # will print 2 (the 0xC4 0x80 of the UTF-8) + print length($unicode), "\n"; # will also print 2 (the 0xC4 0x80 of the UTF-8) =item ==== //depot/macperl/pp_ctl.c#3 (text) ==== Index: perl/pp_ctl.c --- perl/pp_ctl.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/pp_ctl.c Sat Apr 27 16:00:05 2002 @@ -2945,11 +2945,11 @@ /* help out with the "use 5.6" confusion */ if (sver == 0 && (rev > 5 || (rev == 5 && ver >= 100))) { - DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--" - "this is only v%d.%d.%d, stopped" - " (did you mean v%"UVuf".%03"UVuf"?)", - rev, ver, sver, PERL_REVISION, PERL_VERSION, - PERL_SUBVERSION, rev, ver/100); + DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required" + " (did you mean v%"UVuf".%03"UVuf"?)--" + "this is only v%d.%d.%d, stopped", + rev, ver, sver, rev, ver/100, + PERL_REVISION, PERL_VERSION, PERL_SUBVERSION); } else { DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--" ==== //depot/macperl/pp_hot.c#2 (text) ==== Index: perl/pp_hot.c --- perl/pp_hot.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/pp_hot.c Sat Apr 27 16:00:05 2002 @@ -2117,7 +2117,14 @@ break; } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m, TARG, NULL, r_flags)); - sv_catpvn(dstr, s, strend - s); + if (doutf8 && !DO_UTF8(dstr)) { + SV* nsv = sv_2mortal(newSVpvn(s, strend - s)); + + sv_utf8_upgrade(nsv); + sv_catpvn(dstr, SvPVX(nsv), SvCUR(nsv)); + } + else + sv_catpvn(dstr, s, strend - s); (void)SvOOK_off(TARG); Safefree(SvPVX(TARG)); ==== //depot/macperl/pp_sys.c#2 (text) ==== Index: perl/pp_sys.c --- perl/pp_sys.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/pp_sys.c Sat Apr 27 16:00:05 2002 @@ -731,11 +731,16 @@ RETPUSHUNDEF; } + PUTBACK; if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp), - (discp) ? SvPV_nolen(discp) : Nullch)) + (discp) ? SvPV_nolen(discp) : Nullch)) { + SPAGAIN; RETPUSHYES; - else + } + else { + SPAGAIN; RETPUSHUNDEF; + } } PP(pp_tie) @@ -4040,7 +4045,7 @@ TAINT_ENV(); while (++MARK <= SP) { (void)SvPV_nolen(*MARK); /* stringify for taint check */ - if (PL_tainted) + if (PL_tainted) break; } MARK = ORIGMARK; @@ -4166,7 +4171,7 @@ TAINT_ENV(); while (++MARK <= SP) { (void)SvPV_nolen(*MARK); /* stringify for taint check */ - if (PL_tainted) + if (PL_tainted) break; } MARK = ORIGMARK; ==== //depot/macperl/proto.h#2 (text+w) ==== Index: perl/proto.h --- perl/proto.h.~1~ Sat Apr 27 16:00:05 2002 +++ perl/proto.h Sat Apr 27 16:00:05 2002 @@ -602,12 +602,8 @@ PERL_CALLCONV void Perl_reentrant_size(pTHX); PERL_CALLCONV void Perl_reentrant_init(pTHX); PERL_CALLCONV void Perl_reentrant_free(pTHX); -PERL_CALLCONV void* Perl_reentrant_retry(const char*, ...) -#ifdef CHECK_FORMAT - __attribute__((format(printf,1,2))) +PERL_CALLCONV void* Perl_reentrant_retry(const char*, ...); #endif -; -#endif PERL_CALLCONV void Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr); PERL_CALLCONV I32 Perl_call_argv(pTHX_ const char* sub_name, I32 flags, char** argv); PERL_CALLCONV I32 Perl_call_method(pTHX_ const char* methname, I32 flags); @@ -631,7 +627,7 @@ PERL_CALLCONV void Perl_require_pv(pTHX_ const char* pv); PERL_CALLCONV void Perl_pack_cat(pTHX_ SV *cat, char *pat, char *patend, SV **beglist, SV **endlist, SV ***next_in_list, U32 flags); PERL_CALLCONV void Perl_pidgone(pTHX_ Pid_t pid, int status); -PERL_CALLCONV void Perl_pmflag(pTHX_ U16* pmfl, int ch); +PERL_CALLCONV void Perl_pmflag(pTHX_ U32* pmfl, int ch); PERL_CALLCONV OP* Perl_pmruntime(pTHX_ OP* pm, OP* expr, OP* repl); PERL_CALLCONV OP* Perl_pmtrans(pTHX_ OP* o, OP* expr, OP* repl); PERL_CALLCONV OP* Perl_pop_return(pTHX); ==== //depot/macperl/regcomp.c#2 (text) ==== Index: perl/regcomp.c --- perl/regcomp.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/regcomp.c Sat Apr 27 16:00:05 2002 @@ -2149,8 +2149,8 @@ /* Make an OPEN node, if parenthesized. */ if (paren) { if (*RExC_parse == '?') { /* (?...) */ - U16 posflags = 0, negflags = 0; - U16 *flagsp = &posflags; + U32 posflags = 0, negflags = 0; + U32 *flagsp = &posflags; int logical = 0; char *seqstart = RExC_parse; @@ -4775,7 +4775,6 @@ if (lv) { if (sw) { - UV i; U8 s[UTF8_MAXLEN+1]; for (i = 0; i <= 256; i++) { /* just the first 256 */ ==== //depot/macperl/sv.c#2 (text) ==== Index: perl/sv.c --- perl/sv.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/sv.c Sat Apr 27 16:00:05 2002 @@ -9389,7 +9389,7 @@ CvFILE(dstr) = CvXSUB(sstr) ? CvFILE(sstr) : SAVEPV(CvFILE(sstr)); break; default: - Perl_croak(aTHX_ "Bizarre SvTYPE [%d]", SvTYPE(sstr)); + Perl_croak(aTHX_ "Bizarre SvTYPE [%" IVdf "]", (IV)SvTYPE(sstr)); break; } @@ -10412,7 +10412,7 @@ PL_retstack_ix = proto_perl->Tretstack_ix; PL_retstack_max = proto_perl->Tretstack_max; Newz(54, PL_retstack, PL_retstack_max, OP*); - Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, I32); + Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, OP*); /* NOTE: si_dup() looks at PL_markstack */ PL_curstackinfo = si_dup(proto_perl->Tcurstackinfo, param); ==== //depot/macperl/t/TEST#2 (xtext) ==== Index: perl/t/TEST --- perl/t/TEST.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/TEST Sat Apr 27 16:00:05 2002 @@ -9,6 +9,9 @@ # which live dual lives on CPAN. $ENV{PERL_CORE} = 1; +# remove empty elements due to insertion of empty symbols via "''p1'" syntax +@ARGV = grep($_,@ARGV) if $^O eq 'VMS'; + # Cheesy version of Getopt::Std. Maybe we should replace it with that. @argv = (); if ($#ARGV >= 0) { @@ -64,31 +67,46 @@ foreach my $f (sort { $a cmp $b } readdir DIR) { next if $f eq $curdir or $f eq $updir; - my $fullpath = File::Spec->catdir($dir, $f); + my $fullpath = File::Spec->catfile($dir, $f); _find_tests($fullpath) if -d $fullpath; + $fullpath = VMS::Filespec::unixify($fullpath) if $^O eq 'VMS'; push @ARGV, $fullpath if $f =~ /\.t$/; } } +sub _quote_args { + my ($args) = @_; + my $argstring = ''; + + foreach (split(/\s+/,$args)) { + # In VMS protect with doublequotes because otherwise + # DCL will lowercase -- unless already doublequoted. + $_ = q(").$_.q(") if ($^O eq 'VMS') && !/^\"/ && length($_) > 0; + $argstring .= ' ' . $_; + } + return $argstring; +} + unless (@ARGV) { foreach my $dir (qw(base comp cmd run io op uni)) { _find_tests($dir); } _find_tests("lib") unless $core; - my $mani = File::Spec->catdir($updir, "MANIFEST"); + my $mani = File::Spec->catfile($updir, "MANIFEST"); if (open(MANI, $mani)) { while (<MANI>) { # similar code in t/harness if (m!^(ext/\S+/?([^/]+\.t|test\.pl)|lib/\S+?(\.t|test\.pl))\s!) { $t = $1; if (!$core || $t =~ m!^lib/[a-z]!) { - $path = File::Spec->catdir($updir, $t); + $path = File::Spec->catfile($updir, $t); push @ARGV, $path; $name{$path} = $t; } } } + close MANI; } else { warn "$0: cannot open $mani: $!\n"; } @@ -139,8 +157,12 @@ $files = 0; $totmax = 0; - foreach (@tests) { - $name{$_} = File::Spec->catdir('t',$_) unless exists $name{$_}; + foreach my $t (@tests) { + unless (exists $name{$t}) { + my $tname = File::Spec->catfile('t',$t); + $tname = VMS::Filespec::unixify($tname) if $^O eq 'VMS'; + $name{$t} = $tname; + } } my $maxlen = 0; foreach (@name{@tests}) { @@ -169,8 +191,12 @@ next; } } - $te = $name{$test}; - print "$te" . '.' x ($dotdotdot - length($te)); + $te = $name{$test} . '.' x ($dotdotdot - length($name{$test})); + + if ($^O ne 'VMS') { # defer printing on VMS due to piping bug + print $te; + $te = ''; + } $test = $OVER{$test} if exists $OVER{$test}; @@ -208,7 +234,8 @@ } elsif ($type eq 'perl') { my $perl = $ENV{PERL} || './perl'; - my $run = "$perl $testswitch $switch $utf $test |"; + my $redir = ($^O eq 'VMS' ? '2>&1' : ''); + my $run = "$perl" . _quote_args("$testswitch $switch $utf") . " $test $redir|"; open(RESULTS,$run) or print "can't run '$run': $!.\n"; } else { @@ -227,7 +254,7 @@ open HACK, '.\\perl $pl2c $test_executable |'; # cl.exe prints the name of the .c file on stdout (\%^\$^#) -while(<HACK>) {m/^\w+\.[cC]\$/ && next;print} +while(<HACK>) {m/^\\w+\\.[cC]\$/ && next;print} open HACK, '$test_executable |'; while(<HACK>) {print} EOT @@ -246,6 +273,7 @@ $ok = 0; $next = 0; while (<RESULTS>) { + next if /^\s*$/; # skip blank lines if ($verbose) { print $_; } @@ -304,17 +332,17 @@ } if ($ok && $next == $max ) { if ($max) { - print "ok\n"; + print "${te}ok\n"; $good = $good + 1; } else { - print "skipping test on this platform\n"; + print "${te}skipping test on this platform\n"; $files -= 1; } } else { $next += 1; - print "FAILED at test $next\n"; + print "${te}FAILED at test $next\n"; $bad = $bad + 1; $_ = $test; if (/^base/) { ==== //depot/macperl/t/harness#2 (text) ==== Index: perl/t/harness --- perl/t/harness.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/harness Sat Apr 27 16:00:05 2002 @@ -63,10 +63,11 @@ my $mani = File::Spec->catfile(File::Spec->updir, "MANIFEST"); if (open(MANI, $mani)) { while (<MANI>) { # similar code in t/TEST - if (m!^(ext/\S+/([^/]+\.t|test\.pl)|lib/\S+?(\.t|test\.pl))\s!) { + if (m!^(ext/\S+/?([^/]+\.t|test\.pl)|lib/\S+?(\.t|test\.pl))\s!) { push @tests, File::Spec->catfile($updir, $1); } } + close MANI; } else { warn "$0: cannot open $mani: $!\n"; } ==== //depot/macperl/t/japh/abigail.t#2 (text) ==== Index: perl/t/japh/abigail.t --- perl/t/japh/abigail.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/japh/abigail.t Sat Apr 27 16:00:05 2002 @@ -13,7 +13,14 @@ # disable the test!) # # Getting everything to run well on the myriad of platforms Perl runs on -# is unfortunally, not a trivial task. +# is unfortunately not a trivial task. +# +# WARNING: these tests are obfuscated. Do not get frustrated. +# Ask Abigail <[email protected]>, or use the Deparse or Concise +# modules (the former parses Perl to Perl, the latter shows the +# op syntax tree) like this: +# ./perl -Ilib -MO=Deparse foo.pl +# ./perl -Ilib -MO=Concise foo.pl # BEGIN { @@ -216,11 +223,11 @@ END {unlink_all $progfile} my @programs = (<< ' --', << ' --'); -#!./perl -- # No trailing newline after the last line! +#!./perl BEGIN{$|=$SIG{__WARN__}=sub{$_=$_[0];y-_- -;print/(.)"$/;seek _,-open(_ ,"+<$0"),2;truncate _,tell _;close _;exec$0}}//rekcaH_lreP_rehtona_tsuJ -- -#!./perl -- # Remove trailing newline! +#!./perl BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/; truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ -- ==== //depot/macperl/t/lib/MakeMaker/Test/Utils.pm#2 (text) ==== Index: perl/t/lib/MakeMaker/Test/Utils.pm --- perl/t/lib/MakeMaker/Test/Utils.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/lib/MakeMaker/Test/Utils.pm Sat Apr 27 16:00:05 2002 @@ -96,9 +96,9 @@ my $old5lib = $ENV{PERL5LIB}; my $had5lib = exists $ENV{PERL5LIB}; sub perl_lib { - # perl-src/lib/ExtUtils/t/Foo - my $lib = $ENV{PERL_CORE} ? qq{../../../lib} - # ExtUtils-MakeMaker/t/Foo + # perl-src/t/ + my $lib = $ENV{PERL_CORE} ? qq{../lib} + # ExtUtils-MakeMaker/t/ : qq{../blib/lib}; $lib = File::Spec->rel2abs($lib); my @libs = ($lib); ==== //depot/macperl/t/lib/sample-tests/taint#2 (text) ==== ==== //depot/macperl/t/lib/warnings/op#2 (text) ==== Index: perl/t/lib/warnings/op --- perl/t/lib/warnings/op.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/lib/warnings/op Sat Apr 27 16:00:05 2002 @@ -130,10 +130,13 @@ use warnings 'misc' ; my $x ; my $x ; +my $y = my $y ; no warnings 'misc' ; my $x ; +my $y ; EXPECT "my" variable $x masks earlier declaration in same scope at - line 4. +"my" variable $y masks earlier declaration in same statement at - line 5. ######## # op.c use warnings 'closure' ; ==== //depot/macperl/t/lib/warnings/pp_hot#2 (text) ==== Index: perl/t/lib/warnings/pp_hot --- perl/t/lib/warnings/pp_hot.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/lib/warnings/pp_hot Sat Apr 27 16:00:05 2002 @@ -105,6 +105,16 @@ print() on closed filehandle STDIN at - line 6. (Are you trying to call print() on dirhandle STDIN?) ######## +# pp_hot.c [pp_print] +# [ID 20020425.012] from Dave Steiner <[email protected]> +# This goes segv on 5.7.3 +use warnings 'closed' ; +my $fh = *STDOUT{IO}; +close STDOUT or die "Can't close STDOUT"; +print $fh "Shouldn't print anything, but shouldn't SEGV either\n"; +EXPECT +print() on closed filehandle at - line 7. +######## # pp_hot.c [pp_rv2av] use warnings 'uninitialized' ; my $a = undef ; ==== //depot/macperl/t/op/subst.t#2 (xtext) ==== Index: perl/t/op/subst.t --- perl/t/op/subst.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/op/subst.t Sat Apr 27 16:00:05 2002 @@ -7,7 +7,7 @@ } require './test.pl'; -plan( tests => 88 ); +plan( tests => 89 ); $x = 'foo'; $_ = "x"; @@ -374,3 +374,8 @@ $r =~ s/[^\w\.]//g; is($l, $r, "use utf8"); } + +my $pv1 = my $pv2 = "Andreas J. K\303\266nig"; +$pv1 =~ s/A/\x{100}/; +substr($pv2,0,1) = "\x{100}"; +is($pv1, $pv2); ==== //depot/macperl/t/win32/system.t#2 (text) ==== Index: perl/t/win32/system.t --- perl/t/win32/system.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/win32/system.t Sat Apr 27 16:00:05 2002 @@ -96,7 +96,7 @@ END { chdir($cwd) && rmtree("$cwd/$testdir") if -d "$cwd/$testdir"; } -if (open(my $EIN, "$cwd/op/${exename}_exe.uu")) { +if (open(my $EIN, "$cwd/win32/${exename}_exe.uu")) { print "# Unpacking $exename.exe\n"; my $e; { @@ -142,8 +142,8 @@ exit(0); } -open my $T, "$^X -I../lib -w op/system_tests |" - or die "Can't spawn op/system_tests: $!"; +open my $T, "$^X -I../lib -w win32/system_tests |" + or die "Can't spawn win32/system_tests: $!"; my $expect; my $comment = ""; my $test = 0; ==== //depot/macperl/toke.c#2 (text) ==== Index: perl/toke.c --- perl/toke.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/toke.c Sat Apr 27 16:00:05 2002 @@ -6247,7 +6247,7 @@ } void -Perl_pmflag(pTHX_ U16 *pmfl, int ch) +Perl_pmflag(pTHX_ U32* pmfl, int ch) { if (ch == 'i') *pmfl |= PMf_FOLD; ==== //depot/macperl/uconfig.h#2 (text) ==== Index: perl/uconfig.h --- perl/uconfig.h.~1~ Sat Apr 27 16:00:05 2002 +++ perl/uconfig.h Sat Apr 27 16:00:05 2002 @@ -1024,7 +1024,7 @@ /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, - * i.e. 0x1234 or 0x4321, etc... + * in a UV, i.e. 0x1234 or 0x4321 or 0x12345678, etc... * If the compiler supports cross-compiling or multiple-architecture * binaries (eg. on NeXT systems), use compiler-defined macros to * determine the byte order. @@ -2480,12 +2480,16 @@ */ /*#define HAS_TELLDIR_PROTO / **/ +/* HAS_TIME: + * This symbol, if defined, indicates that the time() routine exists. + */ /* Time_t: * This symbol holds the type returned by time(). It can be long, * or time_t on BSD sites (in which case <sys/types.h> should be * included). */ -#define Time_t int /* Time type */ +#define HAS_TIME /**/ +#define Time_t time_t /* Time type */ /* HAS_TIMES: * This symbol, if defined, indicates that the times() routine exists. ==== //depot/macperl/uconfig.sh#2 (xtext) ==== Index: perl/uconfig.sh --- perl/uconfig.sh.~1~ Sat Apr 27 16:00:05 2002 +++ perl/uconfig.sh Sat Apr 27 16:00:05 2002 @@ -382,7 +382,7 @@ d_tcsetpgrp='undef' d_telldir='undef' d_telldirproto='undef' -d_time='undef' +d_time='define' d_times='undef' d_tm_tm_gmtoff='undef' d_tm_tm_zone='undef' @@ -654,7 +654,7 @@ stdio_ptr='((fp)->_IO_read_ptr)' stdio_stream_array='' strerror_r_proto='0' -timetype=int +timetype=time_t tmpnam_r_proto='0' touch='touch' ttyname_r_proto='0' ==== //depot/macperl/util.c#2 (text) ==== Index: perl/util.c --- perl/util.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/util.c Sat Apr 27 16:00:05 2002 @@ -3447,7 +3447,8 @@ if (gv && isGV(gv)) { SV *sv = sv_newmortal(); gv_efullname4(sv, gv, Nullch, FALSE); - name = SvPVX(sv); + if (SvOK(sv)) + name = SvPVX(sv); } if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) { ==== //depot/macperl/vms/descrip_mms.template#2 (text) ==== Index: perl/vms/descrip_mms.template --- perl/vms/descrip_mms.template.~1~ Sat Apr 27 16:00:05 2002 +++ perl/vms/descrip_mms.template Sat Apr 27 16:00:05 2002 @@ -330,6 +330,7 @@ utils1 = [.lib.pod]perldoc.com [.lib.ExtUtils]Miniperl.pm [.utils]c2ph.com [.utils]h2ph.com utils2 = [.utils]h2xs.com [.utils]libnetcfg.com [.lib]perlbug.com [.lib]perlcc.com [.utils]dprofpp.com utils3 = [.utils]perlivp.com [.lib]splain.com [.utils]pl2pm.com [.lib.ExtUtils]xsubpp.com +utils4 = [.utils]enc2xs.com [.utils]piconv.com .ifdef NOX2P all : base extras archcorefiles preplibrary perlpods @@ -346,7 +347,7 @@ @ $(NOOP) libmods : $(LIBPREREQ) @ $(NOOP) -utils : $(utils1) $(utils2) $(utils3) +utils : $(utils1) $(utils2) $(utils3) $(utils4) @ $(NOOP) podxform : [.lib.pod]pod2text.com [.lib.pod]pod2html.com [.lib.pod]pod2latex.com [.lib.pod]pod2man.com [.lib.pod]podchecker.com [.lib.pod]pod2usage.com [.lib.pod]podselect.com @ $(NOOP) @@ -518,6 +519,9 @@ [.utils]dprofpp.com : [.utils]dprofpp.PL $(ARCHDIR)Config.pm $(MINIPERL) $(MMS$SOURCE) +[.utils]enc2xs.com : [.utils]enc2xs.PL $(ARCHDIR)Config.pm + $(MINIPERL) $(MMS$SOURCE) + [.utils]h2ph.com : [.utils]h2ph.PL $(ARCHDIR)Config.pm $(MINIPERL) $(MMS$SOURCE) @@ -535,6 +539,9 @@ $(MINIPERL) $(MMS$SOURCE) Copy/Log [.utils]perlcc.com $(MMS$TARGET) +[.utils]piconv.com : [.utils]piconv.PL $(ARCHDIR)Config.pm + $(MINIPERL) $(MMS$SOURCE) + [.utils]pl2pm.com : [.utils]pl2pm.PL $(ARCHDIR)Config.pm $(MINIPERL) $(MMS$SOURCE) ==== //depot/macperl/vms/test.com#2 (text) ==== Index: perl/vms/test.com --- perl/vms/test.com.~1~ Sat Apr 27 16:00:05 2002 +++ perl/vms/test.com Sat Apr 27 16:00:05 2002 @@ -1,25 +1,24 @@ -$! Test.Com - DCL driver for perl5 regression tests +$! Test.Com - DCL wrapper for perl5 regression test driver +$! +$! Version 2.0 25-April-2002 Craig Berry [email protected] +$! (and many other hands in the last 7+ years) +$! The most significant difference is that we now run the external t/TEST +$! rather than keeping a separately maintained test driver embedded here. $! $! Version 1.1 4-Dec-1995 $! Charles Bailey [email protected] $! -$! A little basic setup +$! Set up error handler and save things we'll restore later. +$ On Control_Y Then Goto Control_Y_exit $ On Error Then Goto wrapup $ olddef = F$Environment("Default") $ oldmsg = F$Environment("Message") -$ If F$Search("t.dir").nes."" -$ Then -$ Set Default [.t] -$ Else -$ If F$TrnLNm("Perl_Root").nes."" -$ Then -$ Set Default Perl_Root:[t] -$ Else -$ Write Sys$Error "Can't find test directory" -$ Exit 44 -$ EndIf -$ EndIf -$ Set Message /NoFacility/NoSeverity/NoIdentification/NoText +$ oldpriv = F$SetPrv("NOALL") ! downgrade privs for safety +$ discard = F$SetPrv("NETMBX,TMPMBX") ! only need these to run tests +$! +$! Process arguments. P1 is the file extension of the Perl images. P2, +$! when not empty, indicates that we are testing a version of Perl built for +$! the VMS debugger. The other arguments are passed directly to t/TEST. $! $ exe = ".Exe" $ If p1.nes."" Then exe = p1 @@ -30,7 +29,8 @@ $ Write Sys$Error "images produced when you built Perl (i.e. "".Exe"", unless you edited" $ Write Sys$Error "Descrip.MMS or used the AXE=1 macro in the MM[SK] command line." $ Write Sys$Error "" -$ Exit 44 +$ $status = 44 +$ goto wrapup $ EndIf $! $! "debug" perl if second parameter is nonblank @@ -40,6 +40,21 @@ $ if p2.nes."" then dbg = "dbg" $ if p2.nes."" then ndbg = "ndbg" $! +$! Make sure we are where we need to be. +$ If F$Search("t.dir").nes."" +$ Then +$ Set Default [.t] +$ Else +$ If F$TrnLNm("Perl_Root").nes."" +$ Then +$ Set Default Perl_Root:[t] +$ Else +$ Write Sys$Error "Can't find test directory" +$ $status = 44 +$ goto wrapup +$ EndIf +$ EndIf +$! $! Pick up a copy of perl to use for the tests $ If F$Search("Perl.").nes."" Then Delete/Log/NoConfirm Perl.;* $ Copy/Log/NoConfirm [-]'ndbg'Perl'exe' []Perl. @@ -52,174 +67,23 @@ $ if f$trnlnm("sys") .nes. "" then DeAssign sys $! $! And do it +$ Set Message /NoFacility/NoSeverity/NoIdentification/NoText $ Show Process/Accounting $ testdir = "Directory/NoHead/NoTrail/Column=1" $ PerlShr_filespec = f$parse("Sys$Disk:[-]''dbg'PerlShr''exe'") $ Define 'dbg'Perlshr 'PerlShr_filespec' -$ if f$mode() .nes. "INTERACTIVE" then Define PERL_SKIP_TTY_TEST 1 -$ MCR Sys$Disk:[]Perl. "-I[-.lib]" - "''p3'" "''p4'" "''p5'" "''p6'" -$ Deck/Dollar=$$END-OF-TEST$$ -# -# The bulk of the below code is scheduled for deletion. test.com -# will shortly use t/TEST. -# - -use Config; -use File::Spec; - -$| = 1; - -# Let tests know they're running in the perl core. Useful for modules -# which live dual lives on CPAN. -$ENV{PERL_CORE} = 1; - -@ARGV = grep($_,@ARGV); # remove empty elements due to "''p1'" syntax - -if (lc($ARGV[0]) eq '-v') { - $verbose = 1; - shift; -} - -chdir 't' if -f 't/TEST'; - -if ($ARGV[0] eq '') { - foreach (<[.*]*.t>, <[-.ext...]*.t>, <[-.lib...]*.t>) { - $_ = File::Spec->abs2rel($_); - s/\[([a-z]+)/[.$1/; # hmm, abs2rel doesn't do subdirs of the cwd - ($fname = $_) =~ s/.*\]//; - push(@ARGV,$_); - } -} - -$bad = 0; -$good = 0; -$extra_skip = 0; -$total = @ARGV; -while ($test = shift) { - if ($test =~ /^$/) { - next; - } - $te = $test; - chop($te); - $te .= '.' x (40 - length($te)); - open(script,"$test") || die "Can't run $test.\n"; - $_ = <script>; - close(script); - if (/#!.*\bperl.*-\w*([tT])/) { - $switch = qq{"-$1"}; - } else { - $switch = ''; - } - open(results,"\$ MCR Sys\$Disk:[]Perl. \"-I[-.lib]\" $switch $test 2>&1|") || (print "can't run.\n"); - $ok = 0; - $next = 0; - $pending_not = 0; - while (<results>) { - if ($verbose) { - print "$te$_"; - $te = ''; - } - unless (/^#/) { - if (/^1\.\.([0-9]+)( todo ([\d ]+))?/) { - $max = $1; - %todo = map { $_ => 1 } split / /, $3 if $3; - $totmax += $max; - $files += 1; - $next = 1; - $ok = 1; - } else { - # our 'echo' substitute produces one more \n than Unix' - next if /^\s*$/; - - - if (/^(not )?ok (\d+)[^#]*(\s*#.*)?/ && - $2 == $next) - { - my($not, $num, $extra) = ($1, $2, $3); - my($istodo) = $extra =~ /^\s*#\s*TODO/ if $extra; - $istodo = 1 if $todo{$num}; - - if( $not && !$istodo ) { - $ok = 0; - $next = $num; - last; - } - elsif( $pending_not ) { - $next = $num; - $ok = 0; - } - else { - $next = $next + 1; - } - } - elsif(/^not $/) { - # VMS has this problem. It sometimes adds newlines - # between prints. This sometimes means you get - # "not \nok 42" - $pending_not = 1; - } - elsif (/^Bail out!\s*(.*)/i) { # magic words - die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n"); - } - else { - $ok = 0; - } - - } - } - } - $next = $next - 1; - if ($ok && $next == $max) { - if ($max) { - print "${te}ok\n"; - $good = $good + 1; - } else { - print "${te}skipping test on this platform\n"; - $files -= 1; - $extra_skip = $extra_skip + 1; - } - } else { - $next += 1; - print "${te}FAILED on test $next\n"; - $bad = $bad + 1; - $_ = $test; - if (/^base/) { - die "Failed a basic test--cannot continue.\n"; - } - } -} - -if ($bad == 0) { - if ($ok) { - print "All tests successful.\n"; - } else { - die "FAILED--no tests were run for some reason.\n"; - } -} else { - # $pct = sprintf("%.2f", $good / $total * 100); - $gtotal = $total - $extra_skip; - if ($gtotal <= 0) { $gtotal = $total; } - $pct = sprintf("%.2f", $good / $gtotal * 100); - if ($bad == 1) { - warn "Failed 1 test, $pct% okay.\n"; - } else { - if ($extra_skip > 0) { - warn "Total tests: $total, Passed $good, Skipped $extra_skip.\n"; - warn "Failed $bad/$gtotal tests, $pct% okay.\n"; - } - else { - warn "Total tests: $total, Passed $good.\n"; - warn "Failed $bad/$gtotal tests, $pct% okay.\n"; - } - } -} -($user,$sys,$cuser,$csys) = times; -print sprintf("u=%g s=%g cu=%g cs=%g scripts=%d tests=%d\n", - $user,$sys,$cuser,$csys,$files,$totmax); -$$END-OF-TEST$$ +$ If F$Mode() .nes. "INTERACTIVE" Then Define/Nolog PERL_SKIP_TTY_TEST 1 +$ MCR Sys$Disk:[]Perl. "-I[-.lib]" TEST. "''p3'" "''p4'" "''p5'" "''p6'" +$ goto wrapup +$! +$ Control_Y_exit: +$ $status = 1552 ! %SYSTEM-W-CONTROLY +$! $ wrapup: -$ deassign 'dbg'Perlshr +$ status = $status +$ If f$trnlnm("''dbg'PerlShr") .nes. "" Then DeAssign 'dbg'PerlShr $ Show Process/Accounting -$ Set Default &olddef -$ Set Message 'oldmsg' -$ Exit +$ If f$type(olddef) .nes. "" Then Set Default &olddef +$ If f$type(oldmsg) .nes. "" Then Set Message 'oldmsg' +$ If f$type(oldpriv) .nes. "" Then discard = F$SetPrv(oldpriv) +$ Exit status ==== //depot/macperl/vms/vms.c#2 (text) ==== Index: perl/vms/vms.c --- perl/vms/vms.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/vms/vms.c Sat Apr 27 16:00:05 2002 @@ -9,7 +9,6 @@ * 20-Aug-1999 revisions by Charles Bailey [email protected] */ -#include <accdef.h> #include <acedef.h> #include <acldef.h> #include <armdef.h> @@ -1341,6 +1340,18 @@ unsigned long int exit_status; }; +typedef struct _closed_pipes Xpipe; +typedef struct _closed_pipes* pXpipe; + +struct _closed_pipes { + int pid; /* PID of subprocess */ + unsigned long completion; /* termination status of subprocess */ +}; +#define NKEEPCLOSED 50 +static Xpipe closed_list[NKEEPCLOSED]; +static int closed_index = 0; +static int closed_num = 0; + #define RETRY_DELAY "0 ::0.20" #define MAX_RETRY 50 @@ -1476,14 +1487,22 @@ { pInfo i = open_pipes; int iss; + pXpipe x; + info->completion &= 0x0FFFFFFF; /* strip off "control" field */ + closed_list[closed_index].pid = info->pid; + closed_list[closed_index].completion = info->completion; + closed_index++; + if (closed_index == NKEEPCLOSED) + closed_index = 0; + closed_num++; + while (i) { if (i == info) break; i = i->next; } if (!i) return; /* unlinked, probably freed too */ - info->completion &= 0x0FFFFFFF; /* strip off "control" field */ info->done = TRUE; /* @@ -2643,6 +2662,7 @@ pInfo info; int done; int sts; + int j; if (statusp) *statusp = 0; @@ -2660,9 +2680,18 @@ if (statusp) *statusp = info->completion; return pid; + } + + /* child that already terminated? */ + for (j = 0; j < NKEEPCLOSED && j < closed_num; j++) { + if (closed_list[j].pid == pid) { + if (statusp) *statusp = closed_list[j].completion; + return pid; + } } - else { /* this child is not one of our own pipe children */ + + /* fall through if this child is not one of our own pipe children */ #if defined(__CRTL_VER) && __CRTL_VER >= 70100322 @@ -2685,22 +2714,16 @@ #endif /* defined(__CRTL_VER) && __CRTL_VER >= 70100322 */ + { $DESCRIPTOR(intdsc,"0 00:00:01"); unsigned long int ownercode = JPI$_OWNER, ownerpid; unsigned long int pidcode = JPI$_PID, mypid; unsigned long int interval[2]; - int termination_mbu = 0; - unsigned short qio_iosb[4]; unsigned int jpi_iosb[2]; - struct itmlst_3 jpilist[3] = { + struct itmlst_3 jpilist[2] = { {sizeof(ownerpid), JPI$_OWNER, &ownerpid, 0}, - {sizeof(termination_mbu), JPI$_TMBU, &termination_mbu, 0}, { 0, 0, 0, 0} }; - char trmmbx[NAM$C_DVI+1]; - $DESCRIPTOR(trmmbxdsc,trmmbx); - struct accdef trmmsg; - unsigned short int mbxchan; if (pid <= 0) { /* Sorry folks, we don't presently implement rooting around for @@ -2711,9 +2734,9 @@ return -1; } - /* Get the owner of the child so I can warn if it's not mine, plus - * get the termination mailbox. If the process doesn't exist or I - * don't have the privs to look at it, I can go home early. + /* Get the owner of the child so I can warn if it's not mine. If the + * process doesn't exist or I don't have the privs to look at it, + * I can go home early. */ sts = sys$getjpiw(0,&pid,NULL,&jpilist,&jpi_iosb,NULL,NULL); if (sts & 1) sts = jpi_iosb[0]; @@ -2741,58 +2764,18 @@ pid,mypid); } - /* It's possible to have a mailbox unit number but no actual mailbox; we - * check for this by assigning a channel to it, which we need anyway. - */ - if (termination_mbu != 0) { - sprintf(trmmbx, "MBA%d:", termination_mbu); - trmmbxdsc.dsc$w_length = strlen(trmmbx); - sts = sys$assign(&trmmbxdsc, &mbxchan, 0, 0); - if (sts == SS$_NOSUCHDEV) { - termination_mbu = 0; /* set up to take "no mailbox" case */ - sts = SS$_NORMAL; - } - _ckvmssts(sts); - } - /* If the process doesn't have a termination mailbox, then simply check - * on it once a second until it's not there anymore. - */ - if (termination_mbu == 0) { - _ckvmssts(sys$bintim(&intdsc,interval)); - while ((sts=lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0)) & 1) { + /* simply check on it once a second until it's not there anymore. */ + + _ckvmssts(sys$bintim(&intdsc,interval)); + while ((sts=lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0)) & 1) { _ckvmssts(sys$schdwk(0,0,interval,0)); _ckvmssts(sys$hiber()); - } - if (sts == SS$_NONEXPR) sts = SS$_NORMAL; - } - else { - /* If we do have a termination mailbox, post reads to it until we get a - * termination message, discarding messages of the wrong type or for other - * processes. If there is a place to put the final status, then do so. - */ - sts = SS$_NORMAL; - while (sts & 1) { - memset((void *) &trmmsg, 0, sizeof(trmmsg)); - sts = sys$qiow(0,mbxchan,IO$_READVBLK,&qio_iosb,0,0, - &trmmsg,ACC$K_TERMLEN,0,0,0,0); - if (sts & 1) sts = qio_iosb[0]; - - if ( sts & 1 - && trmmsg.acc$w_msgtyp == MSG$_DELPROC - && trmmsg.acc$l_pid == pid ) { + } + if (sts == SS$_NONEXPR) sts = SS$_NORMAL; - if (statusp) *statusp = trmmsg.acc$l_finalsts; - sts = sys$dassgn(mbxchan); - break; - } - } - } /* termination_mbu ? */ - _ckvmssts(sts); return pid; - - } /* else one of our own pipe children */ - + } } /* end of waitpid() */ /*}}}*/ /*}}}*/ ==== //depot/macperl/vos/vos.c#2 (text) ==== Index: perl/vos/vos.c --- perl/vos/vos.c.~1~ Sat Apr 27 16:00:05 2002 +++ perl/vos/vos.c Sat Apr 27 16:00:05 2002 @@ -2,6 +2,8 @@ /* Written 02-01-02 by Nick Ing-Simmons ([email protected]) */ /* Modified 02-03-27 by Paul Green ([email protected]) to add socketpair() dummy. */ +/* Modified 02-04-24 by Paul Green ([email protected]) to + have pow(0,0) return 1, avoiding c-1471. */ /* End of modification history */ #include <errno.h> @@ -35,3 +37,22 @@ errno = ENOSYS; return -1; } + +/* Supply a private version of the power function that returns 1 + for x**0. This avoids c-1471. Abigail's Japh tests depend + on this fix. We leave all the other cases to the VOS C + runtime. */ + +double s_crt_pow(double *x, double *y); + +double pow(x,y) +double x, y; +{ + if (y == 0e0) /* c-1471 */ + { + errno = EDOM; + return (1e0); + } + + return(s_crt_pow(&x,&y)); +} ==== //depot/macperl/win32/Makefile#2 (text) ==== Index: perl/win32/Makefile --- perl/win32/Makefile.~1~ Sat Apr 27 16:00:05 2002 +++ perl/win32/Makefile Sat Apr 27 16:00:05 2002 @@ -453,11 +453,14 @@ ..\utils\perlbug \ ..\utils\pl2pm \ ..\utils\c2ph \ + ..\utils\pstruct \ ..\utils\h2xs \ ..\utils\perldoc \ ..\utils\perlcc \ ..\utils\perlivp \ ..\utils\libnetcfg \ + ..\utils\enc2xs \ + ..\utils\piconv \ ..\pod\checkpods \ ..\pod\pod2html \ ..\pod\pod2latex \ @@ -467,6 +470,7 @@ ..\pod\podchecker \ ..\pod\podselect \ ..\x2p\find2perl \ + ..\x2p\psed \ ..\x2p\s2p \ ..\lib\ExtUtils\xsubpp \ bin\exetype.pl \ @@ -1040,18 +1044,22 @@ perlwin32.pod pod2html pod2latex pod2man pod2text pod2usage \ podchecker podselect cd ..\utils - -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc perlivp dprofpp + -del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs perldoc perlivp \ + dprofpp perlcc libnetcfg enc2xs piconv -del /f *.bat cd ..\win32 cd ..\x2p - -del /f find2perl s2p + -del /f find2perl s2p psed -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 .. + -del /s *.lib *.map *.pdb *.ilk *.bs *$(o) .exists pm_to_blib + cd win32 cd $(EXTDIR) - -del /s *.lib *.def *.map *.pdb *.bs Makefile *$(o) pm_to_blib + -del /s *.def Makefile Makefile.old cd ..\win32 -if exist $(AUTODIR) rmdir /s /q $(AUTODIR) -rmdir /s $(AUTODIR) ==== //depot/macperl/win32/buildext.pl#2 (text) ==== Index: perl/win32/buildext.pl --- perl/win32/buildext.pl.~1~ Sat Apr 27 16:00:05 2002 +++ perl/win32/buildext.pl Sat Apr 27 16:00:05 2002 @@ -28,6 +28,16 @@ { $perl = "$here\\$perl"; } +(my $topdir = $perl) =~ s/\\[^\\]+$//; +# miniperl needs to find perlglob and pl2bat +$ENV{PATH} = "$topdir;$topdir\\win32\\bin;$ENV{PATH}"; +#print "PATH=$ENV{PATH}\n"; +my $pl2bat = "$topdir\\win32\\bin\\pl2bat"; +unless (-f "$pl2bat.bat") { + my @args = ($perl, ("$pl2bat.pl") x 2); + print "@args\n"; + system(@args); +} my $make = shift; $make .= " ".shift while $ARGV[0]=~/^-/; my $dep = shift; ==== //depot/macperl/win32/makefile.mk#2 (text) ==== Index: perl/win32/makefile.mk --- perl/win32/makefile.mk.~1~ Sat Apr 27 16:00:05 2002 +++ perl/win32/makefile.mk Sat Apr 27 16:00:05 2002 @@ -589,11 +589,14 @@ ..\utils\perlbug \ ..\utils\pl2pm \ ..\utils\c2ph \ + ..\utils\pstruct \ ..\utils\h2xs \ ..\utils\perldoc \ ..\utils\perlcc \ ..\utils\perlivp \ ..\utils\libnetcfg \ + ..\utils\enc2xs \ + ..\utils\piconv \ ..\pod\checkpods \ ..\pod\pod2html \ ..\pod\pod2latex \ @@ -603,6 +606,7 @@ ..\pod\podchecker \ ..\pod\podselect \ ..\x2p\find2perl \ + ..\x2p\psed \ ..\x2p\s2p \ ..\lib\ExtUtils\xsubpp \ bin\exetype.pl \ @@ -1179,14 +1183,14 @@ 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 *.bat - -cd ..\x2p && del /f find2perl s2p *.bat + -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \ + perldoc perlivp dprofpp perlcc libnetcfg enc2xs piconv *.bat + -cd ..\x2p && del /f find2perl s2p psed *.bat -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new -del /f $(CONFIGPM) -del /f bin\*.bat - -cd $(EXTDIR) && del /s *$(a) *.def *.map *.pdb *.bs Makefile *$(o) \ - pm_to_blib + -cd .. && del /s *$(a) *.map *.pdb *.ilk *.bs *$(o) .exists pm_to_blib + -cd $(EXTDIR) && del /s *.def Makefile Makefile.old -if exist $(AUTODIR) rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR) -if exist $(COREDIR) rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR) ==== //depot/macperl/ext/Encode/lib/Encode/Guess.pm#1 (text) ==== Index: perl/ext/Encode/lib/Encode/Guess.pm --- perl/ext/Encode/lib/Encode/Guess.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/lib/Encode/Guess.pm Sat Apr 27 16:00:05 2002 @@ -0,0 +1,293 @@ +package Encode::Guess; +use strict; + +use Encode qw(:fallbacks find_encoding); +our $VERSION = do { my @r = (q$Revision: 1.3 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + +my $Canon = 'Guess'; +our $DEBUG = 0; +our %DEF_SUSPECTS = map { $_ => find_encoding($_) } qw(ascii utf8); +$Encode::Encoding{$Canon} = + bless { + Name => $Canon, + Suspects => { %DEF_SUSPECTS }, + } => __PACKAGE__; + +use base qw(Encode::Encoding); +sub needs_lines { 1 } +sub perlio_ok { 0 } + +our @EXPORT = qw(guess_encoding); + +sub import { # Exporter not used so we do it on our own + my $callpkg = caller; + for my $item (@EXPORT){ + no strict 'refs'; + *{"$callpkg\::$item"} = \&{"$item"}; + } + set_suspects(@_); +} + +sub set_suspects{ + my $class = shift; + my $self = ref($class) ? $class : $Encode::Encoding{$Canon}; + $self->{Suspects} = { %DEF_SUSPECTS }; + $self->add_suspects(@_); +} + +sub add_suspects{ + my $class = shift; + my $self = ref($class) ? $class : $Encode::Encoding{$Canon}; + for my $c (@_){ + my $e = find_encoding($c) or die "Unknown encoding: $c"; + $self->{Suspects}{$e->name} = $e; + $DEBUG and warn "Added: ", $e->name; + } +} + +sub decode($$;$){ + my ($obj, $octet, $chk) = @_; + my $guessed = guess($obj, $octet); + unless (ref($guessed)){ + require Carp; + Carp::croak($guessed); + } + my $utf8 = $guessed->decode($octet, $chk); + $_[1] = $octet if $chk; + return $utf8; +} + +sub guess_encoding{ + guess($Encode::Encoding{$Canon}, @_); +} + +sub guess { + my $class = shift; + my $obj = ref($class) ? $class : $Encode::Encoding{$Canon}; + my $octet = shift; + # cheat 0: utf8 flag; + Encode::is_utf8($octet) and return find_encoding('utf8'); + # cheat 1: BOM + use Encode::Unicode; + my $BOM = unpack('n', $octet); + return find_encoding('UTF-16') + if ($BOM == 0xFeFF or $BOM == 0xFFFe); + $BOM = unpack('N', $octet); + return find_encoding('UTF-32') + if ($BOM == 0xFeFF or $BOM == 0xFFFe0000); + + my %try = %{$obj->{Suspects}}; + for my $c (@_){ + my $e = find_encoding($c) or die "Unknown encoding: $c"; + $try{$e->name} = $e; + $DEBUG and warn "Added: ", $e->name; + } + my $nline = 1; + for my $line (split /\r|\n|\r\n/, $octet){ + # cheat 2 -- \e in the string + if ($line =~ /\e/o){ + my @keys = keys %try; + delete @try{qw/utf8 ascii/}; + for my $k (@keys){ + ref($try{$k}) eq 'Encode::XS' and delete $try{$k}; + } + } + my %ok = %try; + # warn join(",", keys %try); + for my $k (keys %try){ + my $scratch = $line; + $try{$k}->decode($scratch, FB_QUIET); + if ($scratch eq ''){ + $DEBUG and warn sprintf("%4d:%-24s ok\n", $nline, $k); + }else{ + use bytes (); + $DEBUG and + warn sprintf("%4d:%-24s not ok; %d bytes left\n", + $nline, $k, bytes::length($scratch)); + delete $ok{$k}; + + } + } + %ok or return "No appropriate encodings found!"; + if (scalar(keys(%ok)) == 1){ + my ($retval) = values(%ok); + return $retval; + } + %try = %ok; $nline++; + } + $try{ascii} or + return "Encodings too ambiguous: ", join(" or ", keys %try); + return $try{ascii}; +} + + + +1; +__END__ + +=head1 NAME + +Encode::Guess -- Guesses encoding from data + +=head1 SYNOPSIS + + # if you are sure $data won't contain anything bogus + + use Encode::Guess qw/euc-jp shiftjis 7bit-jis/; + my $utf8 = decode("Guess", $data); + my $data = encode("Guess", $utf8); # this doesn't work! + + # more elaborate way + use Encode::Guess, + my $enc = guess_encoding($data, qw/euc-jp shiftjis 7bit-jis/); + ref($enc) or die "Can't guess: $enc"; # trap error this way + $utf8 = $enc->decode($data); + # or + $utf8 = decode($enc->name, $data) + +=head1 ABSTRACT + +Encode::Guess enables you to guess in what encoding a given data is +encoded, or at least tries to. + +=head1 DESCRIPTION + +By default, it checks only ascii, utf8 and UTF-16/32 with BOM. + + use Encode::Guess; # ascii/utf8/BOMed UTF + +To use it more practically, you have to give the names of encodings to +check (I<suspects> as follows). The name of suspects can either be +canonical names or aliases. + + # tries all major Japanese Encodings as well + use Encode::Guess qw/euc-jp shiftjis 7bit-jis/; + +=over 4 + +=item Encode::Guess->set_suspects + +You can also change the internal suspects list via C<set_suspects> +method. + + use Encode::Guess; + Encode::Guess->set_suspects(qw/euc-jp shiftjis 7bit-jis/); + +=item Encode::Guess->add_suspects + +Or you can use C<add_suspects> method. The difference is that +C<set_suspects> flushes the current suspects list while +C<add_suspects> adds. + + use Encode::Guess; + Encode::Guess->add_suspects(qw/euc-jp shiftjis 7bit-jis/); + # now the suspects are euc-jp,shiftjis,7bit-jis, AND + # euc-kr,euc-cn, and big5-eten + Encode::Guess->add_suspects(qw/euc-kr euc-cn big5-eten/); + +=item Encode::decode("Guess" ...) + +When you are content with suspects list, you can now + + my $utf8 = Encode::decode("Guess", $data); + +=item Encode::Guess->guess($data) + +But it will croak if Encode::Guess fails to eliminate all other +suspects but the right one or no suspect was good. So you should +instead try this; + + my $decoder = Encode::Guess->guess($data); + +On success, $decoder is an object that is documented in +L<Encode::Encoding>. So you can now do this; + + my $utf8 = $decoder->decode($data); + +On failure, $decoder now contains an error message so the whole thing +would be as follows; + + my $decoder = Encode::Guess->guess($data); + die $decoder unless ref($decoder); + my $utf8 = $decoder->decode($data); + +=item guess_encoding($data, [, I<list of suspects>]) + +You can also try C<guess_encoding> function which is exported by +default. It takes $data to check and it also takes the list of +suspects by option. The optional suspect list is I<not reflected> to +the internal suspects list. + + my $decoder = guess_encoding($data, qw/euc-jp euc-kr euc-cn/); + die $decoder unless ref($decoder); + my $utf8 = $decoder->decode($data); + # check only ascii and utf8 + my $decoder = guess_encoding($data); + +=back + +=head1 CAVEATS + +=over 4 + +=item * + +Because of the algorithm used, ISO-8859 series and other single-byte +encodings do not work well unless either one of ISO-8859 is the only +one suspect (besides ascii and utf8). + + use Encode::Guess; + # perhaps ok + my $decoder = guess_encoding($data, 'latin1'); + # definitely NOT ok + my $decoder = guess_encoding($data, qw/latin1 greek/); + +The reason is that Encode::Guess guesses encoding by trial and error. +It first splits $data into lines and tries to decode the line for each +suspect. It keeps it going until all but one encoding was eliminated +out of suspects list. ISO-8859 series is just too successful for most +cases (because it fills almost all code points in \x00-\xff). + +=item * + +Do not mix national standard encodings and the corresponding vendor +encodings. + + # a very bad idea + my $decoder + = guess_encoding($data, qw/shiftjis MacJapanese cp932/); + +The reason is that vendor encoding is usually a superset of national +standard so it becomes too ambiguous for most cases. + +=item * + +On the other hand, mixing various national standard encodings +automagically works unless $data is too short to allow for guessing. + + # This is ok if $data is long enough + my $decoder = + guess_encoding($data, qw/euc-cn + euc-jp shiftjis 7bit-jis + euc-kr + big5-eten/); + +=item * + +DO NOT PUT TOO MANY SUSPECTS! Don't you try something like this! + + my $decoder = guess_encoding($data, + Encode->encodings(":all")); + +=back + +It is, after all, just a guess. You should alway be explicit when it +comes to encodings. But there are some, especially Japanese, +environment that guess-coding is a must. Use this module with care. + +=head1 SEE ALSO + +L<Encode>, L<Encode::Encoding> + +=cut + ==== //depot/macperl/ext/Encode/lib/Encode/MIME/Header.pm#1 (text) ==== Index: perl/ext/Encode/lib/Encode/MIME/Header.pm --- perl/ext/Encode/lib/Encode/MIME/Header.pm.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/lib/Encode/MIME/Header.pm Sat Apr 27 16:00:05 2002 @@ -0,0 +1,212 @@ +package Encode::MIME::Header; +use strict; +# use warnings; +our $VERSION = do { my @r = (q$Revision: 1.3 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + +use Encode qw(find_encoding encode_utf8); +use MIME::Base64; +use Carp; + +my %seed = + ( + decode_b => '1', # decodes 'B' encoding ? + decode_q => '1', # decodes 'Q' encoding ? + encode => 'B', # encode with 'B' or 'Q' ? + bpl => 75, # bytes per line + ); + +$Encode::Encoding{'MIME-Header'} = + bless { + %seed, + Name => 'MIME-Header', + } => __PACKAGE__; + +$Encode::Encoding{'MIME-B'} = + bless { + %seed, + decode_q => 0, + Name => 'MIME-B', + } => __PACKAGE__; + +$Encode::Encoding{'MIME-Q'} = + bless { + %seed, + decode_q => 1, + encode => 'Q', + Name => 'MIME-Q', + } => __PACKAGE__; + +use base qw(Encode::Encoding); + +sub needs_lines { 1 } +sub perlio_ok{ 0 }; + +sub decode($$;$){ + use utf8; + my ($obj, $str, $chk) = @_; + # zap spaces between encoded words + $str =~ s/\?=\s+=\?/\?==\?/gos; + # multi-line header to single line + $str =~ s/(:?\r|\n|\r\n)[ \t]//gos; + $str =~ + s{ + =\? # begin encoded word + ([0-9A-Za-z\-]+) # charset (encoding) + \?([QqBb])\? # delimiter + (.*?) # Base64-encodede contents + \?= # end encoded word + }{ + if (uc($2) eq 'B'){ + $obj->{decode_b} or croak qq(MIME "B" unsupported); + decode_b($1, $3); + }elsif(uc($2) eq 'Q'){ + $obj->{decode_q} or croak qq(MIME "Q" unsupported); + decode_q($1, $3); + }else{ + croak qq(MIME "$2" encoding is nonexistent!); + } + }egox; + $_[1] = '' if $chk; + return $str; +} + +sub decode_b{ + my $enc = shift; + my $d = find_encoding($enc) or croak(Unknown encoding "$enc"); + my $db64 = decode_base64(shift); + return $d->decode($db64, Encode::FB_PERLQQ); +} + +sub decode_q{ + my ($enc, $q) = @_; + my $d = find_encoding($enc) or croak(Unknown encoding "$enc"); + $q =~ s/_/ /go; + $q =~ s/=([0-9A-Fa-f]{2})/pack("C", hex($1))/ego; + return $d->decode($q, Encode::FB_PERLQQ); +} + +my $especials = + join('|' => + map {quotemeta(chr($_))} + unpack("C*", qq{()<>@,;:\"\'/[]?.=})); + +my $re_especials = qr/$especials/o; + +sub encode($$;$){ + my ($obj, $str, $chk) = @_; + my @line = (); + for my $line (split /\r|\n|\r\n/o, $str){ + my (@word, @subline); + for my $word (split /($re_especials)/o, $line){ + if ($word =~ /[^\x00-\x7f]/o){ + push @word, $obj->_encode($word); + }else{ + push @word, $word; + } + } + my $subline = ''; + for my $word (@word){ + use bytes (); + if (bytes::length($subline) + bytes::length($word) > $obj->{bpl}){ + push @subline, $subline; + $subline = ''; + } + $subline .= $word; + } + $subline and push @subline, $subline; + push @line, join("\n " => @subline); + } + $_[1] = '' if $chk; + return join("\n", @line); +} + +use constant HEAD => '=?UTF-8?'; +use constant TAIL => '?='; +use constant SINGLE => { B => \&_encode_b, Q => \&_encode_q, }; + +sub _encode{ + my ($o, $str) = @_; + my $enc = $o->{encode}; + my $llen = ($o->{bpl} - length(HEAD) - 2 - length(TAIL)); + $llen *= $enc eq 'B' ? 3/4 : 1/3; + my @result = (); + my $chunk = ''; + while(my $chr = substr($str, 0, 1, '')){ + use bytes (); + if (bytes::length($chunk) + bytes::length($chr) > $llen){ + push @result, SINGLE->{$enc}($chunk); + $chunk = ''; + } + $chunk .= $chr; + } + $chunk and push @result, SINGLE->{$enc}($chunk); + return @result; +} + +sub _encode_b{ + HEAD . 'B?' . encode_base64(encode_utf8(shift), '') . TAIL; +} + +sub _encode_q{ + my $chunk = shift; + $chunk =~ s{ + ([^0-9A-Za-z]) + }{ + join("" => map {sprintf "=%02X", $_} unpack("C*", $1)) + }egox; + return HEAD . 'Q?' . $chunk . TAIL; +} + +1; +__END__ + +=head1 NAME + +Encode::MIME::Header -- MIME 'B' and 'Q' header encoding + +=head1 SYNOPSIS + + use Encode qw/encode decode/; + $utf8 = decode('MIME-Header', $header); + $header = encode('MIME-Header', $utf8); + +=head1 ABSTRACT + +This module implements RFC 2047 Mime Header Encoding. There are 3 +variant encoding names; C<MIME-Header>, C<MIME-B> and C<MIME-Q>. The +difference is described below + + decode() encode() + ---------------------------------------------- + MIME-Header Both B and Q =?UTF-8?B?....?= + MIME-B B only; Q croaks =?UTF-8?B?....?= + MIME-Q Q only; B croaks =?UTF-8?Q?....?= + +=head1 DESCRIPTION + +When you decode(=?I<encoding>?I<X>?I<ENCODED WORD>?=), I<ENCODED WORD> +is extracted and decoded for I<X> encoding (B for Base64, Q for +Quoted-Printable). Then the decoded chunk is fed to +decode(I<encoding>). So long as I<encoding> is supported by Encode, +any source encoding is fine. + +When you encode, it just encodes UTF-8 string with I<X> encoding then +quoted with =?UTF-8?I<X>?....?= . The parts that RFC 2047 forbids to +encode are left as is and long lines are folded within 76 bytes per +line. + +=head1 BUGS + +It would be nice to support encoding to non-UTF8, such as =?ISO-2022-JP? +and =?ISO-8859-1?= but that makes the implementation too complicated. +These days major mail agents all support =?UTF-8? so I think it is +just good enough. + +=head1 SEE ALSO + +L<Encode> + +RFC 2047, L<http://www.faqs.org/rfcs/rfc2047.html> and many other +locations. + +=cut ==== //depot/macperl/ext/Encode/t/guess.t#1 (text) ==== Index: perl/ext/Encode/t/guess.t --- perl/ext/Encode/t/guess.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/t/guess.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,83 @@ +BEGIN { + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + require Config; import Config; + if ($Config{'extensions'} !~ /\bEncode\b/) { + print "1..0 # Skip: Encode was not built\n"; + exit 0; + } + $| = 1; +} + +use strict; +use File::Basename; +use File::Spec; +use Encode qw(decode encode find_encoding _utf8_off); + +#use Test::More qw(no_plan); +use Test::More tests => 17; +use_ok("Encode::Guess"); +{ + no warnings; + $Encode::Guess::DEBUG = shift || 0; +} + +my $ascii = join('' => map {chr($_)}(0x21..0x7e)); +my $latin1 = join('' => map {chr($_)}(0xa1..0xfe)); +my $utf8on = join('' => map {chr($_)}(0x3000..0x30fe)); +my $utf8off = $utf8on; _utf8_off($utf8off); +my $utf16 = encode('UTF-16', $utf8on); +my $utf32 = encode('UTF-32', $utf8on); + +is(guess_encoding($ascii)->name, 'ascii', 'ascii'); +like(guess_encoding($latin1), qr/No appropriate encoding/io, 'no ascii'); +is(guess_encoding($latin1, 'latin1')->name, 'iso-8859-1', 'iso-8859-1'); +is(guess_encoding($utf8on)->name, 'utf8', 'utf8 w/ flag'); +is(guess_encoding($utf8off)->name, 'utf8', 'utf8 w/o flag'); +is(guess_encoding($utf16)->name, 'UTF-16', 'UTF-16'); +is(guess_encoding($utf32)->name, 'UTF-32', 'UTF-32'); + +my $jisx0201 = File::Spec->catfile(dirname(__FILE__), 'jisx0201.utf'); +my $jisx0208 = File::Spec->catfile(dirname(__FILE__), 'jisx0208.utf'); +my $jisx0212 = File::Spec->catfile(dirname(__FILE__), 'jisx0212.utf'); + +open my $fh, $jisx0208 or die "$jisx0208: $!"; +$utf8off = join('' => <$fh>); +close $fh; +$utf8on = decode('utf8', $utf8off); + +my @jp = qw(7bit-jis shiftjis euc-jp); + +Encode::Guess->set_suspects(@jp); + +for my $jp (@jp){ + my $test = encode($jp, $utf8on); + is(guess_encoding($test)->name, $jp, "JP:$jp"); +} + +is (decode('Guess', encode('euc-jp', $utf8on)), $utf8on, "decode('Guess')"); +eval{ encode('Guess', $utf8on) }; +like($@, qr/not defined/io, "no encode()"); + +my %CJKT = + ( + 'euc-cn' => File::Spec->catfile(dirname(__FILE__), 'gb2312.utf'), + 'euc-jp' => File::Spec->catfile(dirname(__FILE__), 'jisx0208.utf'), + 'euc-kr' => File::Spec->catfile(dirname(__FILE__), 'ksc5601.utf'), + 'big5-eten' => File::Spec->catfile(dirname(__FILE__), 'big5-eten.utf'), +); + +Encode::Guess->set_suspects(keys %CJKT); + +for my $name (keys %CJKT){ + open my $fh, $CJKT{$name} or die "$CJKT{$name}: $!"; + $utf8off = join('' => <$fh>); + close $fh; + + my $test = encode($name, decode('utf8', $utf8off)); + is(guess_encoding($test)->name, $name, "CJKT:$name"); +} + +__END__; ==== //depot/macperl/ext/Encode/t/mime-header.t#1 (text) ==== Index: perl/ext/Encode/t/mime-header.t --- perl/ext/Encode/t/mime-header.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Encode/t/mime-header.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,77 @@ +# +# $Id: mime-header.t,v 1.3 2002/04/26 03:07:59 dankogai Exp $ +# This script is written in utf8 +# +BEGIN { + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + require Config; import Config; + if ($Config{'extensions'} !~ /\bEncode\b/) { + print "1..0 # Skip: Encode was not built\n"; + exit 0; + } + $| = 1; +} + +use strict; +#use Test::More qw(no_plan); +use Test::More tests => 6; +use_ok("Encode::MIME::Header"); + +my $eheader =<<'EOS'; +From: =?US-ASCII?Q?Keith_Moore?= <[email protected]> +To: =?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?= <[email protected]> +CC: =?ISO-8859-1?Q?Andr=E9?= Pirard <[email protected]> +Subject: =?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?= + =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?= +EOS + +my $dheader=<<"EOS"; +From: Keith Moore <moore\@cs.utk.edu> +To: Keld J\xF8rn Simonsen <keld\@dkuug.dk> +CC: Andr\xE9 Pirard <PIRARD\@vm1.ulg.ac.be> +Subject: If you can read this you understand the example. +EOS + +is(Encode::decode('MIME-Header', $eheader), $dheader, "decode (RFC2047)"); + +use utf8; + +$dheader=<<'EOS'; +From: ÂèÈ£º ºæ <[email protected]> +To: [email protected] (ÂèÈ£º=Kogai, ºæ=Dan) +Subject: ʺ¢ÂóÄÅÇ´ÇøÇ´ÉäÄÅžÇâÅåÅÇíÂê´ÇÄÄÅÈùû½½Å´Èï ÅÑÇøǧÉàÉ´Ë°åÅå½ÄìÂÖ®ìÅ©ÅÆÇàÅÜÅ´ÅóŶEncodeÅïÇåÇãÅÆÅãÔºü +EOS + +my $bheader =<<'EOS'; +From:=?UTF-8?B?IOWwj+mjvCDlvL4g?=<[email protected]> +To: [email protected] (=?UTF-8?B?5bCP6aO8?==Kogai,=?UTF-8?B?IOW8vg==?==Dan + ) +Subject: + =?UTF-8?B?IOa8ouWtl+OAgeOCq+OCv+OCq+ODiuOAgeOBsuOCieOBjOOBquOCkuWQq+OCgA==?= + =?UTF-8?B?44CB6Z2e5bi444Gr6ZW344GE44K/44Kk44OI44Or6KGM44GM5LiA5L2T5YWo?= + =?UTF-8?B?5L2T44Gp44Gu44KI44GG44Gr44GX44GmRW5jb2Rl44GV44KM44KL44Gu44GL?= + =?UTF-8?B?77yf?= +EOS + +my $qheader=<<'EOS'; +From:=?UTF-8?Q?=20=E5=B0=8F=E9=A3=BC=20=E5=BC=BE=20?=<[email protected]> +To: [email protected] (=?UTF-8?Q?=E5=B0=8F=E9=A3=BC?==Kogai, + =?UTF-8?Q?=20=E5=BC=BE?==Dan) +Subject: + =?UTF-8?Q?=20=E6=BC=A2=E5=AD=97=E3=80=81=E3=82=AB=E3=82=BF=E3=82=AB?= + =?UTF-8?Q?=E3=83=8A=E3=80=81=E3=81=B2=E3=82=89=E3=81=8C=E3=81=AA=E3=82=92?= + =?UTF-8?Q?=E5=90=AB=E3=82=80=E3=80=81=E9=9D=9E=E5=B8=B8=E3=81=AB=E9=95=B7?= + =?UTF-8?Q?=E3=81=84=E3=82=BF=E3=82=A4=E3=83=88=E3=83=AB=E8=A1=8C=E3=81=8C?= + =?UTF-8?Q?=E4=B8=80=E4=BD=93=E5=85=A8=E4=BD=93=E3=81=A9=E3=81=AE=E3=82=88?= + =?UTF-8?Q?=E3=81=86=E3=81=AB=E3=81=97=E3=81=A6Encode=E3=81=95?= + =?UTF-8?Q?=E3=82=8C=E3=82=8B=E3=81=AE=E3=81=8B=EF=BC=9F?= +EOS + +is(Encode::decode('MIME-Header', $bheader), $dheader, "decode B"); +is(Encode::decode('MIME-Header', $qheader), $dheader, "decode Q"); +is(Encode::encode('MIME-B', $dheader)."\n", $bheader, "encode B"); +is(Encode::encode('MIME-Q', $dheader)."\n", $qheader, "encode Q"); +__END__; ==== //depot/macperl/ext/Storable/t/croak.t#1 (text) ==== Index: perl/ext/Storable/t/croak.t --- perl/ext/Storable/t/croak.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Storable/t/croak.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,41 @@ +#!./perl -w + +# Please keep this test this simple. (ie just one test.) +# There's some sort of not-croaking properly problem in Storable when built +# with 5.005_03. This test shows it up, whereas malice.t does not. +# In particular, don't use Test; as this covers up the problem. + +sub BEGIN { + if ($ENV{PERL_CORE}){ + chdir('t') if -d 't'; + @INC = '.'; + push @INC, '../lib'; + } + require Config; import Config; + if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { + print "1..0 # Skip: Storable was not built\n"; + exit 0; + } + # require 'lib/st-dump.pl'; +} + +use strict; + +BEGIN { + die "Oi! No! Don't change this test so that Carp is used before Storable" + if defined &Carp::carp; +} +use Storable qw(freeze thaw); + +print "1..2\n"; + +for my $test (1,2) { + eval {thaw "\xFF\xFF"}; + if ($@ =~ /Storable binary image v127.255 more recent than I am \(v2\.\d+\)/) + { + print "ok $test\n"; + } else { + chomp $@; + print "not ok $test # Expected a meaningful croak. Got '$@'\n"; + } +} ==== //depot/macperl/ext/Storable/t/downgrade.t#1 (text) ==== Index: perl/ext/Storable/t/downgrade.t --- perl/ext/Storable/t/downgrade.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Storable/t/downgrade.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,378 @@ +#!./perl -w + +# +# Copyright 2002, Larry Wall. +# +# You may redistribute only under the same terms as Perl 5, as specified +# in the README file that comes with the distribution. +# + +# I ought to keep this test easily backwards compatible to 5.004, so no +# qr//; + +# This test checks downgrade behaviour on pre-5.8 perls when new 5.8 features +# are encountered. + +sub BEGIN { + if ($ENV{PERL_CORE}){ + chdir('t') if -d 't'; + @INC = '.'; + push @INC, '../lib'; + } + require Config; import Config; + if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { + print "1..0 # Skip: Storable was not built\n"; + exit 0; + } + # require 'lib/st-dump.pl'; +} + +BEGIN { + if (ord 'A' != 65) { + die <<'EBCDIC'; +This test doesn't have EBCDIC data yet. Please run t/make_downgrade.pl using +perl 5.8 (or later) and append its output to the end of the test. +Please also mail the output to [email protected] so that the CPAN copy of +Storable can be updated. +EBCDIC + } +} +use Test::More; +use Storable 'thaw'; + +use strict; +use vars qw(@RESTRICT_TESTS %R_HASH %U_HASH $UTF8_CROAK $RESTRICTED_CROAK); + +@RESTRICT_TESTS = ('Locked hash', 'Locked hash placeholder', + 'Locked keys', 'Locked keys placeholder', + ); +%R_HASH = (perl => 'rules'); + +if ($] >= 5.007003) { + my $utf8 = "Schlo\xdf" . chr 256; + chop $utf8; + + %U_HASH = (map {$_, $_} 'castle', "ch\xe5teau", $utf8, chr 0x57CE); + plan tests => 169; +} elsif ($] >= 5.006) { + plan tests => 59; +} else { + plan tests => 67; +} + +$UTF8_CROAK = qr/^Cannot retrieve UTF8 data in non-UTF8 perl/; +$RESTRICTED_CROAK = qr/^Cannot retrieve restricted hash/; + +my %tests; +{ + local $/ = "\n\nend\n"; + while (<DATA>) { + next unless /\S/s; + unless (/begin ([0-7]{3}) ([^\n]*)\n(.*)$/s) { + s/\n.*//s; + warn "Dodgy data in section starting '$_'"; + next; + } + next unless oct $1 == ord 'A'; # Skip ASCII on EBCDIC, and vice versa + my $data = unpack 'u', $3; + $tests{$2} = $data; + } +} + +# use Data::Dumper; $Data::Dumper::Useqq = 1; print Dumper \%tests; +sub thaw_hash { + my ($name, $expected) = @_; + my $hash = eval {thaw $tests{$name}}; + is ($@, '', "Thawed $name without error?"); + isa_ok ($hash, 'HASH'); + ok (defined $hash && eq_hash($hash, $expected), + "And it is the hash we expected?"); + $hash; +} + +sub thaw_scalar { + my ($name, $expected) = @_; + my $scalar = eval {thaw $tests{$name}}; + is ($@, '', "Thawed $name without error?"); + isa_ok ($scalar, 'SCALAR', "Thawed $name?"); + is ($$scalar, $expected, "And it is the data we expected?"); + $scalar; +} + +sub thaw_fail { + my ($name, $expected) = @_; + my $thing = eval {thaw $tests{$name}}; + is ($thing, undef, "Thawed $name failed as expected?"); + like ($@, $expected, "Error as predicted?"); +} + +sub test_locked_hash { + my $hash = shift; + my @keys = keys %$hash; + my ($key, $value) = each %$hash; + eval {$hash->{$key} = reverse $value}; + like( $@, qr/^Modification of a read-only value attempted/, + 'trying to change a locked key' ); + is ($hash->{$key}, $value, "hash should not change?"); + eval {$hash->{use} = 'perl'}; + like( $@, qr/^Attempt to access disallowed key 'use' in a restricted hash/, + 'trying to add another key' ); + ok (eq_array([keys %$hash], \@keys), "Still the same keys?"); +} + +sub test_restricted_hash { + my $hash = shift; + my @keys = keys %$hash; + my ($key, $value) = each %$hash; + eval {$hash->{$key} = reverse $value}; + is( $@, '', + 'trying to change a restricted key' ); + is ($hash->{$key}, reverse ($value), "hash should change"); + eval {$hash->{use} = 'perl'}; + like( $@, qr/^Attempt to access disallowed key 'use' in a restricted hash/, + 'trying to add another key' ); + ok (eq_array([keys %$hash], \@keys), "Still the same keys?"); +} + +sub test_placeholder { + my $hash = shift; + eval {$hash->{rules} = 42}; + is ($@, '', 'No errors'); + is ($hash->{rules}, 42, "New value added"); +} + +sub test_newkey { + my $hash = shift; + eval {$hash->{nms} = "http://nms-cgi.sourceforge.net/"}; + is ($@, '', 'No errors'); + is ($hash->{nms}, "http://nms-cgi.sourceforge.net/", "New value added"); +} + +# $Storable::DEBUGME = 1; +thaw_hash ('Hash with utf8 flag but no utf8 keys', \%R_HASH); + +if (eval "use Hash::Util; 1") { + print "# We have Hash::Util, so test that the restricted hashes in <DATA> are valid\n"; + for $Storable::downgrade_restricted (0, 1, undef, "cheese") { + my $hash = thaw_hash ('Locked hash', \%R_HASH); + test_locked_hash ($hash); + $hash = thaw_hash ('Locked hash placeholder', \%R_HASH); + test_locked_hash ($hash); + test_placeholder ($hash); + + $hash = thaw_hash ('Locked keys', \%R_HASH); + test_restricted_hash ($hash); + $hash = thaw_hash ('Locked keys placeholder', \%R_HASH); + test_restricted_hash ($hash); + test_placeholder ($hash); + } +} else { + print "# We don't have Hash::Util, so test that the restricted hashes downgrade\n"; + my $hash = thaw_hash ('Locked hash', \%R_HASH); + test_newkey ($hash); + $hash = thaw_hash ('Locked hash placeholder', \%R_HASH); + test_newkey ($hash); + $hash = thaw_hash ('Locked keys', \%R_HASH); + test_newkey ($hash); + $hash = thaw_hash ('Locked keys placeholder', \%R_HASH); + test_newkey ($hash); + local $Storable::downgrade_restricted = 0; + thaw_fail ('Locked hash', $RESTRICTED_CROAK); + thaw_fail ('Locked hash placeholder', $RESTRICTED_CROAK); + thaw_fail ('Locked keys', $RESTRICTED_CROAK); + thaw_fail ('Locked keys placeholder', $RESTRICTED_CROAK); +} + +if ($] >= 5.006) { + print "# We have utf8 scalars, so test that the utf8 scalars in <DATA> are valid\n"; + print "# These seem to fail on 5.6 - you should seriously consider upgrading to 5.6.1\n" if $] == 5.006; + thaw_scalar ('Short 8 bit utf8 data', "\xDF"); + thaw_scalar ('Long 8 bit utf8 data', "\xDF" x 256); + thaw_scalar ('Short 24 bit utf8 data', chr 0xC0FFEE); + thaw_scalar ('Long 24 bit utf8 data', chr (0xC0FFEE) x 256); +} else { + print "# We don't have utf8 scalars, so test that the utf8 scalars downgrade\n"; + thaw_fail ('Short 8 bit utf8 data', $UTF8_CROAK); + thaw_fail ('Long 8 bit utf8 data', $UTF8_CROAK); + thaw_fail ('Short 24 bit utf8 data', $UTF8_CROAK); + thaw_fail ('Long 24 bit utf8 data', $UTF8_CROAK); + local $Storable::drop_utf8 = 1; + my $bytes = thaw $tests{'Short 8 bit utf8 data as bytes'}; + thaw_scalar ('Short 8 bit utf8 data', $$bytes); + thaw_scalar ('Long 8 bit utf8 data', $$bytes x 256); + $bytes = thaw $tests{'Short 24 bit utf8 data as bytes'}; + thaw_scalar ('Short 24 bit utf8 data', $$bytes); + thaw_scalar ('Long 24 bit utf8 data', $$bytes x 256); +} + +if ($] >= 5.007003) { + print "# We have utf8 hashes, so test that the utf8 hashes in <DATA> are valid\n"; + my $hash = thaw_hash ('Hash with utf8 keys', \%U_HASH); + for (keys %$hash) { + my $l = 0 + /^\w+$/; + my $r = 0 + $hash->{$_} =~ /^\w+$/; + cmp_ok ($l, '==', $r, sprintf "key length %d", length $_); + cmp_ok ($l, '==', $_ eq "ch\xe5teau" ? 0 : 1); + } + if (eval "use Hash::Util; 1") { + print "# We have Hash::Util, so test that the restricted utf8 hash is valid\n"; + my $hash = thaw_hash ('Locked hash with utf8 keys', \%U_HASH); + for (keys %$hash) { + my $l = 0 + /^\w+$/; + my $r = 0 + $hash->{$_} =~ /^\w+$/; + cmp_ok ($l, '==', $r, sprintf "key length %d", length $_); + cmp_ok ($l, '==', $_ eq "ch\xe5teau" ? 0 : 1); + } + test_locked_hash ($hash); + } else { + print "# We don't have Hash::Util, so test that the utf8 hash downgrades\n"; + fail ("You can't get here [perl version $]]. This is a bug in the test. +# Please send the output of perl -V to perlbug\@perl.org"); + } +} else { + print "# We don't have utf8 hashes, so test that the utf8 hashes downgrade\n"; + thaw_fail ('Hash with utf8 keys', $UTF8_CROAK); + thaw_fail ('Locked hash with utf8 keys', $UTF8_CROAK); + local $Storable::drop_utf8 = 1; + my $what = $] < 5.006 ? 'pre 5.6' : '5.6'; + my $expect = thaw $tests{"Hash with utf8 keys for $what"}; + thaw_hash ('Hash with utf8 keys', $expect); + #foreach (keys %$expect) { print "'$_':\t'$expect->{$_}'\n"; } + #foreach (keys %$got) { print "'$_':\t'$got->{$_}'\n"; } + if (eval "use Hash::Util; 1") { + print "# We have Hash::Util, so test that the restricted hashes in <DATA> are valid\n"; + fail ("You can't get here [perl version $]]. This is a bug in the test. +# Please send the output of perl -V to perlbug\@perl.org"); + } else { + print "# We don't have Hash::Util, so test that the restricted hashes downgrade\n"; + my $hash = thaw_hash ('Locked hash with utf8 keys', $expect); + test_newkey ($hash); + local $Storable::downgrade_restricted = 0; + thaw_fail ('Locked hash with utf8 keys', $RESTRICTED_CROAK); + # Which croak comes first is a bit of an implementation issue :-) + local $Storable::drop_utf8 = 0; + thaw_fail ('Locked hash with utf8 keys', $RESTRICTED_CROAK); + } +} +__END__ +# A whole run of 2.x nfreeze data, uuencoded. The "mode bits" are the octal +# value of 'A', the "file name" is the test name. Use make_downgrade.pl to +# generate these. +begin 101 Locked hash +8!049`0````$*!7)U;&5S!`````1P97)L + +end + +begin 101 Locked hash placeholder +C!049`0````(*!7)U;&5S!`````1P97)L#A0````%<G5L97,` + +end + +begin 101 Locked keys +8!049`0````$*!7)U;&5S``````1P97)L + +end + +begin 101 Locked keys placeholder +C!049`0````(*!7)U;&5S``````1P97)L#A0````%<G5L97,` + +end + +begin 101 Short 8 bit utf8 data +&!047`L.? + +end + +begin 101 Short 8 bit utf8 data as bytes +&!04*`L.? + +end + +begin 101 Long 8 bit utf8 data +M!048```"`,.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.? +MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_# +MG\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.? +MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_# +MG\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.? +MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_# +MG\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.? +MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_# +MG\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.? +MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_# +MG\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.? +8PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.? + +end + +begin 101 Short 24 bit utf8 data +)!047!?BPC[^N + +end + +begin 101 Short 24 bit utf8 data as bytes +)!04*!?BPC[^N + +end + +begin 101 Long 24 bit utf8 data +M!048```%`/BPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +MOZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N^+"/ +;OZ[XL(^_KOBPC[^N^+"/OZ[XL(^_KOBPC[^N + +end + +begin 101 Hash with utf8 flag but no utf8 keys +8!049``````$*!7)U;&5S``````1P97)L + +end + +begin 101 Hash with utf8 keys +M!049``````0*!F-A<W1L90`````&8V%S=&QE"@=C:.5T96%U``````=C:.5T +D96%U%P/EGXX!`````^6?CA<'4V-H;&_#GP(````&4V-H;&_? + +end + +begin 101 Locked hash with utf8 keys +M!049`0````0*!F-A<W1L900````&8V%S=&QE"@=C:.5T96%U!`````=C:.5T +D96%U%P/EGXX%`````^6?CA<'4V-H;&_#GP8````&4V-H;&_? + +end + +begin 101 Hash with utf8 keys for pre 5.6 +M!049``````0*!F-A<W1L90`````&8V%S=&QE"@=C:.5T96%U``````=C:.5T +D96%U"@/EGXX``````^6?C@H'4V-H;&_#GP(````&4V-H;&_? + +end + +begin 101 Hash with utf8 keys for 5.6 +M!049``````0*!F-A<W1L90`````&8V%S=&QE"@=C:.5T96%U``````=C:.5T +D96%U%P/EGXX``````^6?CA<'4V-H;&_#GP(````&4V-H;&_? + +end + ==== //depot/macperl/ext/Storable/t/make_downgrade.pl#1 (text) ==== Index: perl/ext/Storable/t/make_downgrade.pl --- perl/ext/Storable/t/make_downgrade.pl.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/Storable/t/make_downgrade.pl Sat Apr 27 16:00:05 2002 @@ -0,0 +1,103 @@ +#!/usr/local/bin/perl -w +use strict; + +use 5.007003; +use Hash::Util qw(lock_hash unlock_hash lock_keys); +use Storable qw(nfreeze); + +# If this looks like a hack, it's probably because it is :-) +sub uuencode_it { + my ($data, $name) = @_; + my $frozen = nfreeze $data; + + my $uu = pack 'u', $frozen; + + printf "begin %3o $name\n", ord 'A'; + print $uu; + print "\nend\n\n"; +} + + +my %hash = (perl=>"rules"); + +lock_hash %hash; + +uuencode_it (\%hash, "Locked hash"); + +unlock_hash %hash; + +lock_keys %hash, 'perl', 'rules'; +lock_hash %hash; + +uuencode_it (\%hash, "Locked hash placeholder"); + +unlock_hash %hash; + +lock_keys %hash, 'perl'; + +uuencode_it (\%hash, "Locked keys"); + +unlock_hash %hash; + +lock_keys %hash, 'perl', 'rules'; + +uuencode_it (\%hash, "Locked keys placeholder"); + +unlock_hash %hash; + +my $utf8 = "\x{DF}\x{100}"; +chop $utf8; + +uuencode_it (\$utf8, "Short 8 bit utf8 data"); + +utf8::encode ($utf8); + +uuencode_it (\$utf8, "Short 8 bit utf8 data as bytes"); + +$utf8 x= 256; + +uuencode_it (\$utf8, "Long 8 bit utf8 data"); + +$utf8 = "\x{C0FFEE}"; + +uuencode_it (\$utf8, "Short 24 bit utf8 data"); + +utf8::encode ($utf8); + +uuencode_it (\$utf8, "Short 24 bit utf8 data as bytes"); + +$utf8 x= 256; + +uuencode_it (\$utf8, "Long 24 bit utf8 data"); + +# Hash which has the utf8 bit set, but no longer has any utf8 keys +my %uhash = ("\x{100}", "gone", "perl", "rules"); +delete $uhash{"\x{100}"}; + +# use Devel::Peek; Dump \%uhash; +uuencode_it (\%uhash, "Hash with utf8 flag but no utf8 keys"); + +$utf8 = "Schlo\xdf" . chr 256; +chop $utf8; +%uhash = (map {$_, $_} 'castle', "ch\xe5teau", $utf8, "\x{57CE}"); + +uuencode_it (\%uhash, "Hash with utf8 keys"); + +lock_hash %uhash; + +uuencode_it (\%uhash, "Locked hash with utf8 keys"); + +my (%pre56, %pre58); + +while (my ($key, $val) = each %uhash) { + # hash keys are always stored downgraded to bytes if possible, with a flag + # to say "promote back to utf8" + # Whereas scalars are stored as is. + utf8::encode ($key) if ord $key > 256; + $pre58{$key} = $val; + utf8::encode ($val) unless $val eq "ch\xe5teau"; + $pre56{$key} = $val; + +} +uuencode_it (\%pre56, "Hash with utf8 keys for pre 5.6"); +uuencode_it (\%pre58, "Hash with utf8 keys for 5.6"); ==== //depot/macperl/ext/threads/shared/t/cond.t#1 (text) ==== Index: perl/ext/threads/shared/t/cond.t --- perl/ext/threads/shared/t/cond.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/ext/threads/shared/t/cond.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,40 @@ +BEGIN { + chdir 't' if -d 't'; + push @INC ,'../lib'; + require Config; import Config; + unless ($Config{'useithreads'}) { + print "1..0 # Skip: no threads\n"; + exit 0; + } +} +print "1..5\n"; +use strict; + + +use threads; + +use threads::shared; + +my $lock : shared; + +sub foo { + lock($lock); + print "ok 1\n"; + sleep 2; + print "ok 2\n"; + cond_wait($lock); + print "ok 5\n"; +} + +sub bar { + lock($lock); + print "ok 3\n"; + cond_signal($lock); + print "ok 4\n"; +} + +my $tr = threads->create(\&foo); +my $tr2 = threads->create(\&bar); +$tr->join(); +$tr2->join(); + ==== //depot/macperl/lib/ExtUtils/t/00setup_dummy.t#1 (text) ==== Index: perl/lib/ExtUtils/t/00setup_dummy.t --- perl/lib/ExtUtils/t/00setup_dummy.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/00setup_dummy.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,90 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} +chdir 't'; + +use strict; +use Test::More tests => 7; +use File::Path; +use File::Basename; + +my %Files = ( + 'Big-Dummy/lib/Big/Dummy.pm' => <<'END', +package Big::Dummy; + +$VERSION = 0.01; + +1; +END + + 'Big-Dummy/Makefile.PL' => <<'END', +use ExtUtils::MakeMaker; + +printf "Current package is: %s\n", __PACKAGE__; + +WriteMakefile( + NAME => 'Big::Dummy', + VERSION_FROM => 'lib/Big/Dummy.pm', + PREREQ_PM => {}, +); +END + + 'Big-Dummy/Liar/lib/Big/Liar.pm' => <<'END', +package Big::Liar; + +$VERSION = 0.01; + +1; +END + + 'Big-Dummy/Liar/Makefile.PL' => <<'END', +use ExtUtils::MakeMaker; + +my $mm = WriteMakefile( + NAME => 'Big::Liar', + VERSION_FROM => 'lib/Big/Liar.pm', + _KEEP_AFTER_FLUSH => 1 + ); + +print "Big::Liar's vars\n"; +foreach my $key (qw(INST_LIB INST_ARCHLIB)) { + print "$key = $mm->{$key}\n"; +} +END + + 'Problem-Module/Makefile.PL' => <<'END', +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Problem::Module', +); +END + + 'Problem-Module/subdir/Makefile.PL' => <<'END', +printf "\@INC %s .\n", (grep { $_ eq '.' } @INC) ? "has" : "doesn't have"; + +warn "I think I'm going to be sick\n"; +die "YYYAaaaakkk\n"; +END + + ); + +while(my($file, $text) = each %Files) { + my $dir = dirname($file); + mkpath $dir; + open(FILE, ">$file"); + print FILE $text; + close FILE; + + ok( -e $file, "$file created" ); +} + + +pass("Setup done"); ==== //depot/macperl/lib/ExtUtils/t/VERSION_FROM.t#1 (text) ==== Index: perl/lib/ExtUtils/t/VERSION_FROM.t --- perl/lib/ExtUtils/t/VERSION_FROM.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/VERSION_FROM.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,37 @@ +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't' if -d 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +chdir 't'; + +use strict; +use Test::More tests => 1; +use MakeMaker::Test::Utils; +use ExtUtils::MakeMaker; +use TieOut; +use File::Path; + +perl_lib(); + +mkdir 'Odd-Version'; +END { chdir File::Spec->updir; rmtree 'Odd-Version' } +chdir 'Odd-Version'; + +open(MPL, ">Version") || die $!; +print MPL "\$VERSION = 0\n"; +close MPL; +END { unlink 'Version' } + +my $stdout = tie *STDOUT, 'TieOut' or die; +my $mm = WriteMakefile( + NAME => 'Version', + VERSION_FROM => 'Version' +); + +is( $mm->{VERSION}, 0, 'VERSION_FROM when $VERSION = 0' ); ==== //depot/macperl/lib/ExtUtils/t/backwards.t#1 (text) ==== Index: perl/lib/ExtUtils/t/backwards.t --- perl/lib/ExtUtils/t/backwards.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/backwards.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,25 @@ +#!/usr/bin/perl -w + +# This is a test for all the odd little backwards compatible things +# MakeMaker has to support. And we do mean backwards. + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't' if -d 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use Test::More tests => 2; + +require ExtUtils::MakeMaker; + +# CPAN.pm wants MM. +can_ok('MM', 'new'); + +# Pre 5.8 ExtUtils::Embed wants MY. +can_ok('MY', 'catdir'); ==== //depot/macperl/lib/ExtUtils/t/zz_cleanup_dummy.t#1 (text) ==== Index: perl/lib/ExtUtils/t/zz_cleanup_dummy.t --- perl/lib/ExtUtils/t/zz_cleanup_dummy.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/ExtUtils/t/zz_cleanup_dummy.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,21 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} +chdir 't'; + + +use strict; +use Test::More tests => 2; +use File::Path; + +rmtree('Big-Dummy'); +ok(!-d 'Big-Dummy', 'Big-Dummy cleaned up'); +rmtree('Problem-Module'); +ok(!-d 'Problem-Module', 'Problem-Module cleaned up'); ==== //depot/macperl/lib/Test/Simple/t/curr_test.t#1 (text) ==== Index: perl/lib/Test/Simple/t/curr_test.t --- perl/lib/Test/Simple/t/curr_test.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/t/curr_test.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,11 @@ +#!/usr/bin/perl -w + +# Dave Rolsky found a bug where if current_test() is used and no +# tests are run via Test::Builder it will blow up. + +use Test::Builder; +$TB = Test::Builder->new; +$TB->plan(tests => 2); +print "ok 1\n"; +print "ok 2\n"; +$TB->current_test(2); ==== //depot/macperl/lib/Test/Simple/t/maybe_regex.t#1 (text) ==== Index: perl/lib/Test/Simple/t/maybe_regex.t --- perl/lib/Test/Simple/t/maybe_regex.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/t/maybe_regex.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,50 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use Test::More tests => 10; + +use Test::Builder; +my $Test = Test::Builder->new; + +SKIP: { + skip "qr// added in 5.005", 3 if $] < 5.005; + + # 5.004 can't even see qr// or it pukes in compile. + eval q{ + my $r = $Test->maybe_regex(qr/^FOO$/i); + ok(defined $r, 'qr// detected'); + ok(('foo' =~ /$r/), 'qr// good match'); + ok(('bar' !~ /$r/), 'qr// bad match'); + }; + die $@ if $@; +} + +{ + my $r = $Test->maybe_regex('/^BAR$/i'); + ok(defined $r, '"//" detected'); + ok(('bar' =~ m/$r/), '"//" good match'); + ok(('foo' !~ m/$r/), '"//" bad match'); +}; + +{ + my $r = $Test->maybe_regex('not a regex'); + ok(!defined $r, 'non-regex detected'); +}; + + +{ + my $r = $Test->maybe_regex('/0/'); + ok(defined $r, 'non-regex detected'); + ok(('f00' =~ m/$r/), '"//" good match'); + ok(('b4r' !~ m/$r/), '"//" bad match'); +}; ==== //depot/macperl/lib/Test/Simple/t/strays.t#1 (text) ==== Index: perl/lib/Test/Simple/t/strays.t --- perl/lib/Test/Simple/t/strays.t.~1~ Sat Apr 27 16:00:05 2002 +++ perl/lib/Test/Simple/t/strays.t Sat Apr 27 16:00:05 2002 @@ -0,0 +1,41 @@ +#!/usr/bin/perl -w + +# Check that stray newlines in test output are probably handed. + +BEGIN { + print "1..0 # Skip not completed\n"; + exit 0; +} + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} +chdir 't'; + +use TieOut; +local *FAKEOUT; +my $out = tie *FAKEOUT, 'TieOut'; + + +use Test::Builder; +my $Test = Test::Builder->new; +my $orig_out = $Test->output; +my $orig_err = $Test->failure_output; +my $orig_todo = $Test->todo_output; + +$Test->output(\*FAKEOUT); +$Test->failure_output(\*FAKEOUT); +$Test->todo_output(\*FAKEOUT); +$Test->no_plan(); + +$Test->ok(1, "name\n"); +$Test->ok(0, "foo\nbar\nbaz"); +$Test->skip("\nmoofer"); +$Test->todo_skip("foo\n\n"); + ==== //depot/macperl/t/lib/sample-tests/bignum#1 (text) ==== Index: perl/t/lib/sample-tests/bignum --- perl/t/lib/sample-tests/bignum.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/lib/sample-tests/bignum Sat Apr 27 16:00:05 2002 @@ -0,0 +1,7 @@ +print <<DUMMY; +1..2 +ok 1 +ok 2 +ok 100001 +ok 136211425 +DUMMY ==== //depot/macperl/t/lib/sample-tests/die#1 (text) ==== Index: perl/t/lib/sample-tests/die --- perl/t/lib/sample-tests/die.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/lib/sample-tests/die Sat Apr 27 16:00:05 2002 @@ -0,0 +1 @@ +exit 1; # exit because die() can be noisy ==== //depot/macperl/t/lib/sample-tests/die_head_end#1 (text) ==== Index: perl/t/lib/sample-tests/die_head_end --- perl/t/lib/sample-tests/die_head_end.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/lib/sample-tests/die_head_end Sat Apr 27 16:00:05 2002 @@ -0,0 +1,8 @@ +print <<DUMMY_TEST; +ok 1 +ok 2 +ok 3 +ok 4 +DUMMY_TEST + +exit 1; ==== //depot/macperl/t/lib/sample-tests/die_last_minute#1 (text) ==== Index: perl/t/lib/sample-tests/die_last_minute --- perl/t/lib/sample-tests/die_last_minute.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/lib/sample-tests/die_last_minute Sat Apr 27 16:00:05 2002 @@ -0,0 +1,9 @@ +print <<DUMMY_TEST; +ok 1 +ok 2 +ok 3 +ok 4 +1..4 +DUMMY_TEST + +exit 1; ==== //depot/macperl/t/win32/system_tests#1 (text) ==== Index: perl/t/win32/system_tests --- perl/t/win32/system_tests.~1~ Sat Apr 27 16:00:05 2002 +++ perl/t/win32/system_tests Sat Apr 27 16:00:05 2002 @@ -0,0 +1,120 @@ +#!perl + +use Config; +use Cwd; +use strict; + +$| = 1; + +my $cwdb = my $cwd = cwd(); +$cwd =~ s,\\,/,g; +$cwdb =~ s,/,\\,g; + +my $testdir = "t e s t"; +my $exename = "showav"; +my $plxname = "showargv"; + +my $exe = "$testdir/$exename"; +my $exex = $exe . ".exe"; +(my $exeb = $exe) =~ s,/,\\,g; +my $exebx = $exeb . ".exe"; + +my $bat = "$testdir/$plxname"; +my $batx = $bat . ".bat"; +(my $batb = $bat) =~ s,/,\\,g; +my $batbx = $batb . ".bat"; + +my $cmdx = $bat . ".cmd"; +my $cmdb = $batb; +my $cmdbx = $cmdb . ".cmd"; + +my @commands = ( + $exe, + $exex, + $exeb, + $exebx, + "./$exe", + "./$exex", + ".\\$exeb", + ".\\$exebx", + "$cwd/$exe", + "$cwd/$exex", + "$cwdb\\$exeb", + "$cwdb\\$exebx", + $bat, + $batx, + $batb, + $batbx, + "./$bat", + "./$batx", + ".\\$batb", + ".\\$batbx", + "$cwd/$bat", + "$cwd/$batx", + "$cwdb\\$batb", + "$cwdb\\$batbx", + $cmdx, + $cmdbx, + "./$cmdx", + ".\\$cmdbx", + "$cwd/$cmdx", + "$cwdb\\$cmdbx", + [$^X, $batx], + [$^X, $batbx], + [$^X, "./$batx"], + [$^X, ".\\$batbx"], + [$^X, "$cwd/$batx"], + [$^X, "$cwdb\\$batbx"], +); + +my @av = ( + undef, + "", + " ", + "abc", + "a b\tc", + "\tabc", + "abc\t", + " abc\t", + "\ta b c ", + ["\ta b c ", ""], + ["\ta b c ", " "], + ["", "\ta b c ", "abc"], + [" ", "\ta b c ", "abc"], + ['" "', 'a" "b" "c', "abc"], +); + +print "1.." . (@commands * @av * 2) . "\n"; +for my $cmds (@commands) { + for my $args (@av) { + my @all_args; + my @cmds = defined($cmds) ? (ref($cmds) ? @$cmds : $cmds) : (); + my @args = defined($args) ? (ref($args) ? @$args : $args) : (); + print "######## [@cmds]\n"; + print "<", join('><', + $cmds[$#cmds], + map { my $x = $_; $x =~ s/"//g; $x } @args), + ">\n"; + if (system(@cmds,@args) != 0) { + print "Failed, status($?)\n"; + if ($Config{ccflags} =~ /\bDDEBUGGING\b/) { + print "Running again in debug mode\n"; + $^D = 1; # -Dp + system(@cmds,@args); + } + } + $^D = 0; + my $cmdstr = join " ", map { /\s|^$/ && !/\"/ + ? qq["$_"] : $_ } @cmds, @args; + print "######## '$cmdstr'\n"; + if (system($cmdstr) != 0) { + print "Failed, status($?)\n"; + if ($Config{ccflags} =~ /\bDDEBUGGING\b/) { + print "Running again in debug mode\n"; + $^D = 1; # -Dp + system($cmdstr); + } + } + $^D = 0; + } +} End of Patch.