This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline. Builds lots of sv.h/embed.h redef warnings
authorNick Ing-Simmons <nik@tiuk.ti.com>
Sat, 29 Sep 2001 17:39:26 +0000 (17:39 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Sat, 29 Sep 2001 17:39:26 +0000 (17:39 +0000)
one test (lib/open.t) fails

p4raw-id: //depot/perlio@12268

70 files changed:
Changes
MANIFEST
NetWare/t/Readme.txt
README.hpux
README.solaris
dump.c
embed.h
embed.pl
ext/B/B/Terse.pm
ext/B/t/b.t [moved from ext/B/B.t with 100% similarity]
ext/B/t/debug.t [moved from ext/B/Debug.t with 100% similarity, mode: 0755]
ext/B/t/deparse.t [moved from ext/B/Deparse.t with 96% similarity]
ext/B/t/showlex.t [moved from ext/B/Showlex.t with 100% similarity, mode: 0755]
ext/B/t/stash.t [moved from ext/B/Stash.t with 100% similarity, mode: 0755]
ext/B/t/terse.t [new file with mode: 0644]
ext/Devel/Peek/Peek.t
ext/Encode/Makefile.PL
ext/File/Glob/Glob.pm
ext/File/Glob/bsd_glob.c
ext/File/Glob/t/basic.t
ext/threads/t/stress_cv.t [new file with mode: 0644]
ext/threads/t/stress_string.t [new file with mode: 0644]
ext/threads/threads.pm
ext/threads/threads.xs
gv.c
iperlsys.h
lib/AutoSplit.t
lib/CPAN.pm
lib/Carp.pm
lib/File/DosGlob.pm
lib/File/DosGlob.t
lib/File/Spec.t
lib/File/Spec/Mac.pm
lib/File/Temp.pm
lib/File/Temp/t/security.t
lib/Test/Simple.pm
lib/Test/Utils.pm
lib/Tie/Scalar.pm
lib/Tie/Scalar.t [new file with mode: 0644]
lib/open.t [new file with mode: 0644]
lib/strict.t
lib/subs.t
lib/unicore/Blocks.pl
lib/unicore/In.pl
lib/unicore/Scripts.pl
lib/unicore/mktables.PL
lib/utf8_heavy.pl
lib/warnings.t
patchlevel.h
perl.c
perl.h
perlio.c
pod/perldsc.pod
pod/perlport.pod
pod/perlunicode.pod
pp_ctl.c
proto.h
sharedsv.c
sv.h
t/op/anonsub.t
t/op/chdir.t
t/op/magic.t
t/op/pat.t
t/op/runlevel.t
t/op/taint.t
t/pod/testp2pt.pl
t/run/kill_perl.t
t/test.pl
util.c
vms/vms.c

diff --git a/Changes b/Changes
index 811cfab..baaff52 100644 (file)
--- a/Changes
+++ b/Changes
@@ -31,6 +31,524 @@ or any other branch.
 Version v5.7.2         Development release working toward v5.8
 --------------
 ____________________________________________________________________________
+[ 12256] By: jhi                                   on 2001/09/28  12:18:29
+        Log: Move the B tests to B/t.
+     Branch: perl
+          + ext/B/t/b.t ext/B/t/debug.t ext/B/t/deparse.t
+          + ext/B/t/showlex.t ext/B/t/stash.t ext/B/t/terse.t
+          - ext/B/B.t ext/B/B/Terse.t ext/B/Debug.t ext/B/Deparse.t
+          - ext/B/Showlex.t ext/B/Stash.t
+          ! MANIFEST
+____________________________________________________________________________
+[ 12255] By: jhi                                   on 2001/09/28  12:09:40
+        Log: Forgot from #12254.
+     Branch: perl
+          + ext/B/B/Terse.t
+____________________________________________________________________________
+[ 12254] By: jhi                                   on 2001/09/28  12:09:06
+        Log: Subject: [PATCH MANIFEST ext/B/B/Terse.t] Add tests for B::Terse
+             From: "chromatic" <chromatic@rmci.net>
+             Date: Thu, 27 Sep 2001 23:22:17 -0600
+             Message-ID: <20010928052747.56587.qmail@onion.perl.org>   
+     Branch: perl
+          ! MANIFEST
+____________________________________________________________________________
+[ 12253] By: jhi                                   on 2001/09/28  02:31:49
+        Log: Test numbering mismatch.
+     Branch: perl
+          ! t/op/chdir.t
+____________________________________________________________________________
+[ 12252] By: jhi                                   on 2001/09/27  22:46:42
+        Log: Subject: [PATCH perl@12239] slightly less broken chdir.t for VMS
+             From: "Craig A. Berry" <craigberry@mac.com>
+             Date: Wed, 26 Sep 2001 17:43:14 -0500
+             Message-Id: <5.1.0.14.0.20010926173048.01aac5b0@exchi01>
+     Branch: perl
+          ! iperlsys.h t/op/chdir.t
+____________________________________________________________________________
+[ 12251] By: jhi                                   on 2001/09/27  22:44:35
+        Log: Subject: [PATCH gv.c] make __ANON__ global
+             From: Robin Barker <rmb1@cise.npl.co.uk>
+             Date: Wed, 26 Sep 2001 17:56:28 +0100 (BST)
+             Message-Id: <200109261656.RAA27762@tempest.npl.co.uk>
+     Branch: perl
+          ! gv.c t/op/anonsub.t t/op/runlevel.t
+____________________________________________________________________________
+[ 12250] By: jhi                                   on 2001/09/27  22:33:11
+        Log: Subject: Re: [BUG] B::Terse can't handle constant scalar refs
+             From: Rafael Garcia-Suarez <rgarciasuarez@free.fr>
+             Date: Thu, 27 Sep 2001 22:34:32 +0200
+             Message-ID: <20010927223432.A1485@rafael>
+     Branch: perl
+          ! ext/B/B/Terse.pm
+____________________________________________________________________________
+[ 12249] By: jhi                                   on 2001/09/27  22:29:32
+        Log: Subject: [PATCH] Cleanup of perldsc.pod      
+             From: Casey West <casey@geeknest.com>
+             Date: Thu, 27 Sep 2001 11:13:17 -0400
+             Message-ID: <20010927111317.A1942@stupid.geeknest.com>
+     Branch: perl
+          ! pod/perldsc.pod
+____________________________________________________________________________
+[ 12248] By: jhi                                   on 2001/09/27  22:23:24
+        Log: Not everyone is using ithreads...
+     Branch: perl
+          ! ext/Devel/Peek/Peek.t
+____________________________________________________________________________
+[ 12247] By: jhi                                   on 2001/09/27  13:39:39
+        Log: Document the nss_delete core dump workaround for HP-UX
+             and Solaris, bug IDs 20010805.018 and 20010629.004.
+     Branch: perl
+          ! README.hpux README.solaris
+____________________________________________________________________________
+[ 12246] By: jhi                                   on 2001/09/27  12:05:36
+        Log: Dump Unicode hash keys also as Unicode,
+             not just as a byte string.
+     Branch: perl
+          ! dump.c ext/Devel/Peek/Peek.t
+____________________________________________________________________________
+[ 12245] By: jhi                                   on 2001/09/27  11:15:51
+        Log: Integrate changes #12241 and #12242 from macperl:
+             
+             Remove unneeded disabling of umask() calls
+             
+             Note (get|set)sockopt are available.
+     Branch: perl
+         !> lib/File/Temp.pm pod/perlport.pod
+____________________________________________________________________________
+[ 12244] By: sky                                   on 2001/09/27  08:53:00
+        Log: Flush buffers on thread closedown.
+     Branch: perl
+          ! ext/threads/threads.xs
+____________________________________________________________________________
+[ 12243] By: jhi                                   on 2001/09/27  02:20:06
+        Log: Dump SvUTF8(sv)s also as \x{...}.
+             
+             TODO: dump the SvUTF8() hash keys similarly. 
+     Branch: perl
+          ! dump.c embed.h embed.pl ext/Devel/Peek/Peek.t proto.h
+____________________________________________________________________________
+[ 12242] By: pudge                                 on 2001/09/26  20:41:35
+        Log: Note (get|set)sockopt are available.
+     Branch: maint-5.6/macperl
+          ! pod/perlport.pod
+____________________________________________________________________________
+[ 12241] By: pudge                                 on 2001/09/26  20:28:49
+        Log: Remove unneeded disabling of umask() calls
+     Branch: maint-5.6/macperl
+          ! lib/File/Temp.pm
+____________________________________________________________________________
+[ 12240] By: sky                                   on 2001/09/26  18:44:56
+        Log: Documention update
+     Branch: perl
+          ! ext/threads/threads.pm
+____________________________________________________________________________
+[ 12239] By: jhi                                   on 2001/09/26  13:49:05
+        Log: Update Changes.
+     Branch: perl
+          ! Changes patchlevel.h
+____________________________________________________________________________
+[ 12238] By: jhi                                   on 2001/09/26  13:40:53
+        Log: Check that all environment variables are tainted.
+     Branch: perl
+          ! t/op/taint.t
+____________________________________________________________________________
+[ 12237] By: jhi                                   on 2001/09/26  13:02:07
+        Log: Manual integration error in #12235.
+     Branch: perl
+          ! lib/File/DosGlob.t
+____________________________________________________________________________
+[ 12236] By: jhi                                   on 2001/09/26  12:57:11
+        Log: Subject: Re: binmode(STDOUT, ":unix") busted when STDOUT is piped.
+             From: "chromatic" <chromatic@rmci.net>
+             Date: Tue, 25 Sep 2001 23:57:07 -0600
+             Message-ID: <20010926060233.7554.qmail@onion.perl.org>
+     Branch: perl
+          ! perlio.c
+____________________________________________________________________________
+[ 12235] By: jhi                                   on 2001/09/26  12:53:16
+        Log: Integrate macperl changes from Chris Nandor:
+             12192 11817 11815 11813 11778 11775
+             
+             Update CPAN.pm to work with new Mac::BuildTools instead
+             of ExtUtils::MM_MacOS "orphan" functions
+             
+             Fix test
+             
+             Make syntax check report in MPW style, fix tests
+             to use Mac::err=unix to get normal-style error
+             messages.
+             
+             More module and test ports from Thomas Wegner et al
+             
+             Fix open of /dev/null for Mac OS
+             
+             Allow for platforms to override formatting of errors
+             on output from Matthias Neeracher (core files)
+     Branch: perl
+          ! ext/B/Deparse.t lib/File/DosGlob.pm lib/File/DosGlob.t
+          ! lib/File/Spec.t lib/File/Temp/t/security.t lib/strict.t
+          ! lib/subs.t lib/warnings.t t/op/magic.t t/run/kill_perl.t
+         !> ext/File/Glob/Glob.pm ext/File/Glob/bsd_glob.c lib/CPAN.pm
+         !> lib/File/Spec/Mac.pm lib/File/Temp.pm perl.c perl.h pp_ctl.c
+         !> t/base/term.t t/op/runlevel.t t/pod/testp2pt.pl util.c
+____________________________________________________________________________
+[ 12234] By: jhi                                   on 2001/09/26  11:58:11
+        Log: grrr.
+     Branch: perl
+          ! t/op/gv.t
+____________________________________________________________________________
+[ 12233] By: jhi                                   on 2001/09/26  11:56:09
+        Log: Retract #12232.
+     Branch: perl
+          ! t/op/gv.t
+____________________________________________________________________________
+[ 12232] By: jhi                                   on 2001/09/26  11:53:37
+        Log: (Retracted by #12233.)
+     Branch: perl
+          ! t/op/gv.t
+____________________________________________________________________________
+[ 12231] By: jhi                                   on 2001/09/26  11:52:09
+        Log: Detypo.
+     Branch: perl
+          ! ext/Encode/Makefile.PL
+____________________________________________________________________________
+[ 12230] By: sky                                   on 2001/09/26  11:36:23
+        Log: Increase the amount of time we spend in each thread, and add one that uses an anonymous sub.
+             We are using a "delay" here because we do not want to depend on thread synchronization issues.
+     Branch: perl
+          + ext/threads/t/stress_cv.t
+          ! MANIFEST ext/threads/t/stress_string.t
+____________________________________________________________________________
+[ 12229] By: jhi                                   on 2001/09/26  11:27:54
+        Log: NetWare tweak from Ananth Kesari.
+     Branch: perl
+          ! NetWare/t/Readme.txt
+____________________________________________________________________________
+[ 12228] By: jhi                                   on 2001/09/26  11:26:26
+        Log: Trick to fool case-blind filesystems.
+     Branch: perl
+          ! ext/Encode/Makefile.PL
+____________________________________________________________________________
+[ 12227] By: sky                                   on 2001/09/26  11:06:50
+        Log: Threads can start executing in a different order than they were
+             created.... so we cannot ok() inside the threadstarter.
+     Branch: perl
+          ! ext/threads/t/stress_string.t
+____________________________________________________________________________
+[ 12226] By: sky                                   on 2001/09/26  07:41:45
+        Log: Add in stress_string.t to stress test threads a bit more.
+     Branch: perl
+          + ext/threads/t/stress_string.t
+          ! MANIFEST
+____________________________________________________________________________
+[ 12225] By: sky                                   on 2001/09/26  07:04:21
+        Log: Fix negative refcount introduced by #12223.
+     Branch: perl
+          ! ext/threads/threads.xs
+____________________________________________________________________________
+[ 12224] By: sky                                   on 2001/09/26  06:57:58
+        Log: Update documentation to match change #12223
+     Branch: perl
+          ! sharedsv.c
+____________________________________________________________________________
+[ 12223] By: sky                                   on 2001/09/26  06:54:32
+        Log: Use a separate interpreter for the sharedsv space. Another
+             negative sv leak. Sigh.
+     Branch: perl
+          ! sharedsv.c
+____________________________________________________________________________
+[ 12222] By: sky                                   on 2001/09/26  05:58:35
+        Log: Do the environ assignment in perl_contruct to match perl_destruct.
+             Now we don't need to perl_parse/perl_run. However environ is a
+             global....
+     Branch: perl
+          ! perl.c
+____________________________________________________________________________
+[ 12221] By: sky                                   on 2001/09/26  05:41:02
+        Log: Move the creation of PL_strtab to perl_construct so we can work
+             with HV and HEs without running perl_parse.
+     Branch: perl
+          ! perl.c
+____________________________________________________________________________
+[ 12220] By: gsar                                  on 2001/09/26  02:18:26
+        Log: integrate macperl changes into maint-5.6
+     Branch: maint-5.6/perl
+         !> (integrate 26 files)
+____________________________________________________________________________
+[ 12219] By: pudge                                 on 2001/09/26  00:19:35
+        Log: Fix just a few of the bugs in Mac::InternetConfig (Bug #462999, Axel Rose);
+             fix doc in Mac::Fonts (Patch #447221, Andreas Marcel Riechert).
+     Branch: maint-5.6/macperl
+          ! macos/ext/Mac/Fonts/Fonts.xs
+          ! macos/ext/Mac/InternetConfig/InternetConfig.pm
+____________________________________________________________________________
+[ 12218] By: ams                                   on 2001/09/25  23:31:33
+        Log: Subject: Re: [PATCH] AutoSplit.t (was Re: Untested libraries update)
+             From: Nicholas Clark <nick@ccl4.org>
+             Date: Wed, 26 Sep 2001 01:20:20 +0100
+             Message-Id: <20010926012020.B48092@plum.flirble.org>
+     Branch: perl
+          ! lib/AutoSplit.t
+____________________________________________________________________________
+[ 12217] By: ams                                   on 2001/09/25  22:33:05
+        Log: Subject: [PATCH perl@12180] angle bracket filespec problem on VMS
+             From: "Craig A. Berry" <craigberry@mac.com>
+             Date: Tue, 25 Sep 2001 18:08:42 -0500
+             Message-Id: <5.1.0.14.0.20010925154848.036887d8@exchi01>
+     Branch: perl
+          ! vms/vms.c
+____________________________________________________________________________
+[ 12216] By: ams                                   on 2001/09/25  21:41:01
+        Log: Subject: [PATCH lib/AutoSplit.t]  Fixing mysterious TEST failure. (was
+             Re: binmode(STDOUT, ":unix") busted when STDOUT is piped.)
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Wed, 26 Sep 2001 00:38:21 -0400
+             Message-Id: <20010926003821.A627@blackrider>
+     Branch: perl
+          ! lib/AutoSplit.t
+____________________________________________________________________________
+[ 12215] By: jhi                                   on 2001/09/25  21:40:04
+        Log: Subject: [PATCH lib/Test/Simple.pm lib/Test/Utils.pm] fix test.deparse
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Tue, 25 Sep 2001 17:43:49 -0400
+             Message-ID: <20010925174349.B19534@blackrider>
+     Branch: perl
+          ! lib/Test/Simple.pm lib/Test/Utils.pm
+____________________________________________________________________________
+[ 12214] By: pudge                                 on 2001/09/25  21:11:21
+        Log: Integrate changes from bleadperl.
+     Branch: maint-5.6/macperl
+         !> pod/perlport.pod
+____________________________________________________________________________
+[ 12213] By: jhi                                   on 2001/09/25  20:37:14
+        Log: skip($mess) should result in one skip.
+     Branch: perl
+          ! t/test.pl
+____________________________________________________________________________
+[ 12212] By: pudge                                 on 2001/09/25  20:21:06
+        Log: Integrate change #12200 from maintperl.
+     Branch: maint-5.6/macperl
+         !> win32/perlhost.h
+____________________________________________________________________________
+[ 12211] By: pudge                                 on 2001/09/25  20:11:56
+        Log: Fix file types to "apple"
+     Branch: maint-5.6/macperl
+          ! macos/ext/Mac/Menus/t/MenuBar.rsrc
+          ! macos/ext/Mac/SAT/t/Collision.rsrc
+____________________________________________________________________________
+[ 12210] By: pudge                                 on 2001/09/25  19:28:20
+        Log: Fix rsrc file as snd file; fix path in t file.
+     Branch: maint-5.6/macperl
+          ! macos/ext/Mac/Notification/t/Notification.rsrc
+          ! macos/ext/Mac/Notification/t/Notification.t
+____________________________________________________________________________
+[ 12209] By: pudge                                 on 2001/09/25  19:15:57
+        Log: Sync up with File::Find from bleadperl.
+     Branch: maint-5.6/macperl
+          ! lib/File/Find.pm t/lib/filefind-taint.t
+____________________________________________________________________________
+[ 12208] By: pudge                                 on 2001/09/25  19:06:48
+        Log: Ignore SIGPIPE being set to IGNORE.  Temporary fix until we upgrade
+             to new version of libnet.  (Axel Rose, Paul Schinder, and a cast
+             of hundreds)
+     Branch: maint-5.6/macperl
+          ! macos/bundled_lib/blib/lib/Net/Cmd.pm
+          ! macos/bundled_lib/blib/lib/Net/FTP/A.pm
+          ! macos/bundled_lib/blib/lib/Net/FTP/I.pm
+____________________________________________________________________________
+[ 12207] By: nick                                  on 2001/09/25  19:04:36
+        Log: Integrate mainline (untested while modem is up)
+     Branch: perlio
+         +> lib/AutoSplit.t t/test.pl
+          - lib/warnings/register.t
+         !> (integrate 28 files)
+____________________________________________________________________________
+[ 12206] By: jhi                                   on 2001/09/25  17:21:00
+        Log: perldiag entry for #12205.
+     Branch: perl
+          ! pod/perldiag.pod
+____________________________________________________________________________
+[ 12205] By: jhi                                   on 2001/09/25  17:20:38
+        Log: Subject: [PATCH] warning on v-string in use/require
+             From: John Peacock <jpeacock@rowman.com>
+             Date: Mon, 24 Sep 2001 17:29:03 -0400
+             Message-ID: <3BAFA59F.9C0E0339@rowman.com>
+     Branch: perl
+          ! ext/IO/lib/IO/Socket.pm pp_ctl.c t/lib/warnings/pp_ctl
+____________________________________________________________________________
+[ 12204] By: jhi                                   on 2001/09/25  17:11:02
+        Log: perltooc et al updates.
+     Branch: perl
+          ! plan9/mkfile pod/roffitall
+____________________________________________________________________________
+[ 12203] By: jhi                                   on 2001/09/25  17:05:19
+        Log: Subject: [PATCH pp_sys.c t/op/chdir.t ...] Deprecating chdir(undef)/chdir('')
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Sun, 23 Sep 2001 00:07:12 -0400
+             Message-ID: <20010923000712.A7005@blackrider>
+     Branch: perl
+          ! pod/perl572delta.pod pod/perldiag.pod pp_sys.c t/op/chdir.t
+____________________________________________________________________________
+[ 12202] By: jhi                                   on 2001/09/25  16:55:29
+        Log: Subject: [PATCH perl@12185] Some Encode/*.enc files needs to be corrected
+             From: SADAHIRO Tomoyuki <BQW10602@nifty.com>
+             Date: Wed, 26 Sep 2001 01:25:10 +0900
+             Message-Id: <20010926012410.5B86.BQW10602@nifty.com>
+     Branch: perl
+          ! ext/Encode/Encode/cp932.enc ext/Encode/Encode/cp936.enc
+          ! ext/Encode/Encode/cp949.enc ext/Encode/Encode/cp950.enc
+          ! ext/Encode/Encode/euc-cn.enc ext/Encode/Encode/shiftjis.enc
+____________________________________________________________________________
+[ 12201] By: jhi                                   on 2001/09/25  16:52:03
+        Log: Integrate change #12200 from maintperl;
+             on windows, virtualized environment could propagate deleted variables
+             into children if they happen to be at the very end of the table
+     Branch: perl
+         !> win32/perlhost.h
+____________________________________________________________________________
+[ 12200] By: gsar                                  on 2001/09/25  16:36:01
+        Log: on windows, virtualized environment could propagate deleted variables
+             into children if they happen to be at the very end of the table
+             (thanks for succinct test case from Johan Holmberg, and fix from
+             Doug Lankshear)
+     Branch: maint-5.6/perl
+          ! win32/perlhost.h
+____________________________________________________________________________
+[ 12199] By: gsar                                  on 2001/09/25  15:19:13
+        Log: avoid the use of ftime() (it does a useless, potentially
+             expensive call to GetTimeZoneInformation()); this potentially
+             also results in three more digits of precision from
+             Time::HiRes::time()
+     Branch: perl
+          ! ext/Time/HiRes/HiRes.xs
+____________________________________________________________________________
+[ 12198] By: jhi                                   on 2001/09/25  14:27:01
+        Log: Replace the use Test::More in t/{op,io,run} with t/test.pl.
+             
+             Note: io/binmode is failing, have to figure out why.
+     Branch: perl
+          + t/test.pl
+          ! MANIFEST t/io/binmode.t t/op/chdir.t t/op/crypt.t
+          ! t/op/inccode.t t/op/rand.t t/op/srand.t t/op/ver.t
+          ! t/run/exit.t
+____________________________________________________________________________
+[ 12197] By: ams                                   on 2001/09/25  13:48:55
+        Log: Subject: [PATCH] AutoSplit.t (was Re: Untested libraries update)
+             From: Nicholas Clark <nick@ccl4.org>
+             Date: Tue, 25 Sep 2001 00:37:40 +0100
+             Message-Id: <20010925003740.S4971@plum.flirble.org>
+             (Further changes expected.)
+     Branch: perl
+          + lib/AutoSplit.t
+          ! MANIFEST
+____________________________________________________________________________
+[ 12196] By: sky                                   on 2001/09/25  13:37:12
+        Log: Second attempt at fixing Time::HiRes::time on win32. Apperently if ENV{TZ} is wrong we fail. New attempt uses 
+             _ftime to try and be more robust.
+     Branch: perl
+          ! ext/Time/HiRes/HiRes.xs
+____________________________________________________________________________
+[ 12194] By: ams                                   on 2001/09/25  11:40:00
+        Log: Subject: [PATCH perl@12180] perltootc -> perltooc in vms/descrip_mms.template
+             From: "Craig A. Berry" <craigberry@mac.com>
+             Date: Mon, 24 Sep 2001 17:54:20 -0500
+             Message-Id: <5.1.0.14.0.20010924171225.01bb0428@exchi01>
+     Branch: perl
+          ! vms/descrip_mms.template
+____________________________________________________________________________
+[ 12193] By: pudge                                 on 2001/09/25  02:53:42
+        Log: Fixes for multiline error parsing (Bug #459263); cmd-.
+             not working, cursor not spinning (Bug #422129); external
+             editor problems (Bug #456329); escape/cmd-. not activating
+             "Cancel" in Save dialog box (Bug #446960); Runtimes not
+             executing on launch (Bug #464441).
+     Branch: maint-5.6/macperl
+          ! macos/macish.c macos/macish.h macos/macperl/MPEditor.c
+          ! macos/macperl/MPGlobals.h macos/macperl/MPScript.c
+          ! macos/macperl/MacPerl.r
+____________________________________________________________________________
+[ 12192] By: pudge                                 on 2001/09/25  02:42:49
+        Log: Update CPAN.pm to work with new Mac::BuildTools instead
+             of ExtUtils::MM_MacOS "orphan" functions
+     Branch: maint-5.6/macperl
+          ! lib/CPAN.pm
+____________________________________________________________________________
+[ 12191] By: pudge                                 on 2001/09/25  02:37:58
+        Log: Fix up another xsubpp problem (Matthias Neeracher)
+     Branch: maint-5.6/macperl
+          ! macos/xsubpp
+____________________________________________________________________________
+[ 12190] By: pudge                                 on 2001/09/25  02:37:38
+        Log: Remove literal tabs from source in MM_MacOS.pm (Thomas Wegner)
+     Branch: maint-5.6/macperl
+          ! macos/lib/ExtUtils/MM_MacOS.pm
+____________________________________________________________________________
+[ 12189] By: pudge                                 on 2001/09/25  02:37:08
+        Log: Fix up Makefiles for more Mac:: modules (and prepare for
+             static build ...?)
+     Branch: maint-5.6/macperl
+          ! macos/Makefile.mk macos/ext/Mac/Makefile.mk
+          ! macos/macperl/Makefile.mk
+____________________________________________________________________________
+[ 12188] By: pudge                                 on 2001/09/25  02:36:19
+        Log: Fix up tests
+     Branch: maint-5.6/macperl
+          ! macos/MacPerlTests.cmd macos/MacPerlTests.plx
+____________________________________________________________________________
+[ 12187] By: pudge                                 on 2001/09/25  02:11:13
+        Log: Make malloc smarter, fix bugs.  (Bug #404030)
+     Branch: maint-5.6/macperl
+          ! macos/icemalloc.c macos/icemalloc.h
+____________________________________________________________________________
+[ 12186] By: nick                                  on 2001/09/24  19:18:17
+        Log: Integrate mainline
+     Branch: perlio
+         +> ext/I18N/Langinfo/fallback.c ext/I18N/Langinfo/fallback.xs
+         +> lib/filetest.t
+         !> (integrate 30 files)
+____________________________________________________________________________
+[ 12185] By: jhi                                   on 2001/09/24  18:56:40
+        Log: Retract #12136, the warnings::register is already
+             tested by t/lib/warnings/9enabled, as pointed out
+             by Paul Marquess.
+     Branch: perl
+          - lib/warnings/register.t
+          ! MANIFEST lib/warnings/register.pm t/lib/1_compile.t
+____________________________________________________________________________
+[ 12184] By: gsar                                  on 2001/09/24  18:39:58
+        Log: fix Time::HiRes implementation of gettimeofday() on windows
+             (HiRes.t#14 now passes)
+     Branch: perl
+          ! ext/Time/HiRes/HiRes.xs
+____________________________________________________________________________
+[ 12183] By: gsar                                  on 2001/09/24  18:13:23
+        Log: File::Spec::catfile() canonifies everything to blackslashes on
+             windows :-(
+     Branch: perl
+          ! lib/ExtUtils/Manifest.t
+____________________________________________________________________________
+[ 12182] By: gsar                                  on 2001/09/24  17:59:54
+        Log: test number mismatch
+     Branch: perl
+          ! t/op/magic.t
+____________________________________________________________________________
+[ 12181] By: jhi                                   on 2001/09/24  17:10:41
+        Log: ok().
+     Branch: perl
+          ! t/op/pack.t
+____________________________________________________________________________
+[ 12180] By: jhi                                   on 2001/09/24  16:09:37
+        Log: unpack("Z*Z*", pack("Z*Z*", ..)) bug, patch and test from
+             Wolfgang Laun <Wolfgang.Laun@alcatel.at>
+     Branch: perl
+          ! pp_pack.c t/op/pack.t
+____________________________________________________________________________
+[ 12179] By: jhi                                   on 2001/09/24  15:46:49
+        Log: Update Changes.
+     Branch: perl
+          ! Changes patchlevel.h
+____________________________________________________________________________
 [ 12178] By: jhi                                   on 2001/09/24  14:12:06
         Log: Subject: [REPATCH] Re: [PATCH lib/ExtUtils/Manifest.pm] Minor bug in comment logic in maniread() on VMS
              From: Michael G Schwern <schwern@pobox.com>
index d10e42d..5f45512 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -56,7 +56,6 @@ ext/attrs/attrs.pm            attrs extension Perl module
 ext/attrs/attrs.xs             attrs extension external subroutines
 ext/attrs/Makefile.PL          attrs extension makefile writer
 ext/B/B.pm             Compiler backend support functions and methods
-ext/B/B.t              See if B works
 ext/B/B.xs             Compiler backend external subroutines
 ext/B/B/Asmdata.pm     Compiler backend data for assembler
 ext/B/B/assemble       Assemble compiler bytecode
@@ -78,9 +77,7 @@ ext/B/B/Stackobj.pm   Compiler stack objects support functions
 ext/B/B/Stash.pm       Compiler module to identify stashes
 ext/B/B/Terse.pm       Compiler Terse backend
 ext/B/B/Xref.pm                Compiler Xref backend
-ext/B/Debug.t          See if B::Debug works
 ext/B/defsubs_h.PL     Generator for constant subroutines
-ext/B/Deparse.t                See if B::Deparse works
 ext/B/Makefile.PL      Compiler backend makefile writer
 ext/B/NOTES            Compiler backend notes
 ext/B/O.pm             Compiler front-end module (-MO=...)
@@ -91,8 +88,12 @@ ext/B/ramblings/magic                Compiler ramblings: notes on magic
 ext/B/ramblings/reg.alloc      Compiler ramblings: register allocation
 ext/B/ramblings/runtime.porting        Compiler ramblings: porting PP enging
 ext/B/README           Compiler backend README
-ext/B/Showlex.t                See if B::ShowLex works
-ext/B/Stash.t          See if B::Stash works
+ext/B/t/b.t            See if B works
+ext/B/t/debug.t                See if B::Debug works
+ext/B/t/deparse.t      See if B::Deparse works
+ext/B/t/showlex.t      See if B::ShowLex works
+ext/B/t/stash.t                See if B::Stash works
+ext/B/t/terse.t                See if B::Terse works
 ext/B/TESTS            Compiler backend test data
 ext/B/Todo             Compiler backend Todo list
 ext/B/typemap                  Compiler backend interface types
@@ -574,6 +575,8 @@ ext/threads/Changes         ithreads
 ext/threads/Makefile.PL                ithreads
 ext/threads/README             ithreads
 ext/threads/t/basic.t          ithreads
+ext/threads/t/stress_cv.t      Test with multiple threads, coderef cv argument.
+ext/threads/t/stress_string.t  Test with multiple threads, string cv argument.
 ext/threads/threads.h          ithreads
 ext/threads/threads.pm          ithreads
 ext/threads/threads.xs         ithreads
@@ -1097,6 +1100,7 @@ lib/NEXT/Changes          NEXT
 lib/NEXT/README                        NEXT
 lib/NEXT/test.pl               See if NEXT works
 lib/open.pm                    Pragma to specify default I/O disciplines
+lib/open.t                     See if the open pragma works
 lib/open2.pl                   Open a two-ended pipe (uses IPC::Open2)
 lib/open3.pl                   Open a three-ended pipe (uses IPC::Open3)
 lib/overload.pm                        Module for overloading perl operators
@@ -1221,6 +1225,7 @@ lib/Tie/Hash.pm                   Base class for tied hashes
 lib/Tie/RefHash.pm             Base class for tied hashes with references as keys
 lib/Tie/RefHash.t              Test for Tie::RefHash and Tie::RefHash::Nestable
 lib/Tie/Scalar.pm              Base class for tied scalars
+lib/Tie/Scalar.t               See if Tie::Scalar works
 lib/Tie/SubstrHash.pm          Compact hash for known key, value and table size
 lib/Tie/SubstrHash.t           Test for Tie::SubstrHash
 lib/Time/gmtime.pm             By-name interface to Perl's builtin gmtime
index 3262417..2b6984f 100644 (file)
@@ -38,14 +38,16 @@ For example, all the scripts that are under 't\base' folder will be
 entered in 'base.pl' and so on. 'nwauto.pl' includes all these '.pl' 
 scripts like 'base.pl', 'comp.pl' etc.
 
+
 Perform the following steps to execute the automated scripts:
 
-1. Make sure that your NetWare server is mapped to "i:".
+1. Map your NetWare server to "i:"
 
-2. Execute "nmake nwinstall" (after building interpreter and extensions)
-in the 'NetWare' folder of the CPAN download. This installs all the 
-library files, perl modules and all the 't' scripts in appropriate 
-folders onto your server.
+2. After complete build (building both interpreter and all extensions)
+of Perl for NetWare, execute "nmake nwinstall" in the 'NetWare' folder
+of the CPAN download. This installs all the library files, perl modules,
+the '.pl' files under 'NetWare\t' folder and all the '.t' scripts
+under 't' folder, all in appropriate folders onto your server.
 
 3. Execute the command  "perl t\NWModify.pl"  on the console command 
 prompt of your server. This script replaces
index fcc9d02..37322a3 100644 (file)
@@ -348,6 +348,33 @@ system.
 In general, a value of 256MB (or "256*1024*1024") is sufficient for
 Perl to compile at maximum optimization.
 
+=head1 nss_delete core dump from op/pwent or op/grent
+
+You may get a bus error core dump from the op/pwent or op/grent
+tests. If compiled with -g you will see a stack trace much like
+the following:
+
+  #0  0xc004216c in  () from /usr/lib/libc.2
+  #1  0xc00d7550 in __nss_src_state_destr () from /usr/lib/libc.2
+  #2  0xc00d7768 in __nss_src_state_destr () from /usr/lib/libc.2
+  #3  0xc00d78a8 in nss_delete () from /usr/lib/libc.2 
+  #4  0xc01126d8 in endpwent () from /usr/lib/libc.2 
+  #5  0xd1950 in Perl_pp_epwent () from ./perl
+  #6  0x94d3c in Perl_runops_standard () from ./perl
+  #7  0x23728 in S_run_body () from ./perl
+  #8  0x23428 in perl_run () from ./perl
+  #9  0x2005c in main () from ./perl
+
+The key here is the C<nss_delete> call.  One workaround for this
+bug seems to be to create add to the file F</etc/nsswitch.conf>
+(at least) the following lines
+
+  group: files 
+  passwd: files
+
+Whether you are using NIS does not matter.  Amazingly enough,
+the same bug affects also Solaris.
+
 =head1 AUTHOR
 
 Jeff Okamoto <okamoto@corp.hp.com>
index 2fbd251..627bc73 100644 (file)
@@ -438,6 +438,10 @@ Building in /tmp sometimes shows this behavior.  The
 test suite detects if you are building in /tmp, but it may not be able
 to catch all tmpfs situations.
 
+=head2 nss_delete core dump from op/pwent or op/grent
+
+See L<perlhpux/"nss_delete core dump from op/pwent or op/grent">.
+
 =head1 PREBUILT BINARIES OF PERL FOR SOLARIS.
 
 You can pick up prebuilt binaries for Solaris from
diff --git a/dump.c b/dump.c
index 509df79..3d24ccb 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -104,42 +104,65 @@ Perl_dump_eval(pTHX)
 }
 
 char *
-Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
+Perl_pv_display(pTHX_ SV *dsv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
 {
     int truncated = 0;
     int nul_terminated = len > cur && pv[cur] == '\0';
 
-    sv_setpvn(sv, "\"", 1);
+    sv_setpvn(dsv, "\"", 1);
     for (; cur--; pv++) {
-       if (pvlim && SvCUR(sv) >= pvlim) {
+       if (pvlim && SvCUR(dsv) >= pvlim) {
             truncated++;
            break;
         }
         if (isPRINT(*pv)) {
             switch (*pv) {
-           case '\t': sv_catpvn(sv, "\\t", 2);  break;
-           case '\n': sv_catpvn(sv, "\\n", 2);  break;
-           case '\r': sv_catpvn(sv, "\\r", 2);  break;
-           case '\f': sv_catpvn(sv, "\\f", 2);  break;
-           case '"':  sv_catpvn(sv, "\\\"", 2); break;
-           case '\\': sv_catpvn(sv, "\\\\", 2); break;
-           default:   sv_catpvn(sv, pv, 1);     break;
+           case '\t': sv_catpvn(dsv, "\\t", 2);  break;
+           case '\n': sv_catpvn(dsv, "\\n", 2);  break;
+           case '\r': sv_catpvn(dsv, "\\r", 2);  break;
+           case '\f': sv_catpvn(dsv, "\\f", 2);  break;
+           case '"':  sv_catpvn(dsv, "\\\"", 2); break;
+           case '\\': sv_catpvn(dsv, "\\\\", 2); break;
+           default:   sv_catpvn(dsv, pv, 1);     break;
             }
         }
        else {
            if (cur && isDIGIT(*(pv+1)))
-               Perl_sv_catpvf(aTHX_ sv, "\\%03o", (U8)*pv);
+               Perl_sv_catpvf(aTHX_ dsv, "\\%03o", (U8)*pv);
            else
-               Perl_sv_catpvf(aTHX_ sv, "\\%o", (U8)*pv);
+               Perl_sv_catpvf(aTHX_ dsv, "\\%o", (U8)*pv);
         }
     }
-    sv_catpvn(sv, "\"", 1);
+    sv_catpvn(dsv, "\"", 1);
     if (truncated)
-       sv_catpvn(sv, "...", 3);
+       sv_catpvn(dsv, "...", 3);
     if (nul_terminated)
-       sv_catpvn(sv, "\\0", 2);
+       sv_catpvn(dsv, "\\0", 2);
 
-    return SvPVX(sv);
+    return SvPVX(dsv);
+}
+
+char *
+Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim)
+{
+    int truncated = 0;
+    char *s, *e;
+
+    sv_setpvn(dsv, "\"", 1);
+    for (s = SvPVX(ssv), e = s + SvCUR(ssv); s < e; s += UTF8SKIP(s)) {
+        UV u;
+        if (pvlim && SvCUR(dsv) >= pvlim) {
+             truncated++;
+             break;
+        }
+        u = utf8_to_uvchr((U8*)s, 0);
+        Perl_sv_catpvf(aTHX_ dsv, "\\x{%x}", u);
+    }
+    sv_catpvn(dsv, "\"", 1);
+    if (truncated)
+        sv_catpvn(dsv, "...", 3);
+    
+    return SvPVX(dsv);
 }
 
 char *
@@ -278,7 +301,8 @@ Perl_sv_peek(pTHX_ SV *sv)
                Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
            Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127));
            if (SvUTF8(sv))
-               Perl_sv_catpvf(aTHX_ t, " [UTF8]");
+               Perl_sv_catpvf(aTHX_ t, " [UTF8 %s]",
+                              sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv)));
            SvREFCNT_dec(tmp);
        }
     }
@@ -1103,7 +1127,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv)));
            if (SvOOK(sv))
                PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
-           PerlIO_printf(file, "%s\n", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
+           PerlIO_printf(file, "%s", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
+           if (SvUTF8(sv)) /* the 8?  \x{....} */
+               PerlIO_printf(file, " [UTF8 %s]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv)));
+           PerlIO_printf(file, "\n");
            Perl_dump_indent(aTHX_ level, file, "  CUR = %"IVdf"\n", (IV)SvCUR(sv));
            Perl_dump_indent(aTHX_ level, file, "  LEN = %"IVdf"\n", (IV)SvLEN(sv));
        }
@@ -1224,14 +1251,18 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 
            hv_iterinit(hv);
            while ((he = hv_iternext(hv)) && count--) {
-               SV *elt;
-               char *key;
-               I32 len;
+               SV *elt, *keysv;
+               char *keypv;
+               STRLEN len;
                U32 hash = HeHASH(he);
 
-               key = hv_iterkey(he, &len);
+               keysv = hv_iterkeysv(he);
+               keypv = SvPV(keysv, len);
                elt = hv_iterval(hv, he);
-               Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%"UVxf"\n", pv_display(d, key, len, 0, pvlim), (UV)hash);
+               Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
+               if (SvUTF8(keysv))
+                   PerlIO_printf(file, "[UTF8 %s] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv)));
+               PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash);
                do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
            }
            hv_iterinit(hv);            /* Return to status quo */
diff --git a/embed.h b/embed.h
index ae62d12..c19e445 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define sv_2iv                 Perl_sv_2iv
 #define sv_2mortal             Perl_sv_2mortal
 #define sv_2nv                 Perl_sv_2nv
+#ifdef CRIPPLED_CC
 #define sv_2pv                 Perl_sv_2pv
+#endif
 #define sv_2pvutf8             Perl_sv_2pvutf8
 #define sv_2pvbyte             Perl_sv_2pvbyte
+#ifdef CRIPPLED_CC
 #define sv_pvn_nomg            Perl_sv_pvn_nomg
+#endif
 #define sv_2uv                 Perl_sv_2uv
 #define sv_iv                  Perl_sv_iv
 #define sv_uv                  Perl_sv_uv
 #define sv_catpvf              Perl_sv_catpvf
 #define sv_vcatpvf             Perl_sv_vcatpvf
 #define sv_catpv               Perl_sv_catpv
+#ifdef CRIPPLED_CC
 #define sv_catpvn              Perl_sv_catpvn
+#endif
+#ifdef CRIPPLED_CC
 #define sv_catsv               Perl_sv_catsv
+#endif
 #define sv_chop                        Perl_sv_chop
 #define sv_clean_all           Perl_sv_clean_all
 #define sv_clean_objs          Perl_sv_clean_objs
 #define sv_peek                        Perl_sv_peek
 #define sv_pos_u2b             Perl_sv_pos_u2b
 #define sv_pos_b2u             Perl_sv_pos_b2u
+#ifdef CRIPPLED_CC
 #define sv_pvn_force           Perl_sv_pvn_force
+#endif
 #define sv_pvutf8n_force       Perl_sv_pvutf8n_force
 #define sv_pvbyten_force       Perl_sv_pvbyten_force
 #define sv_reftype             Perl_sv_reftype
 #define sv_setref_pvn          Perl_sv_setref_pvn
 #define sv_setpv               Perl_sv_setpv
 #define sv_setpvn              Perl_sv_setpvn
+#ifdef CRIPPLED_CC
 #define sv_setsv               Perl_sv_setsv
+#endif
 #define sv_taint               Perl_sv_taint
 #define sv_tainted             Perl_sv_tainted
 #define sv_unmagic             Perl_sv_unmagic
 #define sv_usepvn_mg           Perl_sv_usepvn_mg
 #define get_vtbl               Perl_get_vtbl
 #define pv_display             Perl_pv_display
+#define sv_uni_display         Perl_sv_uni_display
 #define dump_indent            Perl_dump_indent
 #define dump_vindent           Perl_dump_vindent
 #define do_gv_dump             Perl_do_gv_dump
 #define sv_pv                  Perl_sv_pv
 #define sv_pvutf8              Perl_sv_pvutf8
 #define sv_pvbyte              Perl_sv_pvbyte
+#ifdef CRIPPLED_CC
 #define sv_utf8_upgrade                Perl_sv_utf8_upgrade
+#endif
 #define sv_utf8_downgrade      Perl_sv_utf8_downgrade
 #define sv_utf8_encode         Perl_sv_utf8_encode
 #define sv_utf8_decode         Perl_sv_utf8_decode
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #define save_scalar_at         S_save_scalar_at
 #endif
-#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+#if defined(USE_ITHREADS)
 #define sharedsv_init          Perl_sharedsv_init
 #define sharedsv_new           Perl_sharedsv_new
 #define sharedsv_find          Perl_sharedsv_find
 #define sv_usepvn_mg(a,b,c)    Perl_sv_usepvn_mg(aTHX_ a,b,c)
 #define get_vtbl(a)            Perl_get_vtbl(aTHX_ a)
 #define pv_display(a,b,c,d,e)  Perl_pv_display(aTHX_ a,b,c,d,e)
+#define sv_uni_display(a,b,c)  Perl_sv_uni_display(aTHX_ a,b,c)
 #define dump_vindent(a,b,c,d)  Perl_dump_vindent(aTHX_ a,b,c,d)
 #define do_gv_dump(a,b,c,d)    Perl_do_gv_dump(aTHX_ a,b,c,d)
 #define do_gvgv_dump(a,b,c,d)  Perl_do_gvgv_dump(aTHX_ a,b,c,d)
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #define save_scalar_at(a)      S_save_scalar_at(aTHX_ a)
 #endif
-#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+#if defined(USE_ITHREADS)
 #define sharedsv_init()                Perl_sharedsv_init(aTHX)
 #define sharedsv_new()         Perl_sharedsv_new(aTHX)
 #define sharedsv_find(a)       Perl_sharedsv_find(aTHX_ a)
index 8671366..e4dae1b 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -344,12 +344,14 @@ walk_table {
     else {
        my ($flags,$retval,$func,@args) = @_;
        unless ($flags =~ /o/) {
+            $ret .= "#ifdef CRIPPLED_CC\n" if $flags =~ /C/;
            if ($flags =~ /s/) {
                $ret .= hide($func,"S_$func");
            }
            elsif ($flags =~ /p/) {
                $ret .= hide($func,"Perl_$func");
            }
+            $ret .= "#endif\n" if $flags =~ /C/;
        }
     }
     $ret;
@@ -1052,6 +1054,7 @@ __END__
 :
 : flags are single letters with following meanings:
 :      A               member of public API
+:      C               wrap compatibility macro in #ifdef DCRIPPLED_CC
 :      d               function has documentation with its source
 :      s               static function, should have an S_ prefix in source
 :                              file
@@ -1720,10 +1723,10 @@ Apd     |IO*    |sv_2io         |SV* sv
 Apd    |IV     |sv_2iv         |SV* sv
 Apd    |SV*    |sv_2mortal     |SV* sv
 Apd    |NV     |sv_2nv         |SV* sv
-A    |char*  |sv_2pv         |SV* sv|STRLEN* lp
+ACp    |char*  |sv_2pv         |SV* sv|STRLEN* lp
 Apd    |char*  |sv_2pvutf8     |SV* sv|STRLEN* lp
 Apd    |char*  |sv_2pvbyte     |SV* sv|STRLEN* lp
-A    |char*  |sv_pvn_nomg    |SV* sv|STRLEN* lp
+ACp    |char*  |sv_pvn_nomg    |SV* sv|STRLEN* lp
 Apd    |UV     |sv_2uv         |SV* sv
 Apd    |IV     |sv_iv          |SV* sv
 Apd    |UV     |sv_uv          |SV* sv
@@ -1738,8 +1741,8 @@ Apd       |SV*    |sv_bless       |SV* sv|HV* stash
 Afpd   |void   |sv_catpvf      |SV* sv|const char* pat|...
 Ap     |void   |sv_vcatpvf     |SV* sv|const char* pat|va_list* args
 Apd    |void   |sv_catpv       |SV* sv|const char* ptr
-Apd    |void   |sv_catpvn      |SV* sv|const char* ptr|STRLEN len
-Apd    |void   |sv_catsv       |SV* dsv|SV* ssv
+ACpd   |void   |sv_catpvn      |SV* sv|const char* ptr|STRLEN len
+ACpd   |void   |sv_catsv       |SV* dsv|SV* ssv
 Apd    |void   |sv_chop        |SV* sv|char* ptr
 pd     |I32    |sv_clean_all
 pd     |void   |sv_clean_objs
@@ -1774,7 +1777,7 @@ Apd       |SV*    |sv_newref      |SV* sv
 Ap     |char*  |sv_peek        |SV* sv
 Apd    |void   |sv_pos_u2b     |SV* sv|I32* offsetp|I32* lenp
 Apd    |void   |sv_pos_b2u     |SV* sv|I32* offsetp
-Apd    |char*  |sv_pvn_force   |SV* sv|STRLEN* lp
+ACpd   |char*  |sv_pvn_force   |SV* sv|STRLEN* lp
 Apd    |char*  |sv_pvutf8n_force|SV* sv|STRLEN* lp
 Apd    |char*  |sv_pvbyten_force|SV* sv|STRLEN* lp
 Apd    |char*  |sv_reftype     |SV* sv|int ob
@@ -1795,7 +1798,7 @@ Apd       |SV*    |sv_setref_pvn  |SV* rv|const char* classname|char* pv \
                                |STRLEN n
 Apd    |void   |sv_setpv       |SV* sv|const char* ptr
 Apd    |void   |sv_setpvn      |SV* sv|const char* ptr|STRLEN len
-Apd    |void   |sv_setsv       |SV* dsv|SV* ssv
+ACpd   |void   |sv_setsv       |SV* dsv|SV* ssv
 Apd    |void   |sv_taint       |SV* sv
 Apd    |bool   |sv_tainted     |SV* sv
 Apd    |int    |sv_unmagic     |SV* sv|int type
@@ -1898,8 +1901,9 @@ Apd       |void   |sv_setpvn_mg   |SV *sv|const char *ptr|STRLEN len
 Apd    |void   |sv_setsv_mg    |SV *dstr|SV *sstr
 Apd    |void   |sv_usepvn_mg   |SV *sv|char *ptr|STRLEN len
 Ap     |MGVTBL*|get_vtbl       |int vtbl_id
-p      |char*  |pv_display     |SV *sv|char *pv|STRLEN cur|STRLEN len \
+p      |char*  |pv_display     |SV *dsv|char *pv|STRLEN cur|STRLEN len \
                                |STRLEN pvlim
+p      |char*  |sv_uni_display |SV *dsv|SV *ssv|STRLEN pvlim
 Afp    |void   |dump_indent    |I32 level|PerlIO *file|const char* pat|...
 Ap     |void   |dump_vindent   |I32 level|PerlIO *file|const char* pat \
                                |va_list *args
@@ -1926,7 +1930,7 @@ Apd       |char*  |sv_2pvbyte_nolen|SV* sv
 Apd    |char*  |sv_pv          |SV *sv
 Apd    |char*  |sv_pvutf8      |SV *sv
 Apd    |char*  |sv_pvbyte      |SV *sv
-Apd    |STRLEN |sv_utf8_upgrade|SV *sv
+ACpd   |STRLEN |sv_utf8_upgrade|SV *sv
 ApdM   |bool   |sv_utf8_downgrade|SV *sv|bool fail_ok
 Apd    |void   |sv_utf8_encode |SV *sv
 ApdM   |bool   |sv_utf8_decode |SV *sv
index 52f0549..4c31a66 100644 (file)
@@ -118,6 +118,27 @@ sub B::NV::terse {
     printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
 }
 
+sub B::RV::terse {
+    my ($rv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) %s\n", class($rv), $$rv, printref($rv);
+}
+
+sub printref {
+    my $rv = shift;
+    my $rcl = class($rv->RV);
+    if ($rcl eq 'PV') {
+       return "\\" . cstring($rv->RV->$rcl);
+    } elsif ($rcl eq 'NV') {
+       return "\\" . $rv->RV->$rcl;
+    } elsif ($rcl eq 'IV') {
+       return sprintf "\\%" . ($rv->RV->FLAGS & SVf_IVisUV ? "u" : "d"),
+           $rv->RV->int_value;
+    } elsif ($rcl eq 'RV') {
+       return "\\" . printref($rv->RV);
+    }
+}
+
 sub B::NULL::terse {
     my ($sv, $level) = @_;
     print indent($level);
similarity index 100%
rename from ext/B/B.t
rename to ext/B/t/b.t
old mode 100644 (file)
new mode 100755 (executable)
similarity index 100%
rename from ext/B/Debug.t
rename to ext/B/t/debug.t
similarity index 96%
rename from ext/B/Deparse.t
rename to ext/B/t/deparse.t
index 0aff882..b8e29a6 100644 (file)
@@ -95,10 +95,11 @@ my $Is_VMS = $^O eq 'VMS';
 my $Is_MacOS = $^O eq 'MacOS';
 
 my $path = join " ", map { qq["-I$_"] } @INC;
+$path .= " -MMac::err=unix" if $Is_MacOS;
 my $redir = $Is_MacOS ? "" : "2>&1";
 
 $a = `$^X $path "-MO=Deparse" -anle 1 $redir`;
-$a =~ s/-e syntax OK\n//g;
+$a =~ s/(?:# )?-e syntax OK\n//g;  # "# " for Mac OS
 $a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
 $a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
 $b = <<'EOF';
old mode 100644 (file)
new mode 100755 (executable)
similarity index 100%
rename from ext/B/Showlex.t
rename to ext/B/t/showlex.t
old mode 100644 (file)
new mode 100755 (executable)
similarity index 100%
rename from ext/B/Stash.t
rename to ext/B/t/stash.t
diff --git a/ext/B/t/terse.t b/ext/B/t/terse.t
new file mode 100644 (file)
index 0000000..cf9bdb4
--- /dev/null
@@ -0,0 +1,108 @@
+#!./perl
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+use Test::More tests => 15;
+
+use_ok( 'B::Terse' );
+
+# indent should return a string indented four spaces times the argument
+is( B::Terse::indent(2), ' ' x 8, 'indent works with an argument' );
+is( B::Terse::indent(), '', 'indent works with no argument' );
+
+# this should fail without a reference
+eval { B::Terse::terse('scalar') };
+like( $@, qr/not a reference/, 'terse() caught bad parameters okay' );
+
+# now point it at a sub and see what happens
+sub foo {}
+
+my $sub;
+eval{ $sub = B::Terse::compile('', 'foo') };
+is( $@, '', 'compile() worked without error' );
+ok( defined &$sub, 'got a valid subref back from compile()' );
+
+# and point it at a real sub and hope the returned ops look alright
+my $out = tie *STDOUT, 'TieOut';
+$sub = B::Terse::compile('', 'bar');
+$sub->();
+
+# now build some regexes that should match the dumped ops
+my ($hex, $op) = ('\(0x[a-f0-9]+\)', '\s+\w+');
+my %ops = map { $_ => qr/$_ $hex$op/ }
+       qw ( OP COP     LOOP PMOP UNOP BINOP LOGOP LISTOP );
+
+# split up the output lines into individual ops (terse is, well, terse!)
+# use an array here so $_ is modifiable
+my @lines = split(/\n+/, $out->read);
+foreach (@lines) {
+       next unless /\S/;
+       s/^\s+//;
+       if (/^([A-Z]+)\s+/) {
+               my $op = $1;
+               next unless exists $ops{$op};
+               like( $_, $ops{$op}, "$op appears okay" );
+               delete $ops{$op};
+               s/$ops{$op}//;
+               redo if $_;
+       }
+}
+
+warn "# didn't find " . join(' ', keys %ops) if keys %ops;
+
+# XXX:
+# this tries to get at all tersified optypes in B::Terse
+# if you add AV, NULL, PADOP, PVOP, or SPECIAL, add it to the regex above too
+#
+use vars qw( $a $b );
+sub bar {
+       # OP SVOP COP IV here or in sub definition
+       my @bar = (1, 2, 3);
+
+       # got a GV here
+       my $foo = $a + $b;
+
+       # NV here
+       $a = 1.234;
+
+       # this is awful, but it gives a PMOP
+       my $boo = split('', $foo);
+
+       # PMOP
+       LOOP: for (1 .. 10) {
+               last LOOP if $_ % 2;
+       }
+
+       # make a PV
+       $foo = "a string";
+}
+
+# Schwern's example of finding an RV
+my $path = join " ", map { qq["-I$_"] } @INC;
+my $redir = $^O eq 'MacOS' ? '' : "2>&1";
+my $items = qx{$^X $path "-MO=Terse" -le "print \\42" $redir};
+like( $items, qr/RV $hex \\42/, 'found an RV, appears okay!' );
+
+package TieOut;
+
+sub TIEHANDLE {
+       bless( \(my $out), $_[0] );
+}
+
+sub PRINT {
+       my $self = shift;
+       $$self .= join('', @_);
+}
+
+sub PRINTF {
+       my $self = shift;
+       $$self .= sprintf(@_);
+}
+
+sub read {
+       my $self = shift;
+       return substr($$self, 0, length($$self), '');
+}
index be7bf82..dde4cd1 100644 (file)
@@ -12,7 +12,7 @@ BEGIN {
 
 use Devel::Peek;
 
-print "1..17\n";
+print "1..19\n";
 
 our $DEBUG = 0;
 open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
@@ -317,6 +317,41 @@ do_test(17,
     FLAGS = $ADDR
     EGV = $ADDR\\t"a"');
 
+do_test(18,
+       chr(256).chr(0).chr(512),
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\((?:PADBUSY,PADTMP,)?POK,READONLY,pPOK,UTF8\\)
+  PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
+  CUR = 5
+  LEN = 6');
+
+do_test(19,
+       {chr(256)=>chr(512)},
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(SHAREKEYS\\)
+    IV = 1
+    NV = 0
+    ARRAY = $ADDR  \\(0:7, 1:1\\)
+    hash quality = 100.0%
+    KEYS = 1
+    FILL = 1
+    MAX = 7
+    RITER = -1
+    EITER = $ADDR
+    Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
+    SV = PV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(POK,pPOK,UTF8\\)
+      PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
+      CUR = 2
+      LEN = 3');
+
 END {
   1 while unlink("peek$$");
 }
index 30d9ffc..2ac571a 100644 (file)
@@ -46,6 +46,9 @@ sub post_initialize
   {
    $o{$e.$x} = 1;
   }
+ # Trick case-blind filesystems.
+ delete $o{'encode'.$x};
+ $o{'Encode'.$x} = 1;
  # Reset the variable
  $self->{'O_FILES'} = [sort keys %o];
  my @files;
index cad8131..a704b56 100644 (file)
@@ -384,7 +384,7 @@ the standard Perl distribution.
 
 Mac OS (Classic) users should note a few differences. Since
 Mac OS is not Unix, when the glob code encounters a tilde glob (e.g.
-~user/foo) and the C<GLOB_TILDE> flag is used, it simply returns that
+~user) and the C<GLOB_TILDE> flag is used, it simply returns that
 pattern without doing any expansion.
 
 Glob on Mac OS is case-insensitive by default (if you don't use any
@@ -397,6 +397,29 @@ always begins with a volume name, a relative pathname should always
 begin with a ':'.  If specifying a volume name only, a trailing ':' is
 required.
 
+The specification of pathnames in glob patterns adheres to the usual Mac
+OS conventions: The path separator is a colon ':', not a slash '/'. A
+full path always begins with a volume name. A relative pathname on Mac
+OS must always begin with a ':', except when specifying a file or
+directory name in the current working directory, where the leading colon
+is optional. If specifying a volume name only, a trailing ':' is
+required. Due to these rules, a glob like E<lt>*:E<gt> will find all
+mounted volumes, while a glob like E<lt>*E<gt> or E<lt>:*E<gt> will find
+all files and directories in the current directory.
+
+Note that updirs in the glob pattern are resolved before the matching begins,
+i.e. a pattern like "*HD:t?p::a*" will be matched as "*HD:a*". Note also,
+that a single trailing ':' in the pattern is ignored (unless it's a volume
+name pattern like "*HD:"), i.e. a glob like E<lt>:*:E<gt> will find both
+directories I<and> files (and not, as one might expect, only directories).
+You can, however, use the C<GLOB_MARK> flag to distinguish (without a file
+test) directory names from file names.
+
+If the C<GLOB_MARK> flag is set, all directory paths will have a ':' appended.
+Since a directory like 'lib:' is I<not> a valid I<relative> path on Mac OS,
+both a leading and a trailing colon will be added, when the directory name in
+question doesn't contain any colons (e.g. 'lib' becomes ':lib:').
+
 =back
 
 =head1 AUTHOR
index fa601fc..d0d4a91 100644 (file)
@@ -206,6 +206,23 @@ my_readdir(DIR *d)
 #define        my_readdir      readdir
 #endif
 
+#ifdef MACOS_TRADITIONAL
+#include <Files.h>
+#include <Types.h>
+#include <string.h>
+
+#define NO_UPDIR_ERR 1 /* updir resolving failed */
+
+static Boolean g_matchVol; /* global variable */
+static short updir(char *path);
+static short resolve_updirs(char *new_pattern);
+static void remove_trColon(char *path);
+static short glob_mark_Mac(Char *pathbuf, Char *pathend, Char *pathend_last);
+static OSErr GetVolInfo(short volume, Boolean indexed, FSSpec *spec);
+static void name_f_FSSpec(StrFileName volname, FSSpec *spec);
+
+#endif
+
 int
 bsd_glob(const char *pattern, int flags,
         int (*errfunc)(const char *, int), glob_t *pglob)
@@ -214,7 +231,15 @@ bsd_glob(const char *pattern, int flags,
        int c;
        Char *bufnext, *bufend, patbuf[MAXPATHLEN];
 
+#ifdef MACOS_TRADITIONAL
+       char *new_pat, *p, *np;
+       int err;
+       size_t len;
+#endif
+
+#ifndef MACOS_TRADITIONAL
        patnext = (U8 *) pattern;
+#endif
        if (!(flags & GLOB_APPEND)) {
                pglob->gl_pathc = 0;
                pglob->gl_pathv = NULL;
@@ -246,6 +271,62 @@ bsd_glob(const char *pattern, int flags,
                patnext += 2;
        }
 #endif
+
+#ifdef MACOS_TRADITIONAL
+       /* Check if we need to match a volume name (e.g. '*HD:*') */
+       g_matchVol = false;
+       p = (char *) pattern;
+       if (*p != BG_SEP) {
+           p++;
+           while (*p != BG_EOS) {
+               if (*p == BG_SEP) {
+                   g_matchVol = true;
+                   break;
+               }
+               p++;
+           }
+       }
+
+       /* Transform the pattern:
+        * (a) Resolve updirs, e.g.
+        *     '*:t*p::'       -> '*:'
+        *         ':a*:tmp::::'   -> '::'
+        *         ':base::t*p:::' -> '::'
+        *     '*HD::'         -> return 0 (error, quit silently)
+        *
+        * (b) Remove a single trailing ':', unless it's a "match volume only"
+        *     pattern like '*HD:'; e.g.
+        *     '*:tmp:' -> '*:tmp'  but
+        *     '*HD:'   -> '*HD:'
+        *     (If we don't do that, even filenames will have a trailing ':' in
+        *     the result.)
+        */
+
+       /* We operate on a copy of the pattern */
+       len = strlen(pattern);
+       New(0, new_pat, len + 1, char);
+       if (new_pat == NULL)
+           return (GLOB_NOSPACE);
+
+       p = (char *) pattern;
+       np = new_pat;
+       while (*np++ = *p++) ;
+
+       /* Resolve updirs ... */
+       err = resolve_updirs(new_pat);
+       if (err) {
+           Safefree(new_pat);
+           /* The pattern is incorrect: tried to move
+              up above the volume root, see above.
+              We quit silently. */
+           return 0;
+       }
+       /* remove trailing colon ... */
+       remove_trColon(new_pat);
+       patnext = (U8 *) new_pat;
+
+#endif /* MACOS_TRADITIONAL */
+
        if (flags & GLOB_QUOTE) {
                /* Protect the quoted characters. */
                while (bufnext < bufend && (c = *patnext++) != BG_EOS)
@@ -273,10 +354,19 @@ bsd_glob(const char *pattern, int flags,
                        *bufnext++ = c;
        *bufnext = BG_EOS;
 
+#ifdef MACOS_TRADITIONAL
+       if (flags & GLOB_BRACE)
+           err = globexp1(patbuf, pglob);
+       else
+           err = glob0(patbuf, pglob);
+       Safefree(new_pat);
+       return err;
+#else
        if (flags & GLOB_BRACE)
            return globexp1(patbuf, pglob);
        else
            return glob0(patbuf, pglob);
+#endif
 }
 
 /*
@@ -582,7 +672,7 @@ glob0(const Char *pattern, glob_t *pglob)
         }
        else if (!(pglob->gl_flags & GLOB_NOSORT))
                qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc,
-                   pglob->gl_pathc - oldpathc, sizeof(char *), 
+                   pglob->gl_pathc - oldpathc, sizeof(char *),
                    (pglob->gl_flags & (GLOB_ALPHASORT|GLOB_NOCASE))
                        ? ci_compare : compare);
        pglob->gl_flags = oldflags;
@@ -658,10 +748,17 @@ glob2(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last,
                                  (S_ISLNK(sb.st_mode) &&
                            (g_stat(pathbuf, &sb, pglob) == 0) &&
                            S_ISDIR(sb.st_mode)))) {
+#ifdef MACOS_TRADITIONAL
+                               short err;
+                               err = glob_mark_Mac(pathbuf, pathend, pathend_last);
+                               if (err)
+                                       return (err);
+#else
                                if (pathend+1 > pathend_last)
                                        return (1);
                                *pathend++ = BG_SEP;
                                *pathend = BG_EOS;
+#endif
                        }
                        ++pglob->gl_matchc;
 #ifdef GLOB_DEBUG
@@ -746,6 +843,50 @@ glob3(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last,
                }
         }
 #endif
+
+#ifdef MACOS_TRADITIONAL
+       if ((!*pathbuf) && (g_matchVol)) {
+           FSSpec spec;
+           short index;
+           StrFileName vol_name; /* unsigned char[64] on MacOS */
+
+           err = 0;
+           nocase = ((pglob->gl_flags & GLOB_NOCASE) != 0);
+
+           /* Get and match a list of volume names */
+           for (index = 0; !GetVolInfo(index+1, true, &spec); ++index) {
+               register U8 *sc;
+               register Char *dc;
+
+               name_f_FSSpec(vol_name, &spec);
+
+               /* Initial BG_DOT must be matched literally. */
+               if (*vol_name == BG_DOT && *pattern != BG_DOT)
+                   continue;
+               dc = pathend;
+               sc = (U8 *) vol_name;
+               while (dc < pathend_last && (*dc++ = *sc++) != BG_EOS)
+                   ;
+               if (dc >= pathend_last) {
+                   *dc = BG_EOS;
+                   err = 1;
+                   break;
+               }
+
+               if (!match(pathend, pattern, restpattern, nocase)) {
+                   *pathend = BG_EOS;
+                   continue;
+               }
+               err = glob2(pathbuf, pathbuf_last, --dc, pathend_last,
+                   restpattern, restpattern_last, pglob, limitp);
+               if (err)
+                   break;
+           }
+           return(err);
+
+       } else { /* open dir */
+#endif /* MACOS_TRADITIONAL */
+
        if ((dirp = g_opendir(pathbuf, pglob)) == NULL) {
                /* TODO: don't call for ENOENT or ENOTDIR? */
                if (pglob->gl_errfunc) {
@@ -798,6 +939,10 @@ glob3(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last,
        else
                PerlDir_close(dirp);
        return(err);
+
+#ifdef MACOS_TRADITIONAL
+       }
+#endif
 }
 
 
@@ -1038,3 +1183,209 @@ qprintf(const char *str, register Char *s)
        (void)printf("\n");
 }
 #endif /* GLOB_DEBUG */
+
+
+#ifdef MACOS_TRADITIONAL
+
+/* Replace the last occurence of the pattern ":[^:]+::", e.g. ":lib::",
+   with a single ':', if possible. It is not an error, if the pattern
+   doesn't match (we return -1), but if there are two consecutive colons
+   '::', there must be a preceding ':[^:]+'. Hence,  a volume path like
+   "HD::" is considered to be an error (we return 1), that is, it can't
+   be resolved. We return 0 on success.
+*/
+
+static short
+updir(char *path)
+{
+       char *pb, *pe, *lastchar;
+       char *bgn_mark, *end_mark;
+       char *f, *m, *b; /* front, middle, back */
+       size_t len;
+
+       len = strlen(path);
+       lastchar = path + (len-1);
+       b = lastchar;
+       m = lastchar-1;
+       f = lastchar-2;
+
+       /* find a '[^:]::' (e.g. b::) pattern ... */
+       while ( !( (*f != BG_SEP) && (*m == BG_SEP) && (*b == BG_SEP) )
+               && (f >= path)) {
+               f--;
+               m--;
+               b--;
+       }
+
+       if (f < path) { /* no (more) match */
+               return -1;
+       }
+
+       end_mark = b;
+
+       /* ... and now find its preceding colon ':' */
+       while ((*f != BG_SEP) && (f >= path)) {
+               f--;
+       }
+       if (f < path) {
+               /* No preceding colon found, must be a
+                  volume path. We can't move up the
+                  tree and that's an error */
+               return 1;
+       }
+       bgn_mark = f;
+
+       /* Shrink path, i.e. exclude all characters between
+          bgn_mark and end_mark */
+
+       pb = bgn_mark;
+       pe = end_mark;
+       while (*pb++ = *pe++) ;
+       return 0;
+}
+
+
+/* Resolve all updirs in pattern. */
+
+static short
+resolve_updirs(char *new_pattern)
+{
+       short err;
+
+       do {
+               err = updir(new_pattern);
+       } while (!err);
+       if (err == 1) {
+               return NO_UPDIR_ERR;
+       }
+       return 0;
+}
+
+
+/* Remove a trailing colon from the path, but only if it's
+   not a volume path (e.g. HD:) and not a path consisting
+   solely of colons. */
+
+static void
+remove_trColon(char *path)
+{
+       char *lastchar, *lc;
+
+       /* if path matches the pattern /:[^:]+:$/, we can
+          remove the trailing ':' */
+
+       lc = lastchar = path + (strlen(path) - 1);
+       if (*lastchar == BG_SEP) {
+               /* there's a trailing ':', there must be at least
+                  one preceding char != ':' and a preceding ':' */
+               lc--;
+               if ((*lc != BG_SEP) && (lc >= path)) {
+                       lc--;
+               } else {
+                       return;
+               }
+               while ((*lc != BG_SEP) && (lc >= path)) {
+                       lc--;
+               }
+               if (lc >= path) {
+                       /* ... there's a preceding ':', we remove
+                          the trailing colon */
+                       *lastchar = BG_EOS;
+               }
+       }
+}
+
+
+/* With the GLOB_MARK flag on, we append a colon, if pathbuf
+   is a directory. If the directory name contains no colons,
+   e.g. 'lib', we can't simply append a ':', since this (e.g.
+   'lib:') is not a valid (relative) path on Mac OS. Instead,
+   we add a leading _and_ trailing ':'. */
+
+static short
+glob_mark_Mac(Char *pathbuf, Char *pathend, Char *pathend_last)
+{
+       Char *p, *pe;
+       Boolean is_file = true;
+
+       /* check if pathbuf contains a ':',
+          i.e. is not a file name */
+       p = pathbuf;
+       while (*p != BG_EOS) {
+               if (*p == BG_SEP) {
+                       is_file = false;
+                       break;
+               }
+               p++;
+       }
+
+       if (is_file) {
+               if (pathend+2 > pathend_last) {
+                       return (1);
+               }
+               /* right shift one char */
+               pe = p = pathend;
+               p--;
+               pathend++;
+               while (p >= pathbuf) {
+                       *pe-- = *p--;
+               }
+               /* first char becomes a colon */
+               *pathbuf = BG_SEP;
+               /* append a colon */
+               *pathend++ = BG_SEP;
+               *pathend = BG_EOS;
+
+       } else {
+               if (pathend+1 > pathend_last) {
+                       return (1);
+               }
+               *pathend++ = BG_SEP;
+               *pathend = BG_EOS;
+       }
+       return 0;
+}
+
+
+/* Return a FSSpec record for the specified volume
+   (borrowed from MacPerl.xs). */
+
+static OSErr
+GetVolInfo(short volume, Boolean indexed, FSSpec* spec)
+{
+       OSErr           err; /* OSErr: 16-bit integer */
+       HParamBlockRec  pb;
+
+       pb.volumeParam.ioNamePtr        = spec->name;
+       pb.volumeParam.ioVRefNum        = indexed ? 0 : volume;
+       pb.volumeParam.ioVolIndex       = indexed ? volume : 0;
+
+       if (err = PBHGetVInfoSync(&pb))
+               return err;
+
+       spec->vRefNum   = pb.volumeParam.ioVRefNum;
+       spec->parID     = 1;
+
+       return noErr; /* 0 */
+}
+
+/* Extract a C name from a FSSpec. Note that there are
+   no leading or trailing colons. */
+
+static void
+name_f_FSSpec(StrFileName name, FSSpec *spec)
+{
+       unsigned char *nc;
+       const short len = spec->name[0];
+       short i;
+
+       /* FSSpec.name is a Pascal string,
+          convert it to C ... */
+       nc = name;
+       for (i=1; i<=len; i++) {
+               *nc++ = spec->name[i];
+       }
+       *nc = BG_EOS;
+}
+
+#endif /* MACOS_TRADITIONAL */
index fe844b2..65fa36a 100755 (executable)
@@ -110,6 +110,7 @@ print "ok 7\n";
 # Working on t/TEST often causes this test to fail because it sees Emacs temp
 # and RCS files.  Filter them out, and .pm files too, and patch temp files.
 @a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a;
+@a = (grep !/test.pl/, @a) if $^O eq 'VMS';
 
 print "# @a\n";
 
@@ -118,7 +119,7 @@ unless (@a == 3
         and $a[1] eq 'a'
         and $a[2] eq 'b')
 {
-    print "not ok 8 # @a";
+    print "not ok 8 # @a\n";
 } else {
     print "ok 8\n";
 }
diff --git a/ext/threads/t/stress_cv.t b/ext/threads/t/stress_cv.t
new file mode 100644 (file)
index 0000000..eb2bab1
--- /dev/null
@@ -0,0 +1,48 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    unless ($Config{'useithreads'}) {
+       print "1..0 # Skip: no useithreads\n";
+       exit 0; 
+    }
+}
+
+use ExtUtils::testlib;
+use strict;
+BEGIN { print "1..64\n" };
+use threads;
+
+
+print "ok 1\n";
+
+
+
+
+sub ok {       
+    my ($id, $ok, $name) = @_;
+    
+    # You have to do it this way or VMS will get confused.
+    print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
+
+    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+    
+    return $ok;
+}
+
+
+ok(2,1,"");
+
+
+my @threads;
+for(3..33) {
+  ok($_,1,"Multiple thread test");
+  push @threads ,threads->create(sub { my $i = shift; for(1..500000) { $i++}},$_);
+}
+
+my $i = 34;
+for(@threads) {
+  $_->join;
+  ok($i++,1,"Thread joined");
+}
+
diff --git a/ext/threads/t/stress_string.t b/ext/threads/t/stress_string.t
new file mode 100644 (file)
index 0000000..23449d2
--- /dev/null
@@ -0,0 +1,51 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    unless ($Config{'useithreads'}) {
+       print "1..0 # Skip: no useithreads\n";
+       exit 0; 
+    }
+}
+
+use ExtUtils::testlib;
+use strict;
+BEGIN { print "1..64\n" };
+use threads;
+
+
+print "ok 1\n";
+
+
+
+
+sub ok {       
+    my ($id, $ok, $name) = @_;
+    
+    # You have to do it this way or VMS will get confused.
+    print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
+
+    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+    
+    return $ok;
+}
+
+
+ok(2,1,"");
+
+sub test9 {
+  my $i = shift;
+  for(1..500000) { $i++};
+}
+my @threads;
+for(3..33) {
+  ok($_,1,"Multiple thread test");
+  push @threads ,threads->create('test9',$_);
+}
+
+my $i = 34;
+for(@threads) {
+  $_->join;
+  ok($i++,1,"Thread joined");
+}
+
index ae7eb99..9f9c323 100755 (executable)
@@ -151,6 +151,8 @@ please join perl-ithreads@perl.org for more information
 
 =item creating a thread from within a thread is unsafe under win32
 
+=item PERL_OLD_SIGNALS are not threadsafe, will not be.
+
 =back
 
 =head1 SEE ALSO
index 5678bcb..5caedbe 100755 (executable)
@@ -56,6 +56,7 @@ void* Perl_thread_run(void * arg) {
        }
 
        MUTEX_LOCK(&thread->mutex);
+       PerlIO_flush((PerlIO*)NULL);
        perl_destruct(thread->interp);  
        perl_free(thread->interp);
        if(thread->detached == 1) {
@@ -281,12 +282,12 @@ BOOT:
 #else
                thread->thr = pthread_self();
 #endif
+               SHAREDSvEDIT(threads);
                thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread->thr));
                thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
-               SHAREDSvEDIT(threads);
                hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
-               SHAREDSvRELEASE(threads);
                SvREFCNT_dec(thread_tid_ptr);
+               SHAREDSvRELEASE(threads);
        }
        MUTEX_INIT(&create_mutex);
 
diff --git a/gv.c b/gv.c
index 6538377..2ed4809 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -656,7 +656,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
                  strEQ(name, "ARGVOUT")))
                    global = TRUE;
            }
-           else if (*name == '_' && !name[1])
+           else if (*name == '_' && (!name[1] || strEQ(name,"__ANON__")))
                global = TRUE;
 
            if (global)
index 298f82a..d3e8254 100644 (file)
@@ -415,7 +415,7 @@ struct IPerlDirInfo
 
 #define PerlDir_mkdir(name, mode)      Mkdir((name), (mode))
 #ifdef VMS
-#  define PerlDir_chdir(n)             Chdir(((n) && *(n)) ? (n) : "SYS$LOGIN")
+#  define PerlDir_chdir(n)             Chdir((n))
 #else
 #  define PerlDir_chdir(name)          chdir((name))
 #endif
index 32f5bd0..296e359 100644 (file)
@@ -79,7 +79,7 @@ foreach (@tests) {
                | \#(?!\#)      # or a # character not followed by #
                | (?<!\n)\#     # or a # character not preceded by \n
               )*)/sgmx;
-  foreach ($args{Name}, $args{Require}) {
+  foreach ($args{Name}, $args{Require}, $args{Extra}) {
     chomp $_ if defined $_;
   }
   my @extra_args = !defined $args{Extra} ? () : split /,/, $args{Extra};
@@ -146,6 +146,23 @@ foreach (@tests) {
       defined eval $code or fail(), print "# Code:  $code\n# Error: $@";
     }
   }
+  if (my $sleepfor = $args{Sleep}) {
+    # We need to sleep for a while
+    # Need the sleep hack else the next test is so fast that the timestamp
+    # compare routine in AutoSplit thinks that it shouldn't split the files.
+    my $time = time;
+    my $until = $time + $sleepfor;
+    my $attempts = 3;
+    do {
+      sleep ($sleepfor)
+    } while (time < $until && --$attempts > 0);
+    if ($attempts == 0) {
+      printf << "EOM", time;
+# Attempted to sleep for $sleepfor second(s), started at $time, now %d.
+# sleep attempt ppears to have failed; some tests may fail as a result.
+EOM
+    }
+  }
   unless ($args{SameAgain}) {
     $i++;
     rmtree($dir);
@@ -265,12 +282,10 @@ AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
 ## Tests
 is (&*MOD*::obsolete, 0);
 is (&*MOD*::obsolete, 1);
-{my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
-printf "# time is %d (hopefully >=2 seconds later)\n", time;
+## Sleep
+2
 ## SameAgain
 True, so don't scrub this directory.
-Need the sleep hack else the next test is so fast that the timestamp compare
-routine in AutoSplit thinks that it shouldn't split the files.
 IIRC DOS FAT filesystems have only 2 second granularity.
 ################################################################
 ## Name
@@ -298,8 +313,8 @@ AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
 ## Tests
 is (&*MOD*::skeleton, "bones", "skeleton");
 eval {&*MOD*::gonner}; ok ($@ =~ m!^Can't locate auto/*MOD*/gonner.al in \@INC!, "Check &*MOD*::gonner is now a gonner") or print "# \$\@='$@'\n";
-{my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
-printf "# time is %d (hopefully >=2 seconds later)\n", time;
+## Sleep
+2
 ## SameAgain
 True, so don't scrub this directory.
 ################################################################
@@ -328,8 +343,8 @@ AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
 ## Tests
 is (&*MOD*::ghost, "bump");
 is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies undead?");
-{my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
-printf "# time is %d (hopefully >=2 seconds later)\n", time;
+## Sleep
+2
 ## SameAgain
 True, so don't scrub this directory.
 ################################################################
@@ -350,8 +365,8 @@ Without the the timestamp check make sure that nothing happens
 ## Tests
 is (&*MOD*::ghoul, "wail", "still haunted");
 is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies still undead?");
-{my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
-printf "# time is %d (hopefully >=2 seconds later)\n", time;
+## Sleep
+2
 ## SameAgain
 True, so don't scrub this directory.
 ################################################################
index db24a06..de1158d 100644 (file)
@@ -25,6 +25,8 @@ use File::Spec;
 no lib "."; # we need to run chdir all over and we would get at wrong
             # libraries there
 
+require Mac::BuildTools if $^O eq 'MacOS';
+
 END { $End++; &cleanup; }
 
 %CPAN::DEBUG = qw[
@@ -3964,7 +3966,7 @@ sub look {
     my($self) = @_;
 
     if ($^O eq 'MacOS') {
-      $self->ExtUtils::MM_MacOS::look;
+      $self->Mac::BuildTools::look;
       return;
     }
 
@@ -4055,7 +4057,7 @@ sub readme {
        or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
 
     if ($^O eq 'MacOS') {
-        ExtUtils::MM_MacOS::launch_file($local_file);
+        Mac::BuildTools::launch_file($local_file);
         return;
     }
 
@@ -4357,7 +4359,7 @@ or
     $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
 
     if ($^O eq 'MacOS') {
-        ExtUtils::MM_MacOS::make($self);
+        Mac::BuildTools::make($self);
         return;
     }
 
@@ -4603,7 +4605,7 @@ sub test {
        if $CPAN::DEBUG;
 
     if ($^O eq 'MacOS') {
-        ExtUtils::MM_MacOS::make_test($self);
+        Mac::BuildTools::make_test($self);
         return;
     }
 
@@ -4634,7 +4636,7 @@ sub clean {
     $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
 
     if ($^O eq 'MacOS') {
-        ExtUtils::MM_MacOS::make_clean($self);
+        Mac::BuildTools::make_clean($self);
         return;
     }
 
@@ -4709,7 +4711,7 @@ sub install {
        if $CPAN::DEBUG;
 
     if ($^O eq 'MacOS') {
-        ExtUtils::MM_MacOS::make_install($self);
+        Mac::BuildTools::make_install($self);
         return;
     }
 
@@ -4875,7 +4877,7 @@ sub find_bundle_file {
     my $what2 = $what;
     if ($^O eq 'MacOS') {
       $what =~ s/^://;
-      $what2 =~ tr|:|/|;
+      $what =~ tr|:|/|;
       $what2 =~ s/:Bundle://;
       $what2 =~ tr|:|/|;
     } else {
@@ -5722,7 +5724,7 @@ is available. Can\'t continue.
         $tar->extract(@af);
     }
 
-    ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
+    Mac::BuildTools::convert_files([$tar->list_files], 1)
         if ($^O eq 'MacOS');
 
     return 1;
index f2e042e..cd2cfdb 100644 (file)
@@ -50,7 +50,7 @@ This feature is enabled by 'importing' the non-existent symbol
 
     perl -MCarp=verbose script.pl
 
-or by including the string C<MCarp=verbose> in the L<PERL5OPT>
+or by including the string C<MCarp=verbose> in the PERL5OPT
 environment variable.
 
 =head1 BUGS
index aa9beb9..a1c27d5 100644 (file)
@@ -94,6 +94,207 @@ sub doglob {
     return @retval;
 }
 
+
+#
+# Do DOS-like globbing on Mac OS 
+#
+sub doglob_Mac {
+    my $cond = shift;
+    my @retval = ();
+
+       #print "doglob_Mac: ", join('|', @_), "\n";
+  OUTER:
+    for my $arg (@_) {
+        local $_ = $arg;
+       my @matched = ();
+       my @globdirs = ();
+       my $head = ':';
+       my $not_esc_head = $head;
+       my $sepchr = ':';       
+       next OUTER unless defined $_ and $_ ne '';
+       # if arg is within quotes strip em and do no globbing
+       if (/^"(.*)"\z/s) {
+           $_ = $1;
+               # $_ may contain escaped metachars '\*', '\?' and '\'
+               my $not_esc_arg = $_;
+               $not_esc_arg =~ s/\\([*?\\])/$1/g;
+           if ($cond eq 'd') { push(@retval, $not_esc_arg) if -d $not_esc_arg }
+           else              { push(@retval, $not_esc_arg) if -e $not_esc_arg }
+           next OUTER;
+       }
+
+       if (m|^(.*?)(:+)([^:]*)\z|s) { # note: $1 is not greedy
+           my $tail;
+           ($head, $sepchr, $tail) = ($1,$2,$3);
+           #print "div: |$head|$sepchr|$tail|\n";
+           push (@retval, $_), next OUTER if $tail eq '';              
+               #
+               # $head may contain escaped metachars '\*' and '\?'
+               
+               my $tmp_head = $head;
+               # if a '*' or '?' is preceded by an odd count of '\', temporary delete 
+               # it (and its preceding backslashes), i.e. don't treat '\*' and '\?' as 
+               # wildcards
+               $tmp_head =~ s/(\\*)([*?])/$2 x ((length($1) + 1) % 2)/eg;
+       
+               if ($tmp_head =~ /[*?]/) { # if there are wildcards ... 
+               @globdirs = doglob_Mac('d', $head);
+               push(@retval, doglob_Mac($cond, map {"$_$sepchr$tail"} @globdirs)),
+                   next OUTER if @globdirs;
+           }
+               
+               $head .= $sepchr; 
+               $not_esc_head = $head;
+               # unescape $head for file operations
+               $not_esc_head =~ s/\\([*?\\])/$1/g;
+           $_ = $tail;
+       }
+       #
+       # If file component has no wildcards, we can avoid opendir
+       
+       my $tmp_tail = $_;
+       # if a '*' or '?' is preceded by an odd count of '\', temporary delete 
+       # it (and its preceding backslashes), i.e. don't treat '\*' and '\?' as 
+       # wildcards
+       $tmp_tail =~ s/(\\*)([*?])/$2 x ((length($1) + 1) % 2)/eg;
+       
+       unless ($tmp_tail =~ /[*?]/) { # if there are wildcards ...
+           $not_esc_head = $head = '' if $head eq ':';
+           my $not_esc_tail = $_;
+           # unescape $head and $tail for file operations
+           $not_esc_tail =~ s/\\([*?\\])/$1/g;
+           $head .= $_;
+               $not_esc_head .= $not_esc_tail;
+           if ($cond eq 'd') { push(@retval,$head) if -d $not_esc_head }
+           else              { push(@retval,$head) if -e $not_esc_head }
+           next OUTER;
+       }
+       #print "opendir($not_esc_head)\n";
+       opendir(D, $not_esc_head) or next OUTER;
+       my @leaves = readdir D;
+       closedir D;
+
+       # escape regex metachars but not '\' and glob chars '*', '?'
+       $_ =~ s:([].+^\-\${}[|]):\\$1:g;
+       # and convert DOS-style wildcards to regex,
+       # but only if they are not escaped
+       $_ =~ s/(\\*)([*?])/$1 . ('.' x ((length($1) + 1) % 2)) . $2/eg;
+
+       #print "regex: '$_', head: '$head', unescaped head: '$not_esc_head'\n";
+       my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '\\z|ios }';
+       warn($@), next OUTER if $@;
+      INNER:
+       for my $e (@leaves) {
+           next INNER if $e eq '.' or $e eq '..';
+           next INNER if $cond eq 'd' and ! -d "$not_esc_head$e";
+               
+               if (&$matchsub($e)) {
+                       my $leave = (($not_esc_head eq ':') && (-f "$not_esc_head$e")) ? 
+                               "$e" : "$not_esc_head$e";
+                       #
+                       # On Mac OS, the two glob metachars '*' and '?' and the escape 
+                       # char '\' are valid characters for file and directory names. 
+                       # We have to escape and treat them specially.
+                       $leave =~ s|([*?\\])|\\$1|g;            
+                       push(@matched, $leave);
+                       next INNER;
+               }
+       }
+       push @retval, @matched if @matched;
+    }
+    return @retval;
+}
+
+#
+# _expand_volume() will only be used on Mac OS (Classic): 
+# Takes an array of original patterns as argument and returns an array of  
+# possibly modified patterns. Each original pattern is processed like 
+# that:
+# + If there's a volume name in the pattern, we push a separate pattern 
+#   for each mounted volume that matches (with '*', '?' and '\' escaped).  
+# + If there's no volume name in the original pattern, it is pushed 
+#   unchanged. 
+# Note that the returned array of patterns may be empty.
+#  
+sub _expand_volume {
+       
+       require MacPerl; # to be verbose
+       
+       my @pat = @_;
+       my @new_pat = ();
+       my @FSSpec_Vols = MacPerl::Volumes();
+       my @mounted_volumes = ();
+
+       foreach my $spec_vol (@FSSpec_Vols) {           
+               # push all mounted volumes into array
+       push @mounted_volumes, MacPerl::MakePath($spec_vol);
+       }
+       #print "mounted volumes: |@mounted_volumes|\n";
+       
+       while (@pat) {
+               my $pat = shift @pat;   
+               if ($pat =~ /^([^:]+:)(.*)\z/) { # match a volume name?
+                       my $vol_pat = $1;
+                       my $tail = $2;
+                       #
+                       # escape regex metachars but not '\' and glob chars '*', '?'
+                       $vol_pat =~ s:([].+^\-\${}[|]):\\$1:g;
+                       # and convert DOS-style wildcards to regex,
+                       # but only if they are not escaped
+                       $vol_pat =~ s/(\\*)([*?])/$1 . ('.' x ((length($1) + 1) % 2)) . $2/eg;
+                       #print "volume regex: '$vol_pat' \n";
+                               
+                       foreach my $volume (@mounted_volumes) {
+                               if ($volume =~ m|^$vol_pat\z|ios) {
+                                       #
+                                       # On Mac OS, the two glob metachars '*' and '?' and the  
+                                       # escape char '\' are valid characters for volume names. 
+                                       # We have to escape and treat them specially.
+                                       $volume =~ s|([*?\\])|\\$1|g;
+                                       push @new_pat, $volume . $tail;
+                               }
+                       }                       
+               } else { # no volume name in pattern, push original pattern
+                       push @new_pat, $pat;
+               }
+       }
+       return @new_pat;
+}
+
+
+#
+# _preprocess_pattern() will only be used on Mac OS (Classic): 
+# Resolves any updirs in the pattern. Removes a single trailing colon 
+# from the pattern, unless it's a volume name pattern like "*HD:"
+#
+sub _preprocess_pattern {
+       my @pat = @_;
+       
+       foreach my $p (@pat) {
+               my $proceed;
+               # resolve any updirs, e.g. "*HD:t?p::a*" -> "*HD:a*"
+               do {
+                       $proceed = ($p =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);  
+               } while ($proceed);
+               # remove a single trailing colon, e.g. ":*:" -> ":*"
+               $p =~ s/:([^:]+):\z/:$1/;
+       }
+       return @pat;
+}
+               
+               
+#
+# _un_escape() will only be used on Mac OS (Classic):
+# Unescapes a list of arguments which may contain escaped 
+# metachars '*', '?' and '\'.
+#
+sub _un_escape {
+       foreach (@_) {
+               s/\\([*?\\])/$1/g;
+       }
+       return @_;
+}
+
 #
 # this can be used to override CORE::glob in a specific
 # package by saying C<use File::DosGlob 'glob';> in that
@@ -172,8 +373,16 @@ sub glob {
 
     # if we're just beginning, do it all first
     if ($iter{$cxix} == 0) {
-       $entries{$cxix} = [doglob(1,@pat)];
+       if ($^O eq 'MacOS') {
+               # first, take care of updirs and trailing colons
+               @pat = _preprocess_pattern(@pat);
+               # expand volume names
+               @pat = _expand_volume(@pat);
+               $entries{$cxix} = (@pat) ? [_un_escape( doglob_Mac(1,@pat) )] : [()];
+       } else {
+               $entries{$cxix} = [doglob(1,@pat)];
     }
+       }
 
     # chuck it all out, quick or slow
     if (wantarray) {
@@ -253,6 +462,61 @@ of the quoting rules used.
 
 Extending it to csh patterns is left as an exercise to the reader.
 
+=head1 NOTES
+
+=over 4
+
+=item *
+
+Mac OS (Classic) users should note a few differences. The specification 
+of pathnames in glob patterns adheres to the usual Mac OS conventions: 
+The path separator is a colon ':', not a slash '/' or backslash '\'. A 
+full path always begins with a volume name. A relative pathname on Mac 
+OS must always begin with a ':', except when specifying a file or 
+directory name in the current working directory, where the leading colon 
+is optional. If specifying a volume name only, a trailing ':' is 
+required. Due to these rules, a glob like E<lt>*:E<gt> will find all 
+mounted volumes, while a glob like E<lt>*E<gt> or E<lt>:*E<gt> will find 
+all files and directories in the current directory.
+
+Note that updirs in the glob pattern are resolved before the matching begins,
+i.e. a pattern like "*HD:t?p::a*" will be matched as "*HD:a*". Note also,
+that a single trailing ':' in the pattern is ignored (unless it's a volume
+name pattern like "*HD:"), i.e. a glob like <:*:> will find both directories 
+I<and> files (and not, as one might expect, only directories). 
+
+The metachars '*', '?' and the escape char '\' are valid characters in 
+volume, directory and file names on Mac OS. Hence, if you want to match
+a '*', '?' or '\' literally, you have to escape these characters. Due to 
+perl's quoting rules, things may get a bit complicated, when you want to 
+match a string like '\*' literally, or when you want to match '\' literally, 
+but treat the immediately following character '*' as metachar. So, here's a 
+rule of thumb (applies to both single- and double-quoted strings): escape 
+each '*' or '?' or '\' with a backslash, if you want to treat them literally, 
+and then double each backslash and your are done. E.g. 
+
+- Match '\*' literally
+
+   escape both '\' and '*'  : '\\\*'
+   double the backslashes   : '\\\\\\*'
+
+(Internally, the glob routine sees a '\\\*', which means that both '\' and 
+'*' are escaped.)
+
+
+- Match '\' literally, treat '*' as metachar
+
+   escape '\' but not '*'   : '\\*'
+   double the backslashes   : '\\\\*'
+
+(Internally, the glob routine sees a '\\*', which means that '\' is escaped and 
+'*' is not.)
+
+Note that you also have to quote literal spaces in the glob pattern, as described
+above.
+
+=back
+
 =head1 EXPORTS (by request only)
 
 glob()
index 31e36e2..4017fab 100755 (executable)
@@ -15,23 +15,33 @@ print "1..10\n";
 use File::DosGlob 'glob';
 
 # test if $_ takes as the default
+my $expected;
+if ($^O eq 'MacOS') {
+    $expected = $_ = ":op:a*.t";
+} else {
+    $expected = $_ = "op/a*.t";
+}
 $_ = "op/a*.t";
 my @r = glob;
-print "not " if $_ ne 'op/a*.t';
+print "not " if $_ ne $expected;
 print "ok 1\n";
 print "# |@r|\nnot " if @r < 9;
 print "ok 2\n";
 
 # check if <*/*> works
-@r = <*/a*.t>;
+if ($^O eq 'MacOS') {
+    @r = <:*:a*.t>;
+} else {
+    @r = <*/a*.t>;
+}
 # atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
-print "not " if @r < 9;
+print "# |@r|\nnot " if @r < 9;
 print "ok 3\n";
 my $r = scalar @r;
 
 # check if scalar context works
 @r = ();
-while (defined($_ = <*/a*.t>)) {
+while (defined($_ = ($^O eq 'MacOS') ? <:*:a*.t> : <*/a*.t>)) {
     print "# $_\n";
     push @r, $_;
 }
@@ -40,25 +50,40 @@ print "ok 4\n";
 
 # check if list context works
 @r = ();
-for (<*/a*.t>) {
-    print "# $_\n";
-    push @r, $_;
+if ($^O eq 'MacOS') {
+    for (<:*:a*.t>) {
+       print "# $_\n";
+       push @r, $_;
+    }
+} else {
+    for (<*/a*.t>) {
+       print "# $_\n";
+       push @r, $_;
+    }
 }
 print "not " if @r != $r;
 print "ok 5\n";
 
 # test if implicit assign to $_ in while() works
 @r = ();
-while (<*/a*.t>) {
-    print "# $_\n";
-    push @r, $_;
+if ($^O eq 'MacOS') {
+    while (<:*:a*.t>) {
+       print "# $_\n";
+       push @r, $_;
+    }
+} else {
+    while (<*/a*.t>) {
+       print "# $_\n";
+       push @r, $_;
+    }
 }
 print "not " if @r != $r;
 print "ok 6\n";
 
 # test if explicit glob() gets assign magic too
 my @s = ();
-while (glob '*/a*.t') {
+my $pat = ($^O eq 'MacOS') ? ':*:a*.t': '*/a*.t';
+while (glob ($pat)) {
     print "# $_\n";
     push @s, $_;
 }
index b6adc77..a7b0470 100755 (executable)
@@ -253,27 +253,152 @@ BEGIN {
 [ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ],
 [ "OS2->catfile('a','b','c')",            'a/b/c'          ],
 
-[ "Mac->splitpath('file')",          ',,file'          ],
-[ "Mac->splitpath(':file')",         ',:,file'         ],
-[ "Mac->splitpath(':d1',1)",         ',:d1:,'          ],
-[ "Mac->splitpath('d1',1)",          'd1:,,'           ],
-[ "Mac->splitpath('d1:d2:d3:')",     'd1:,d2:d3:,'     ],
-[ "Mac->splitpath('d1:d2:d3',1)",    'd1:,d2:d3:,'     ],
-[ "Mac->splitpath(':d1:d2:d3:')",    ',:d1:d2:d3:,'    ],
-[ "Mac->splitpath(':d1:d2:d3:',1)",  ',:d1:d2:d3:,'    ],
-[ "Mac->splitpath('d1:d2:d3:file')", 'd1:,d2:d3:,file' ],
-[ "Mac->splitpath('d1:d2:d3',1)",    'd1:,d2:d3:,'     ],
-
-[ "Mac->catdir('')",                ':'           ],
-[ "Mac->catdir('d1','d2','d3')",    'd1:d2:d3:'   ],
-[ "Mac->catdir('d1','d2/','d3')",   'd1:d2/:d3:'  ],
+
+[ "Mac->catpath('','','')",              ''                ],
+[ "Mac->catpath('',':','')",             ':'               ],
+[ "Mac->catpath('','::','')",            '::'              ],
+
+[ "Mac->catpath('hd','','')",            'hd:'             ],
+[ "Mac->catpath('hd:','','')",           'hd:'             ],
+[ "Mac->catpath('hd:',':','')",          'hd:'             ], 
+[ "Mac->catpath('hd:','::','')",         'hd::'            ],
+
+[ "Mac->catpath('hd','','file')",       'hd:file'          ],
+[ "Mac->catpath('hd',':','file')",      'hd:file'          ],
+[ "Mac->catpath('hd','::','file')",     'hd::file'         ],
+[ "Mac->catpath('hd',':::','file')",    'hd:::file'        ],
+
+[ "Mac->catpath('hd:','',':file')",      'hd:file'         ],
+[ "Mac->catpath('hd:',':',':file')",     'hd:file'         ],
+[ "Mac->catpath('hd:','::',':file')",    'hd::file'        ],
+[ "Mac->catpath('hd:',':::',':file')",   'hd:::file'       ],
+
+[ "Mac->catpath('hd:','d1','file')",     'hd:d1:file'      ],
+[ "Mac->catpath('hd:',':d1:',':file')",  'hd:d1:file'      ],
+
+[ "Mac->catpath('','d1','')",            ':d1:'            ],
+[ "Mac->catpath('',':d1','')",           ':d1:'            ],
+[ "Mac->catpath('',':d1:','')",          ':d1:'            ],
+
+[ "Mac->catpath('','d1','file')",        ':d1:file'        ],
+[ "Mac->catpath('',':d1:',':file')",     ':d1:file'        ],
+
+[ "Mac->catpath('','','file')",          'file'            ],
+[ "Mac->catpath('','',':file')",         'file'            ], # !
+[ "Mac->catpath('',':',':file')",        ':file'           ], # !
+
+
+[ "Mac->splitpath(':')",              ',:,'               ],
+[ "Mac->splitpath('::')",             ',::,'              ],
+[ "Mac->splitpath(':::')",            ',:::,'             ],
+
+[ "Mac->splitpath('file')",           ',,file'            ],
+[ "Mac->splitpath(':file')",          ',:,file'           ],
+
+[ "Mac->splitpath('d1',1)",           ',:d1:,'            ], # dir, not volume
+[ "Mac->splitpath(':d1',1)",          ',:d1:,'            ],
+[ "Mac->splitpath(':d1:',1)",         ',:d1:,'            ],
+[ "Mac->splitpath(':d1:')",           ',:d1:,'            ],
+[ "Mac->splitpath(':d1:d2:d3:')",     ',:d1:d2:d3:,'      ],
+[ "Mac->splitpath(':d1:d2:d3:',1)",   ',:d1:d2:d3:,'      ],
+[ "Mac->splitpath(':d1:file')",       ',:d1:,file'        ],
+[ "Mac->splitpath('::d1:file')",      ',::d1:,file'       ],
+
+[ "Mac->splitpath('hd:', 1)",         'hd:,,'             ],
+[ "Mac->splitpath('hd:')",            'hd:,,'             ],
+[ "Mac->splitpath('hd:d1:d2:')",      'hd:,:d1:d2:,'      ],
+[ "Mac->splitpath('hd:d1:d2',1)",     'hd:,:d1:d2:,'      ],
+[ "Mac->splitpath('hd:d1:d2:file')",  'hd:,:d1:d2:,file'  ],
+[ "Mac->splitpath('hd:d1:d2::file')", 'hd:,:d1:d2::,file' ],
+[ "Mac->splitpath('hd::d1:d2:file')", 'hd:,::d1:d2:,file' ], # invalid path
+[ "Mac->splitpath('hd:file')",        'hd:,,file'         ],
+
+[ "Mac->splitdir('')",                 ''            ],
+[ "Mac->splitdir(':')",                ':'           ],
+[ "Mac->splitdir('::')",               '::'          ],
+[ "Mac->splitdir(':::')",              ':::'         ],
+[ "Mac->splitdir(':::d1:d2')",         ',,,d1,d2'    ],
+
+[ "Mac->splitdir(':d1:d2:d3::')",      ',d1,d2,d3,'  ],
+[ "Mac->splitdir(':d1:d2:d3:')",       ',d1,d2,d3'   ],
+[ "Mac->splitdir(':d1:d2:d3')",        ',d1,d2,d3'   ],
+
+[ "Mac->splitdir('hd:d1:d2:::')",      'hd,d1,d2,,'  ],
+[ "Mac->splitdir('hd:d1:d2::')",       'hd,d1,d2,'   ],
+[ "Mac->splitdir('hd:d1:d2:')",        'hd,d1,d2'    ],
+[ "Mac->splitdir('hd:d1:d2')",         'hd,d1,d2'    ],
+[ "Mac->splitdir('hd:d1::d2::')",      'hd,d1,,d2,'  ],
+
+[ "Mac->catdir()",                 ''            ],
+[ "Mac->catdir('')",               ':'           ],
+[ "Mac->catdir(':')",              ':'           ],
+
+[ "Mac->catdir('', '')",           '::'          ], # Hmm... ":" ? 
+[ "Mac->catdir('', ':')",          '::'          ], # Hmm... ":" ? 
+[ "Mac->catdir(':', ':')",         '::'          ], # Hmm... ":" ? 
+[ "Mac->catdir(':', '')",          '::'          ], # Hmm... ":" ? 
+
+[ "Mac->catdir('', '::')",         '::'          ],
+[ "Mac->catdir(':', '::')",        '::'          ], # but catdir('::', ':') is ':::'
+
+[ "Mac->catdir('::', '')",         ':::'         ], # Hmm... "::" ? 
+[ "Mac->catdir('::', ':')",        ':::'         ], # Hmm... "::" ? 
+
+[ "Mac->catdir('::', '::')",       ':::'         ], # ok
+
+#
+# Unix counterparts:
+#
+
+# Unix catdir('.') =        "."
+
+# Unix catdir('','') =      "/"
+# Unix catdir('','.') =     "/"
+# Unix catdir('.','.') =    "."
+# Unix catdir('.','') =     "."
+
+# Unix catdir('','..') =    "/"
+# Unix catdir('.','..') =   ".."
+
+# Unix catdir('..','') =    ".."
+# Unix catdir('..','.') =   ".."
+# Unix catdir('..','..') =  "../.."
+
+[ "Mac->catdir(':d1','d2')",        ':d1:d2:'     ],
 [ "Mac->catdir('','d1','d2','d3')", ':d1:d2:d3:'  ],
 [ "Mac->catdir('','','d2','d3')",   '::d2:d3:'    ],
 [ "Mac->catdir('','','','d3')",     ':::d3:'      ],
-[ "Mac->catdir(':name')",           ':name:'      ],
-[ "Mac->catdir(':name',':name')",   ':name:name:' ],
+[ "Mac->catdir(':d1')",             ':d1:'        ],
+[ "Mac->catdir(':d1',':d2')",       ':d1:d2:'     ],
+[ "Mac->catdir('', ':d1',':d2')",   ':d1:d2:'     ],
+[ "Mac->catdir('','',':d1',':d2')", '::d1:d2:'    ],
+
+[ "Mac->catdir('hd')",              'hd:'         ],
+[ "Mac->catdir('hd','d1','d2')",    'hd:d1:d2:'   ],
+[ "Mac->catdir('hd','d1/','d2')",   'hd:d1/:d2:'  ],
+[ "Mac->catdir('hd','',':d1')",     'hd::d1:'     ],
+[ "Mac->catdir('hd','d1')",         'hd:d1:'      ],
+[ "Mac->catdir('hd','d1', '')",     'hd:d1::'     ],
+[ "Mac->catdir('hd','d1','','')",   'hd:d1:::'    ],
+[ "Mac->catdir('hd:',':d1')",       'hd:d1:'      ],
+[ "Mac->catdir('hd:d1:',':d2')",    'hd:d1:d2:'   ],
+[ "Mac->catdir('hd:','d1')",        'hd:d1:'      ],
+[ "Mac->catdir('hd',':d1')",        'hd:d1:'      ],
+[ "Mac->catdir('hd:d1:',':d2')",    'hd:d1:d2:'   ],
+[ "Mac->catdir('hd:d1:',':d2:')",   'hd:d1:d2:'   ],
+
+
+[ "Mac->catfile()",                      ''            ], 
+[ "Mac->catfile('')",                    ''            ],
+[ "Mac->catfile(':')",                   ':'           ],
+[ "Mac->catfile(':', '')",               ':'           ],
+
+[ "Mac->catfile('hd','d1','file')",      'hd:d1:file'  ],
+[ "Mac->catfile('hd','d1',':file')",     'hd:d1:file'  ],
+[ "Mac->catfile('file')",                'file'        ], 
+[ "Mac->catfile(':', 'file')",           ':file'       ], 
+[ "Mac->catfile('', 'file')",            ':file'       ], 
 
-[ "Mac->catfile('a','b','c')", 'a:b:c' ],
 
 [ "Mac->canonpath('')",                   ''     ],
 [ "Mac->canonpath(':')",                  ':'    ],
@@ -281,20 +406,33 @@ BEGIN {
 [ "Mac->canonpath('a::')",                'a::'  ],
 [ "Mac->canonpath(':a::')",               ':a::' ],
 
-[ "Mac->abs2rel('t1:t2:t3','t1:t2:t3')",    ':'            ],
-[ "Mac->abs2rel('t1:t2','t1:t2:t3')",       '::'           ],
-[ "Mac->abs2rel('t1:t4','t1:t2:t3')",       ':::t4'        ],
-[ "Mac->abs2rel('t1:t2:t4','t1:t2:t3')",    '::t4'         ],
-[ "Mac->abs2rel('t1:t2:t3:t4','t1:t2:t3')", ':t4'          ],
-[ "Mac->abs2rel('t4:t5:t6','t1:t2:t3')",    '::::t4:t5:t6' ],
-[ "Mac->abs2rel('t1','t1:t2:t3')",          ':::'          ],
-
-[ "Mac->rel2abs(':t4','t1:t2:t3')",          't1:t2:t3:t4'    ],
-[ "Mac->rel2abs(':t4:t5','t1:t2:t3')",       't1:t2:t3:t4:t5' ],
-[ "Mac->rel2abs('','t1:t2:t3')",             ''               ],
-[ "Mac->rel2abs('::','t1:t2:t3')",           't1:t2:t3::'     ],
-[ "Mac->rel2abs('::t4','t1:t2:t3')",         't1:t2:t3::t4'   ],
-[ "Mac->rel2abs('t1','t1:t2:t3')",           't1'             ],
+[ "Mac->abs2rel('hd:d1:d2:','hd:d1:d2:')",            ':'            ],
+[ "Mac->abs2rel('hd:d1:d2:','hd:d1:d2:file')",        ':'            ], # ignore base's file portion
+[ "Mac->abs2rel('hd:d1:d2:file','hd:d1:d2:')",        ':file'        ], 
+[ "Mac->abs2rel('hd:d1:','hd:d1:d2:')",               '::'           ],
+[ "Mac->abs2rel('hd:d3:','hd:d1:d2:')",               ':::d3:'       ],
+[ "Mac->abs2rel('hd:d3:','hd:d1:d2::')",              '::d3:'        ],
+[ "Mac->abs2rel('hd:d1:d4:d5:','hd:d1::d2:d3::')",    '::d1:d4:d5:'  ],
+[ "Mac->abs2rel('hd:d1:d4:d5:','hd:d1::d2:d3:')",     ':::d1:d4:d5:' ], # first, resolve updirs in base
+[ "Mac->abs2rel('hd:d1:d3:','hd:d1:d2:')",            '::d3:'        ],
+[ "Mac->abs2rel('hd:d1::d3:','hd:d1:d2:')",           ':::d3:'       ],
+[ "Mac->abs2rel('hd:d3:','hd:d1:d2:')",               ':::d3:'       ], # same as above
+[ "Mac->abs2rel('hd:d1:d2:d3:','hd:d1:d2:')",         ':d3:'         ],
+[ "Mac->abs2rel('hd:d1:d2:d3::','hd:d1:d2:')",        ':d3::'        ],
+[ "Mac->abs2rel('v1:d3:d4:d5:','v2:d1:d2:')",         ':::d3:d4:d5:' ], # ignore base's volume
+[ "Mac->abs2rel('hd:','hd:d1:d2:')",                  ':::'          ],
+
+[ "Mac->rel2abs(':d3:','hd:d1:d2:')",          'hd:d1:d2:d3:'     ], 
+[ "Mac->rel2abs(':d3:d4:','hd:d1:d2:')",       'hd:d1:d2:d3:d4:'  ], 
+[ "Mac->rel2abs('','hd:d1:d2:')",              ''                 ],
+[ "Mac->rel2abs('::','hd:d1:d2:')",            'hd:d1:d2::'       ],
+[ "Mac->rel2abs('::','hd:d1:d2:file')",        'hd:d1:d2::'       ],# ignore base's file portion
+[ "Mac->rel2abs(':file','hd:d1:d2:')",         'hd:d1:d2:file'    ],
+[ "Mac->rel2abs('::file','hd:d1:d2:')",        'hd:d1:d2::file'   ],
+[ "Mac->rel2abs('::d3:','hd:d1:d2:')",         'hd:d1:d2::d3:'    ],
+[ "Mac->rel2abs('hd:','hd:d1:d2:')",           'hd:'              ], # path already absolute
+[ "Mac->rel2abs('hd:d3:file','hd:d1:d2:')",    'hd:d3:file'       ],
+[ "Mac->rel2abs('hd:d3:','hd:d1:file')",       'hd:d3:'           ],
 ) ;
 
 # Grab all of the plain routines from File::Spec
index 9ef55ec..6b62747 100644 (file)
@@ -8,6 +8,8 @@ $VERSION = '1.2';
 
 @ISA = qw(File::Spec::Unix);
 
+use Cwd;
+
 =head1 NAME
 
 File::Spec::Mac - File::Spec for MacOS
@@ -37,51 +39,87 @@ sub canonpath {
 
 =item catdir
 
-Concatenate two or more directory names to form a complete path ending with 
-a directory.  Put a trailing : on the end of the complete path if there 
-isn't one, because that's what's done in MacPerl's environment.
+Concatenate two or more directory names to form a path separated by colons
+(":") ending with a directory.  Automatically puts a trailing ":" on the
+end of the complete path, because that's what's done in MacPerl's
+environment and helps to distinguish a file path from a directory path.
+
+The intended purpose of this routine is to concatenate I<directory names>.
+But because of the nature of Macintosh paths, some additional possibilities
+are allowed to make using this routine give reasonable results for some
+common situations. In other words, you are also allowed to concatenate
+I<paths> instead of directory names (strictly speaking, a string like ":a"
+is a path, but not a name, since it contains a punctuation character ":").
+
+Here are the rules that are used: Each argument has its trailing ":" removed.
+Each argument, except the first, has its leading ":" removed.  They are then
+joined together by a ":" and a trailing ":" is added to the path.
+
+So, beside calls like
+
+    File::Spec->catdir("a") = "a:"
+    File::Spec->catdir("a","b") = "a:b:"
+    File::Spec->catdir("","a","b") = ":a:b:"
+    File::Spec->catdir("a","","b") = "a::b:"
+    File::Spec->catdir("") = ":"
+    File::Spec->catdir("a","b","") = "a:b::"     (!)
+    File::Spec->catdir() = ""                    (special case)
+
+calls like the following
 
-The fundamental requirement of this routine is that
+    File::Spec->catdir("a:",":b") = "a:b:"
+    File::Spec->catdir("a:b:",":c") = "a:b:c:"
+    File::Spec->catdir("a:","b") = "a:b:"
+    File::Spec->catdir("a",":b") = "a:b:"
+    File::Spec->catdir(":a","b") = ":a:b:"
+    File::Spec->catdir("","",":a",":b") = "::a:b:"
+    File::Spec->catdir("",":a",":b") = ":a:b:" (!)
+    File::Spec->catdir(":") = ":"
 
-         File::Spec->catdir(split(":",$path)) eq $path
+are allowed.
 
-But because of the nature of Macintosh paths, some additional 
-possibilities are allowed to make using this routine give reasonable results 
-for some common situations.  Here are the rules that are used.  Each 
-argument has its trailing ":" removed.  Each argument, except the first,
-has its leading ":" removed.  They are then joined together by a ":".
+To get a path beginning with a ":" (a relative path), put a "" as the first
+argument. Beginning the first argument with a ":" (e.g. ":a") will also work
+(see the examples).
 
-So
+Since Mac OS (Classic) uses the concept of volumes, there is an ambiguity:
+Does the first argument in
 
-         File::Spec->catdir("a","b") = "a:b:"
-         File::Spec->catdir("a:",":b") = "a:b:"
-         File::Spec->catdir("a:","b") = "a:b:"
-         File::Spec->catdir("a",":b") = "a:b"
-         File::Spec->catdir("a","","b") = "a::b"
+    File::Spec->catdir("LWP","Protocol");
 
-etc.
+denote a volume or a directory, i.e. should the path be relative or absolute?
+There is no way of telling except by checking for the existence of "LWP:" (a
+volume) or ":LWP" (a directory), but those checks aren't made here. Thus, according
+to the above rules, the path "LWP:Protocol:" will be returned, which, considered
+alone, is an absolute path, although the volume "LWP:" may not exist. Hence, don't
+forget to put a ":" in the appropriate place in the path if you want to
+distinguish unambiguously. (Remember that a valid relative path should always begin
+with a ":", unless you are specifying a file or a directory that resides in the
+I<current> directory. In that case, the leading ":" is not mandatory.)
 
-To get a relative path (one beginning with :), begin the first argument with :
-or put a "" as the first argument.
+With version 1.2 of File::Spec, there's a new method called C<catpath>, that
+takes volume, directory and file portions and returns an entire path (see below).
+While C<catdir> is still suitable for the concatenation of I<directory names>,
+you should consider using C<catpath> to concatenate I<volume names> and
+I<directory paths>, because it avoids any ambiguities. E.g.
 
-If you don't want to worry about these rules, never allow a ":" on the ends 
-of any of the arguments except at the beginning of the first.
+    $dir      = File::Spec->catdir("LWP","Protocol");
+    $abs_path = File::Spec->catpath("MacintoshHD:", $dir, "");
 
-Under MacPerl, there is an additional ambiguity.  Does the user intend that
+yields
 
-         File::Spec->catfile("LWP","Protocol","http.pm")
+    "MacintoshHD:LWP:Protocol:" .
 
-be relative or absolute?  There's no way of telling except by checking for the
-existence of LWP: or :LWP, and even there he may mean a dismounted volume or
-a relative path in a different directory (like in @INC).   So those checks
-aren't done here. This routine will treat this as absolute.
 
 =cut
 
 sub catdir {
-    shift;
+    my $self = shift;
+    return '' unless @_;
     my @args = @_;
     my $result = shift @args;
+    #  To match the actual end of the string,
+    #  not ignoring newline, you can use \Z(?!\n).
     $result =~ s/:\Z(?!\n)//;
     foreach (@args) {
        s/:\Z(?!\n)//;
@@ -95,21 +133,24 @@ sub catdir {
 
 Concatenate one or more directory names and a filename to form a
 complete path ending with a filename.  Since this uses catdir, the
-same caveats apply.  Note that the leading : is removed from the filename,
-so that 
+same caveats apply.  Note that the leading ":" is removed from the
+filename, so that
 
-         File::Spec->catfile($ENV{HOME},"file");
+    File::Spec->catfile("a", "b", "file"); # = "a:b:file"
 
 and
 
-         File::Spec->catfile($ENV{HOME},":file");
+    File::Spec->catfile("a", "b", ":file"); # = "a:b:file"
 
-give the same answer, as one might expect.
+give the same answer, as one might expect. To concatenate I<volume names>,
+I<directory paths> and I<filenames>, you should consider using C<catpath>
+(see below).
 
 =cut
 
 sub catfile {
     my $self = shift;
+    return '' unless @_;
     my $file = pop @_;
     return $file unless @_;
     my $dir = $self->catdir(@_);
@@ -119,7 +160,7 @@ sub catfile {
 
 =item curdir
 
-Returns a string representing the current directory.
+Returns a string representing the current directory. On Mac OS, this is ":".
 
 =cut
 
@@ -129,7 +170,7 @@ sub curdir {
 
 =item devnull
 
-Returns a string representing the null device.
+Returns a string representing the null device. On Mac OS, this is "Dev:Null".
 
 =cut
 
@@ -141,7 +182,9 @@ sub devnull {
 
 Returns a string representing the root directory.  Under MacPerl,
 returns the name of the startup volume, since that's the closest in
-concept, although other volumes aren't rooted there.
+concept, although other volumes aren't rooted there. The name has a
+trailing ":", because that's the correct specification for a volume
+name on Mac OS.
 
 =cut
 
@@ -159,10 +202,9 @@ sub rootdir {
 
 =item tmpdir
 
-Returns a string representation of the first existing directory
-from the following list or '' if none exist:
-
-    $ENV{TMPDIR}
+Returns the contents of $ENV{TMPDIR}, if that directory exits or the current working
+directory otherwise. Under MacPerl, $ENV{TMPDIR} will contain a path like
+"MacintoshHD:Temporary Items:", which is a hidden directory on your startup volume.
 
 =cut
 
@@ -170,13 +212,15 @@ my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $tmpdir;
     $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
-    $tmpdir = '' unless defined $tmpdir;
+    unless (defined($tmpdir)) {
+       $tmpdir = cwd();
+    }
     return $tmpdir;
 }
 
 =item updir
 
-Returns a string representing the parent directory.
+Returns a string representing the parent directory. On Mac OS, this is "::".
 
 =cut
 
@@ -186,32 +230,41 @@ sub updir {
 
 =item file_name_is_absolute
 
-Takes as argument a path and returns true, if it is an absolute path.  In 
-the case where a name can be either relative or absolute (for example, a 
-folder named "HD" in the current working directory on a drive named "HD"), 
-relative wins.  Use ":" in the appropriate place in the path if you want to
-distinguish unambiguously.
+Takes as argument a path and returns true, if it is an absolute path.
+This does not consult the local filesystem. If
+the path has a leading ":", it's a relative path. Otherwise, it's an
+absolute path, unless the path doesn't contain any colons, i.e. it's a name
+like "a". In this particular case, the path is considered to be relative
+(i.e. it is considered to be a filename). Use ":" in the appropriate place
+in the path if you want to distinguish unambiguously. As a special case,
+the filename '' is always considered to be absolute.
+
+E.g.
+
+    File::Spec->file_name_is_absolute("a");             # false (relative)
+    File::Spec->file_name_is_absolute(":a:b:");         # false (relative)
+    File::Spec->file_name_is_absolute("MacintoshHD:");  # true (absolute)
+    File::Spec->file_name_is_absolute("");              # true (absolute)
 
-As a special case, the file name '' is always considered to be absolute.
 
 =cut
 
 sub file_name_is_absolute {
     my ($self,$file) = @_;
     if ($file =~ /:/) {
-       return ($file !~ m/^:/s);
+       return (! ($file =~ m/^:/s) );
     } elsif ( $file eq '' ) {
         return 1 ;
     } else {
-       return (! -e ":$file");
+       return 0; # i.e. a file like "a"
     }
 }
 
 =item path
 
-Returns the null list for the MacPerl application, since the concept is 
-usually meaningless under MacOS. But if you're using the MacPerl tool under 
-MPW, it gives back $ENV{Commands} suitably split, as is done in 
+Returns the null list for the MacPerl application, since the concept is
+usually meaningless under MacOS. But if you're using the MacPerl tool under
+MPW, it gives back $ENV{Commands} suitably split, as is done in
 :lib:ExtUtils:MM_Mac.pm.
 
 =cut
@@ -227,40 +280,107 @@ sub path {
 
 =item splitpath
 
+    ($volume,$directories,$file) = File::Spec->splitpath( $path );
+    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Splits a path in to volume, directory, and filename portions.
+
+On Mac OS, assumes that the last part of the path is a filename unless
+$no_file is true or a trailing separator ":" is present.
+
+The volume portion is always returned with a trailing ":". The directory portion
+is always returned with a leading (to denote a relative path) and a trailing ":"
+(to denote a directory). The file portion is always returned I<without> a leading ":".
+Empty portions are returned as "".
+
+The results can be passed to L</catpath()> to get back a path equivalent to
+(usually identical to) the original path.
+
+
 =cut
 
 sub splitpath {
     my ($self,$path, $nofile) = @_;
-
-    my ($volume,$directory,$file) = ('','','');
+    my ($volume,$directory,$file);
 
     if ( $nofile ) {
-        ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\Z(?!\n)))?)(.*)@s;
+        ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
     }
     else {
-        $path =~ 
-            m@^( (?: [^:]+: )? ) 
-                ( (?: .*: )? )
-                ( .* )
-             @xs;
+        $path =~
+            m|^( (?: [^:]+: )? )
+               ( (?: .*: )? )
+               ( .* )
+             |xs;
         $volume    = $1;
         $directory = $2;
         $file      = $3;
     }
 
-    # Make sure non-empty volumes and directories end in ':'
-    $volume    .= ':' if $volume    =~ m@[^:]\Z(?!\n)@ ;
-    $directory .= ':' if $directory =~ m@[^:]\Z(?!\n)@ ;
+    $volume = '' unless defined($volume);
+       $directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir"
+    if ($directory) {
+        # Make sure non-empty directories begin and end in ':'
+        $directory .= ':' unless (substr($directory,-1) eq ':');
+        $directory = ":$directory" unless (substr($directory,0,1) eq ':');
+    } else {
+       $directory = '';
+    }
+    $file = '' unless defined($file);
+
     return ($volume,$directory,$file);
 }
 
 
 =item splitdir
 
+The opposite of L</catdir()>.
+
+    @dirs = File::Spec->splitdir( $directories );
+
+$directories must be only the directory portion of the path on systems
+that have the concept of a volume or that have path syntax that differentiates
+files from directories.
+
+Unlike just splitting the directories on the separator, empty directory names
+(C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing
+colon to distinguish a directory path from a file path, a single trailing colon
+will be ignored, i.e. there's no empty directory name after it.
+
+Hence, on Mac OS, both
+
+    File::Spec->splitdir( ":a:b::c:" );    and
+    File::Spec->splitdir( ":a:b::c" );
+
+yield:
+
+    ( "", "a", "b", "", "c")
+
+while
+
+    File::Spec->splitdir( ":a:b::c::" );
+
+yields:
+
+    ( "", "a", "b", "", "c", "")
+
+
 =cut
 
 sub splitdir {
     my ($self,$directories) = @_ ;
+
+    if ($directories =~ /^:*\Z(?!\n)/) {
+       # dir is an empty string or a colon path like ':', i.e. the
+       # current dir, or '::', the parent dir, etc. We return that
+       # dir (as is done on Unix).
+       return $directories;
+    }
+
+    # remove a trailing colon, if any (this way, splitdir is the
+    # opposite of catdir, which automatically appends a ':')
+    $directories =~ s/:\Z(?!\n)//;
+
     #
     # split() likes to forget about trailing null fields, so here we
     # check to be sure that there will not be any before handling the
@@ -271,7 +391,7 @@ sub splitdir {
     }
     else {
         #
-        # since there was a trailing separator, add a file name to the end, 
+        # since there was a trailing separator, add a file name to the end,
         # then do the split, then replace it with ''.
         #
         my( @directories )= split( m@:@, "${directories}dummy" ) ;
@@ -283,42 +403,88 @@ sub splitdir {
 
 =item catpath
 
+    $path = File::Spec->catpath($volume,$directory,$file);
+
+Takes volume, directory and file portions and returns an entire path. On Mac OS,
+$volume, $directory and $file are concatenated.  A ':' is inserted if need be. You
+may pass an empty string for each portion. If all portions are empty, the empty
+string is returned. If $volume is empty, the result will be a relative path,
+beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
+is removed form $file and the remainder is returned. If $file is empty, the
+resulting path will have a trailing ':'.
+
+
 =cut
 
 sub catpath {
-    my $self = shift ;
+    my ($self,$volume,$directory,$file) = @_;
 
-    my $result = shift ;
-    $result =~ s@^([^/])@/$1@s ;
+    if ( (! $volume) && (! $directory) ) {
+       $file =~ s/^:// if $file;
+       return $file ;
+    }
 
-    my $segment ;
-    for $segment ( @_ ) {
-        if ( $result =~ m@[^/]\Z(?!\n)@ && $segment =~ m@^[^/]@s ) {
-            $result .= "/$segment" ;
-        }
-        elsif ( $result =~ m@/\Z(?!\n)@ && $segment =~ m@^/@s ) {
-            $result  =~ s@/+\Z(?!\n)@/@;
-            $segment =~ s@^/+@@s;
-            $result  .= "$segment" ;
-        }
-        else {
-            $result  .= $segment ;
-        }
+    my $path = $volume; # may be ''
+    $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
+
+    if ($directory) {
+       $directory =~ s/^://; # remove leading ':' if any
+       $path .= $directory;
+       $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
     }
 
-    return $result ;
+    if ($file) {
+       $file =~ s/^://; # remove leading ':' if any
+       $path .= $file;
+    }
+
+    return $path;
 }
 
 =item abs2rel
 
-See L<File::Spec::Unix/abs2rel> for general documentation.
+Takes a destination path and an optional base path and returns a relative path
+from the base path to the destination path:
+
+    $rel_path = File::Spec->abs2rel( $path ) ;
+    $rel_path = File::Spec->abs2rel( $path, $base ) ;
+
+Note that both paths are assumed to have a notation that distinguishes a
+directory path (with trailing ':') from a file path (without trailing ':').
+
+If $base is not present or '', then the current working directory is used.
+If $base is relative, then it is converted to absolute form using C<rel2abs()>.
+This means that it is taken to be relative to the current working directory.
+
+Since Mac OS has the concept of volumes, this assumes that both paths
+are on the $destination volume, and ignores the $base volume (!).
+
+If $base doesn't have a trailing colon, the last element of $base is
+assumed to be a filename. This filename is ignored (!). Otherwise all path
+components are assumed to be directories.
+
+If $path is relative, it is converted to absolute form using C<rel2abs()>.
+This means that it is taken to be relative to the current working directory.
+
+Based on code written by Shigio Yamaguchi.
 
-Unlike C<File::Spec::Unix->abs2rel()>, this function will make
-checks against the local filesystem if necessary.  See
-L</file_name_is_absolute> for details.
 
 =cut
 
+# maybe this should be done in canonpath() ?
+sub _resolve_updirs {
+       my $path = shift @_;
+       my $proceed;
+
+       # resolve any updirs, e.g. "HD:tmp::file" -> "HD:file"
+       do {
+               $proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);
+       } while ($proceed);
+
+       return $path;
+}
+
+
 sub abs2rel {
     my($self,$path,$base) = @_;
 
@@ -329,62 +495,106 @@ sub abs2rel {
 
     # Figure out the effective $base and clean it up.
     if ( !defined( $base ) || $base eq '' ) {
-        $base = cwd() ;
+       $base = cwd();
     }
     elsif ( ! $self->file_name_is_absolute( $base ) ) {
         $base = $self->rel2abs( $base ) ;
+       $base = _resolve_updirs( $base ); # resolve updirs in $base
     }
+    else {
+       $base = _resolve_updirs( $base );
+    }
+
+    # Split up paths
+    my ( $path_dirs, $path_file ) =  ($self->splitpath( $path ))[1,2] ;
+
+    # ignore $base's volume and file
+    my $base_dirs = ($self->splitpath( $base ))[1] ;
 
     # Now, remove all leading components that are the same
-    my @pathchunks = $self->splitdir( $path );
-    my @basechunks = $self->splitdir( $base );
+    my @pathchunks = $self->splitdir( $path_dirs );
+    my @basechunks = $self->splitdir( $base_dirs );
 
-    while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
+    while ( @pathchunks &&
+           @basechunks &&
+           lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
         shift @pathchunks ;
         shift @basechunks ;
     }
 
-    $path = join( ':', @pathchunks );
+    # @pathchunks now has the directories to descend in to.
+    $path_dirs = $self->catdir( @pathchunks );
 
     # @basechunks now contains the number of directories to climb out of.
-    $base = ':' x @basechunks ;
+    $base_dirs = (':' x @basechunks) . ':' ;
 
-    return "$base:$path" ;
+    return $self->catpath( '', $base_dirs . $path_dirs, $path_file ) ;
 }
 
 =item rel2abs
 
-See L<File::Spec::Unix/rel2abs> for general documentation.
+Converts a relative path to an absolute path:
+
+    $abs_path = File::Spec->rel2abs( $path ) ;
+    $abs_path = File::Spec->rel2abs( $path, $base ) ;
 
-Unlike C<File::Spec::Unix->rel2abs()>, this function will make
-checks against the local filesystem if necessary.  See
-L</file_name_is_absolute> for details.
+Note that both paths are assumed to have a notation that distinguishes a
+directory path (with trailing ':') from a file path (without trailing ':').
+
+If $base is not present or '', then $base is set to the current working
+directory. If $base is relative, then it is converted to absolute form
+using C<rel2abs()>. This means that it is taken to be relative to the
+current working directory.
+
+If $base doesn't have a trailing colon, the last element of $base is
+assumed to be a filename. This filename is ignored (!). Otherwise all path
+components are assumed to be directories.
+
+If $path is already absolute, it is returned and $base is ignored.
+
+Based on code written by Shigio Yamaguchi.
 
 =cut
 
 sub rel2abs {
-    my ($self,$path,$base ) = @_;
+    my ($self,$path,$base) = @_;
 
-    if ( ! $self->file_name_is_absolute( $path ) ) {
+    if ( ! $self->file_name_is_absolute($path) ) {
+        # Figure out the effective $base and clean it up.
         if ( !defined( $base ) || $base eq '' ) {
-            $base = cwd() ;
+           $base = cwd();
         }
-        elsif ( ! $self->file_name_is_absolute( $base ) ) {
-            $base = $self->rel2abs( $base ) ;
-        }
-        else {
-            $base = $self->canonpath( $base ) ;
+        elsif ( ! $self->file_name_is_absolute($base) ) {
+            $base = $self->rel2abs($base) ;
         }
 
-        $path = $self->canonpath("$base$path") ;
-    }
+       # Split up paths
+
+       # igonore $path's volume
+        my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ;
+
+        # ignore $base's file part
+       my ( $base_vol, $base_dirs, undef ) = $self->splitpath($base) ;
+
+       # Glom them together
+       $path_dirs = ':' if ($path_dirs eq '');
+       $base_dirs =~ s/:$//; # remove trailing ':', if any
+       $base_dirs = $base_dirs . $path_dirs;
 
-    return $path ;
+        $path = $self->catpath( $base_vol, $base_dirs, $path_file );
+    }
+    return $path;
 }
 
 
 =back
 
+=head1 AUTHORS
+
+See the authors list in L<File::Spec>. Mac OS support by Paul Schinder
+<schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
+
+
 =head1 SEE ALSO
 
 L<File::Spec>
index b686682..97b2895 100644 (file)
@@ -9,7 +9,8 @@ File::Temp - return name and handle of a temporary file safely
 =head1 PORTABILITY
 
 This module is designed to be portable across operating systems
-and it currently supports Unix, VMS, DOS, OS/2 and Windows. When
+and it currently supports Unix, VMS, DOS, OS/2, Windows and
+Mac OS (Classic). When
 porting to a new OS there are generally three main issues
 that have to be solved:
 
@@ -40,7 +41,7 @@ The C<_can_do_level> method should be modified accordingly.
 
 =head1 SYNOPSIS
 
-  use File::Temp qw/ tempfile tempdir /; 
+  use File::Temp qw/ tempfile tempdir /;
 
   $dir = tempdir( CLEANUP => 1 );
   ($fh, $filename) = tempfile( DIR => $dir );
@@ -91,7 +92,7 @@ Objects (NOT YET IMPLEMENTED):
 
 C<File::Temp> can be used to create and open temporary files in a safe way.
 The tempfile() function can be used to return the name and the open
-filehandle of a temporary file.  The tempdir() function can 
+filehandle of a temporary file.  The tempdir() function can
 be used to create a temporary directory.
 
 The security aspect of temporary file creation is emphasized such that
@@ -164,9 +165,9 @@ use base qw/Exporter/;
 # add contents of these tags to @EXPORT
 Exporter::export_tags('POSIX','mktemp');
 
-# Version number 
+# Version number
 
-$VERSION = '0.12';
+$VERSION = '0.13';
 
 # This is a list of characters that can be used in random filenames
 
@@ -197,17 +198,19 @@ use constant HIGH     => 2;
 
 my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
 
-for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
-  my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
-  no strict 'refs';
-  $OPENFLAGS |= $bit if eval {
-    # Make sure that redefined die handlers do not cause problems
-    # eg CGI::Carp
-    local $SIG{__DIE__} = sub {};
-    local $SIG{__WARN__} = sub {};
-    $bit = &$func();
-    1;
-  };
+unless ($^O eq 'MacOS') {
+  for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
+    my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+    no strict 'refs';
+    $OPENFLAGS |= $bit if eval {
+      # Make sure that redefined die handlers do not cause problems
+      # eg CGI::Carp
+      local $SIG{__DIE__} = sub {};
+      local $SIG{__WARN__} = sub {};
+      $bit = &$func();
+      1;
+    };
+  }
 }
 
 # On some systems the O_TEMPORARY flag can be used to tell the OS
@@ -218,17 +221,19 @@ for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
 # this by using a second open flags variable
 
 my $OPENTEMPFLAGS = $OPENFLAGS;
-for my $oflag (qw/ TEMPORARY /) {
-  my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
-  no strict 'refs';
-  $OPENTEMPFLAGS |= $bit if eval {
-    # Make sure that redefined die handlers do not cause problems
-    # eg CGI::Carp
-    local $SIG{__DIE__} = sub {};
-    local $SIG{__WARN__} = sub {};
-    $bit = &$func();
-    1;
-  };
+unless ($^O eq 'MacOS') {
+  for my $oflag (qw/ TEMPORARY /) {
+    my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+    no strict 'refs';
+    $OPENTEMPFLAGS |= $bit if eval {
+      # Make sure that redefined die handlers do not cause problems
+      # eg CGI::Carp
+      local $SIG{__DIE__} = sub {};
+      local $SIG{__WARN__} = sub {};
+      $bit = &$func();
+      1;
+    };
+  }
 }
 
 # INTERNAL ROUTINES - not to be used outside of package
@@ -253,7 +258,7 @@ for my $oflag (qw/ TEMPORARY /) {
 #                  default is 0.
 #   "unlink_on_close" => indicates that, if possible,  the OS should remove
 #                        the file as soon as it is closed. Usually indicates
-#                        use of the O_TEMPORARY flag to sysopen. 
+#                        use of the O_TEMPORARY flag to sysopen.
 #                        Usually irrelevant on unix
 
 # Optionally a reference to a scalar can be passed into the function
@@ -361,8 +366,8 @@ sub _gettemp {
     # Split the directory and put it back together again
     my @dirs = File::Spec->splitdir($directories);
 
-    # If @dirs only has one entry that means we are in the current
-    # directory
+    # If @dirs only has one entry (i.e. the directory template) that means
+    # we are in the current directory
     if ($#dirs == 0) {
       $parent = File::Spec->curdir;
     } else {
@@ -395,7 +400,7 @@ sub _gettemp {
 
   }
 
-  # Check that the parent directories exist 
+  # Check that the parent directories exist
   # Do this even for the case where we are simply returning a name
   # not a file -- no point returning a name that includes a directory
   # that does not exist or is not writable
@@ -468,7 +473,7 @@ sub _gettemp {
 
        # Reset umask
        umask($umask);
-       
+
        # Opened successfully - return file handle and name
        return ($fh, $path);
 
@@ -484,7 +489,7 @@ sub _gettemp {
        }
 
        # Loop round for another try
-       
+
       }
     } elsif ($options{"mkdir"}) {
 
@@ -585,10 +590,10 @@ sub _randchar {
 }
 
 # Internal routine to replace the XXXX... with random characters
-# This has to be done by _gettemp() every time it fails to 
+# This has to be done by _gettemp() every time it fails to
 # open a temp file/dir
 
-# Arguments:  $template (the template with XXX), 
+# Arguments:  $template (the template with XXX),
 #             $ignore   (number of characters at end to ignore)
 
 # Returns:    modified template
@@ -684,7 +689,7 @@ sub _is_safe {
 }
 
 # Internal routine to check whether a directory is safe
-# for temp files. Safer than _is_safe since it checks for 
+# for temp files. Safer than _is_safe since it checks for
 # the possibility of chown giveaway and if that is a possibility
 # checks each directory in the path to see if it is safe (with _is_safe)
 
@@ -769,7 +774,7 @@ sub _is_verysafe {
 
 sub _can_unlink_opened_file {
 
-  if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos') {
+  if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos' || $^O eq 'MacOS') {
     return 0;
   } else {
     return 1;
@@ -793,7 +798,7 @@ sub _can_do_level {
   return 1 if $level == STANDARD;
 
   # Currently, the systems that can do HIGH or MEDIUM are identical
-  if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos') {
+  if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS') {
     return 0;
   } else {
     return 1;
@@ -936,20 +941,20 @@ is specified.
 Return the filename and filehandle as before except that the file is
 automatically removed when the program exits. Default is for the file
 to be removed if a file handle is requested and to be kept if the
-filename is requested. In a scalar context (where no filename is 
+filename is requested. In a scalar context (where no filename is
 returned) the file is always deleted either on exit or when it is closed.
 
 If the template is not specified, a template is always
 automatically generated. This temporary file is placed in tmpdir()
-(L<File::Spec>) unless a directory is specified explicitly with the 
+(L<File::Spec>) unless a directory is specified explicitly with the
 DIR option.
 
   $fh = tempfile( $template, DIR => $dir );
 
 If called in scalar context, only the filehandle is returned
-and the file will automatically be deleted when closed (see 
+and the file will automatically be deleted when closed (see
 the description of tmpfile() elsewhere in this document).
-This is the preferred mode of operation, as if you only 
+This is the preferred mode of operation, as if you only
 have a filehandle, you can never create a race condition
 by fumbling with the filename. On systems that can not unlink
 an open file or can not mark a file as temporary when it is opened
@@ -961,7 +966,7 @@ to setting UNLINK to 1). The C<UNLINK> flag is ignored if present.
 
 This will return the filename based on the template but
 will not open this file.  Cannot be used in conjunction with
-UNLINK set to true. Default is to always open the file 
+UNLINK set to true. Default is to always open the file
 to protect from possible race conditions. A warning is issued
 if warnings are turned on. Consider using the tmpnam()
 and mktemp() functions described elsewhere in this document
@@ -1040,7 +1045,7 @@ sub tempfile {
   # On unix this is irrelevant and can be worked out after the file is
   # opened (simply by unlinking the open filehandle). On Windows or VMS
   # we have to indicate temporary-ness when we open the file. In general
-  # we only want a true temporary file if we are returning just the 
+  # we only want a true temporary file if we are returning just the
   # filehandle - if the user wants the filename they probably do not
   # want the file to disappear as soon as they close it.
   # For this reason, tie unlink_on_close to the return context regardless
@@ -1118,7 +1123,7 @@ prepending the supplied directory.
 
   $tempdir = tempdir ( $template, TMPDIR => 1 );
 
-Using the supplied template, creat the temporary directory in 
+Using the supplied template, create the temporary directory in
 a standard location for temporary files. Equivalent to doing
 
   $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
@@ -1130,7 +1135,7 @@ nor a directory are supplied.
 
   $tempdir = tempdir( $template, CLEANUP => 1);
 
-Create a temporary directory using the supplied template, but 
+Create a temporary directory using the supplied template, but
 attempt to remove it (and all files inside it) when the program
 exits. Note that an attempt will be made to remove all files from
 the directory even if they were not created by this module (otherwise
@@ -1213,6 +1218,10 @@ sub tempdir  {
     $template =~ m/([\.\]:>]+)$/;
     $suffixlen = length($1);
   }
+  if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
+    # dir name has a trailing ':'
+    ++$suffixlen;
+  }
 
   my $errstr;
   croak "Error in tempdir() using $template: $errstr"
@@ -1237,7 +1246,7 @@ sub tempdir  {
 
 =head1 MKTEMP FUNCTIONS
 
-The following functions are Perl implementations of the 
+The following functions are Perl implementations of the
 mktemp() family of temp file generation system calls.
 
 =over 4
@@ -1353,6 +1362,10 @@ sub mkdtemp {
     $template =~ m/([\.\]:>]+)$/;
     $suffixlen = length($1);
   }
+  if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
+    # dir name has a trailing ':'
+    ++$suffixlen;
+  }
   my ($junk, $tmpdir, $errstr);
   croak "Error creating temp directory from template $template\: $errstr"
     unless (($junk, $tmpdir) = _gettemp($template,
@@ -1401,7 +1414,7 @@ sub mktemp {
 =head1 POSIX FUNCTIONS
 
 This section describes the re-implementation of the tmpnam()
-and tmpfile() functions described in L<POSIX> 
+and tmpfile() functions described in L<POSIX>
 using the mkstemp() from this module.
 
 Unlike the L<POSIX|POSIX> implementations, the directory used
@@ -1493,7 +1506,7 @@ These functions are provided for backwards compatibility
 with common tempfile generation C library functions.
 
 They are not exported and must be addressed using the full package
-name. 
+name.
 
 =over 4
 
@@ -1501,14 +1514,14 @@ name.
 
 Return the name of a temporary file in the specified directory
 using a prefix. The file is guaranteed not to exist at the time
-the function was called, but such guarantees are good for one 
+the function was called, but such guarantees are good for one
 clock tick only.  Always use the proper form of C<sysopen>
 with C<O_CREAT | O_EXCL> if you must open such a filename.
 
   $filename = File::Temp::tempnam( $dir, $prefix );
 
 Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
-(using unix file convention as an example) 
+(using unix file convention as an example)
 
 Because this function uses mktemp(), it can suffer from race conditions.
 
@@ -1700,11 +1713,11 @@ for sticky bit.
 In addition to the MEDIUM security checks, also check for the
 possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
 sysconf() function. If this is a possibility, each directory in the
-path is checked in turn for safeness, recursively walking back to the 
+path is checked in turn for safeness, recursively walking back to the
 root directory.
 
 For platforms that do not support the L<POSIX|POSIX>
-C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is 
+C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
 assumed that ``chown() giveaway'' is possible and the recursive test
 is performed.
 
@@ -1717,7 +1730,7 @@ The level can be changed as follows:
 The level constants are not exported by the module.
 
 Currently, you must be running at least perl v5.6.0 in order to
-run with MEDIUM or HIGH security. This is simply because the 
+run with MEDIUM or HIGH security. This is simply because the
 safety tests use functions from L<Fcntl|Fcntl> that are not
 available in older versions of perl. The problem is that the version
 number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
@@ -1734,7 +1747,7 @@ If you really need to see whether the change has been accepted
 simply examine the return value of C<safe_level>.
 
   $newlevel = File::Temp->safe_level( File::Temp::HIGH );
-  die "Could not change to high security" 
+  die "Could not change to high security"
       if $newlevel != File::Temp::HIGH;
 
 =cut
@@ -1744,7 +1757,7 @@ simply examine the return value of C<safe_level>.
   my $LEVEL = STANDARD;
   sub safe_level {
     my $self = shift;
-    if (@_) { 
+    if (@_) {
       my $level = shift;
       if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
        carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
@@ -1766,8 +1779,8 @@ simply examine the return value of C<safe_level>.
 =item TopSystemUID
 
 This is the highest UID on the current system that refers to a root
-UID. This is used to make sure that the temporary directory is 
-owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than 
+UID. This is used to make sure that the temporary directory is
+owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
 simply by root.
 
 This is required since on many unix systems C</tmp> is not owned
@@ -1840,7 +1853,7 @@ operating system and to help with portability.
 
 L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
 
-See L<IO::File> and L<File::MkTemp> for different implementations of 
+See L<IO::File> and L<File::MkTemp> for different implementations of
 temporary file handling.
 
 =head1 AUTHOR
@@ -1852,7 +1865,7 @@ Astronomy Research Council. All Rights Reserved.  This program is free
 software; you can redistribute it and/or modify it under the same
 terms as Perl itself.
 
-Original Perl implementation loosely based on the OpenBSD C code for 
+Original Perl implementation loosely based on the OpenBSD C code for
 mkstemp(). Thanks to Tom Christiansen for suggesting that this module
 should be written and providing ideas for code improvements and
 security enhancements.
index 7f557e3..e0cf85b 100755 (executable)
@@ -27,7 +27,7 @@ ok(1);
 # The high security tests must currently be skipped on some platforms
 my $skipplat = ( (
                  # No sticky bits.
-                 $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'os2' || $^O eq 'dos' || $^O eq 'mpeix'
+                 $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'os2' || $^O eq 'dos' || $^O eq 'mpeix' || $^O eq 'MacOS'
                  ) ? 1 : 0 );
 
 # Can not run high security tests in perls before 5.6.0
index dda36a1..f72f393 100644 (file)
@@ -70,16 +70,17 @@ sub no_plan {
 }
 
 
-
-$| = 1;
-open(*TESTOUT, ">&STDOUT") or _whoa(1, "Can't dup STDOUT!");
-open(*TESTERR, ">&STDOUT") or _whoa(1, "Can't dup STDOUT!");
-{
-    my $orig_fh = select TESTOUT;
-    $| = 1;
-    select TESTERR;
+unless( $^C ) {    
     $| = 1;
-    select $orig_fh;
+    open(*TESTOUT, ">&STDOUT") or _whoa(1, "Can't dup STDOUT!");
+    open(*TESTERR, ">&STDOUT") or _whoa(1, "Can't dup STDOUT!");
+    {
+        my $orig_fh = select TESTOUT;
+        $| = 1;
+        select TESTERR;
+        $| = 1;
+        select $orig_fh;
+    }
 }
 
 =head1 NAME
index 17908eb..1d00f90 100644 (file)
@@ -17,6 +17,8 @@ $VERSION = '0.02';
 sub my_print (*@) {
     my($fh, @args) = @_;
 
+    return 1 if $^C;
+
     local $\;
     print $fh @args;
 }
index bcaad0b..c23c121 100644 (file)
@@ -92,7 +92,7 @@ sub new {
 
 sub TIESCALAR {
     my $pkg = shift;
-    if (defined &{"{$pkg}::new"}) {
+       if ($pkg->can('new') and $pkg ne __PACKAGE__) {
        warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing");
        $pkg->new(@_);
     }
diff --git a/lib/Tie/Scalar.t b/lib/Tie/Scalar.t
new file mode 100644 (file)
index 0000000..3c5d9b6
--- /dev/null
@@ -0,0 +1,76 @@
+#!./perl
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+# this must come before main, or tests will fail
+package TieTest;
+
+use Tie::Scalar;
+use vars qw( @ISA );
+@ISA = qw( Tie::Scalar );
+
+sub new { 'Fooled you.' }
+
+package main;
+
+use vars qw( $flag );
+use Test::More tests => 13;
+
+use_ok( 'Tie::Scalar' );
+
+# these are "abstract virtual" parent methods
+for my $method qw( TIESCALAR FETCH STORE ) {
+       eval { Tie::Scalar->$method() };
+       like( $@, qr/doesn't define a $method/, "croaks on inherited $method()" );
+}
+
+# the default value is undef
+my $scalar = Tie::StdScalar->TIESCALAR();
+is( $$scalar, undef, 'used TIESCALAR, default value is still undef' );
+
+# Tie::StdScalar redirects to TIESCALAR
+$scalar = Tie::StdScalar->new();
+is( $$scalar, undef, 'used new(), default value is still undef' );
+
+# this approach should work as well
+tie $scalar, 'Tie::StdScalar';
+is( $$scalar, undef, 'tied a scalar, default value is undef' );
+
+# first set, then read
+$scalar = 'fetch me';
+is( $scalar, 'fetch me', 'STORE() and FETCH() verified with one test!' );
+
+# test DESTROY with an object that signals its destruction
+{
+       my $scalar = 'foo';
+       tie $scalar, 'Tie::StdScalar', DestroyAction->new();
+       ok( $scalar, 'tied once more' );
+       is( $flag, undef, 'destroy flag not set' );
+}
+
+# $scalar out of scope, Tie::StdScalar::DESTROY() called, DestroyAction set flag
+is( $flag, 1, 'and DESTROY() works' );
+
+# we want some noise, and some way to capture it
+use warnings;
+my $warn;
+local $SIG{__WARN__} = sub {
+       $warn = $_[0];
+};
+
+# Tie::Scalar::TIEHANDLE should find and call TieTest::new and complain
+is( tie( my $foo, 'TieTest'), 'Fooled you.', 'delegated to new()' );
+like( $warn, qr/WARNING: calling TieTest->new/, 'caught warning fine' );
+
+package DestroyAction;
+
+sub new {
+       bless( \(my $self), $_[0] );
+}
+
+sub DESTROY {
+       $main::flag = 1;
+}
diff --git a/lib/open.t b/lib/open.t
new file mode 100644 (file)
index 0000000..90e5e3b
--- /dev/null
@@ -0,0 +1,68 @@
+#!./perl
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+use Test::More tests => 12;
+
+# open::import expects 'open' as its first argument, but it clashes with open()
+sub import {
+       open::import( 'open', @_ );
+}
+
+# can't use require_ok() here, with a name like 'open'
+ok( require 'open.pm', 'required okay!' );
+
+# this should fail
+eval { import() };
+like( $@, qr/needs explicit list of disciplines/, 'import fails without args' );
+
+# the hint bits shouldn't be set yet
+is( $^H & $open::hint_bits, 0, '$^H is okay before open import runs' );
+
+# prevent it from loading I18N::Langinfo, so we can test encoding failures
+local @INC;
+$ENV{LC_ALL} = '';
+eval { import( 'IN', 'locale' ) };
+like( $@, qr/Cannot figure out an encoding/, 'no encoding found' );
+
+my $warn;
+local $SIG{__WARN__} = sub {
+       $warn .= shift;
+};
+
+# and it shouldn't be able to find this discipline
+eval{ import( 'IN', 'macguffin' ) };
+like( $warn, qr/Unknown discipline layer/, 'warned about unknown discipline' );
+
+# now load a real-looking locale
+$ENV{LC_ALL} = ' .utf8';
+import( 'IN', 'locale' );
+is( ${^OPEN}, ':utf8\0', 'set locale layer okay!' );
+
+# and see if it sets the magic variables appropriately
+import( 'IN', ':crlf' );
+ok( $^H & $open::hint_bits, '$^H is set after open import runs' );
+is( $^H{'open_IN'}, 'crlf', 'set crlf layer okay!' );
+
+# it should reset them appropriately, too
+import( 'IN', ':raw' );
+is( $^H{'open_IN'}, 'raw', 'set raw layer okay!' );
+
+# it dies if you don't set IN, OUT, or INOUT
+eval { import( 'sideways', ':raw' ) };
+like( $@, qr/Unknown discipline class/, 'croaked with unknown class' );
+
+# but it handles them all so well together
+import( 'INOUT', ':raw :crlf' );
+is( ${^OPEN}, ':raw :crlf\0:raw :crlf', 'multi types, multi disciplines' );
+is( $^H{'open_INOUT'}, 'crlf', 'last layer set in %^H' );
+
+__END__
+# this one won't run as $locale_encoding is already set
+# perhaps qx{} it, if it's important to run
+$ENV{LC_ALL} = 'nonexistent.euc';
+eval { open::_get_locale_encoding() };
+like( $@, qr/too ambiguous/, 'died with ambiguous locale encoding' );
index 6067ad3..3a0a2ec 100644 (file)
@@ -69,11 +69,11 @@ for (@prgs){
     print TEST $prog,"\n";
     close TEST;
     my $results = $Is_MSWin32 ?
-                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
-                  $^O eq 'MacOS' ?
-                  `$^X -I::lib $switch $tmpfile` :
+                     `.\\perl -I../lib $switch $tmpfile 2>&1` :
                   $^O eq 'NetWare' ?
-                  `perl -I../lib $switch $tmpfile 2>&1` :
+                     `perl -I../lib $switch $tmpfile 2>&1` :
+                  $^O eq 'MacOS' ?
+                     `$^X -I::lib -MMac::err=unix $switch $tmpfile` :
                   `./perl $switch $tmpfile 2>&1`;
     my $status = $?;
     $results =~ s/\n+$//;
index 2f684b4..a98dd1d 100644 (file)
@@ -47,11 +47,13 @@ for (@prgs){
     print TEST $prog,"\n";
     close TEST;
     my $results = $Is_VMS ?
-                  `./perl $switch $tmpfile 2>&1` :
+                     `./perl $switch $tmpfile 2>&1` :
                  $Is_MSWin32 ?
-                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                     `.\\perl -I../lib $switch $tmpfile 2>&1` :
                  $Is_NetWare ?
-                  `perl -I../lib $switch $tmpfile 2>&1` :
+                     `perl -I../lib $switch $tmpfile 2>&1` :
+                 $Is_MacOS ?
+                     `$^X -I::lib -MMac::err=unix $switch $tmpfile` :
                   `./perl $switch $tmpfile 2>&1`;
     my $status = $?;
     $results =~ s/\n+$//;
index e45026a..83c2757 100644 (file)
 # This file is built by mktables.PL from e.g. Unicode.txt.
 # Any changes made here will be lost!
 return <<'END';
-0000   007F    Basic Latin     # BasicLatin In/40.pl
-0080   00FF    Latin-1 Supplement      # Latin1Supplement In/41.pl
-0100   017F    Latin Extended-A        # LatinExtendedA In/42.pl
-0180   024F    Latin Extended-B        # LatinExtendedB In/43.pl
-0250   02AF    IPA Extensions  # IPAExtensions In/44.pl
-02B0   02FF    Spacing Modifier Letters        # SpacingModifierLetters In/45.pl
-0300   036F    Combining Diacritical Marks     # CombiningDiacriticalMarks In/46.pl
-0370   03FF    Greek   # GreekBlock In/47.pl
-0400   04FF    Cyrillic        # CyrillicBlock In/48.pl
-0530   058F    Armenian        # ArmenianBlock In/49.pl
-0590   05FF    Hebrew  # HebrewBlock In/50.pl
-0600   06FF    Arabic  # ArabicBlock In/51.pl
-0700   074F    Syriac          # SyriacBlock In/52.pl
-0780   07BF    Thaana  # ThaanaBlock In/53.pl
-0900   097F    Devanagari      # DevanagariBlock In/54.pl
-0980   09FF    Bengali # BengaliBlock In/55.pl
-0A00   0A7F    Gurmukhi        # GurmukhiBlock In/56.pl
-0A80   0AFF    Gujarati        # GujaratiBlock In/57.pl
-0B00   0B7F    Oriya   # OriyaBlock In/58.pl
-0B80   0BFF    Tamil   # TamilBlock In/59.pl
-0C00   0C7F    Telugu  # TeluguBlock In/60.pl
-0C80   0CFF    Kannada # KannadaBlock In/61.pl
-0D00   0D7F    Malayalam       # MalayalamBlock In/62.pl
-0D80   0DFF    Sinhala # SinhalaBlock In/63.pl
-0E00   0E7F    Thai    # ThaiBlock In/64.pl
-0E80   0EFF    Lao     # LaoBlock In/65.pl
-0F00   0FFF    Tibetan # TibetanBlock In/66.pl
-1000   109F    Myanmar         # MyanmarBlock In/67.pl
-10A0   10FF    Georgian        # GeorgianBlock In/68.pl
-1100   11FF    Hangul Jamo     # HangulJamo In/69.pl
-1200   137F    Ethiopic        # EthiopicBlock In/70.pl
-13A0   13FF    Cherokee        # CherokeeBlock In/71.pl
-1400   167F    Unified Canadian Aboriginal Syllabics   # UnifiedCanadianAboriginalSyllabics In/72.pl
-1680   169F    Ogham   # OghamBlock In/73.pl
-16A0   16FF    Runic   # RunicBlock In/74.pl
-1780   17FF    Khmer   # KhmerBlock In/75.pl
-1800   18AF    Mongolian       # MongolianBlock In/76.pl
-1E00   1EFF    Latin Extended Additional       # LatinExtendedAdditional In/77.pl
-1F00   1FFF    Greek Extended  # GreekExtended In/78.pl
-2000   206F    General Punctuation     # GeneralPunctuation In/79.pl
-2070   209F    Superscripts and Subscripts     # SuperscriptsandSubscripts In/80.pl
-20A0   20CF    Currency Symbols        # CurrencySymbols In/81.pl
-20D0   20FF    Combining Marks for Symbols     # CombiningMarksforSymbols In/82.pl
-2100   214F    Letterlike Symbols      # LetterlikeSymbols In/83.pl
-2150   218F    Number Forms    # NumberForms In/84.pl
-2190   21FF    Arrows  # Arrows In/85.pl
-2200   22FF    Mathematical Operators  # MathematicalOperators In/86.pl
-2300   23FF    Miscellaneous Technical # MiscellaneousTechnical In/87.pl
-2400   243F    Control Pictures        # ControlPictures In/88.pl
-2440   245F    Optical Character Recognition   # OpticalCharacterRecognition In/89.pl
-2460   24FF    Enclosed Alphanumerics  # EnclosedAlphanumerics In/90.pl
-2500   257F    Box Drawing     # BoxDrawing In/91.pl
-2580   259F    Block Elements  # BlockElements In/92.pl
-25A0   25FF    Geometric Shapes        # GeometricShapes In/93.pl
-2600   26FF    Miscellaneous Symbols   # MiscellaneousSymbols In/94.pl
-2700   27BF    Dingbats        # Dingbats In/95.pl
-2800   28FF    Braille Patterns        # BraillePatterns In/96.pl
-2E80   2EFF    CJK Radicals Supplement # CJKRadicalsSupplement In/97.pl
-2F00   2FDF    Kangxi Radicals # KangxiRadicals In/98.pl
-2FF0   2FFF    Ideographic Description Characters      # IdeographicDescriptionCharacters In/99.pl
-3000   303F    CJK Symbols and Punctuation     # CJKSymbolsandPunctuation In/100.pl
-3040   309F    Hiragana        # HiraganaBlock In/101.pl
-30A0   30FF    Katakana        # KatakanaBlock In/102.pl
-3100   312F    Bopomofo        # BopomofoBlock In/103.pl
-3130   318F    Hangul Compatibility Jamo       # HangulCompatibilityJamo In/104.pl
-3190   319F    Kanbun  # Kanbun In/105.pl
-31A0   31BF    Bopomofo Extended       # BopomofoExtended In/106.pl
-3200   32FF    Enclosed CJK Letters and Months # EnclosedCJKLettersandMonths In/107.pl
-3300   33FF    CJK Compatibility       # CJKCompatibility In/108.pl
-3400   4DB5    CJK Unified Ideographs Extension A      # CJKUnifiedIdeographsExtensionA In/109.pl
-4E00   9FFF    CJK Unified Ideographs  # CJKUnifiedIdeographs In/110.pl
-A000   A48F    Yi Syllables    # YiSyllables In/111.pl
-A490   A4CF    Yi Radicals     # YiRadicals In/112.pl
-AC00   D7A3    Hangul Syllables        # HangulSyllables In/113.pl
-D800   DB7F    High Surrogates # HighSurrogates In/114.pl
-DB80   DBFF    High Private Use Surrogates     # HighPrivateUseSurrogates In/115.pl
-DC00   DFFF    Low Surrogates  # LowSurrogates In/116.pl
-E000   F8FF    Private Use     # PrivateUse In/117.pl
-F900   FAFF    CJK Compatibility Ideographs    # CJKCompatibilityIdeographs In/118.pl
-FB00   FB4F    Alphabetic Presentation Forms   # AlphabeticPresentationForms In/119.pl
-FB50   FDFF    Arabic Presentation Forms-A     # ArabicPresentationFormsA In/120.pl
-FE20   FE2F    Combining Half Marks    # CombiningHalfMarks In/121.pl
-FE30   FE4F    CJK Compatibility Forms # CJKCompatibilityForms In/122.pl
-FE50   FE6F    Small Form Variants     # SmallFormVariants In/123.pl
-FE70   FEFE    Arabic Presentation Forms-B     # ArabicPresentationFormsB In/124.pl
-FEFF   FEFF    Specials        # Specials In/125.pl
-FF00   FFEF    Halfwidth and Fullwidth Forms   # HalfwidthandFullwidthForms In/126.pl
-FFF0   FFFD    Specials        # Specials In/125.pl
-10300  1032F   Old Italic      # OldItalicBlock In/127.pl
-10330  1034F   Gothic  # GothicBlock In/128.pl
-10400  1044F   Deseret # DeseretBlock In/129.pl
-1D000  1D0FF   Byzantine Musical Symbols       # ByzantineMusicalSymbols In/130.pl
-1D100  1D1FF   Musical Symbols # MusicalSymbols In/131.pl
-1D400  1D7FF   Mathematical Alphanumeric Symbols       # MathematicalAlphanumericSymbols In/132.pl
-20000  2A6D6   CJK Unified Ideographs Extension B      # CJKUnifiedIdeographsExtensionB In/133.pl
-2F800  2FA1F   CJK Compatibility Ideographs Supplement # CJKCompatibilityIdeographsSupplement In/134.pl
-E0000  E007F   Tags    # Tags In/135.pl
-F0000  FFFFD   Private Use     # PrivateUse In/117.pl
-100000 10FFFD  Private Use     # PrivateUse In/117.pl
+0000   007F    Basic Latin     # In/40.pl
+0080   00FF    Latin-1 Supplement      # In/41.pl
+0100   017F    Latin Extended-A        # In/42.pl
+0180   024F    Latin Extended-B        # In/43.pl
+0250   02AF    IPA Extensions  # In/44.pl
+02B0   02FF    Spacing Modifier Letters        # In/45.pl
+0300   036F    Combining Diacritical Marks     # In/46.pl
+0370   03FF    Greek   # In/47.pl
+0400   04FF    Cyrillic        # In/48.pl
+0530   058F    Armenian        # In/49.pl
+0590   05FF    Hebrew  # In/50.pl
+0600   06FF    Arabic  # In/51.pl
+0700   074F    Syriac  # In/52.pl
+0780   07BF    Thaana  # In/53.pl
+0900   097F    Devanagari      # In/54.pl
+0980   09FF    Bengali # In/55.pl
+0A00   0A7F    Gurmukhi        # In/56.pl
+0A80   0AFF    Gujarati        # In/57.pl
+0B00   0B7F    Oriya   # In/58.pl
+0B80   0BFF    Tamil   # In/59.pl
+0C00   0C7F    Telugu  # In/60.pl
+0C80   0CFF    Kannada # In/61.pl
+0D00   0D7F    Malayalam       # In/62.pl
+0D80   0DFF    Sinhala # In/63.pl
+0E00   0E7F    Thai    # In/64.pl
+0E80   0EFF    Lao     # In/65.pl
+0F00   0FFF    Tibetan # In/66.pl
+1000   109F    Myanmar # In/67.pl
+10A0   10FF    Georgian        # In/68.pl
+1100   11FF    Hangul Jamo     # In/69.pl
+1200   137F    Ethiopic        # In/70.pl
+13A0   13FF    Cherokee        # In/71.pl
+1400   167F    Unified Canadian Aboriginal Syllabics   # In/72.pl
+1680   169F    Ogham   # In/73.pl
+16A0   16FF    Runic   # In/74.pl
+1780   17FF    Khmer   # In/75.pl
+1800   18AF    Mongolian       # In/76.pl
+1E00   1EFF    Latin Extended Additional       # In/77.pl
+1F00   1FFF    Greek Extended  # In/78.pl
+2000   206F    General Punctuation     # In/79.pl
+2070   209F    Superscripts and Subscripts     # In/80.pl
+20A0   20CF    Currency Symbols        # In/81.pl
+20D0   20FF    Combining Marks for Symbols     # In/82.pl
+2100   214F    Letterlike Symbols      # In/83.pl
+2150   218F    Number Forms    # In/84.pl
+2190   21FF    Arrows  # In/85.pl
+2200   22FF    Mathematical Operators  # In/86.pl
+2300   23FF    Miscellaneous Technical # In/87.pl
+2400   243F    Control Pictures        # In/88.pl
+2440   245F    Optical Character Recognition   # In/89.pl
+2460   24FF    Enclosed Alphanumerics  # In/90.pl
+2500   257F    Box Drawing     # In/91.pl
+2580   259F    Block Elements  # In/92.pl
+25A0   25FF    Geometric Shapes        # In/93.pl
+2600   26FF    Miscellaneous Symbols   # In/94.pl
+2700   27BF    Dingbats        # In/95.pl
+2800   28FF    Braille Patterns        # In/96.pl
+2E80   2EFF    CJK Radicals Supplement # In/97.pl
+2F00   2FDF    Kangxi Radicals # In/98.pl
+2FF0   2FFF    Ideographic Description Characters      # In/99.pl
+3000   303F    CJK Symbols and Punctuation     # In/100.pl
+3040   309F    Hiragana        # In/101.pl
+30A0   30FF    Katakana        # In/102.pl
+3100   312F    Bopomofo        # In/103.pl
+3130   318F    Hangul Compatibility Jamo       # In/104.pl
+3190   319F    Kanbun  # In/105.pl
+31A0   31BF    Bopomofo Extended       # In/106.pl
+3200   32FF    Enclosed CJK Letters and Months # In/107.pl
+3300   33FF    CJK Compatibility       # In/108.pl
+3400   4DB5    CJK Unified Ideographs Extension A      # In/109.pl
+4E00   9FFF    CJK Unified Ideographs  # In/110.pl
+A000   A48F    Yi Syllables    # In/111.pl
+A490   A4CF    Yi Radicals     # In/112.pl
+AC00   D7A3    Hangul Syllables        # In/113.pl
+D800   DB7F    High Surrogates # In/114.pl
+DB80   DBFF    High Private Use Surrogates     # In/115.pl
+DC00   DFFF    Low Surrogates  # In/116.pl
+E000   F8FF    Private Use     # In/117.pl
+F900   FAFF    CJK Compatibility Ideographs    # In/118.pl
+FB00   FB4F    Alphabetic Presentation Forms   # In/119.pl
+FB50   FDFF    Arabic Presentation Forms-A     # In/120.pl
+FE20   FE2F    Combining Half Marks    # In/121.pl
+FE30   FE4F    CJK Compatibility Forms # In/122.pl
+FE50   FE6F    Small Form Variants     # In/123.pl
+FE70   FEFE    Arabic Presentation Forms-B     # In/124.pl
+FEFF   FEFF    Specials        # In/125.pl
+FF00   FFEF    Halfwidth and Fullwidth Forms   # In/126.pl
+FFF0   FFFD    Specials        # In/125.pl
+10300  1032F   Old Italic      # In/127.pl
+10330  1034F   Gothic  # In/128.pl
+10400  1044F   Deseret # In/129.pl
+1D000  1D0FF   Byzantine Musical Symbols       # In/130.pl
+1D100  1D1FF   Musical Symbols # In/131.pl
+1D400  1D7FF   Mathematical Alphanumeric Symbols       # In/132.pl
+20000  2A6D6   CJK Unified Ideographs Extension B      # In/133.pl
+2F800  2FA1F   CJK Compatibility Ideographs Supplement # In/134.pl
+E0000  E007F   Tags    # In/135.pl
+F0000  FFFFD   Private Use     # In/117.pl
+100000 10FFFD  Private Use     # In/117.pl
 END
index a6c2419..c11445c 100644 (file)
 # This file is built by mktables.PL from e.g. Unicode.txt.
 # Any changes made here will be lost!
 %utf8::In = (
-'Latin'                                  =>   0,
-'Greek'                                  =>   1,
-'Cyrillic'                               =>   2,
-'Armenian'                               =>   3,
-'Hebrew'                                 =>   4,
-'Arabic'                                 =>   5,
-'Syriac'                                 =>   6,
-'Thaana'                                 =>   7,
-'Devanagari'                             =>   8,
-'Bengali'                                =>   9,
-'Gurmukhi'                               =>  10,
-'Gujarati'                               =>  11,
-'Oriya'                                  =>  12,
-'Tamil'                                  =>  13,
-'Telugu'                                 =>  14,
-'Kannada'                                =>  15,
-'Malayalam'                              =>  16,
-'Sinhala'                                =>  17,
-'Thai'                                   =>  18,
-'Lao'                                    =>  19,
-'Tibetan'                                =>  20,
-'Myanmar'                                =>  21,
-'Georgian'                               =>  22,
-'Hangul'                                 =>  23,
-'Ethiopic'                               =>  24,
-'Cherokee'                               =>  25,
-'CanadianAboriginal'                     =>  26,
-'Ogham'                                  =>  27,
-'Runic'                                  =>  28,
-'Khmer'                                  =>  29,
-'Mongolian'                              =>  30,
-'Hiragana'                               =>  31,
-'Katakana'                               =>  32,
-'Bopomofo'                               =>  33,
-'Han'                                    =>  34,
-'Yi'                                     =>  35,
-'OldItalic'                              =>  36,
-'Gothic'                                 =>  37,
-'Deseret'                                =>  38,
-'Inherited'                              =>  39,
-'BasicLatin'                             =>  40,
-'Latin1Supplement'                       =>  41,
-'LatinExtendedA'                         =>  42,
-'LatinExtendedB'                         =>  43,
-'IPAExtensions'                          =>  44,
-'SpacingModifierLetters'                 =>  45,
-'CombiningDiacriticalMarks'              =>  46,
-'GreekBlock'                             =>  47,
-'CyrillicBlock'                          =>  48,
-'ArmenianBlock'                          =>  49,
-'HebrewBlock'                            =>  50,
-'ArabicBlock'                            =>  51,
-'SyriacBlock'                            =>  52,
-'ThaanaBlock'                            =>  53,
-'DevanagariBlock'                        =>  54,
-'BengaliBlock'                           =>  55,
-'GurmukhiBlock'                          =>  56,
-'GujaratiBlock'                          =>  57,
-'OriyaBlock'                             =>  58,
-'TamilBlock'                             =>  59,
-'TeluguBlock'                            =>  60,
-'KannadaBlock'                           =>  61,
-'MalayalamBlock'                         =>  62,
-'SinhalaBlock'                           =>  63,
-'ThaiBlock'                              =>  64,
-'LaoBlock'                               =>  65,
-'TibetanBlock'                           =>  66,
-'MyanmarBlock'                           =>  67,
-'GeorgianBlock'                          =>  68,
-'HangulJamo'                             =>  69,
-'EthiopicBlock'                          =>  70,
-'CherokeeBlock'                          =>  71,
-'UnifiedCanadianAboriginalSyllabics'     =>  72,
-'OghamBlock'                             =>  73,
-'RunicBlock'                             =>  74,
-'KhmerBlock'                             =>  75,
-'MongolianBlock'                         =>  76,
-'LatinExtendedAdditional'                =>  77,
-'GreekExtended'                          =>  78,
-'GeneralPunctuation'                     =>  79,
-'SuperscriptsandSubscripts'              =>  80,
-'CurrencySymbols'                        =>  81,
-'CombiningMarksforSymbols'               =>  82,
-'LetterlikeSymbols'                      =>  83,
-'NumberForms'                            =>  84,
-'Arrows'                                 =>  85,
-'MathematicalOperators'                  =>  86,
-'MiscellaneousTechnical'                 =>  87,
-'ControlPictures'                        =>  88,
-'OpticalCharacterRecognition'            =>  89,
-'EnclosedAlphanumerics'                  =>  90,
-'BoxDrawing'                             =>  91,
-'BlockElements'                          =>  92,
-'GeometricShapes'                        =>  93,
-'MiscellaneousSymbols'                   =>  94,
-'Dingbats'                               =>  95,
-'BraillePatterns'                        =>  96,
-'CJKRadicalsSupplement'                  =>  97,
-'KangxiRadicals'                         =>  98,
-'IdeographicDescriptionCharacters'       =>  99,
-'CJKSymbolsandPunctuation'               => 100,
-'HiraganaBlock'                          => 101,
-'KatakanaBlock'                          => 102,
-'BopomofoBlock'                          => 103,
-'HangulCompatibilityJamo'                => 104,
-'Kanbun'                                 => 105,
-'BopomofoExtended'                       => 106,
-'EnclosedCJKLettersandMonths'            => 107,
-'CJKCompatibility'                       => 108,
-'CJKUnifiedIdeographsExtensionA'         => 109,
-'CJKUnifiedIdeographs'                   => 110,
-'YiSyllables'                            => 111,
-'YiRadicals'                             => 112,
-'HangulSyllables'                        => 113,
-'HighSurrogates'                         => 114,
-'HighPrivateUseSurrogates'               => 115,
-'LowSurrogates'                          => 116,
-'PrivateUse'                             => 117,
-'CJKCompatibilityIdeographs'             => 118,
-'AlphabeticPresentationForms'            => 119,
-'ArabicPresentationFormsA'               => 120,
-'CombiningHalfMarks'                     => 121,
-'CJKCompatibilityForms'                  => 122,
-'SmallFormVariants'                      => 123,
-'ArabicPresentationFormsB'               => 124,
-'Specials'                               => 125,
-'HalfwidthandFullwidthForms'             => 126,
-'OldItalicBlock'                         => 127,
-'GothicBlock'                            => 128,
-'DeseretBlock'                           => 129,
-'ByzantineMusicalSymbols'                => 130,
-'MusicalSymbols'                         => 131,
-'MathematicalAlphanumericSymbols'        => 132,
-'CJKUnifiedIdeographsExtensionB'         => 133,
-'CJKCompatibilityIdeographsSupplement'   => 134,
-'Tags'                                   => 135,
+'LATIN'                                       =>   0,
+'GREEK'                                       =>   1,
+'CYRILLIC'                                    =>   2,
+'ARMENIAN'                                    =>   3,
+'HEBREW'                                      =>   4,
+'ARABIC'                                      =>   5,
+'SYRIAC'                                      =>   6,
+'THAANA'                                      =>   7,
+'DEVANAGARI'                                  =>   8,
+'BENGALI'                                     =>   9,
+'GURMUKHI'                                    =>  10,
+'GUJARATI'                                    =>  11,
+'ORIYA'                                       =>  12,
+'TAMIL'                                       =>  13,
+'TELUGU'                                      =>  14,
+'KANNADA'                                     =>  15,
+'MALAYALAM'                                   =>  16,
+'SINHALA'                                     =>  17,
+'THAI'                                        =>  18,
+'LAO'                                         =>  19,
+'TIBETAN'                                     =>  20,
+'MYANMAR'                                     =>  21,
+'GEORGIAN'                                    =>  22,
+'HANGUL'                                      =>  23,
+'ETHIOPIC'                                    =>  24,
+'CHEROKEE'                                    =>  25,
+'CANADIAN-ABORIGINAL'                         =>  26,
+'OGHAM'                                       =>  27,
+'RUNIC'                                       =>  28,
+'KHMER'                                       =>  29,
+'MONGOLIAN'                                   =>  30,
+'HIRAGANA'                                    =>  31,
+'KATAKANA'                                    =>  32,
+'BOPOMOFO'                                    =>  33,
+'HAN'                                         =>  34,
+'YI'                                          =>  35,
+'OLD-ITALIC'                                  =>  36,
+'GOTHIC'                                      =>  37,
+'DESERET'                                     =>  38,
+'INHERITED'                                   =>  39,
+'Basic Latin'                                 =>  40,
+'Latin-1 Supplement'                          =>  41,
+'Latin Extended-A'                            =>  42,
+'Latin Extended-B'                            =>  43,
+'IPA Extensions'                              =>  44,
+'Spacing Modifier Letters'                    =>  45,
+'Combining Diacritical Marks'                 =>  46,
+'Greek Block'                                 =>  47,
+'Cyrillic Block'                              =>  48,
+'Armenian Block'                              =>  49,
+'Hebrew Block'                                =>  50,
+'Arabic Block'                                =>  51,
+'Syriac Block'                                =>  52,
+'Thaana Block'                                =>  53,
+'Devanagari Block'                            =>  54,
+'Bengali Block'                               =>  55,
+'Gurmukhi Block'                              =>  56,
+'Gujarati Block'                              =>  57,
+'Oriya Block'                                 =>  58,
+'Tamil Block'                                 =>  59,
+'Telugu Block'                                =>  60,
+'Kannada Block'                               =>  61,
+'Malayalam Block'                             =>  62,
+'Sinhala Block'                               =>  63,
+'Thai Block'                                  =>  64,
+'Lao Block'                                   =>  65,
+'Tibetan Block'                               =>  66,
+'Myanmar Block'                               =>  67,
+'Georgian Block'                              =>  68,
+'Hangul Jamo'                                 =>  69,
+'Ethiopic Block'                              =>  70,
+'Cherokee Block'                              =>  71,
+'Unified Canadian Aboriginal Syllabics'       =>  72,
+'Ogham Block'                                 =>  73,
+'Runic Block'                                 =>  74,
+'Khmer Block'                                 =>  75,
+'Mongolian Block'                             =>  76,
+'Latin Extended Additional'                   =>  77,
+'Greek Extended'                              =>  78,
+'General Punctuation'                         =>  79,
+'Superscripts and Subscripts'                 =>  80,
+'Currency Symbols'                            =>  81,
+'Combining Marks for Symbols'                 =>  82,
+'Letterlike Symbols'                          =>  83,
+'Number Forms'                                =>  84,
+'Arrows'                                      =>  85,
+'Mathematical Operators'                      =>  86,
+'Miscellaneous Technical'                     =>  87,
+'Control Pictures'                            =>  88,
+'Optical Character Recognition'               =>  89,
+'Enclosed Alphanumerics'                      =>  90,
+'Box Drawing'                                 =>  91,
+'Block Elements'                              =>  92,
+'Geometric Shapes'                            =>  93,
+'Miscellaneous Symbols'                       =>  94,
+'Dingbats'                                    =>  95,
+'Braille Patterns'                            =>  96,
+'CJK Radicals Supplement'                     =>  97,
+'Kangxi Radicals'                             =>  98,
+'Ideographic Description Characters'          =>  99,
+'CJK Symbols and Punctuation'                 => 100,
+'Hiragana Block'                              => 101,
+'Katakana Block'                              => 102,
+'Bopomofo Block'                              => 103,
+'Hangul Compatibility Jamo'                   => 104,
+'Kanbun'                                      => 105,
+'Bopomofo Extended'                           => 106,
+'Enclosed CJK Letters and Months'             => 107,
+'CJK Compatibility'                           => 108,
+'CJK Unified Ideographs Extension A'          => 109,
+'CJK Unified Ideographs'                      => 110,
+'Yi Syllables'                                => 111,
+'Yi Radicals'                                 => 112,
+'Hangul Syllables'                            => 113,
+'High Surrogates'                             => 114,
+'High Private Use Surrogates'                 => 115,
+'Low Surrogates'                              => 116,
+'Private Use'                                 => 117,
+'CJK Compatibility Ideographs'                => 118,
+'Alphabetic Presentation Forms'               => 119,
+'Arabic Presentation Forms-A'                 => 120,
+'Combining Half Marks'                        => 121,
+'CJK Compatibility Forms'                     => 122,
+'Small Form Variants'                         => 123,
+'Arabic Presentation Forms-B'                 => 124,
+'Specials'                                    => 125,
+'Halfwidth and Fullwidth Forms'               => 126,
+'Old Italic'                                  => 127,
+'Gothic Block'                                => 128,
+'Deseret Block'                               => 129,
+'Byzantine Musical Symbols'                   => 130,
+'Musical Symbols'                             => 131,
+'Mathematical Alphanumeric Symbols'           => 132,
+'CJK Unified Ideographs Extension B'          => 133,
+'CJK Compatibility Ideographs Supplement'     => 134,
+'Tags'                                        => 135,
+);
+%utf8::InPat = (
+'alp' => {
+       'Alphabetic[- _]?Presentation[- _]?Forms' => 'Alphabetic Presentation Forms',
+},
+'ara' => {
+       'ARABIC' => 'ARABIC',
+       'Arabic[- _]?Block' => 'Arabic Block',
+       'Arabic[- _]?Presentation[- _]?Forms[- _]?A' => 'Arabic Presentation Forms-A',
+       'Arabic[- _]?Presentation[- _]?Forms[- _]?B' => 'Arabic Presentation Forms-B',
+},
+'arm' => {
+       'ARMENIAN' => 'ARMENIAN',
+       'Armenian[- _]?Block' => 'Armenian Block',
+},
+'arr' => {
+       'Arrows' => 'Arrows',
+},
+'bas' => {
+       'Basic[- _]?Latin' => 'Basic Latin',
+},
+'ben' => {
+       'BENGALI' => 'BENGALI',
+       'Bengali[- _]?Block' => 'Bengali Block',
+},
+'blo' => {
+       'Block[- _]?Elements' => 'Block Elements',
+},
+'bop' => {
+       'BOPOMOFO' => 'BOPOMOFO',
+       'Bopomofo[- _]?Block' => 'Bopomofo Block',
+       'Bopomofo[- _]?Extended' => 'Bopomofo Extended',
+},
+'box' => {
+       'Box[- _]?Drawing' => 'Box Drawing',
+},
+'bra' => {
+       'Braille[- _]?Patterns' => 'Braille Patterns',
+},
+'byz' => {
+       'Byzantine[- _]?Musical[- _]?Symbols' => 'Byzantine Musical Symbols',
+},
+'can' => {
+       'CANADIAN[- _]?ABORIGINAL' => 'CANADIAN-ABORIGINAL',
+},
+'che' => {
+       'CHEROKEE' => 'CHEROKEE',
+       'Cherokee[- _]?Block' => 'Cherokee Block',
+},
+'cjk' => {
+       'CJK[- _]?Radicals[- _]?Supplement' => 'CJK Radicals Supplement',
+       'CJK[- _]?Symbols[- _]?and[- _]?Punctuation' => 'CJK Symbols and Punctuation',
+       'CJK[- _]?Compatibility' => 'CJK Compatibility',
+       'CJK[- _]?Unified[- _]?Ideographs[- _]?Extension[- _]?A' => 'CJK Unified Ideographs Extension A',
+       'CJK[- _]?Unified[- _]?Ideographs' => 'CJK Unified Ideographs',
+       'CJK[- _]?Compatibility[- _]?Ideographs' => 'CJK Compatibility Ideographs',
+       'CJK[- _]?Compatibility[- _]?Forms' => 'CJK Compatibility Forms',
+       'CJK[- _]?Unified[- _]?Ideographs[- _]?Extension[- _]?B' => 'CJK Unified Ideographs Extension B',
+       'CJK[- _]?Compatibility[- _]?Ideographs[- _]?Supplement' => 'CJK Compatibility Ideographs Supplement',
+},
+'com' => {
+       'Combining[- _]?Diacritical[- _]?Marks' => 'Combining Diacritical Marks',
+       'Combining[- _]?Marks[- _]?for[- _]?Symbols' => 'Combining Marks for Symbols',
+       'Combining[- _]?Half[- _]?Marks' => 'Combining Half Marks',
+},
+'con' => {
+       'Control[- _]?Pictures' => 'Control Pictures',
+},
+'cur' => {
+       'Currency[- _]?Symbols' => 'Currency Symbols',
+},
+'cyr' => {
+       'CYRILLIC' => 'CYRILLIC',
+       'Cyrillic[- _]?Block' => 'Cyrillic Block',
+},
+'des' => {
+       'DESERET' => 'DESERET',
+       'Deseret[- _]?Block' => 'Deseret Block',
+},
+'dev' => {
+       'DEVANAGARI' => 'DEVANAGARI',
+       'Devanagari[- _]?Block' => 'Devanagari Block',
+},
+'din' => {
+       'Dingbats' => 'Dingbats',
+},
+'enc' => {
+       'Enclosed[- _]?Alphanumerics' => 'Enclosed Alphanumerics',
+       'Enclosed[- _]?CJK[- _]?Letters[- _]?and[- _]?Months' => 'Enclosed CJK Letters and Months',
+},
+'eth' => {
+       'ETHIOPIC' => 'ETHIOPIC',
+       'Ethiopic[- _]?Block' => 'Ethiopic Block',
+},
+'gen' => {
+       'General[- _]?Punctuation' => 'General Punctuation',
+},
+'geo' => {
+       'GEORGIAN' => 'GEORGIAN',
+       'Georgian[- _]?Block' => 'Georgian Block',
+       'Geometric[- _]?Shapes' => 'Geometric Shapes',
+},
+'got' => {
+       'GOTHIC' => 'GOTHIC',
+       'Gothic[- _]?Block' => 'Gothic Block',
+},
+'gre' => {
+       'GREEK' => 'GREEK',
+       'Greek[- _]?Block' => 'Greek Block',
+       'Greek[- _]?Extended' => 'Greek Extended',
+},
+'guj' => {
+       'GUJARATI' => 'GUJARATI',
+       'Gujarati[- _]?Block' => 'Gujarati Block',
+},
+'gur' => {
+       'GURMUKHI' => 'GURMUKHI',
+       'Gurmukhi[- _]?Block' => 'Gurmukhi Block',
+},
+'hal' => {
+       'Halfwidth[- _]?and[- _]?Fullwidth[- _]?Forms' => 'Halfwidth and Fullwidth Forms',
+},
+'han' => {
+       'HANGUL' => 'HANGUL',
+       'HAN' => 'HAN',
+       'Hangul[- _]?Jamo' => 'Hangul Jamo',
+       'Hangul[- _]?Compatibility[- _]?Jamo' => 'Hangul Compatibility Jamo',
+       'Hangul[- _]?Syllables' => 'Hangul Syllables',
+},
+'heb' => {
+       'HEBREW' => 'HEBREW',
+       'Hebrew[- _]?Block' => 'Hebrew Block',
+},
+'hig' => {
+       'High[- _]?Surrogates' => 'High Surrogates',
+       'High[- _]?Private[- _]?Use[- _]?Surrogates' => 'High Private Use Surrogates',
+},
+'hir' => {
+       'HIRAGANA' => 'HIRAGANA',
+       'Hiragana[- _]?Block' => 'Hiragana Block',
+},
+'ide' => {
+       'Ideographic[- _]?Description[- _]?Characters' => 'Ideographic Description Characters',
+},
+'inh' => {
+       'INHERITED' => 'INHERITED',
+},
+'ipa' => {
+       'IPA[- _]?Extensions' => 'IPA Extensions',
+},
+'kan' => {
+       'KANNADA' => 'KANNADA',
+       'Kannada[- _]?Block' => 'Kannada Block',
+       'Kangxi[- _]?Radicals' => 'Kangxi Radicals',
+       'Kanbun' => 'Kanbun',
+},
+'kat' => {
+       'KATAKANA' => 'KATAKANA',
+       'Katakana[- _]?Block' => 'Katakana Block',
+},
+'khm' => {
+       'KHMER' => 'KHMER',
+       'Khmer[- _]?Block' => 'Khmer Block',
+},
+'lao' => {
+       'LAO' => 'LAO',
+       'Lao[- _]?Block' => 'Lao Block',
+},
+'lat' => {
+       'LATIN' => 'LATIN',
+       'Latin[- _]?1[- _]?Supplement' => 'Latin-1 Supplement',
+       'Latin[- _]?Extended[- _]?A' => 'Latin Extended-A',
+       'Latin[- _]?Extended[- _]?B' => 'Latin Extended-B',
+       'Latin[- _]?Extended[- _]?Additional' => 'Latin Extended Additional',
+},
+'let' => {
+       'Letterlike[- _]?Symbols' => 'Letterlike Symbols',
+},
+'low' => {
+       'Low[- _]?Surrogates' => 'Low Surrogates',
+},
+'mal' => {
+       'MALAYALAM' => 'MALAYALAM',
+       'Malayalam[- _]?Block' => 'Malayalam Block',
+},
+'mat' => {
+       'Mathematical[- _]?Operators' => 'Mathematical Operators',
+       'Mathematical[- _]?Alphanumeric[- _]?Symbols' => 'Mathematical Alphanumeric Symbols',
+},
+'mis' => {
+       'Miscellaneous[- _]?Technical' => 'Miscellaneous Technical',
+       'Miscellaneous[- _]?Symbols' => 'Miscellaneous Symbols',
+},
+'mon' => {
+       'MONGOLIAN' => 'MONGOLIAN',
+       'Mongolian[- _]?Block' => 'Mongolian Block',
+},
+'mus' => {
+       'Musical[- _]?Symbols' => 'Musical Symbols',
+},
+'mya' => {
+       'MYANMAR' => 'MYANMAR',
+       'Myanmar[- _]?Block' => 'Myanmar Block',
+},
+'num' => {
+       'Number[- _]?Forms' => 'Number Forms',
+},
+'ogh' => {
+       'OGHAM' => 'OGHAM',
+       'Ogham[- _]?Block' => 'Ogham Block',
+},
+'old' => {
+       'OLD[- _]?ITALIC' => 'OLD-ITALIC',
+       'Old[- _]?Italic' => 'Old Italic',
+},
+'opt' => {
+       'Optical[- _]?Character[- _]?Recognition' => 'Optical Character Recognition',
+},
+'ori' => {
+       'ORIYA' => 'ORIYA',
+       'Oriya[- _]?Block' => 'Oriya Block',
+},
+'pri' => {
+       'Private[- _]?Use' => 'Private Use',
+},
+'run' => {
+       'RUNIC' => 'RUNIC',
+       'Runic[- _]?Block' => 'Runic Block',
+},
+'sin' => {
+       'SINHALA' => 'SINHALA',
+       'Sinhala[- _]?Block' => 'Sinhala Block',
+},
+'sma' => {
+       'Small[- _]?Form[- _]?Variants' => 'Small Form Variants',
+},
+'spa' => {
+       'Spacing[- _]?Modifier[- _]?Letters' => 'Spacing Modifier Letters',
+},
+'spe' => {
+       'Specials' => 'Specials',
+},
+'sup' => {
+       'Superscripts[- _]?and[- _]?Subscripts' => 'Superscripts and Subscripts',
+},
+'syr' => {
+       'SYRIAC' => 'SYRIAC',
+       'Syriac[- _]?Block' => 'Syriac Block',
+},
+'tag' => {
+       'Tags' => 'Tags',
+},
+'tam' => {
+       'TAMIL' => 'TAMIL',
+       'Tamil[- _]?Block' => 'Tamil Block',
+},
+'tel' => {
+       'TELUGU' => 'TELUGU',
+       'Telugu[- _]?Block' => 'Telugu Block',
+},
+'tha' => {
+       'THAANA' => 'THAANA',
+       'THAI' => 'THAI',
+       'Thaana[- _]?Block' => 'Thaana Block',
+       'Thai[- _]?Block' => 'Thai Block',
+},
+'tib' => {
+       'TIBETAN' => 'TIBETAN',
+       'Tibetan[- _]?Block' => 'Tibetan Block',
+},
+'uni' => {
+       'Unified[- _]?Canadian[- _]?Aboriginal[- _]?Syllabics' => 'Unified Canadian Aboriginal Syllabics',
+},
+'yi' => {
+       'YI' => 'YI',
+},
+'yi ' => {
+       'Yi[- _]?Syllables' => 'Yi Syllables',
+       'Yi[- _]?Radicals' => 'Yi Radicals',
+},
 );
index ed0168e..b924f3a 100644 (file)
 # This file is built by mktables.PL from e.g. Unicode.txt.
 # Any changes made here will be lost!
 return <<'END';
-0041   005A    LATIN   # Latin In/0.pl
-0061   007A    LATIN   # Latin In/0.pl
-00AA           LATIN   # Latin In/0.pl
-00BA           LATIN   # Latin In/0.pl
-00C0   00D6    LATIN   # Latin In/0.pl
-00D8   00F6    LATIN   # Latin In/0.pl
-00F8   01BA    LATIN   # Latin In/0.pl
-01BB           LATIN   # Latin In/0.pl
-01BC   01BF    LATIN   # Latin In/0.pl
-01C0   01C3    LATIN   # Latin In/0.pl
-01C4   021F    LATIN   # Latin In/0.pl
-0222   0233    LATIN   # Latin In/0.pl
-0250   02AD    LATIN   # Latin In/0.pl
-02B0   02B8    LATIN   # Latin In/0.pl
-02E0   02E4    LATIN   # Latin In/0.pl
-1E00   1E9B    LATIN   # Latin In/0.pl
-1EA0   1EF9    LATIN   # Latin In/0.pl
-207F           LATIN   # Latin In/0.pl
-212A   212B    LATIN   # Latin In/0.pl
-FB00   FB06    LATIN   # Latin In/0.pl
-FF21   FF3A    LATIN   # Latin In/0.pl
-FF41   FF5A    LATIN   # Latin In/0.pl
-00B5           GREEK   # Greek In/1.pl
-037A           GREEK   # Greek In/1.pl
-0386           GREEK   # Greek In/1.pl
-0388   038A    GREEK   # Greek In/1.pl
-038C           GREEK   # Greek In/1.pl
-038E   03A1    GREEK   # Greek In/1.pl
-03A3   03CE    GREEK   # Greek In/1.pl
-03D0   03D7    GREEK   # Greek In/1.pl
-03DA   03F5    GREEK   # Greek In/1.pl
-1F00   1F15    GREEK   # Greek In/1.pl
-1F18   1F1D    GREEK   # Greek In/1.pl
-1F20   1F45    GREEK   # Greek In/1.pl
-1F48   1F4D    GREEK   # Greek In/1.pl
-1F50   1F57    GREEK   # Greek In/1.pl
-1F59           GREEK   # Greek In/1.pl
-1F5B           GREEK   # Greek In/1.pl
-1F5D           GREEK   # Greek In/1.pl
-1F5F   1F7D    GREEK   # Greek In/1.pl
-1F80   1FB4    GREEK   # Greek In/1.pl
-1FB6   1FBC    GREEK   # Greek In/1.pl
-1FBE           GREEK   # Greek In/1.pl
-1FC2   1FC4    GREEK   # Greek In/1.pl
-1FC6   1FCC    GREEK   # Greek In/1.pl
-1FD0   1FD3    GREEK   # Greek In/1.pl
-1FD6   1FDB    GREEK   # Greek In/1.pl
-1FE0   1FEC    GREEK   # Greek In/1.pl
-1FF2   1FF4    GREEK   # Greek In/1.pl
-1FF6   1FFC    GREEK   # Greek In/1.pl
-2126           GREEK   # Greek In/1.pl
-0400   0481    CYRILLIC        # Cyrillic In/2.pl
-0483   0486    CYRILLIC        # Cyrillic In/2.pl
-048C   04C4    CYRILLIC        # Cyrillic In/2.pl
-04C7   04C8    CYRILLIC        # Cyrillic In/2.pl
-04CB   04CC    CYRILLIC        # Cyrillic In/2.pl
-04D0   04F5    CYRILLIC        # Cyrillic In/2.pl
-04F8   04F9    CYRILLIC        # Cyrillic In/2.pl
-0531   0556    ARMENIAN        # Armenian In/3.pl
-0559           ARMENIAN        # Armenian In/3.pl
-0561   0587    ARMENIAN        # Armenian In/3.pl
-FB13   FB17    ARMENIAN        # Armenian In/3.pl
-05D0   05EA    HEBREW  # Hebrew In/4.pl
-05F0   05F2    HEBREW  # Hebrew In/4.pl
-FB1D           HEBREW  # Hebrew In/4.pl
-FB1F   FB28    HEBREW  # Hebrew In/4.pl
-FB2A   FB36    HEBREW  # Hebrew In/4.pl
-FB38   FB3C    HEBREW  # Hebrew In/4.pl
-FB3E           HEBREW  # Hebrew In/4.pl
-FB40   FB41    HEBREW  # Hebrew In/4.pl
-FB43   FB44    HEBREW  # Hebrew In/4.pl
-FB46   FB4F    HEBREW  # Hebrew In/4.pl
-0621   063A    ARABIC  # Arabic In/5.pl
-0641   064A    ARABIC  # Arabic In/5.pl
-0671   06D3    ARABIC  # Arabic In/5.pl
-06D5           ARABIC  # Arabic In/5.pl
-06E5   06E6    ARABIC  # Arabic In/5.pl
-06FA   06FC    ARABIC  # Arabic In/5.pl
-FB50   FBB1    ARABIC  # Arabic In/5.pl
-FBD3   FD3D    ARABIC  # Arabic In/5.pl
-FD50   FD8F    ARABIC  # Arabic In/5.pl
-FD92   FDC7    ARABIC  # Arabic In/5.pl
-FDF0   FDFB    ARABIC  # Arabic In/5.pl
-FE70   FE72    ARABIC  # Arabic In/5.pl
-FE74           ARABIC  # Arabic In/5.pl
-FE76   FEFC    ARABIC  # Arabic In/5.pl
-0710           SYRIAC  # Syriac In/6.pl
-0711           SYRIAC  # Syriac In/6.pl
-0712   072C    SYRIAC  # Syriac In/6.pl
-0730   074A    SYRIAC  # Syriac In/6.pl
-0780   07A5    THAANA  # Thaana In/7.pl
-07A6   07B0    THAANA  # Thaana In/7.pl
-0901   0902    DEVANAGARI      # Devanagari In/8.pl
-0903           DEVANAGARI      # Devanagari In/8.pl
-0905   0939    DEVANAGARI      # Devanagari In/8.pl
-093C           DEVANAGARI      # Devanagari In/8.pl
-093D           DEVANAGARI      # Devanagari In/8.pl
-093E   0940    DEVANAGARI      # Devanagari In/8.pl
-0941   0948    DEVANAGARI      # Devanagari In/8.pl
-0949   094C    DEVANAGARI      # Devanagari In/8.pl
-094D           DEVANAGARI      # Devanagari In/8.pl
-0950           DEVANAGARI      # Devanagari In/8.pl
-0951   0954    DEVANAGARI      # Devanagari In/8.pl
-0958   0961    DEVANAGARI      # Devanagari In/8.pl
-0962   0963    DEVANAGARI      # Devanagari In/8.pl
-0966   096F    DEVANAGARI      # Devanagari In/8.pl
-0981           BENGALI # Bengali In/9.pl
-0985   098C    BENGALI # Bengali In/9.pl
-098F   0990    BENGALI # Bengali In/9.pl
-0993   09A8    BENGALI # Bengali In/9.pl
-09AA   09B0    BENGALI # Bengali In/9.pl
-09B2           BENGALI # Bengali In/9.pl
-09B6   09B9    BENGALI # Bengali In/9.pl
-09BC           BENGALI # Bengali In/9.pl
-09BE   09C0    BENGALI # Bengali In/9.pl
-09C1   09C4    BENGALI # Bengali In/9.pl
-09C7   09C8    BENGALI # Bengali In/9.pl
-09CB   09CC    BENGALI # Bengali In/9.pl
-09CD           BENGALI # Bengali In/9.pl
-09D7           BENGALI # Bengali In/9.pl
-09DC   09DD    BENGALI # Bengali In/9.pl
-09DF   09E1    BENGALI # Bengali In/9.pl
-09E2   09E3    BENGALI # Bengali In/9.pl
-09E6   09EF    BENGALI # Bengali In/9.pl
-09F0   09F1    BENGALI # Bengali In/9.pl
-0A02           GURMUKHI        # Gurmukhi In/10.pl
-0A05   0A0A    GURMUKHI        # Gurmukhi In/10.pl
-0A0F   0A10    GURMUKHI        # Gurmukhi In/10.pl
-0A13   0A28    GURMUKHI        # Gurmukhi In/10.pl
-0A2A   0A30    GURMUKHI        # Gurmukhi In/10.pl
-0A32   0A33    GURMUKHI        # Gurmukhi In/10.pl
-0A35   0A36    GURMUKHI        # Gurmukhi In/10.pl
-0A38   0A39    GURMUKHI        # Gurmukhi In/10.pl
-0A3C           GURMUKHI        # Gurmukhi In/10.pl
-0A3E   0A40    GURMUKHI        # Gurmukhi In/10.pl
-0A41   0A42    GURMUKHI        # Gurmukhi In/10.pl
-0A47   0A48    GURMUKHI        # Gurmukhi In/10.pl
-0A4B   0A4D    GURMUKHI        # Gurmukhi In/10.pl
-0A59   0A5C    GURMUKHI        # Gurmukhi In/10.pl
-0A5E           GURMUKHI        # Gurmukhi In/10.pl
-0A66   0A6F    GURMUKHI        # Gurmukhi In/10.pl
-0A70   0A71    GURMUKHI        # Gurmukhi In/10.pl
-0A72   0A74    GURMUKHI        # Gurmukhi In/10.pl
-0A81   0A82    GUJARATI        # Gujarati In/11.pl
-0A83           GUJARATI        # Gujarati In/11.pl
-0A85   0A8B    GUJARATI        # Gujarati In/11.pl
-0A8D           GUJARATI        # Gujarati In/11.pl
-0A8F   0A91    GUJARATI        # Gujarati In/11.pl
-0A93   0AA8    GUJARATI        # Gujarati In/11.pl
-0AAA   0AB0    GUJARATI        # Gujarati In/11.pl
-0AB2   0AB3    GUJARATI        # Gujarati In/11.pl
-0AB5   0AB9    GUJARATI        # Gujarati In/11.pl
-0ABC           GUJARATI        # Gujarati In/11.pl
-0ABD           GUJARATI        # Gujarati In/11.pl
-0ABE   0AC0    GUJARATI        # Gujarati In/11.pl
-0AC1   0AC5    GUJARATI        # Gujarati In/11.pl
-0AC7   0AC8    GUJARATI        # Gujarati In/11.pl
-0AC9           GUJARATI        # Gujarati In/11.pl
-0ACB   0ACC    GUJARATI        # Gujarati In/11.pl
-0ACD           GUJARATI        # Gujarati In/11.pl
-0AD0           GUJARATI        # Gujarati In/11.pl
-0AE0           GUJARATI        # Gujarati In/11.pl
-0AE6   0AEF    GUJARATI        # Gujarati In/11.pl
-0B01           ORIYA   # Oriya In/12.pl
-0B02   0B03    ORIYA   # Oriya In/12.pl
-0B05   0B0C    ORIYA   # Oriya In/12.pl
-0B0F   0B10    ORIYA   # Oriya In/12.pl
-0B13   0B28    ORIYA   # Oriya In/12.pl
-0B2A   0B30    ORIYA   # Oriya In/12.pl
-0B32   0B33    ORIYA   # Oriya In/12.pl
-0B36   0B39    ORIYA   # Oriya In/12.pl
-0B3C           ORIYA   # Oriya In/12.pl
-0B3D           ORIYA   # Oriya In/12.pl
-0B3E           ORIYA   # Oriya In/12.pl
-0B3F           ORIYA   # Oriya In/12.pl
-0B40           ORIYA   # Oriya In/12.pl
-0B41   0B43    ORIYA   # Oriya In/12.pl
-0B47   0B48    ORIYA   # Oriya In/12.pl
-0B4B   0B4C    ORIYA   # Oriya In/12.pl
-0B4D           ORIYA   # Oriya In/12.pl
-0B56           ORIYA   # Oriya In/12.pl
-0B57           ORIYA   # Oriya In/12.pl
-0B5C   0B5D    ORIYA   # Oriya In/12.pl
-0B5F   0B61    ORIYA   # Oriya In/12.pl
-0B66   0B6F    ORIYA   # Oriya In/12.pl
-0B82           TAMIL   # Tamil In/13.pl
-0B83           TAMIL   # Tamil In/13.pl
-0B85   0B8A    TAMIL   # Tamil In/13.pl
-0B8E   0B90    TAMIL   # Tamil In/13.pl
-0B92   0B95    TAMIL   # Tamil In/13.pl
-0B99   0B9A    TAMIL   # Tamil In/13.pl
-0B9C           TAMIL   # Tamil In/13.pl
-0B9E   0B9F    TAMIL   # Tamil In/13.pl
-0BA3   0BA4    TAMIL   # Tamil In/13.pl
-0BA8   0BAA    TAMIL   # Tamil In/13.pl
-0BAE   0BB5    TAMIL   # Tamil In/13.pl
-0BB7   0BB9    TAMIL   # Tamil In/13.pl
-0BBE   0BBF    TAMIL   # Tamil In/13.pl
-0BC0           TAMIL   # Tamil In/13.pl
-0BC1   0BC2    TAMIL   # Tamil In/13.pl
-0BC6   0BC8    TAMIL   # Tamil In/13.pl
-0BCA   0BCC    TAMIL   # Tamil In/13.pl
-0BCD           TAMIL   # Tamil In/13.pl
-0BD7           TAMIL   # Tamil In/13.pl
-0BE7   0BEF    TAMIL   # Tamil In/13.pl
-0BF0   0BF2    TAMIL   # Tamil In/13.pl
-0C01   0C03    TELUGU  # Telugu In/14.pl
-0C05   0C0C    TELUGU  # Telugu In/14.pl
-0C0E   0C10    TELUGU  # Telugu In/14.pl
-0C12   0C28    TELUGU  # Telugu In/14.pl
-0C2A   0C33    TELUGU  # Telugu In/14.pl
-0C35   0C39    TELUGU  # Telugu In/14.pl
-0C3E   0C40    TELUGU  # Telugu In/14.pl
-0C41   0C44    TELUGU  # Telugu In/14.pl
-0C46   0C48    TELUGU  # Telugu In/14.pl
-0C4A   0C4D    TELUGU  # Telugu In/14.pl
-0C55   0C56    TELUGU  # Telugu In/14.pl
-0C60   0C61    TELUGU  # Telugu In/14.pl
-0C66   0C6F    TELUGU  # Telugu In/14.pl
-0C82   0C83    KANNADA # Kannada In/15.pl
-0C85   0C8C    KANNADA # Kannada In/15.pl
-0C8E   0C90    KANNADA # Kannada In/15.pl
-0C92   0CA8    KANNADA # Kannada In/15.pl
-0CAA   0CB3    KANNADA # Kannada In/15.pl
-0CB5   0CB9    KANNADA # Kannada In/15.pl
-0CBE           KANNADA # Kannada In/15.pl
-0CBF           KANNADA # Kannada In/15.pl
-0CC0   0CC4    KANNADA # Kannada In/15.pl
-0CC6           KANNADA # Kannada In/15.pl
-0CC7   0CC8    KANNADA # Kannada In/15.pl
-0CCA   0CCB    KANNADA # Kannada In/15.pl
-0CCC   0CCD    KANNADA # Kannada In/15.pl
-0CD5   0CD6    KANNADA # Kannada In/15.pl
-0CDE           KANNADA # Kannada In/15.pl
-0CE0   0CE1    KANNADA # Kannada In/15.pl
-0CE6   0CEF    KANNADA # Kannada In/15.pl
-0D02   0D03    MALAYALAM       # Malayalam In/16.pl
-0D05   0D0C    MALAYALAM       # Malayalam In/16.pl
-0D0E   0D10    MALAYALAM       # Malayalam In/16.pl
-0D12   0D28    MALAYALAM       # Malayalam In/16.pl
-0D2A   0D39    MALAYALAM       # Malayalam In/16.pl
-0D3E   0D40    MALAYALAM       # Malayalam In/16.pl
-0D41   0D43    MALAYALAM       # Malayalam In/16.pl
-0D46   0D48    MALAYALAM       # Malayalam In/16.pl
-0D4A   0D4C    MALAYALAM       # Malayalam In/16.pl
-0D4D           MALAYALAM       # Malayalam In/16.pl
-0D57           MALAYALAM       # Malayalam In/16.pl
-0D60   0D61    MALAYALAM       # Malayalam In/16.pl
-0D66   0D6F    MALAYALAM       # Malayalam In/16.pl
-0D82   0D83    SINHALA # Sinhala In/17.pl
-0D85   0D96    SINHALA # Sinhala In/17.pl
-0D9A   0DB1    SINHALA # Sinhala In/17.pl
-0DB3   0DBB    SINHALA # Sinhala In/17.pl
-0DBD           SINHALA # Sinhala In/17.pl
-0DC0   0DC6    SINHALA # Sinhala In/17.pl
-0DCA           SINHALA # Sinhala In/17.pl
-0DCF   0DD1    SINHALA # Sinhala In/17.pl
-0DD2   0DD4    SINHALA # Sinhala In/17.pl
-0DD6           SINHALA # Sinhala In/17.pl
-0DD8   0DDF    SINHALA # Sinhala In/17.pl
-0DF2   0DF3    SINHALA # Sinhala In/17.pl
-0E01   0E30    THAI    # Thai In/18.pl
-0E31           THAI    # Thai In/18.pl
-0E32   0E33    THAI    # Thai In/18.pl
-0E34   0E3A    THAI    # Thai In/18.pl
-0E40   0E45    THAI    # Thai In/18.pl
-0E46           THAI    # Thai In/18.pl
-0E47   0E4E    THAI    # Thai In/18.pl
-0E50   0E59    THAI    # Thai In/18.pl
-0E81   0E82    LAO     # Lao In/19.pl
-0E84           LAO     # Lao In/19.pl
-0E87   0E88    LAO     # Lao In/19.pl
-0E8A           LAO     # Lao In/19.pl
-0E8D           LAO     # Lao In/19.pl
-0E94   0E97    LAO     # Lao In/19.pl
-0E99   0E9F    LAO     # Lao In/19.pl
-0EA1   0EA3    LAO     # Lao In/19.pl
-0EA5           LAO     # Lao In/19.pl
-0EA7           LAO     # Lao In/19.pl
-0EAA   0EAB    LAO     # Lao In/19.pl
-0EAD   0EB0    LAO     # Lao In/19.pl
-0EB1           LAO     # Lao In/19.pl
-0EB2   0EB3    LAO     # Lao In/19.pl
-0EB4   0EB9    LAO     # Lao In/19.pl
-0EBB   0EBC    LAO     # Lao In/19.pl
-0EBD           LAO     # Lao In/19.pl
-0EC0   0EC4    LAO     # Lao In/19.pl
-0EC6           LAO     # Lao In/19.pl
-0EC8   0ECD    LAO     # Lao In/19.pl
-0ED0   0ED9    LAO     # Lao In/19.pl
-0EDC   0EDD    LAO     # Lao In/19.pl
-0F00           TIBETAN # Tibetan In/20.pl
-0F18   0F19    TIBETAN # Tibetan In/20.pl
-0F20   0F29    TIBETAN # Tibetan In/20.pl
-0F2A   0F33    TIBETAN # Tibetan In/20.pl
-0F35           TIBETAN # Tibetan In/20.pl
-0F37           TIBETAN # Tibetan In/20.pl
-0F39           TIBETAN # Tibetan In/20.pl
-0F40   0F47    TIBETAN # Tibetan In/20.pl
-0F49   0F6A    TIBETAN # Tibetan In/20.pl
-0F71   0F7E    TIBETAN # Tibetan In/20.pl
-0F7F           TIBETAN # Tibetan In/20.pl
-0F80   0F84    TIBETAN # Tibetan In/20.pl
-0F86   0F87    TIBETAN # Tibetan In/20.pl
-0F88   0F8B    TIBETAN # Tibetan In/20.pl
-0F90   0F97    TIBETAN # Tibetan In/20.pl
-0F99   0FBC    TIBETAN # Tibetan In/20.pl
-0FC6           TIBETAN # Tibetan In/20.pl
-1000   1021    MYANMAR # Myanmar In/21.pl
-1023   1027    MYANMAR # Myanmar In/21.pl
-1029   102A    MYANMAR # Myanmar In/21.pl
-102C           MYANMAR # Myanmar In/21.pl
-102D   1030    MYANMAR # Myanmar In/21.pl
-1031           MYANMAR # Myanmar In/21.pl
-1032           MYANMAR # Myanmar In/21.pl
-1036   1037    MYANMAR # Myanmar In/21.pl
-1038           MYANMAR # Myanmar In/21.pl
-1039           MYANMAR # Myanmar In/21.pl
-1040   1049    MYANMAR # Myanmar In/21.pl
-1050   1055    MYANMAR # Myanmar In/21.pl
-1056   1057    MYANMAR # Myanmar In/21.pl
-1058   1059    MYANMAR # Myanmar In/21.pl
-10A0   10C5    GEORGIAN        # Georgian In/22.pl
-10D0   10F6    GEORGIAN        # Georgian In/22.pl
-1100   1159    HANGUL  # Hangul In/23.pl
-115F   11A2    HANGUL  # Hangul In/23.pl
-11A8   11F9    HANGUL  # Hangul In/23.pl
-3131   318E    HANGUL  # Hangul In/23.pl
-AC00   D7A3    HANGUL  # Hangul In/23.pl
-FFA0   FFBE    HANGUL  # Hangul In/23.pl
-FFC2   FFC7    HANGUL  # Hangul In/23.pl
-FFCA   FFCF    HANGUL  # Hangul In/23.pl
-FFD2   FFD7    HANGUL  # Hangul In/23.pl
-FFDA   FFDC    HANGUL  # Hangul In/23.pl
-1200   1206    ETHIOPIC        # Ethiopic In/24.pl
-1208   1246    ETHIOPIC        # Ethiopic In/24.pl
-1248           ETHIOPIC        # Ethiopic In/24.pl
-124A   124D    ETHIOPIC        # Ethiopic In/24.pl
-1250   1256    ETHIOPIC        # Ethiopic In/24.pl
-1258           ETHIOPIC        # Ethiopic In/24.pl
-125A   125D    ETHIOPIC        # Ethiopic In/24.pl
-1260   1286    ETHIOPIC        # Ethiopic In/24.pl
-1288           ETHIOPIC        # Ethiopic In/24.pl
-128A   128D    ETHIOPIC        # Ethiopic In/24.pl
-1290   12AE    ETHIOPIC        # Ethiopic In/24.pl
-12B0           ETHIOPIC        # Ethiopic In/24.pl
-12B2   12B5    ETHIOPIC        # Ethiopic In/24.pl
-12B8   12BE    ETHIOPIC        # Ethiopic In/24.pl
-12C0           ETHIOPIC        # Ethiopic In/24.pl
-12C2   12C5    ETHIOPIC        # Ethiopic In/24.pl
-12C8   12CE    ETHIOPIC        # Ethiopic In/24.pl
-12D0   12D6    ETHIOPIC        # Ethiopic In/24.pl
-12D8   12EE    ETHIOPIC        # Ethiopic In/24.pl
-12F0   130E    ETHIOPIC        # Ethiopic In/24.pl
-1310           ETHIOPIC        # Ethiopic In/24.pl
-1312   1315    ETHIOPIC        # Ethiopic In/24.pl
-1318   131E    ETHIOPIC        # Ethiopic In/24.pl
-1320   1346    ETHIOPIC        # Ethiopic In/24.pl
-1348   135A    ETHIOPIC        # Ethiopic In/24.pl
-1369   1371    ETHIOPIC        # Ethiopic In/24.pl
-1372   137C    ETHIOPIC        # Ethiopic In/24.pl
-13A0   13F4    CHEROKEE        # Cherokee In/25.pl
-1401   166C    CANADIAN-ABORIGINAL     # CanadianAboriginal In/26.pl
-166F   1676    CANADIAN-ABORIGINAL     # CanadianAboriginal In/26.pl
-1681   169A    OGHAM   # Ogham In/27.pl
-16A0   16EA    RUNIC   # Runic In/28.pl
-16EE   16F0    RUNIC   # Runic In/28.pl
-1780   17B3    KHMER   # Khmer In/29.pl
-17B4   17B6    KHMER   # Khmer In/29.pl
-17B7   17BD    KHMER   # Khmer In/29.pl
-17BE   17C5    KHMER   # Khmer In/29.pl
-17C6           KHMER   # Khmer In/29.pl
-17C7   17C8    KHMER   # Khmer In/29.pl
-17C9   17D3    KHMER   # Khmer In/29.pl
-17E0   17E9    KHMER   # Khmer In/29.pl
-1810   1819    MONGOLIAN       # Mongolian In/30.pl
-1820   1842    MONGOLIAN       # Mongolian In/30.pl
-1843           MONGOLIAN       # Mongolian In/30.pl
-1844   1877    MONGOLIAN       # Mongolian In/30.pl
-1880   18A8    MONGOLIAN       # Mongolian In/30.pl
-18A9           MONGOLIAN       # Mongolian In/30.pl
-3041   3094    HIRAGANA        # Hiragana In/31.pl
-309D   309E    HIRAGANA        # Hiragana In/31.pl
-30A1   30FA    KATAKANA        # Katakana In/32.pl
-30FD   30FE    KATAKANA        # Katakana In/32.pl
-FF66   FF6F    KATAKANA        # Katakana In/32.pl
-FF71   FF9D    KATAKANA        # Katakana In/32.pl
-3105   312C    BOPOMOFO        # Bopomofo In/33.pl
-31A0   31B7    BOPOMOFO        # Bopomofo In/33.pl
-2E80   2E99    HAN     # Han In/34.pl
-2E9B   2EF3    HAN     # Han In/34.pl
-2F00   2FD5    HAN     # Han In/34.pl
-3005           HAN     # Han In/34.pl
-3007           HAN     # Han In/34.pl
-3021   3029    HAN     # Han In/34.pl
-3038   303A    HAN     # Han In/34.pl
-3400   4DB5    HAN     # Han In/34.pl
-4E00   9FA5    HAN     # Han In/34.pl
-F900   FA2D    HAN     # Han In/34.pl
-20000  2A6D6   HAN     # Han In/34.pl
-2F800  2FA1D   HAN     # Han In/34.pl
-A000   A48C    YI      # Yi In/35.pl
-A490   A4A1    YI      # Yi In/35.pl
-A4A4   A4B3    YI      # Yi In/35.pl
-A4B5   A4C0    YI      # Yi In/35.pl
-A4C2   A4C4    YI      # Yi In/35.pl
-A4C6           YI      # Yi In/35.pl
-10300  1031E   OLD-ITALIC      # OldItalic In/36.pl
-10330  10349   GOTHIC  # Gothic In/37.pl
-1034A          GOTHIC  # Gothic In/37.pl
-10400  10425   DESERET # Deseret In/38.pl
-10428  1044D   DESERET # Deseret In/38.pl
-0300   034E    INHERITED       # Inherited In/39.pl
-0360   0362    INHERITED       # Inherited In/39.pl
-0488   0489    INHERITED       # Inherited In/39.pl
-0591   05A1    INHERITED       # Inherited In/39.pl
-05A3   05B9    INHERITED       # Inherited In/39.pl
-05BB   05BD    INHERITED       # Inherited In/39.pl
-05BF           INHERITED       # Inherited In/39.pl
-05C1   05C2    INHERITED       # Inherited In/39.pl
-05C4           INHERITED       # Inherited In/39.pl
-064B   0655    INHERITED       # Inherited In/39.pl
-0670           INHERITED       # Inherited In/39.pl
-06D6   06DC    INHERITED       # Inherited In/39.pl
-06DD   06DE    INHERITED       # Inherited In/39.pl
-06DF   06E4    INHERITED       # Inherited In/39.pl
-06E7   06E8    INHERITED       # Inherited In/39.pl
-06EA   06ED    INHERITED       # Inherited In/39.pl
-20D0   20DC    INHERITED       # Inherited In/39.pl
-20DD   20E0    INHERITED       # Inherited In/39.pl
-20E1           INHERITED       # Inherited In/39.pl
-20E2   20E3    INHERITED       # Inherited In/39.pl
-302A   302F    INHERITED       # Inherited In/39.pl
-3099   309A    INHERITED       # Inherited In/39.pl
-FB1E           INHERITED       # Inherited In/39.pl
-FE20   FE23    INHERITED       # Inherited In/39.pl
-1D167  1D169   INHERITED       # Inherited In/39.pl
-1D17B  1D182   INHERITED       # Inherited In/39.pl
-1D185  1D18B   INHERITED       # Inherited In/39.pl
-1D1AA  1D1AD   INHERITED       # Inherited In/39.pl
+0041   005A    LATIN   # In/0.pl
+0061   007A    LATIN   # In/0.pl
+00AA           LATIN   # In/0.pl
+00BA           LATIN   # In/0.pl
+00C0   00D6    LATIN   # In/0.pl
+00D8   00F6    LATIN   # In/0.pl
+00F8   01BA    LATIN   # In/0.pl
+01BB           LATIN   # In/0.pl
+01BC   01BF    LATIN   # In/0.pl
+01C0   01C3    LATIN   # In/0.pl
+01C4   021F    LATIN   # In/0.pl
+0222   0233    LATIN   # In/0.pl
+0250   02AD    LATIN   # In/0.pl
+02B0   02B8    LATIN   # In/0.pl
+02E0   02E4    LATIN   # In/0.pl
+1E00   1E9B    LATIN   # In/0.pl
+1EA0   1EF9    LATIN   # In/0.pl
+207F           LATIN   # In/0.pl
+212A   212B    LATIN   # In/0.pl
+FB00   FB06    LATIN   # In/0.pl
+FF21   FF3A    LATIN   # In/0.pl
+FF41   FF5A    LATIN   # In/0.pl
+00B5           GREEK   # In/1.pl
+037A           GREEK   # In/1.pl
+0386           GREEK   # In/1.pl
+0388   038A    GREEK   # In/1.pl
+038C           GREEK   # In/1.pl
+038E   03A1    GREEK   # In/1.pl
+03A3   03CE    GREEK   # In/1.pl
+03D0   03D7    GREEK   # In/1.pl
+03DA   03F5    GREEK   # In/1.pl
+1F00   1F15    GREEK   # In/1.pl
+1F18   1F1D    GREEK   # In/1.pl
+1F20   1F45    GREEK   # In/1.pl
+1F48   1F4D    GREEK   # In/1.pl
+1F50   1F57    GREEK   # In/1.pl
+1F59           GREEK   # In/1.pl
+1F5B           GREEK   # In/1.pl
+1F5D           GREEK   # In/1.pl
+1F5F   1F7D    GREEK   # In/1.pl
+1F80   1FB4    GREEK   # In/1.pl
+1FB6   1FBC    GREEK   # In/1.pl
+1FBE           GREEK   # In/1.pl
+1FC2   1FC4    GREEK   # In/1.pl
+1FC6   1FCC    GREEK   # In/1.pl
+1FD0   1FD3    GREEK   # In/1.pl
+1FD6   1FDB    GREEK   # In/1.pl
+1FE0   1FEC    GREEK   # In/1.pl
+1FF2   1FF4    GREEK   # In/1.pl
+1FF6   1FFC    GREEK   # In/1.pl
+2126           GREEK   # In/1.pl
+0400   0481    CYRILLIC        # In/2.pl
+0483   0486    CYRILLIC        # In/2.pl
+048C   04C4    CYRILLIC        # In/2.pl
+04C7   04C8    CYRILLIC        # In/2.pl
+04CB   04CC    CYRILLIC        # In/2.pl
+04D0   04F5    CYRILLIC        # In/2.pl
+04F8   04F9    CYRILLIC        # In/2.pl
+0531   0556    ARMENIAN        # In/3.pl
+0559           ARMENIAN        # In/3.pl
+0561   0587    ARMENIAN        # In/3.pl
+FB13   FB17    ARMENIAN        # In/3.pl
+05D0   05EA    HEBREW  # In/4.pl
+05F0   05F2    HEBREW  # In/4.pl
+FB1D           HEBREW  # In/4.pl
+FB1F   FB28    HEBREW  # In/4.pl
+FB2A   FB36    HEBREW  # In/4.pl
+FB38   FB3C    HEBREW  # In/4.pl
+FB3E           HEBREW  # In/4.pl
+FB40   FB41    HEBREW  # In/4.pl
+FB43   FB44    HEBREW  # In/4.pl
+FB46   FB4F    HEBREW  # In/4.pl
+0621   063A    ARABIC  # In/5.pl
+0641   064A    ARABIC  # In/5.pl
+0671   06D3    ARABIC  # In/5.pl
+06D5           ARABIC  # In/5.pl
+06E5   06E6    ARABIC  # In/5.pl
+06FA   06FC    ARABIC  # In/5.pl
+FB50   FBB1    ARABIC  # In/5.pl
+FBD3   FD3D    ARABIC  # In/5.pl
+FD50   FD8F    ARABIC  # In/5.pl
+FD92   FDC7    ARABIC  # In/5.pl
+FDF0   FDFB    ARABIC  # In/5.pl
+FE70   FE72    ARABIC  # In/5.pl
+FE74           ARABIC  # In/5.pl
+FE76   FEFC    ARABIC  # In/5.pl
+0710           SYRIAC  # In/6.pl
+0711           SYRIAC  # In/6.pl
+0712   072C    SYRIAC  # In/6.pl
+0730   074A    SYRIAC  # In/6.pl
+0780   07A5    THAANA  # In/7.pl
+07A6   07B0    THAANA  # In/7.pl
+0901   0902    DEVANAGARI      # In/8.pl
+0903           DEVANAGARI      # In/8.pl
+0905   0939    DEVANAGARI      # In/8.pl
+093C           DEVANAGARI      # In/8.pl
+093D           DEVANAGARI      # In/8.pl
+093E   0940    DEVANAGARI      # In/8.pl
+0941   0948    DEVANAGARI      # In/8.pl
+0949   094C    DEVANAGARI      # In/8.pl
+094D           DEVANAGARI      # In/8.pl
+0950           DEVANAGARI      # In/8.pl
+0951   0954    DEVANAGARI      # In/8.pl
+0958   0961    DEVANAGARI      # In/8.pl
+0962   0963    DEVANAGARI      # In/8.pl
+0966   096F    DEVANAGARI      # In/8.pl
+0981           BENGALI # In/9.pl
+0985   098C    BENGALI # In/9.pl
+098F   0990    BENGALI # In/9.pl
+0993   09A8    BENGALI # In/9.pl
+09AA   09B0    BENGALI # In/9.pl
+09B2           BENGALI # In/9.pl
+09B6   09B9    BENGALI # In/9.pl
+09BC           BENGALI # In/9.pl
+09BE   09C0    BENGALI # In/9.pl
+09C1   09C4    BENGALI # In/9.pl
+09C7   09C8    BENGALI # In/9.pl
+09CB   09CC    BENGALI # In/9.pl
+09CD           BENGALI # In/9.pl
+09D7           BENGALI # In/9.pl
+09DC   09DD    BENGALI # In/9.pl
+09DF   09E1    BENGALI # In/9.pl
+09E2   09E3    BENGALI # In/9.pl
+09E6   09EF    BENGALI # In/9.pl
+09F0   09F1    BENGALI # In/9.pl
+0A02           GURMUKHI        # In/10.pl
+0A05   0A0A    GURMUKHI        # In/10.pl
+0A0F   0A10    GURMUKHI        # In/10.pl
+0A13   0A28    GURMUKHI        # In/10.pl
+0A2A   0A30    GURMUKHI        # In/10.pl
+0A32   0A33    GURMUKHI        # In/10.pl
+0A35   0A36    GURMUKHI        # In/10.pl
+0A38   0A39    GURMUKHI        # In/10.pl
+0A3C           GURMUKHI        # In/10.pl
+0A3E   0A40    GURMUKHI        # In/10.pl
+0A41   0A42    GURMUKHI        # In/10.pl
+0A47   0A48    GURMUKHI        # In/10.pl
+0A4B   0A4D    GURMUKHI        # In/10.pl
+0A59   0A5C    GURMUKHI        # In/10.pl
+0A5E           GURMUKHI        # In/10.pl
+0A66   0A6F    GURMUKHI        # In/10.pl
+0A70   0A71    GURMUKHI        # In/10.pl
+0A72   0A74    GURMUKHI        # In/10.pl
+0A81   0A82    GUJARATI        # In/11.pl
+0A83           GUJARATI        # In/11.pl
+0A85   0A8B    GUJARATI        # In/11.pl
+0A8D           GUJARATI        # In/11.pl
+0A8F   0A91    GUJARATI        # In/11.pl
+0A93   0AA8    GUJARATI        # In/11.pl
+0AAA   0AB0    GUJARATI        # In/11.pl
+0AB2   0AB3    GUJARATI        # In/11.pl
+0AB5   0AB9    GUJARATI        # In/11.pl
+0ABC           GUJARATI        # In/11.pl
+0ABD           GUJARATI        # In/11.pl
+0ABE   0AC0    GUJARATI        # In/11.pl
+0AC1   0AC5    GUJARATI        # In/11.pl
+0AC7   0AC8    GUJARATI        # In/11.pl
+0AC9           GUJARATI        # In/11.pl
+0ACB   0ACC    GUJARATI        # In/11.pl
+0ACD           GUJARATI        # In/11.pl
+0AD0           GUJARATI        # In/11.pl
+0AE0           GUJARATI        # In/11.pl
+0AE6   0AEF    GUJARATI        # In/11.pl
+0B01           ORIYA   # In/12.pl
+0B02   0B03    ORIYA   # In/12.pl
+0B05   0B0C    ORIYA   # In/12.pl
+0B0F   0B10    ORIYA   # In/12.pl
+0B13   0B28    ORIYA   # In/12.pl
+0B2A   0B30    ORIYA   # In/12.pl
+0B32   0B33    ORIYA   # In/12.pl
+0B36   0B39    ORIYA   # In/12.pl
+0B3C           ORIYA   # In/12.pl
+0B3D           ORIYA   # In/12.pl
+0B3E           ORIYA   # In/12.pl
+0B3F           ORIYA   # In/12.pl
+0B40           ORIYA   # In/12.pl
+0B41   0B43    ORIYA   # In/12.pl
+0B47   0B48    ORIYA   # In/12.pl
+0B4B   0B4C    ORIYA   # In/12.pl
+0B4D           ORIYA   # In/12.pl
+0B56           ORIYA   # In/12.pl
+0B57           ORIYA   # In/12.pl
+0B5C   0B5D    ORIYA   # In/12.pl
+0B5F   0B61    ORIYA   # In/12.pl
+0B66   0B6F    ORIYA   # In/12.pl
+0B82           TAMIL   # In/13.pl
+0B83           TAMIL   # In/13.pl
+0B85   0B8A    TAMIL   # In/13.pl
+0B8E   0B90    TAMIL   # In/13.pl
+0B92   0B95    TAMIL   # In/13.pl
+0B99   0B9A    TAMIL   # In/13.pl
+0B9C           TAMIL   # In/13.pl
+0B9E   0B9F    TAMIL   # In/13.pl
+0BA3   0BA4    TAMIL   # In/13.pl
+0BA8   0BAA    TAMIL   # In/13.pl
+0BAE   0BB5    TAMIL   # In/13.pl
+0BB7   0BB9    TAMIL   # In/13.pl
+0BBE   0BBF    TAMIL   # In/13.pl
+0BC0           TAMIL   # In/13.pl
+0BC1   0BC2    TAMIL   # In/13.pl
+0BC6   0BC8    TAMIL   # In/13.pl
+0BCA   0BCC    TAMIL   # In/13.pl
+0BCD           TAMIL   # In/13.pl
+0BD7           TAMIL   # In/13.pl
+0BE7   0BEF    TAMIL   # In/13.pl
+0BF0   0BF2    TAMIL   # In/13.pl
+0C01   0C03    TELUGU  # In/14.pl
+0C05   0C0C    TELUGU  # In/14.pl
+0C0E   0C10    TELUGU  # In/14.pl
+0C12   0C28    TELUGU  # In/14.pl
+0C2A   0C33    TELUGU  # In/14.pl
+0C35   0C39    TELUGU  # In/14.pl
+0C3E   0C40    TELUGU  # In/14.pl
+0C41   0C44    TELUGU  # In/14.pl
+0C46   0C48    TELUGU  # In/14.pl
+0C4A   0C4D    TELUGU  # In/14.pl
+0C55   0C56    TELUGU  # In/14.pl
+0C60   0C61    TELUGU  # In/14.pl
+0C66   0C6F    TELUGU  # In/14.pl
+0C82   0C83    KANNADA # In/15.pl
+0C85   0C8C    KANNADA # In/15.pl
+0C8E   0C90    KANNADA # In/15.pl
+0C92   0CA8    KANNADA # In/15.pl
+0CAA   0CB3    KANNADA # In/15.pl
+0CB5   0CB9    KANNADA # In/15.pl
+0CBE           KANNADA # In/15.pl
+0CBF           KANNADA # In/15.pl
+0CC0   0CC4    KANNADA # In/15.pl
+0CC6           KANNADA # In/15.pl
+0CC7   0CC8    KANNADA # In/15.pl
+0CCA   0CCB    KANNADA # In/15.pl
+0CCC   0CCD    KANNADA # In/15.pl
+0CD5   0CD6    KANNADA # In/15.pl
+0CDE           KANNADA # In/15.pl
+0CE0   0CE1    KANNADA # In/15.pl
+0CE6   0CEF    KANNADA # In/15.pl
+0D02   0D03    MALAYALAM       # In/16.pl
+0D05   0D0C    MALAYALAM       # In/16.pl
+0D0E   0D10    MALAYALAM       # In/16.pl
+0D12   0D28    MALAYALAM       # In/16.pl
+0D2A   0D39    MALAYALAM       # In/16.pl
+0D3E   0D40    MALAYALAM       # In/16.pl
+0D41   0D43    MALAYALAM       # In/16.pl
+0D46   0D48    MALAYALAM       # In/16.pl
+0D4A   0D4C    MALAYALAM       # In/16.pl
+0D4D           MALAYALAM       # In/16.pl
+0D57           MALAYALAM       # In/16.pl
+0D60   0D61    MALAYALAM       # In/16.pl
+0D66   0D6F    MALAYALAM       # In/16.pl
+0D82   0D83    SINHALA # In/17.pl
+0D85   0D96    SINHALA # In/17.pl
+0D9A   0DB1    SINHALA # In/17.pl
+0DB3   0DBB    SINHALA # In/17.pl
+0DBD           SINHALA # In/17.pl
+0DC0   0DC6    SINHALA # In/17.pl
+0DCA           SINHALA # In/17.pl
+0DCF   0DD1    SINHALA # In/17.pl
+0DD2   0DD4    SINHALA # In/17.pl
+0DD6           SINHALA # In/17.pl
+0DD8   0DDF    SINHALA # In/17.pl
+0DF2   0DF3    SINHALA # In/17.pl
+0E01   0E30    THAI    # In/18.pl
+0E31           THAI    # In/18.pl
+0E32   0E33    THAI    # In/18.pl
+0E34   0E3A    THAI    # In/18.pl
+0E40   0E45    THAI    # In/18.pl
+0E46           THAI    # In/18.pl
+0E47   0E4E    THAI    # In/18.pl
+0E50   0E59    THAI    # In/18.pl
+0E81   0E82    LAO     # In/19.pl
+0E84           LAO     # In/19.pl
+0E87   0E88    LAO     # In/19.pl
+0E8A           LAO     # In/19.pl
+0E8D           LAO     # In/19.pl
+0E94   0E97    LAO     # In/19.pl
+0E99   0E9F    LAO     # In/19.pl
+0EA1   0EA3    LAO     # In/19.pl
+0EA5           LAO     # In/19.pl
+0EA7           LAO     # In/19.pl
+0EAA   0EAB    LAO     # In/19.pl
+0EAD   0EB0    LAO     # In/19.pl
+0EB1           LAO     # In/19.pl
+0EB2   0EB3    LAO     # In/19.pl
+0EB4   0EB9    LAO     # In/19.pl
+0EBB   0EBC    LAO     # In/19.pl
+0EBD           LAO     # In/19.pl
+0EC0   0EC4    LAO     # In/19.pl
+0EC6           LAO     # In/19.pl
+0EC8   0ECD    LAO     # In/19.pl
+0ED0   0ED9    LAO     # In/19.pl
+0EDC   0EDD    LAO     # In/19.pl
+0F00           TIBETAN # In/20.pl
+0F18   0F19    TIBETAN # In/20.pl
+0F20   0F29    TIBETAN # In/20.pl
+0F2A   0F33    TIBETAN # In/20.pl
+0F35           TIBETAN # In/20.pl
+0F37           TIBETAN # In/20.pl
+0F39           TIBETAN # In/20.pl
+0F40   0F47    TIBETAN # In/20.pl
+0F49   0F6A    TIBETAN # In/20.pl
+0F71   0F7E    TIBETAN # In/20.pl
+0F7F           TIBETAN # In/20.pl
+0F80   0F84    TIBETAN # In/20.pl
+0F86   0F87    TIBETAN # In/20.pl
+0F88   0F8B    TIBETAN # In/20.pl
+0F90   0F97    TIBETAN # In/20.pl
+0F99   0FBC    TIBETAN # In/20.pl
+0FC6           TIBETAN # In/20.pl
+1000   1021    MYANMAR # In/21.pl
+1023   1027    MYANMAR # In/21.pl
+1029   102A    MYANMAR # In/21.pl
+102C           MYANMAR # In/21.pl
+102D   1030    MYANMAR # In/21.pl
+1031           MYANMAR # In/21.pl
+1032           MYANMAR # In/21.pl
+1036   1037    MYANMAR # In/21.pl
+1038           MYANMAR # In/21.pl
+1039           MYANMAR # In/21.pl
+1040   1049    MYANMAR # In/21.pl
+1050   1055    MYANMAR # In/21.pl
+1056   1057    MYANMAR # In/21.pl
+1058   1059    MYANMAR # In/21.pl
+10A0   10C5    GEORGIAN        # In/22.pl
+10D0   10F6    GEORGIAN        # In/22.pl
+1100   1159    HANGUL  # In/23.pl
+115F   11A2    HANGUL  # In/23.pl
+11A8   11F9    HANGUL  # In/23.pl
+3131   318E    HANGUL  # In/23.pl
+AC00   D7A3    HANGUL  # In/23.pl
+FFA0   FFBE    HANGUL  # In/23.pl
+FFC2   FFC7    HANGUL  # In/23.pl
+FFCA   FFCF    HANGUL  # In/23.pl
+FFD2   FFD7    HANGUL  # In/23.pl
+FFDA   FFDC    HANGUL  # In/23.pl
+1200   1206    ETHIOPIC        # In/24.pl
+1208   1246    ETHIOPIC        # In/24.pl
+1248           ETHIOPIC        # In/24.pl
+124A   124D    ETHIOPIC        # In/24.pl
+1250   1256    ETHIOPIC        # In/24.pl
+1258           ETHIOPIC        # In/24.pl
+125A   125D    ETHIOPIC        # In/24.pl
+1260   1286    ETHIOPIC        # In/24.pl
+1288           ETHIOPIC        # In/24.pl
+128A   128D    ETHIOPIC        # In/24.pl
+1290   12AE    ETHIOPIC        # In/24.pl
+12B0           ETHIOPIC        # In/24.pl
+12B2   12B5    ETHIOPIC        # In/24.pl
+12B8   12BE    ETHIOPIC        # In/24.pl
+12C0           ETHIOPIC        # In/24.pl
+12C2   12C5    ETHIOPIC        # In/24.pl
+12C8   12CE    ETHIOPIC        # In/24.pl
+12D0   12D6    ETHIOPIC        # In/24.pl
+12D8   12EE    ETHIOPIC        # In/24.pl
+12F0   130E    ETHIOPIC        # In/24.pl
+1310           ETHIOPIC        # In/24.pl
+1312   1315    ETHIOPIC        # In/24.pl
+1318   131E    ETHIOPIC        # In/24.pl
+1320   1346    ETHIOPIC        # In/24.pl
+1348   135A    ETHIOPIC        # In/24.pl
+1369   1371    ETHIOPIC        # In/24.pl
+1372   137C    ETHIOPIC        # In/24.pl
+13A0   13F4    CHEROKEE        # In/25.pl
+1401   166C    CANADIAN-ABORIGINAL     # In/26.pl
+166F   1676    CANADIAN-ABORIGINAL     # In/26.pl
+1681   169A    OGHAM   # In/27.pl
+16A0   16EA    RUNIC   # In/28.pl
+16EE   16F0    RUNIC   # In/28.pl
+1780   17B3    KHMER   # In/29.pl
+17B4   17B6    KHMER   # In/29.pl
+17B7   17BD    KHMER   # In/29.pl
+17BE   17C5    KHMER   # In/29.pl
+17C6           KHMER   # In/29.pl
+17C7   17C8    KHMER   # In/29.pl
+17C9   17D3    KHMER   # In/29.pl
+17E0   17E9    KHMER   # In/29.pl
+1810   1819    MONGOLIAN       # In/30.pl
+1820   1842    MONGOLIAN       # In/30.pl
+1843           MONGOLIAN       # In/30.pl
+1844   1877    MONGOLIAN       # In/30.pl
+1880   18A8    MONGOLIAN       # In/30.pl
+18A9           MONGOLIAN       # In/30.pl
+3041   3094    HIRAGANA        # In/31.pl
+309D   309E    HIRAGANA        # In/31.pl
+30A1   30FA    KATAKANA        # In/32.pl
+30FD   30FE    KATAKANA        # In/32.pl
+FF66   FF6F    KATAKANA        # In/32.pl
+FF71   FF9D    KATAKANA        # In/32.pl
+3105   312C    BOPOMOFO        # In/33.pl
+31A0   31B7    BOPOMOFO        # In/33.pl
+2E80   2E99    HAN     # In/34.pl
+2E9B   2EF3    HAN     # In/34.pl
+2F00   2FD5    HAN     # In/34.pl
+3005           HAN     # In/34.pl
+3007           HAN     # In/34.pl
+3021   3029    HAN     # In/34.pl
+3038   303A    HAN     # In/34.pl
+3400   4DB5    HAN     # In/34.pl
+4E00   9FA5    HAN     # In/34.pl
+F900   FA2D    HAN     # In/34.pl
+20000  2A6D6   HAN     # In/34.pl
+2F800  2FA1D   HAN     # In/34.pl
+A000   A48C    YI      # In/35.pl
+A490   A4A1    YI      # In/35.pl
+A4A4   A4B3    YI      # In/35.pl
+A4B5   A4C0    YI      # In/35.pl
+A4C2   A4C4    YI      # In/35.pl
+A4C6           YI      # In/35.pl
+10300  1031E   OLD-ITALIC      # In/36.pl
+10330  10349   GOTHIC  # In/37.pl
+1034A          GOTHIC  # In/37.pl
+10400  10425   DESERET # In/38.pl
+10428  1044D   DESERET # In/38.pl
+0300   034E    INHERITED       # In/39.pl
+0360   0362    INHERITED       # In/39.pl
+0488   0489    INHERITED       # In/39.pl
+0591   05A1    INHERITED       # In/39.pl
+05A3   05B9    INHERITED       # In/39.pl
+05BB   05BD    INHERITED       # In/39.pl
+05BF           INHERITED       # In/39.pl
+05C1   05C2    INHERITED       # In/39.pl
+05C4           INHERITED       # In/39.pl
+064B   0655    INHERITED       # In/39.pl
+0670           INHERITED       # In/39.pl
+06D6   06DC    INHERITED       # In/39.pl
+06DD   06DE    INHERITED       # In/39.pl
+06DF   06E4    INHERITED       # In/39.pl
+06E7   06E8    INHERITED       # In/39.pl
+06EA   06ED    INHERITED       # In/39.pl
+20D0   20DC    INHERITED       # In/39.pl
+20DD   20E0    INHERITED       # In/39.pl
+20E1           INHERITED       # In/39.pl
+20E2   20E3    INHERITED       # In/39.pl
+302A   302F    INHERITED       # In/39.pl
+3099   309A    INHERITED       # In/39.pl
+FB1E           INHERITED       # In/39.pl
+FE20   FE23    INHERITED       # In/39.pl
+1D167  1D169   INHERITED       # In/39.pl
+1D17B  1D182   INHERITED       # In/39.pl
+1D185  1D18B   INHERITED       # In/39.pl
+1D1AA  1D1AD   INHERITED       # In/39.pl
 END
index f86ff69..642c66f 100755 (executable)
@@ -231,7 +231,8 @@ mkdir "To", 0755;
 
 # This is not written for speed...
 
-my %InId;
+my %InIdScript;
+my %InIdBlock;
 my $InId = 0;
 
 foreach $file (@todo) {
@@ -258,9 +259,6 @@ END
     close OUT;
 }
 
-# Do Scripts before Blocks so that in case of naming conflicts
-# the more natural one (Script) wins over the artificial one (Block).
-
 print "Scripts\n";
 open(UD, 'Scripts.txt') or die "Can't open Scripts.txt: $!\n";
 open(OUT, ">Scripts.pl") or die "Can't create Scripts.pl: $!\n";
@@ -281,13 +279,11 @@ while (<UD>) {
     chomp;
     ($code, $last, $name) = /^([0-9a-f]+)(?:\.\.([0-9a-f]+))?\s+;\s+(.+)\s+\#/i;
     if ($name) {
-       my $InName = lc($name);
-       $InName =~ s/\b(\w)/uc($1)/ge;
-       $InName =~ s/\W+//g;
+       my $InName = $name;
        my $id;
-        unless (exists $InId{$InName}) {
+        unless (exists $InIdScript{$InName}) {
            print "\t$InName\n";
-           $id = $Scripts{$InName} = $InId{$InName} = $InId++;
+           $id = $Scripts{$InName} = $InIdScript{$InName} = $InId++;
            open(SCRIPT, ">In/$id.pl") or die "create In/$id.pl: $!\n";
            print SCRIPT <<EOH;
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
@@ -297,10 +293,10 @@ return <<'END';
 EOH
             close(SCRIPT);
        } else {
-           $id = $InId{$InName};
+           $id = $InIdScript{$InName};
        }
        $last = "" unless defined $last;
-       print OUT "$code\t$last\t$name\t# $InName In/$id.pl\n";
+       print OUT "$code\t$last\t$name\t# In/$id.pl\n";
         open(SCRIPT, ">>In/$id.pl");
        print SCRIPT <<END;
 $code  $last
@@ -309,7 +305,7 @@ END
     }
 }
 
-for my $id (values %InId) {
+for my $id (values %InIdScript) {
     open(SCRIPT, ">>In/$id.pl");
     print SCRIPT <<END2;
 END
@@ -339,22 +335,18 @@ while (<UD>) {
     next if /^#/;
     next if /^$/;
     chomp;
-    ($code, $last, $name) = /^([0-9a-f]+)\.\.([0-9a-f]+); (.+)/i;
+    ($code, $last, $name) = /^([0-9a-f]+)\.\.([0-9a-f]+); (.+?)\s*$/i;
     if ($name) {
        my $InName = $name;
-       $InName =~ s/\W+//g;
        print "\t$InName\n";
        my $id;
        # TODO: only the first one of Private Use blocks qualifies
-        unless (exists $InId{$InName}) {
-           $InId{$InName} = $InId++;
-       } elsif (exists $Scripts{$InName}) {
-           $InName .= 'Block';
-           $InId{$InName} = $InId++;
+        unless (exists $InIdBlock{$InName}) {
+           $InIdBlock{$InName} = $InId++;
        }
-       $id = $InId{$InName};
+       $id = $InIdBlock{$InName};
        open(BLOCK, ">In/$id.pl") or die "create In/$id.pl: $!\n";
-       print OUT "$code\t$last\t$name\t# $InName In/$id.pl\n";
+       print OUT "$code\t$last\t$name\t# In/$id.pl\n";
        print BLOCK <<EOH;
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
 # This file is built by $0 from e.g. $UnicodeData.
@@ -381,9 +373,57 @@ print INID <<EOH;
 %utf8::In = (
 EOH
 
-# Order doesn't matter but let's prettyprint anyway.
-foreach my $in (sort { $InId{$a} <=> $InId{$b} } keys %InId) {
-    printf INID "%-40s => %3d,\n", "'$in'", $InId{$in};
+my %InIdScriptById = reverse %InIdScript;
+my %InIdBlockById  = reverse %InIdBlock;
+
+my @InIdScriptById = sort { $a <=> $b } keys %InIdScriptById;
+my @InIdBlockById  = sort { $a <=> $b } keys %InIdBlockById;
+
+my %InId;
+my %IdIdLcName;
+
+for my $id (@InIdScriptById) {
+    my $name = $InIdScriptById{$id};
+    my $lcname = lc($name);
+    $InId{$name} = $id;
+    $IdIdLcName{$lcname} = $id;
+}
+
+for my $id (@InIdBlockById) {
+    my $name = $InIdBlockById{$id};
+    my $lcname = lc($name);
+    if (exists $IdIdLcName{$lcname}) {
+       $InId{"$name Block"} = $id;
+    } else {
+       $InId{$name} = $id;
+    }
+    $IdIdLcName{$lcname} = $id;
+}
+
+my @InId = sort { $InId{$a} <=> $InId{$b} } keys %InId;
+
+my %InIdPrefix;
+
+foreach my $in (@InId) {
+    my $inpat = $in;
+    $inpat =~ s/([- ])/[- _]?/g;
+    push @{$InIdPrefix{lc(substr($in, 0, 3))}}, [ $in, $inpat ];
+    printf INID "%-45s => %3d,\n", "'$in'", $InId{$in};
+}
+
+print INID ");\n";
+
+print INID <<EOH;
+%utf8::InPat = (
+EOH
+
+foreach my $prefix (sort keys %InIdPrefix) {
+    printf INID "'$prefix' => {\n";
+    foreach my $ininpat (@{$InIdPrefix{$prefix}}) {
+       my ($in, $inpat) = @$ininpat;
+       printf INID "\t'$inpat' => '$in',\n";
+    }
+    printf INID "},\n";
 }
 
 print INID ");\n";
index a90e24c..e8cf0cc 100644 (file)
@@ -26,11 +26,20 @@ sub SWASHNEW {
     while (($caller = caller($i)) eq __PACKAGE__) { $i++ }
     my $encoding = $enc{$caller} || "unicore";
     (my $file = $type) =~ s!::!/!g;
-    if ($file =~ /^In(.+)/) {
+    if ($file =~ /^In[- ]?(.+)/i) {
        my $In = $1;
        defined %utf8::In || do "$encoding/In.pl";
-       if (exists $utf8::In{$In}) {
-           $file = "$encoding/In/$utf8::In{$In}";
+       my $prefix = substr(lc($In), 0, 3);
+       if (exists $utf8::InPat{$prefix}) {
+           for my $k (keys %{$utf8::InPat{$prefix}}) {
+               if ($In =~ /^$k$/i) {
+                   $In = $utf8::InPat{$prefix}->{$k};
+                   if (exists $utf8::In{$In}) {
+                       $file = "$encoding/In/$utf8::In{$In}";
+                       last;
+                   }
+               }
+           }
        }
     } else {
        $file =~ s#^(Is|To)([A-Z].*)#$1/$2#;
@@ -43,7 +52,7 @@ sub SWASHNEW {
            || do "$file.pl"
            || do "$encoding/$file.pl"
            || do "$encoding/Is/${type}.pl"
-           || croak("Can't find $encoding character property \"$type\"");
+           || croak("Can't find Unicode character property \"$type\"");
     }
 
     $| = 1;
index d234a98..b6daebc 100644 (file)
@@ -91,11 +91,13 @@ for (@prgs){
     print TEST $prog,"\n";
     close TEST;
     my $results = $Is_VMS ?
-                  `./perl "-I../lib" $switch $tmpfile` :
+                     `./perl "-I../lib" $switch $tmpfile` :
                  $Is_MSWin32 ?
-                  `.\\perl -I../lib $switch $tmpfile` :
+                     `.\\perl -I../lib $switch $tmpfile` :
                  $Is_NetWare ?
-                  `perl -I../lib $switch $tmpfile` :
+                     `perl -I../lib $switch $tmpfile` :
+                 $Is_MacOS ?
+                     `$^X -I::lib $switch -MMac::err=unix $tmpfile` :
                   `./perl -I../lib $switch $tmpfile`;
     my $status = $?;
     $results =~ s/\n+$//;
index 66d5a9a..44b37c0 100644 (file)
@@ -70,7 +70,7 @@
 #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
 static char    *local_patches[] = {
         NULL
-       ,"DEVEL12178"
+       ,"DEVEL12256"
        ,NULL
 };
 
diff --git a/perl.c b/perl.c
index 9843134..c671343 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -272,6 +272,27 @@ perl_construct(pTHXx)
     New(31337, PL_reentrant_buffer,1, REBUF);
     New(31337, PL_reentrant_buffer->tmbuff,1, struct tm);
 #endif
+
+    /* Note that strtab is a rather special HV.  Assumptions are made
+       about not iterating on it, and not adding tie magic to it.
+       It is properly deallocated in perl_destruct() */
+    PL_strtab = newHV();
+
+#ifdef USE_5005THREADS
+    MUTEX_INIT(&PL_strtab_mutex);
+#endif
+    HvSHAREKEYS_off(PL_strtab);                        /* mandatory */
+    hv_ksplit(PL_strtab, 512);
+
+#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
+    _dyld_lookup_and_bind
+       ("__environ", (unsigned long *) &environ_pointer, NULL);
+#endif /* environ */
+
+#ifdef  USE_ENVIRON_ARRAY
+    PL_origenviron = environ;
+#endif
+
     ENTER;
 }
 
@@ -450,6 +471,7 @@ perl_destruct(pTHXx)
 
        for (i = 0; environ[i]; i++)
            safesysfree(environ[i]);
+
        /* Must use safesysfree() when working with environ. */
        safesysfree(environ);           
 
@@ -919,11 +941,6 @@ setuid perl scripts securely.\n");
 #endif
 #endif
 
-#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
-    _dyld_lookup_and_bind
-       ("__environ", (unsigned long *) &environ_pointer, NULL);
-#endif /* environ */
-
     PL_origargc = argc;
     {
         /* we copy rather than point to argv
@@ -939,9 +956,7 @@ setuid perl scripts securely.\n");
         }
     }
 
-#ifdef  USE_ENVIRON_ARRAY
-    PL_origenviron = environ;
-#endif
+
 
     if (PL_do_undump) {
 
@@ -1547,7 +1562,7 @@ S_run_body(pTHX_ I32 oldscope)
 
        if (PL_minus_c) {
 #ifdef MACOS_TRADITIONAL
-           PerlIO_printf(Perl_error_log, "%s syntax OK\n", MacPerl_MPWFileName(PL_origfilename));
+           PerlIO_printf(Perl_error_log, "%s syntax OK\n", MacPerl_MPWFileName(PL_origfilename));
 #else
            PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
 #endif
@@ -2586,15 +2601,7 @@ S_init_main_stash(pTHX)
 {
     GV *gv;
 
-    /* Note that strtab is a rather special HV.  Assumptions are made
-       about not iterating on it, and not adding tie magic to it.
-       It is properly deallocated in perl_destruct() */
-    PL_strtab = newHV();
-#ifdef USE_5005THREADS
-    MUTEX_INIT(&PL_strtab_mutex);
-#endif
-    HvSHAREKEYS_off(PL_strtab);                        /* mandatory */
-    hv_ksplit(PL_strtab, 512);
+
 
     PL_curstash = PL_defstash = newHV();
     PL_curstname = newSVpvn("main",4);
diff --git a/perl.h b/perl.h
index 6601c76..6f3026c 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1813,6 +1813,10 @@ typedef struct ptr_tbl PTR_TBL_t;
 #  define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
 #endif
 
+#ifndef PERL_WRITE_MSG_TO_CONSOLE
+#  define PERL_WRITE_MSG_TO_CONSOLE(io, msg, len) PerlIO_write(io, msg, len)
+#endif
+
 #ifndef MAXPATHLEN
 #  ifdef PATH_MAX
 #    ifdef _POSIX_PATH_MAX
index d05bf3c..eb32a04 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -945,15 +945,16 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
     PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n",
                 f, PerlIOBase(f)->tab->name, iotype, mode,
                 (names) ? names : "(Null)");
+    PerlIO_flush(f);
     if (!names && (O_TEXT != O_BINARY && (mode & O_BINARY))) {
        PerlIO *top = f;
        while (*top) {
            if (PerlIOBase(top)->tab == &PerlIO_crlf) {
-               PerlIO_flush(top);
                PerlIOBase(top)->flags &= ~PERLIO_F_CRLF;
                break;
            }
            top = PerlIONext(top);
+           PerlIO_flush(top);
        }
     }
     return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE;
index 5ab97e1..c7c1be2 100644 (file)
@@ -18,11 +18,11 @@ The 5.0 release of Perl let us have complex data structures.  You
 may now write something like this and all of a sudden, you'd have a array
 with three dimensions!
 
-    for $x (1 .. 10) {
-       for $y (1 .. 10) {
-           for $z (1 .. 10) {
-               $AoA[$x][$y][$z] =
-                   $x ** $y + $z;
+    my @AoA;
+    for my $x (1 .. 10) {
+       for my $y (1 .. 10) {
+           for my $z (1 .. 10) {
+               $AoA[$x][$y][$z] = $x ** $y + $z;
            }
        }
     }
@@ -102,7 +102,11 @@ Now, because the top level contains only references, if you try to print
 out your array in with a simple print() function, you'll get something
 that doesn't look very nice, like this:
 
-    @AoA = ( [2, 3], [4, 5, 7], [0] );
+    my @AoA = (
+               [2, 3,  ],
+               [4, 5, 7],
+               [0,     ],
+              );
     print $AoA[1][2];
   7
     print @AoA;
@@ -123,79 +127,46 @@ elements or else taking a reference to the same memory location
 repeatedly.  Here's the case where you just get the count instead
 of a nested array:
 
-    for $i (1..10) {
-       @array = somefunc($i);
-       $AoA[$i] = @array;      # WRONG!
+    my @AoA;
+    for my $i (1..10) {
+       my @array   = somefunc($i);
+          $AoA[$i] = @array;       # WRONG!
     }
 
 That's just the simple case of assigning an array to a scalar and getting
 its element count.  If that's what you really and truly want, then you
 might do well to consider being a tad more explicit about it, like this:
 
-    for $i (1..10) {
-       @array = somefunc($i);
-       $counts[$i] = scalar @array;
+    my @counts;
+    for my $i (1..10) {
+       my @array      = somefunc($i);
+          $counts[$i] = scalar @array;
     }
 
-Here's the case of taking a reference to the same memory location
-again and again:
+Here's the right way to do the reference C<@array>:
 
-    for $i (1..10) {
-       @array = somefunc($i);
-       $AoA[$i] = \@array;     # WRONG!
-    }
-
-So, what's the big problem with that?  It looks right, doesn't it?
-After all, I just told you that you need an array of references, so by
-golly, you've made me one!
-
-Unfortunately, while this is true, it's still broken.  All the references
-in @AoA refer to the I<very same place>, and they will therefore all hold
-whatever was last in @array!  It's similar to the problem demonstrated in
-the following C program:
-
-    #include <pwd.h>
-    main() {
-       struct passwd *getpwnam(), *rp, *dp;
-       rp = getpwnam("root");
-       dp = getpwnam("daemon");
-
-       printf("daemon name is %s\nroot name is %s\n",
-               dp->pw_name, rp->pw_name);
-    }
-
-Which will print
-
-    daemon name is daemon
-    root name is daemon
-
-The problem is that both C<rp> and C<dp> are pointers to the same location
-in memory!  In C, you'd have to remember to malloc() yourself some new
-memory.  In Perl, you'll want to use the array constructor C<[]> or the
-hash constructor C<{}> instead.   Here's the right way to do the preceding
-broken code fragments:
-
-    for $i (1..10) {
-       @array = somefunc($i);
-       $AoA[$i] = [ @array ];
+    my @AoA
+    for my $i (1..10) {
+       my @array   = somefunc($i);
+          $AoA[$i] = [ @array ];
     }
 
 The square brackets make a reference to a new array with a I<copy>
-of what's in @array at the time of the assignment.  This is what
-you want.
+of what's in C<@array>.
 
 Note that this will produce something similar, but it's
 much harder to read:
 
-    for $i (1..10) {
-       @array = 0 .. $i;
-       @{$AoA[$i]} = @array;
+    my @AoA;
+    for my $i (1..10) {
+       my @array        = somefunc($i);
+          @{ $AoA[$i] } = @array;
     }
 
 Is it the same?  Well, maybe so--and maybe not.  The subtle difference
 is that when you assign something in square brackets, you know for sure
 it's always a brand new reference with a new I<copy> of the data.
-Something else could be going on in this new case with the C<@{$AoA[$i]}}>
+Something else could be going on in this new case with the C<@{ $AoA[$i]} }>
 dereference on the left-hand-side of the assignment.  It all depends on
 whether C<$AoA[$i]> had been undefined to start with, or whether it
 already contained a reference.  If you had already populated @AoA with
@@ -206,7 +177,7 @@ references, as in
 Then the assignment with the indirection on the left-hand-side would
 use the existing reference that was already there:
 
-    @{$AoA[3]} = @array;
+    @{ $AoA[3] } = @array;
 
 Of course, this I<would> have the "interesting" effect of clobbering
 @another_array.  (Have you ever noticed how when a programmer says
@@ -221,9 +192,10 @@ efficient.
 Surprisingly, the following dangerous-looking construct will
 actually work out fine:
 
-    for $i (1..10) {
-        my @array = somefunc($i);
-        $AoA[$i] = \@array;
+    my @AoA;
+    for my $i (1..10) {
+        my @array   = somefunc($i);
+           $AoA[$i] = \@array;
     }
 
 That's because my() is more of a run-time statement than it is a
@@ -242,14 +214,14 @@ do the right thing behind the scenes.
 
 In summary:
 
-    $AoA[$i] = [ @array ];     # usually best
-    $AoA[$i] = \@array;                # perilous; just how my() was that array?
-    @{ $AoA[$i] } = @array;    # way too tricky for most programmers
+    $AoA[$i]      = [ @array ];        # usually best
+    $AoA[$i]      =  \@array;  # perilous; just how my() is that array?
+    @{ $AoA[$i] } =   @array;  # way too tricky for most programmers
 
 
 =head1 CAVEAT ON PRECEDENCE
 
-Speaking of things like C<@{$AoA[$i]}>, the following are actually the
+Speaking of things like C<@{ $AoA[$i] }>, the following are actually the
 same thing:
 
     $aref->[2][2]      # clear
@@ -284,9 +256,9 @@ also disallow accidental "symbolic dereferencing".  Therefore if you'd done
 this:
 
     my $aref = [
-       [ "fred", "barney", "pebbles", "bambam", "dino", ],
-       [ "homer", "bart", "marge", "maggie", ],
-       [ "george", "jane", "elroy", "judy", ],
+       [ 'fred',   'barney', 'pebbles', 'bambam', 'dino', ],
+       [ 'homer',  'bart',   'marge',   'maggie',         ],
+       [ 'george', 'jane',   'elroy',   'judy',           ],
     ];
 
     print $aref[2][2];
@@ -334,55 +306,60 @@ types of data structures.
 
 =head2 Declaration of a ARRAY OF ARRAYS
 
- @AoA = (
-        [ "fred", "barney" ],
-        [ "george", "jane", "elroy" ],
-        [ "homer", "marge", "bart" ],
my @AoA = (
+        [ 'fred',   'barney'         ],
+        [ 'george', 'jane',  'elroy' ],
+        [ 'homer',  'marge', 'bart'  ],
       );
 
 =head2 Generation of a ARRAY OF ARRAYS
 
  # reading from file
+ my @AoA;
  while ( <> ) {
      push @AoA, [ split ];
  }
 
  # calling a function
- for $i ( 1 .. 10 ) {
+ my @AoA;
+ foreach my $i ( 1 .. 10 ) {
      $AoA[$i] = [ somefunc($i) ];
  }
 
  # using temp vars
- for $i ( 1 .. 10 ) {
-     @tmp = somefunc($i);
-     $AoA[$i] = [ @tmp ];
+ my @AoA;
+ foreach my $i ( 1 .. 10 ) {
+     my @tmp     = somefunc($i);
+        $AoA[$i] = [ @tmp ];
  }
 
  # add to an existing row
- push @{ $AoA[0] }, "wilma", "betty";
+ push @{ $AoA[0] }, 'wilma', 'betty';
 
 =head2 Access and Printing of a ARRAY OF ARRAYS
 
+ my @AoA;
+
  # one element
- $AoA[0][0] = "Fred";
+ $AoA[0][0] = 'Fred';
 
  # another element
  $AoA[1][1] =~ s/(\w)/\u$1/;
 
  # print the whole thing with refs
- for $aref ( @AoA ) {
+ foreach my $aref ( @AoA ) {
      print "\t [ @$aref ],\n";
  }
 
  # print the whole thing with indices
- for $i ( 0 .. $#AoA ) {
-     print "\t [ @{$AoA[$i]} ],\n";
+ foreach my $i ( 0 .. $#AoA ) {
+     print "\t [ @{ $AoA[$i] } ],\n";
  }
 
  # print the whole thing one at a time
- for $i ( 0 .. $#AoA ) {
-     for $j ( 0 .. $#{ $AoA[$i] } ) {
-         print "elt $i $j is $AoA[$i][$j]\n";
+ foreach my $i ( 0 .. $#AoA ) {
+     foreach my $j ( 0 .. $#{ $AoA[$i] } ) {
+         print "element $i $j is $AoA[$i][$j]\n";
      }
  }
 
@@ -390,77 +367,86 @@ types of data structures.
 
 =head2 Declaration of a HASH OF ARRAYS
 
- %HoA = (
-        flintstones        => [ "fred", "barney" ],
-        jetsons            => [ "george", "jane", "elroy" ],
-        simpsons           => [ "homer", "marge", "bart" ],
my %HoA = (
+        flintstones => [ 'fred',   'barney'         ],
+        jetsons     => [ 'george', 'jane',  'elroy' ],
+        simpsons    => [ 'homer',  'marge', 'bart'  ],
       );
 
 =head2 Generation of a HASH OF ARRAYS
 
  # reading from file
  # flintstones: fred barney wilma dino
+ my %HoA;
  while ( <> ) {
-     next unless s/^(.*?):\s*//;
+     next unless s/^([^:]*):\s*//;
      $HoA{$1} = [ split ];
  }
 
  # reading from file; more temps
  # flintstones: fred barney wilma dino
- while ( $line = <> ) {
-     ($who, $rest) = split /:\s*/, $line, 2;
-     @fields = split ' ', $rest;
-     $HoA{$who} = [ @fields ];
+ my %HoA;
+ while ( my $line = <> ) {
+     my ($who, $rest) = split /:\s*/, $line, 2;
+     my @fields       = split ' ', $rest;
+        $HoA{$who}    = [ @fields ];
  }
 
  # calling a function that returns a list
- for $group ( "simpsons", "jetsons", "flintstones" ) {
+ my %HoA;
+ foreach my $group ( 'simpsons', 'jetsons', 'flintstones' ) {
      $HoA{$group} = [ get_family($group) ];
  }
 
  # likewise, but using temps
- for $group ( "simpsons", "jetsons", "flintstones" ) {
-     @members = get_family($group);
-     $HoA{$group} = [ @members ];
+ my %HoA;
+ foreach my $group ( 'simpsons', 'jetsons', 'flintstones' ) {
+     my @members     = get_family($group);
+        $HoA{$group} = [ @members ];
  }
 
  # append new members to an existing family
- push @{ $HoA{"flintstones"} }, "wilma", "betty";
+ push @{ $HoA{flintstones} }, 'wilma', 'betty';
 
 =head2 Access and Printing of a HASH OF ARRAYS
 
+ my %HoA;
+
  # one element
- $HoA{flintstones}[0] = "Fred";
+ $HoA{flintstones}[0] = 'Fred';
 
  # another element
  $HoA{simpsons}[1] =~ s/(\w)/\u$1/;
 
  # print the whole thing
- foreach $family ( keys %HoA ) {
-     print "$family: @{ $HoA{$family} }\n"
+ foreach my $family ( keys %HoA ) {
+     print "$family: @{ $HoA{$family} }\n";
  }
 
  # print the whole thing with indices
- foreach $family ( keys %HoA ) {
-     print "family: ";
-     foreach $i ( 0 .. $#{ $HoA{$family} } ) {
+ foreach my $family ( keys %HoA ) {
+     print 'family: ';
+     foreach my $i ( 0 .. $#{ $HoA{$family} } ) {
          print " $i = $HoA{$family}[$i]";
      }
      print "\n";
  }
 
  # print the whole thing sorted by number of members
- foreach $family ( sort { @{$HoA{$b}} <=> @{$HoA{$a}} } keys %HoA ) {
+ sub num_members {
+   @{ $HoA{$b} } <=> @{ $HoA{$a} }
+ }
+ foreach my $family ( sort num_members keys %HoA ) {
      print "$family: @{ $HoA{$family} }\n"
  }
 
  # print the whole thing sorted by number of members and name
foreach $family ( sort {
-                           @{$HoA{$b}} <=> @{$HoA{$a}}
-                                       ||
-                                   $a cmp $b
-           } keys %HoA )
- {
sub members_and_name {
+   @{ $HoA{$b} } <=> @{ $HoA{$a} }
+                ||
+             $a cmp $b
+ }
foreach my $family ( sort members_and_name keys %HoA ) {
      print "$family: ", join(", ", sort @{ $HoA{$family} }), "\n";
  }
 
@@ -468,20 +454,20 @@ types of data structures.
 
 =head2 Declaration of a ARRAY OF HASHES
 
- @AoH = (
my @AoH = (
         {
-            Lead     => "fred",
-            Friend   => "barney",
+            Lead     => 'fred',
+            Friend   => 'barney',
         },
         {
-            Lead     => "george",
-            Wife     => "jane",
-            Son      => "elroy",
+            Lead     => 'george',
+            Wife     => 'jane',
+            Son      => 'elroy',
         },
         {
-            Lead     => "homer",
-            Wife     => "marge",
-            Son      => "bart",
+            Lead     => 'homer',
+            Wife     => 'marge',
+            Son      => 'bart',
         }
   );
 
@@ -489,11 +475,12 @@ types of data structures.
 
  # reading from file
  # format: LEAD=fred FRIEND=barney
+ my @AoH;
  while ( <> ) {
-     $rec = {};
-     for $field ( split ) {
-         ($key, $value) = split /=/, $field;
-         $rec->{$key} = $value;
+     my $rec = {};
+     foreach my $field ( split ) {
+         my($key, $value) = split /=/, $field;
+         $rec->{$key}     = $value;
      }
      push @AoH, $rec;
  }
@@ -502,55 +489,60 @@ types of data structures.
  # reading from file
  # format: LEAD=fred FRIEND=barney
  # no temp
+ my @AoH;
  while ( <> ) {
      push @AoH, { split /[\s+=]/ };
  }
 
  # calling a function  that returns a key/value pair list, like
- # "lead","fred","daughter","pebbles"
- while ( %fields = getnextpairset() ) {
+ # lead => 'fred', daughter => 'pebbles'
+ my @AoH;
+ while ( my %fields = getnextpairset() ) {
      push @AoH, { %fields };
  }
 
  # likewise, but using no temp vars
+ my @AoH;
  while (<>) {
      push @AoH, { parsepairs($_) };
  }
 
  # add key/value to an element
- $AoH[0]{pet} = "dino";
+ $AoH[0]{pet} = 'dino';
  $AoH[2]{pet} = "santa's little helper";
 
 =head2 Access and Printing of a ARRAY OF HASHES
 
+ my @AoH;
+
  # one element
- $AoH[0]{lead} = "fred";
+ $AoH[0]{lead} = 'fred';
 
  # another element
  $AoH[1]{lead} =~ s/(\w)/\u$1/;
 
  # print the whole thing with refs
- for $href ( @AoH ) {
-     print "{ ";
-     for $role ( keys %$href ) {
-         print "$role=$href->{$role} ";
+ foreach my $href ( @AoH ) {
+     print '{ ';
+     foreach my $role ( keys %$href ) {
+         print "$role = $href->{$role} ";
      }
      print "}\n";
  }
 
  # print the whole thing with indices
- for $i ( 0 .. $#AoH ) {
+ foreach my $i ( 0 .. $#AoH ) {
      print "$i is { ";
-     for $role ( keys %{ $AoH[$i] } ) {
-         print "$role=$AoH[$i]{$role} ";
+     foreach my $role ( keys %{ $AoH[$i] } ) {
+         print "$role = $AoH[$i]{$role} ";
      }
      print "}\n";
  }
 
  # print the whole thing one at a time
- for $i ( 0 .. $#AoH ) {
-     for $role ( keys %{ $AoH[$i] } ) {
-         print "elt $i $role is $AoH[$i]{$role}\n";
+ foreach my $i ( 0 .. $#AoH ) {
+     foreach my $role ( keys %{ $AoH[$i] } ) {
+         print "element $i $role is $AoH[$i]{$role}\n";
      }
  }
 
@@ -558,20 +550,20 @@ types of data structures.
 
 =head2 Declaration of a HASH OF HASHES
 
- %HoH = (
my %HoH = (
         flintstones => {
-               lead      => "fred",
-               pal       => "barney",
+               lead      => 'fred',
+               pal       => 'barney',
         },
         jetsons     => {
-               lead      => "george",
-               wife      => "jane",
-               "his boy" => "elroy",
+               lead      => 'george',
+               wife      => 'jane',
+               'his boy' => 'elroy',
         },
         simpsons    => {
-               lead      => "homer",
-               wife      => "marge",
-               kid       => "bart",
+               lead      => 'homer',
+               wife      => 'marge',
+               kid       => 'bart',
        },
  );
 
@@ -579,94 +571,113 @@ types of data structures.
 
  # reading from file
  # flintstones: lead=fred pal=barney wife=wilma pet=dino
+ my %HoH;
  while ( <> ) {
-     next unless s/^(.*?):\s*//;
-     $who = $1;
-     for $field ( split ) {
-         ($key, $value) = split /=/, $field;
+     next unless s/^([^:]*):\s*//;
+     my $who = $1;
+     for my $field ( split ) {
+         my($key, $value) = split /=/, $field;
          $HoH{$who}{$key} = $value;
      }
 
 
  # reading from file; more temps
+ my %HoH;
  while ( <> ) {
-     next unless s/^(.*?):\s*//;
-     $who = $1;
-     $rec = {};
+     next unless s/^([^:]*):\s*//;
+     my $who = $1;
+     my $rec = {};
      $HoH{$who} = $rec;
-     for $field ( split ) {
-         ($key, $value) = split /=/, $field;
-         $rec->{$key} = $value;
+     foreach my $field ( split ) {
+         my($key, $value) = split /=/, $field;
+         $rec->{$key}     = $value;
      }
  }
 
  # calling a function  that returns a key,value hash
- for $group ( "simpsons", "jetsons", "flintstones" ) {
+ my %HoH;
+ foreach my $group ( 'simpsons', 'jetsons', 'flintstones' ) {
      $HoH{$group} = { get_family($group) };
  }
 
  # likewise, but using temps
- for $group ( "simpsons", "jetsons", "flintstones" ) {
-     %members = get_family($group);
+ my %HoH;
+ foreach my $group ( 'simpsons', 'jetsons', 'flintstones' ) {
+     my %members  = get_family($group);
      $HoH{$group} = { %members };
  }
 
  # append new members to an existing family
- %new_folks = (
-     wife => "wilma",
-     pet  => "dino",
+ my %HoH;
+ my %new_folks = (
+     wife => 'wilma',
+     pet  => 'dino',
  );
 
- for $what (keys %new_folks) {
+ foreach my $what (keys %new_folks) {
      $HoH{flintstones}{$what} = $new_folks{$what};
  }
 
 =head2 Access and Printing of a HASH OF HASHES
 
+ %HoH;
+
  # one element
- $HoH{flintstones}{wife} = "wilma";
+ $HoH{flintstones}{wife} = 'wilma';
 
  # another element
  $HoH{simpsons}{lead} =~ s/(\w)/\u$1/;
 
  # print the whole thing
- foreach $family ( keys %HoH ) {
+ foreach my $family ( keys %HoH ) {
      print "$family: { ";
-     for $role ( keys %{ $HoH{$family} } ) {
-         print "$role=$HoH{$family}{$role} ";
+     foreach my $role ( keys %{ $HoH{$family} } ) {
+         print "$role = $HoH{$family}{$role} ";
      }
      print "}\n";
  }
 
  # print the whole thing  somewhat sorted
- foreach $family ( sort keys %HoH ) {
+ foreach my $family ( sort keys %HoH ) {
      print "$family: { ";
-     for $role ( sort keys %{ $HoH{$family} } ) {
-         print "$role=$HoH{$family}{$role} ";
+     foreach my $role ( sort keys %{ $HoH{$family} } ) {
+         print "$role = $HoH{$family}{$role} ";
      }
      print "}\n";
  }
 
-
  # print the whole thing sorted by number of members
- foreach $family ( sort { keys %{$HoH{$b}} <=> keys %{$HoH{$a}} } keys %HoH ) {
+ sub num_members {
+   keys %{ $HoH{$b} }  <=>  keys %{ $HoH{$a} }
+ }
+ foreach my $family ( sort num_members keys %HoH ) {
      print "$family: { ";
-     for $role ( sort keys %{ $HoH{$family} } ) {
-         print "$role=$HoH{$family}{$role} ";
+     foreach my $role ( sort keys %{ $HoH{$family} } ) {
+         print "$role = $HoH{$family}{$role} ";
      }
      print "}\n";
  }
 
  # establish a sort order (rank) for each role
- $i = 0;
- for ( qw(lead wife son daughter pal pet) ) { $rank{$_} = ++$i }
+ my %rank;
+ my $i = 0;
+ foreach ( qw(lead wife son daughter pal pet) ) {
+   $rank{$_} = ++$i;
+ }
 
  # now print the whole thing sorted by number of members
- foreach $family ( sort { keys %{ $HoH{$b} } <=> keys %{ $HoH{$a} } } keys %HoH ) {
+ sub num_members {
+   keys %{ $HoH{$b} }  <=>  keys %{ $HoH{$a} }
+ }
+ sub rank {
+   $rank{$a} <=> $rank{$b}
+ }
+
+ foreach my $family ( sort num_members keys %HoH ) {
      print "$family: { ";
      # and print these according to rank order
-     for $role ( sort { $rank{$a} <=> $rank{$b} }  keys %{ $HoH{$family} } ) {
-         print "$role=$HoH{$family}{$role} ";
+     foreach my $role ( sort rank keys %{ $HoH{$family} } ) {
+         print "$role = $HoH{$family}{$role} ";
      }
      print "}\n";
  }
@@ -679,7 +690,7 @@ types of data structures.
 Here's a sample showing how to create and use a record whose fields are of
 many different sorts:
 
-     $rec = {
+     my $rec = {
         TEXT      => $string,
         SEQUENCE  => [ @old_values ],
         LOOKUP    => { %some_table },
@@ -690,14 +701,14 @@ many different sorts:
 
      print $rec->{TEXT};
 
-     print $rec->{SEQUENCE}[0];
-     $last = pop @ { $rec->{SEQUENCE} };
+     print $rec->{SEQUENCE}->[0];
+     my $last = pop @{ $rec->{SEQUENCE} };
 
-     print $rec->{LOOKUP}{"key"};
-     ($first_k, $first_v) = each %{ $rec->{LOOKUP} };
+     print $rec->{LOOKUP}->{key};
+     my($first_k, $first_v) = each %{ $rec->{LOOKUP} };
 
-     $answer = $rec->{THATCODE}->($arg);
-     $answer = $rec->{THISCODE}->($arg1, $arg2);
+     my $answer = $rec->{THATCODE}->($arg);
+     my $result = $rec->{THISCODE}->($arg1, $arg2);
 
      # careful of extra block braces on fh ref
      print { $rec->{HANDLE} } "a string\n";
@@ -708,55 +719,52 @@ many different sorts:
 
 =head2 Declaration of a HASH OF COMPLEX RECORDS
 
-     %TV = (
+     my %TV = (
         flintstones => {
-            series   => "flintstones",
+            series   => 'flintstones',
             nights   => [ qw(monday thursday friday) ],
             members  => [
-                { name => "fred",    role => "lead", age  => 36, },
-                { name => "wilma",   role => "wife", age  => 31, },
-                { name => "pebbles", role => "kid",  age  =>  4, },
+                { name => 'fred',    role => 'lead', age  => 36, },
+                { name => 'wilma',   role => 'wife', age  => 31, },
+                { name => 'pebbles', role => 'kid',  age  =>  4, },
             ],
         },
 
         jetsons     => {
-            series   => "jetsons",
+            series   => 'jetsons',
             nights   => [ qw(wednesday saturday) ],
             members  => [
-                { name => "george",  role => "lead", age  => 41, },
-                { name => "jane",    role => "wife", age  => 39, },
-                { name => "elroy",   role => "kid",  age  =>  9, },
+                { name => 'george",  role => 'lead', age  => 41, },
+                { name => 'jane",    role => 'wife', age  => 39, },
+                { name => 'elroy",   role => 'kid',  age  =>  9, },
             ],
          },
 
         simpsons    => {
-            series   => "simpsons",
+            series   => 'simpsons',
             nights   => [ qw(monday) ],
             members  => [
-                { name => "homer", role => "lead", age  => 34, },
-                { name => "marge", role => "wife", age => 37, },
-                { name => "bart",  role => "kid",  age  =>  11, },
+                { name => 'homer', role => 'lead', age => 34, },
+                { name => 'marge', role => 'wife', age => 37, },
+                { name => 'bart',  role => 'kid',  age => 11, },
             ],
          },
       );
 
 =head2 Generation of a HASH OF COMPLEX RECORDS
 
-     # reading from file
-     # this is most easily done by having the file itself be
-     # in the raw data format as shown above.  perl is happy
-     # to parse complex data structures if declared as data, so
-     # sometimes it's easiest to do that
+Here's a piece by piece build up of a hash of complex records.  We'll
+read in a file that has our data in it.
 
-     # here's a piece by piece build up
-     $rec = {};
-     $rec->{series} = "flintstones";
+     my %TV  = ();
+     my $rec = {};
+     $rec->{series} = 'flintstones';
      $rec->{nights} = [ find_days() ];
 
-     @members = ();
+     my @members = ();
      # assume this file in field=value syntax
-     while (<>) {
-         %fields = split /[\s=]+/;
+     while ( <> ) {
+         my %fields = split /[\s=]+/, $_;
          push @members, { %fields };
      }
      $rec->{members} = [ @members ];
@@ -764,19 +772,18 @@ many different sorts:
      # now remember the whole thing
      $TV{ $rec->{series} } = $rec;
 
-     ###########################################################
-     # now, you might want to make interesting extra fields that
-     # include pointers back into the same data structure so if
-     # change one piece, it changes everywhere, like for example
-     # if you wanted a {kids} field that was a reference
-     # to an array of the kids' records without having duplicate
-     # records and thus update problems.
-     ###########################################################
-     foreach $family (keys %TV) {
-         $rec = $TV{$family}; # temp pointer
-         @kids = ();
-         for $person ( @{ $rec->{members} } ) {
-             if ($person->{role} =~ /kid|son|daughter/) {
+Now, you might want to make interesting extra fields that
+include pointers back into the same data structure so if
+change one piece, it changes everywhere, like for example
+if you wanted a 'kids' field that was a reference
+to an array of the kids' records without having duplicate
+records and thus update problems.
+
+     foreach my $family ( keys %TV ) {
+         my $rec  = $TV{$family}; # $rec points to $TV{$family}
+         my @kids = ();
+         foreach my $person ( @{ $rec->{members} } ) {
+             if ( $person->{role} =~ /kid|son|daughter/ ) {
                  push @kids, $person;
              }
          }
@@ -784,30 +791,33 @@ many different sorts:
          $rec->{kids} = [ @kids ];
      }
 
-     # you copied the array, but the array itself contains pointers
-     # to uncopied objects. this means that if you make bart get
-     # older via
+You copied the array, but the array itself contains pointers
+to uncopied objects. This means that if you make bart get
+older via
 
      $TV{simpsons}{kids}[0]{age}++;
 
-     # then this would also change in
-     print $TV{simpsons}{members}[2]{age};
-
-     # because $TV{simpsons}{kids}[0] and $TV{simpsons}{members}[2]
-     # both point to the same underlying anonymous hash table
+Then this would also change in C<$TV{simpsons}{members}[2]{age}>
+because C<$TV{simpsons}{kids}[0]> and C<$TV{simpsons}{members}[2]>
+both point to the same underlying anonymous hash table.
 
      # print the whole thing
-     foreach $family ( keys %TV ) {
-         print "the $family";
-         print " is on during @{ $TV{$family}{nights} }\n";
-         print "its members are:\n";
-         for $who ( @{ $TV{$family}{members} } ) {
+     foreach my $family ( keys %TV ) {
+         print "the $family is on during @{ $TV{$family}{nights} }\n",
+               "its members are:\n";
+
+         foraech my $who ( @{ $TV{$family}{members} } ) {
              print " $who->{name} ($who->{role}), age $who->{age}\n";
          }
-         print "it turns out that $TV{$family}{lead} has ";
-         print scalar ( @{ $TV{$family}{kids} } ), " kids named ";
-         print join (", ", map { $_->{name} } @{ $TV{$family}{kids} } );
-         print "\n";
+
+         print "it turns out that $TV{$family}{lead} has ",
+               scalar ( @{ $TV{$family}{kids} } ),
+               ' kids named ',
+               join(
+                    ', ',
+                    map { $_->{name} } @{ $TV{$family}{kids} }
+                   ),
+               "\n";
      }
 
 =head1 Database Ties
@@ -828,5 +838,8 @@ perlref(1), perllol(1), perldata(1), perlobj(1)
 
 Tom Christiansen <F<tchrist@perl.com>>
 
-Last update:
+Last update (by Tom):
 Wed Oct 23 04:57:50 MET DST 1996
+
+Last update (by Casey West, <F<casey@geeknest.com>>
+Mon Sep 17 13:33:41 EDT 2001
index e4a50b0..8e94e22 100644 (file)
@@ -1572,7 +1572,7 @@ is used directly as Perl's exit status. (VMS)
 
 =item getsockopt SOCKET,LEVEL,OPTNAME
 
-Not implemented. (S<Mac OS>, Plan9)
+Not implemented. (Plan9)
 
 =item glob EXPR
 
@@ -1690,7 +1690,7 @@ Not implemented. (MPE/iX, Win32)
 
 =item setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL
 
-Not implemented. (S<Mac OS>, Plan9)
+Not implemented. (Plan9)
 
 =item shmctl ID,CMD,ARG
 
index 63ad011..f27173c 100644 (file)
@@ -169,9 +169,10 @@ character with the Unicode uppercase property, while C<\p{M}> matches
 any mark character.  Single letter properties may omit the brackets,
 so that can be written C<\pM> also.  Many predefined character classes
 are available, such as C<\p{IsMirrored}> and C<\p{InTibetan}>.  The
-names of the C<In> classes are the official Unicode script and block
-names but with all non-alphanumeric characters removed, for example
-the block name C<"Latin-1 Supplement"> becomes C<\p{InLatin1Supplement}>.
+recommended names of the C<In> classes are the official Unicode script
+and block names but with all non-alphanumeric characters removed, for
+example the block name C<"Latin-1 Supplement"> becomes
+C<\p{InLatin1Supplement}>.
 
 Here is the list as of Unicode 3.1.0 (the two-letter classes) and
 as defined by Perl (the one-letter classes) (in Unicode materials
index 2c7bde3..8b320bf 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1493,7 +1493,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 #endif
        PerlIO *serr = Perl_error_log;
 
-       PerlIO_write(serr, message, msglen);
+       PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
        (void)PerlIO_flush(serr);
 #ifdef USE_SFIO
        errno = e;
@@ -3323,10 +3323,14 @@ trylocal: {
        SETERRNO(0, SS$_NORMAL);
 
     /* Assume success here to prevent recursive requirement. */
-    (void)hv_store(GvHVn(PL_incgv), name, strlen(name),
-                  (hook_sv ? SvREFCNT_inc(hook_sv)
-                           : newSVpv(CopFILE(&PL_compiling), 0)),
-                  0 );
+    len = strlen(name);
+    /* Check whether a hook in @INC has already filled %INC */
+    if (!hook_sv || !(svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
+       (void)hv_store(GvHVn(PL_incgv), name, len,
+                      (hook_sv ? SvREFCNT_inc(hook_sv)
+                               : newSVpv(CopFILE(&PL_compiling), 0)),
+                      0 );
+    }
 
     ENTER;
     SAVETMPS;
diff --git a/proto.h b/proto.h
index 077bc92..9c1115c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -897,7 +897,8 @@ PERL_CALLCONV void  Perl_sv_setpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
 PERL_CALLCONV void     Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr);
 PERL_CALLCONV void     Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
 PERL_CALLCONV MGVTBL*  Perl_get_vtbl(pTHX_ int vtbl_id);
-PERL_CALLCONV char*    Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+PERL_CALLCONV char*    Perl_pv_display(pTHX_ SV *dsv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+PERL_CALLCONV char*    Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim);
 PERL_CALLCONV void     Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
 #ifdef CHECK_FORMAT
  __attribute__((format(printf,pTHX_3,pTHX_4)))
index d03443c..2d347b8 100644 (file)
@@ -44,8 +44,11 @@ currently only stores a pointer to the first interpreter.
 void
 Perl_sharedsv_init(pTHX)
 {
-    PL_sharedsv_space = PERL_GET_CONTEXT;
-    MUTEX_INIT(&PL_sharedsv_space_mutex);
+  PerlInterpreter* old_context = PERL_GET_CONTEXT;
+  PL_sharedsv_space = perl_alloc();
+  perl_construct(PL_sharedsv_space);
+  PERL_SET_CONTEXT(old_context);
+  MUTEX_INIT(&PL_sharedsv_space_mutex);
 }
 
 /*
diff --git a/sv.h b/sv.h
index 0b3aba2..7ca49a7 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -983,17 +983,11 @@ otherwise.
 #define sv_utf8_upgrade_macro(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC)
 
 /* function style also available for sourcecompat */
-#undef sv_setsv
 #define sv_setsv(dsv, ssv) sv_setsv_macro(dsv, ssv)
-#undef sv_catsv
 #define sv_catsv(dsv, ssv) sv_catsv_macro(dsv, ssv)
-#undef sv_catpvn
 #define sv_catpvn(dsv, sstr, slen) sv_catpvn_macro(dsv, sstr, slen)
-#undef sv_2pv
 #define sv_2pv(sv, lp) sv_2pv_macro(sv, lp)
-#undef sv_pvn_force
 #define sv_pvn_force(sv, lp) sv_pvn_force_macro(sv, lp)
-#undef sv_utf8_upgrade
 #define sv_utf8_upgrade(sv) sv_utf8_upgrade_macro(sv)
 
 #undef SvPV
index 0e4c404..fef40f9 100755 (executable)
@@ -97,3 +97,8 @@ sub X {
 X();
 EXPECT
 ok 1
+########
+package;
+print sub { return "ok 1\n" } -> ();
+EXPECT
+ok 1
index 23ac735..c668494 100644 (file)
@@ -8,25 +8,33 @@ BEGIN {
 }
 
 require "test.pl";
-plan(tests => 25);
+plan(tests => 31);
 
 my $IsVMS = $^O eq 'VMS';
 
+my ($saved_sys_login);
+BEGIN {
+    $saved_sys_login = $ENV{'SYS$LOGIN'} if $^O eq 'VMS'
+}
+END {
+    $ENV{'SYS$LOGIN'} = $saved_sys_login if $^O eq 'VMS';
+}
+
 # Might be a little early in the testing process to start using these,
 # but I can't think of a way to write this test without them.
 use File::Spec::Functions qw(:DEFAULT splitdir rel2abs);
 
 # Can't use Cwd::abs_path() because it has different ideas about
-# path seperators than File::Spec.
+# path separators than File::Spec.
 sub abs_path {
-    rel2abs(curdir);
+    $IsVMS ? uc(rel2abs(curdir)) : rel2abs(curdir);
 }
 
 my $Cwd = abs_path;
 
 # Let's get to a known position
 SKIP: {
-    skip("Already in t/", 2) if (splitdir(abs_path))[-1] eq 't';
+    skip("Already in t/", 2) if (splitdir(abs_path))[-1] eq ($IsVMS ? 'T' : 't');
 
     ok( chdir('t'),     'chdir("t")');
     is( abs_path, catdir($Cwd, 't'),       '  abs_path() agrees' );
@@ -44,7 +52,7 @@ sub check_env {
     if( $key eq 'SYS$LOGIN' && !$IsVMS ) {
         ok( !chdir(),         "chdir() on $^O ignores only \$ENV{$key} set" );
         is( abs_path, $Cwd,   '  abs_path() did not change' );
-        pass( "  no need to chdir back on $^O" );
+        pass( "  no need to test SYS\$LOGIN on $^O" ) for 1..7;
     }
     else {
         ok( chdir(),              "chdir() w/ only \$ENV{$key} set" );
@@ -80,18 +88,26 @@ WARNING
     }
 }
 
+sub clean_env {
+    delete $ENV{$_} foreach @magic_envs;
+    # The following means we won't really be testing for non-existence,
+    # but in Perl we can only delete from the process table, not the job 
+    # table.
+    $ENV{'SYS$LOGIN'} = '' if $IsVMS;
+}
+
 foreach my $key (@magic_envs) {
     # We're going to be using undefs a lot here.
     no warnings 'uninitialized';
 
-    local %ENV = ();
-    $ENV{$key} = catdir $Cwd, 'op';
+    clean_env;
+    $ENV{$key} = catdir $Cwd, ($IsVMS ? 'OP' : 'op');
     
     check_env($key);
 }
 
 {
-    local %ENV = ();
+    clean_env;
 
     ok( !chdir(),                   'chdir() w/o any ENV set' );
     is( abs_path, $Cwd,             '  abs_path() agrees' );
index ae1b1d9..bbccd8e 100755 (executable)
@@ -37,21 +37,26 @@ sub skip {
 
 print "1..41\n";
 
-
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_NetWare = $^O eq 'NetWare';
 $Is_VMS     = $^O eq 'VMS';
-$Is_Dos   = $^O eq 'dos';
-$Is_os2   = $^O eq 'os2';
-$Is_Cygwin   = $^O eq 'cygwin';
+$Is_Dos     = $^O eq 'dos';
+$Is_os2     = $^O eq 'os2';
+$Is_Cygwin  = $^O eq 'cygwin';
+$Is_MacOS   = $^O eq 'MacOS';
 $Is_MPE     = $^O eq 'mpeix';          
-$PERL = ($Is_MSWin32 ? '.\perl' : ($Is_NetWare ? 'perl' : './perl'));
+
+$PERL = ($Is_NetWare ? 'perl'   :
+        $Is_MacOS   ? $^X      :
+        $Is_MSWin32 ? '.\perl' :
+        './perl');
 
 eval '$ENV{"FOO"} = "hi there";';      # check that ENV is inited inside eval
 # cmd.exe will echo 'variable=value' but 4nt will echo just the value
 # -- Nikola Knezevic
-if ($Is_MSWin32) { ok `set FOO` =~ /^(FOO=)?hi there$/; }
-else             { ok `echo \$FOO` eq "hi there\n"; }
+if ($Is_MSWin32)  { ok `set FOO` =~ /^(FOO=)?hi there$/; }
+elsif ($Is_MacOS) { ok "1 # skipped", 1; }
+else              { ok `echo \$FOO` eq "hi there\n"; }
 
 unlink 'ajslkdfpqjsjfk';
 $! = 0;
@@ -59,7 +64,7 @@ open(FOO,'ajslkdfpqjsjfk');
 ok $!, $!;
 close FOO; # just mention it, squelch used-only-once
 
-if ($Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE) {
+if ($Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS) {
     skip() for 1..2;
 }
 else {
@@ -142,10 +147,13 @@ ok $$ > 0, $$;
     elsif($Is_os2) {
        $wd = Cwd::sys_cwd();
     }
+    elsif($Is_MacOS) {
+       $wd = ':';
+    }
     else {
        $wd = '.';
     }
-    my $perl = "$wd/perl";
+    my $perl = $Is_MacOS ? $^X : "$wd/perl";
     my $headmaybe = '';
     my $tailmaybe = '';
     $script = "$wd/show-shebang";
@@ -170,6 +178,12 @@ EOT
     elsif ($Is_os2) {
       $script = "./show-shebang";
     }
+    elsif ($Is_MacOS) {
+      $script = ":show-shebang";
+    }
+    elsif ($Is_MacOS) {
+      $script = ":show-shebang";
+    }
     if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'vmesa') {  # no shebang
        $headmaybe = <<EOH ;
     eval 'exec ./perl -S \$0 \${1+"\$\@"}'
@@ -185,7 +199,7 @@ print "\$^X is $^X, \$0 is $0\n";
 EOF
     ok close(SCRIPT), $!;
     ok chmod(0755, $script), $!;
-    $_ = `$script`;
+    $_ = $Is_MacOS ? `$perl $script` : `$script`;
     s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2;
     s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
     s{is perl}{is $perl}; # for systems where $^X is only a basename
@@ -203,7 +217,7 @@ ok $] >= 5.00319, $];
 ok $^O;
 ok $^T > 850000000, $^T;
 
-if ($Is_VMS || $Is_Dos) {
+if ($Is_VMS || $Is_Dos || $Is_MacOS) {
     skip() for 1..2;
 }
 else {
index 2042f39..f5a2edd 100755 (executable)
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..715\n";
+print "1..716\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -2121,9 +2121,13 @@ sub ok ($$) {
 }
 
 {
-  # high bit bug -- japhy
-  my $x = "ab\200d";
-  $x =~ /.*?\200/ or print "not ";
-  print "ok 715\n";
+    # high bit bug -- japhy
+    my $x = "ab\200d";
+    $x =~ /.*?\200/ or print "not ";
+    print "ok 715\n";
 }
 
+{
+    print "not " unless "\x80" =~ /\p{in-latin1_SUPPLEMENT}/;
+    print "ok 716\n";
+}
index 1364801..03e253e 100755 (executable)
@@ -33,12 +33,14 @@ for (@prgs){
     print TEST "$prog\n";
     close TEST;
     my $results = $Is_VMS ?
-                  `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` :
-                     $Is_MSWin32 ?  
-                         `.\\perl -I../lib $switch $tmpfile 2>&1` :
-                     $Is_NetWare ?  
-                         `perl -I../lib $switch $tmpfile 2>&1` :
-                             `./perl $switch $tmpfile 2>&1`;
+                      `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` :
+                 $Is_MSWin32 ?  
+                     `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                 $Is_NetWare ?  
+                     `perl -I../lib $switch $tmpfile 2>&1` :
+                 $Is_MacOS ?
+                     `$^X -I::lib -MMac::err=unix $switch $tmpfile` :
+                 `./perl $switch $tmpfile 2>&1`;
     my $status = $?;
     $results =~ s/\n+$//;
     # allow expected output to be written as if $prog is on STDIN
@@ -309,6 +311,7 @@ $SIG{__DIE__} = sub {
 eval { die };
 &{sub { eval 'die' }}();
 sub foo { eval { die } } foo();
+{package rmb; sub{ eval{die} } ->() }; # check __ANON__ is global      
 EXPECT
 In DIE
 main|-|8|(eval)
@@ -318,6 +321,9 @@ main|-|9|main::__ANON__
 In DIE
 main|-|10|(eval)
 main|-|10|main::foo
+In DIE
+rmb|-|11|(eval)
+rmb|-|11|main::__ANON__
 ########
 package TEST;
  
index 592bb2a..8ae8202 100755 (executable)
@@ -109,7 +109,7 @@ print PROG 'print "@ARGV\n"', "\n";
 close PROG;
 my $echo = "$Invoke_Perl $ECHO";
 
-print "1..175\n";
+print "1..176\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -121,7 +121,7 @@ print "1..175\n";
     delete @ENV{@MoreEnv};
     $ENV{TERM} = 'dumb';
 
-    if ($Is_Cygwin) {
+    if ($Is_Cygwin && ! -f 'cygwin1.dll') {
        system("/usr/bin/cp /usr/bin/cygwin1.dll .") &&
            die "$0: failed to cp cygwin1.dll: $!\n";
        END { unlink "cygwin1.dll" } # yes, done for all platforms...
@@ -870,5 +870,18 @@ else {
 
 }
 
+{
+    # Check that all environment variables are tainted.
+    my @untainted;
+    while (my ($k, $v) = each %ENV) {
+       if (!tainted($v) &&
+           # These we have untainted explicitly earlier.
+           $k !~ /^(BASH_ENV|CDPATH|ENV|IFS|PATH|TEMP|TERM|TMP)$/) {
+           push @untainted, "# '$k' = '$v'\n";
+       }
+    }
+    print @untainted == 0 ? "ok 176\n" : "not ok 176\n";
+    print "# untainted:\n", @untainted if @untainted; 
+}
 
 
index 735350f..4d99f82 100644 (file)
@@ -47,8 +47,10 @@ if ($^O eq 'VMS') { # clean up directory spec
     $INSTDIR =~ s#/$##;
     $INSTDIR =~ s#/000000/#/#;
 }
+# cut 't/pod' from path (cut 't:pod:' on Mac OS)
 $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod');
 $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't');
+
 my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'),
                    catfile($INSTDIR, 'scripts'),
                    catfile($INSTDIR, 'pod'),
index 9dcd59d..1d09d4e 100644 (file)
@@ -75,6 +75,9 @@ foreach my $prog (@prgs) {
     elsif ($^O eq 'NetWare') {
         $results = `perl -I../lib $switch $tmpfile 2>&1`;
     }
+    elsif ($^O eq 'MacOS') {
+       $results = `$^X -I::lib -MMac::err=unix $switch $tmpfile`;
+    }
     else {
       $results = `./perl -I../lib $switch $tmpfile 2>&1`;
     }
index c7c9908..029d80f 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -110,7 +110,8 @@ sub fail {
 # Note: can't pass multipart messages since we try to
 # be compatible with Test::More::skip().
 sub skip {
-    my ($mess, $n) = @_;
+    my $mess = shift;
+    my $n    = @_ ? shift : 1;
     for (1..$n) {
        ok(1, "# skip:", $mess);
     }
diff --git a/util.c b/util.c
index e1bf571..29935d2 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1234,7 +1234,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
 #endif
        PerlIO *serr = Perl_error_log;
 
-       PerlIO_write(serr, message, msglen);
+       PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
        (void)PerlIO_flush(serr);
 #ifdef USE_SFIO
        errno = e;
@@ -1327,7 +1327,7 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args)
     {
        PerlIO *serr = Perl_error_log;
 
-       PerlIO_write(serr, message, msglen);
+       PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
 #ifdef LEAKTEST
        DEBUG_L(*message == '!'
                ? (xstat(message[1]=='!'
@@ -1442,7 +1442,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
         }
        {
            PerlIO *serr = Perl_error_log;
-           PerlIO_write(serr, message, msglen);
+           PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
            (void)PerlIO_flush(serr);
        }
         my_failure_exit();
@@ -1479,7 +1479,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
         }
        {
            PerlIO *serr = Perl_error_log;
-           PerlIO_write(serr, message, msglen);
+           PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
 #ifdef LEAKTEST
            DEBUG_L(*message == '!'
                ? (xstat(message[1]=='!'
index