This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
authorNick Ing-Simmons <nik@tiuk.ti.com>
Mon, 24 Sep 2001 19:18:17 +0000 (19:18 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Mon, 24 Sep 2001 19:18:17 +0000 (19:18 +0000)
p4raw-id: //depot/perlio@12186

33 files changed:
Changes
Configure
MANIFEST
djgpp/djgppsed.sh
dosish.h
ext/Encode/Encode/gb2312.enc
ext/I18N/Langinfo/Langinfo.xs
ext/I18N/Langinfo/Makefile.PL
ext/I18N/Langinfo/fallback.c [new file with mode: 0644]
ext/I18N/Langinfo/fallback.xs [new file with mode: 0644]
ext/Time/HiRes/HiRes.xs
ext/threads/Makefile.PL
ext/threads/threads.xs
lib/Cwd.pm
lib/ExtUtils/Command.t
lib/ExtUtils/Constant.pm
lib/ExtUtils/Manifest.pm
lib/ExtUtils/Manifest.t
lib/filetest.t [new file with mode: 0644]
lib/h2xs.t
makedef.pl
patchlevel.h
pod/perlfunc.pod
pod/perlvar.pod
pp_ctl.c
pp_pack.c
t/lib/1_compile.t
t/op/inccode.t
t/op/magic.t
t/op/pack.t
t/op/study.t
utils/h2xs.PL
vms/test.com

diff --git a/Changes b/Changes
index ea6d15e..811cfab 100644 (file)
--- a/Changes
+++ b/Changes
@@ -31,6 +31,532 @@ or any other branch.
 Version v5.7.2         Development release working toward v5.8
 --------------
 ____________________________________________________________________________
+[ 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>
+             Date: Mon, 24 Sep 2001 11:12:13 -0400
+             Message-ID: <20010924111213.G27885@blackrider>
+     Branch: perl
+          ! lib/ExtUtils/Manifest.pm
+____________________________________________________________________________
+[ 12177] By: jhi                                   on 2001/09/24  14:02:32
+        Log: Subject: [PATCH vms/test.com] Fixing inline TODO recognition
+             From: Michael G Schwern <schwern@pobox.com> 
+             Date: Mon, 24 Sep 2001 11:02:07 -0400
+             Message-ID: <20010924110207.E27885@blackrider>
+     Branch: perl
+          ! vms/test.com
+____________________________________________________________________________
+[ 12176] By: ams                                   on 2001/09/24  14:01:59
+        Log: Update Changes.
+     Branch: perl
+          ! Changes
+____________________________________________________________________________
+[ 12175] By: jhi                                   on 2001/09/24  13:20:28
+        Log: Various cleanups.
+     Branch: perl
+          ! ext/threads/Makefile.PL ext/threads/threads.xs
+____________________________________________________________________________
+[ 12173] By: pudge                                 on 2001/09/24  12:56:13
+        Log: Integrate maint-5.6/perl changes 12024, 12026, 12145, 12146.
+     Branch: maint-5.6/macperl
+         !> (integrate 33 files)
+____________________________________________________________________________
+[ 12171] By: jhi                                   on 2001/09/24  12:26:58
+        Log: Subject: [PATCH gb2312.enc] (Re: [PATCH perl@12088] 2022-cn.enc of Encode.pm)
+             From: SADAHIRO Tomoyuki <BQW10602@nifty.com>
+             Date: Mon, 24 Sep 2001 20:04:58 +0900
+             Message-Id: <20010924200207.A030.BQW10602@nifty.com>         
+     Branch: perl
+          ! ext/Encode/Encode/gb2312.enc
+____________________________________________________________________________
+[ 12170] By: jhi                                   on 2001/09/24  12:08:30
+        Log: Clarifying comment to #12164.
+     Branch: perl
+          ! lib/Cwd.pm
+____________________________________________________________________________
+[ 12169] By: jhi                                   on 2001/09/24  11:59:33
+        Log: Subject: [PATCH] Re: What sort of Makefile.PL should h2xs write?
+             From: Nicholas Clark <nick@ccl4.org>
+             Date: Sun, 23 Sep 2001 23:00:56 +0100
+             Message-ID: <20010923230055.Y4971@plum.flirble.org>
+             
+             (with "sample_constants" changed to "fallback")
+     Branch: perl
+          + ext/I18N/Langinfo/fallback.c ext/I18N/Langinfo/fallback.xs
+          ! MANIFEST ext/I18N/Langinfo/Langinfo.xs
+          ! ext/I18N/Langinfo/Makefile.PL lib/ExtUtils/Constant.pm
+          ! lib/h2xs.t utils/h2xs.PL
+____________________________________________________________________________
+[ 12168] By: jhi                                   on 2001/09/24  11:25:56
+        Log: Metaconfig unit change for #12167.
+     Branch: metaconfig
+          ! U/modified/Cppsym.U
+____________________________________________________________________________
+[ 12167] By: jhi                                   on 2001/09/24  11:25:22
+        Log: Add a few glibc cpp symbols to probe for.
+     Branch: perl
+          ! Configure
+____________________________________________________________________________
+[ 12166] By: jhi                                   on 2001/09/24  11:14:43
+        Log: DJGPP tweaks for Laszlo Molnar.
+     Branch: perl
+          ! djgpp/djgppsed.sh dosish.h
+____________________________________________________________________________
+[ 12165] By: ams                                   on 2001/09/24  10:07:08
+        Log: Subject: [PATCH t/op/inccode.t] More tests
+             From: rgarciasuarez@free.fr (Rafael Garcia-Suarez)
+             Date: 24 Sep 2001 10:01:44 -0000
+             Message-Id: <slrn9qu158.l2t.rgarciasuarez@rafael.kazibao.net>
+     Branch: perl
+          ! t/op/inccode.t
+____________________________________________________________________________
+[ 12164] By: ams                                   on 2001/09/24  09:43:29
+        Log: Subject: [PATCH Cwd.pm] local $/ = "\n";
+             From: Jeff 'japhy/Marillion' Pinyan <jeffp@crusoe.net>
+             Date: Mon, 24 Sep 2001 00:22:32 -0400 (EDT)
+             Message-Id: <Pine.GSO.4.21.0109240021410.9178-100000@crusoe.crusoe.net>
+     Branch: perl
+          ! lib/Cwd.pm
+____________________________________________________________________________
+[ 12163] By: jhi                                   on 2001/09/23  22:50:35
+        Log: 1_compile updates.
+     Branch: perl
+          ! t/lib/1_compile.t
+____________________________________________________________________________
+[ 12162] By: jhi                                   on 2001/09/23  21:11:22
+        Log: Subject: [PATCH] proposal : put the @INC-hooks directly in %INC
+             From: Rafael Garcia-Suarez <rgarciasuarez@free.fr>
+             Date: Wed, 19 Sep 2001 22:47:14 +0200
+             Message-ID: <20010919224714.A6382@rafael>
+     Branch: perl
+          ! pod/perlvar.pod pp_ctl.c
+____________________________________________________________________________
+[ 12161] By: ams                                   on 2001/09/23  17:40:02
+        Log: Subject: [PATCH MANIFEST lib/filetest t/lib/1_compile.t] Add Tests for
+             filetest Pragma
+             From: "chromatic" <chromatic@rmci.net>
+             Date: Sun, 23 Sep 2001 12:07:25 -0600
+             Message-Id: <20010923181223.32427.qmail@onion.perl.org>
+     Branch: perl
+          + lib/filetest.t
+          ! MANIFEST t/lib/1_compile.t
+____________________________________________________________________________
+[ 12160] By: ams                                   on 2001/09/23  16:32:11
+        Log: Additional minor chdir() tweak.
+     Branch: perl
+          ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 12159] By: ams                                   on 2001/09/23  16:25:01
+        Log: Subject: PATCH lib/ExtUtils/Command.t
+             From: Abe Timmerman <abe@ztreet.demon.nl>
+             Date: Sun, 23 Sep 2001 19:11:44 +0200
+             Message-Id: <b94sqtk7sidi2501apjssfubdc2ulmap38@4ax.com>
+     Branch: perl
+          ! lib/ExtUtils/Command.t
+____________________________________________________________________________
+[ 12158] By: jhi                                   on 2001/09/23  12:52:36
+        Log: Subject: [PATCH] Win32 compilation without USE_ITHREADS
+             From: "Mattia Barbon" <mbarbon@dsi.unive.it>
+             Date: Sun, 23 Sep 2001 02:02:26 +0200
+             Message-ID: <3BAD42B2.2951.39B2E2A@localhost>
+     Branch: perl
+          ! makedef.pl
+____________________________________________________________________________
+[ 12157] By: jhi                                   on 2001/09/23  12:46:05
+        Log: Subject: [PATCH t/op/study.t] Cleanup & OS/390 "fix"
+             From: Michael G Schwern <schwern@pobox.com> (by way of Craig A. Berry)         
+             Date: Sat, 22 Sep 2001 12:54:39 -0500
+             Message-Id: <a05101003b7d27f77cfa1@[172.16.52.1]>
+     Branch: perl
+          ! t/op/study.t
+____________________________________________________________________________
+[ 12156] By: nick                                  on 2001/09/23  07:48:44
+        Log: Integrate mainline
+     Branch: perlio
+          - check83.pl
+         !> ext/Encode/Encode/2022-cn.enc
+____________________________________________________________________________
+[ 12155] By: nick                                  on 2001/09/23  07:48:01
+        Log: Integrate mainline
+     Branch: perlio
+         +> (branch 64 files)
+          - ext/Encode/Encode/cns11643-1.enc
+          - ext/Encode/Encode/cns11643-2.enc
+          - ext/Encode/Encode/iso2022-cn.enc
+          - ext/Encode/Encode/iso2022-jp.enc
+          - ext/Encode/Encode/iso2022-jp1.enc
+          - ext/Encode/Encode/iso2022-jp2.enc
+          - ext/Encode/Encode/iso2022-kr.enc ext/Encode/Encode/iso2022.enc
+          - ext/Encode/Encode/iso8859-1.enc
+          - ext/Encode/Encode/iso8859-1.ucm
+          - ext/Encode/Encode/iso8859-10.enc
+          - ext/Encode/Encode/iso8859-10.ucm
+          - ext/Encode/Encode/iso8859-13.enc
+          - ext/Encode/Encode/iso8859-13.ucm
+          - ext/Encode/Encode/iso8859-14.enc
+          - ext/Encode/Encode/iso8859-14.ucm
+          - ext/Encode/Encode/iso8859-15.enc
+          - ext/Encode/Encode/iso8859-15.ucm
+          - ext/Encode/Encode/iso8859-16.enc
+          - ext/Encode/Encode/iso8859-16.ucm
+          - ext/Encode/Encode/iso8859-2.enc
+          - ext/Encode/Encode/iso8859-2.ucm
+          - ext/Encode/Encode/iso8859-3.enc
+          - ext/Encode/Encode/iso8859-3.ucm
+          - ext/Encode/Encode/iso8859-4.enc
+          - ext/Encode/Encode/iso8859-4.ucm
+          - ext/Encode/Encode/iso8859-5.enc
+          - ext/Encode/Encode/iso8859-5.ucm
+          - ext/Encode/Encode/iso8859-6.enc
+          - ext/Encode/Encode/iso8859-6.ucm
+          - ext/Encode/Encode/iso8859-7.enc
+          - ext/Encode/Encode/iso8859-7.ucm
+          - ext/Encode/Encode/iso8859-8.enc
+          - ext/Encode/Encode/iso8859-8.ucm
+          - ext/Encode/Encode/iso8859-9.enc
+          - ext/Encode/Encode/iso8859-9.ucm
+          - ext/Encode/Encode/isoir-197.enc
+          - ext/Encode/Encode/macRomania.enc pod/perltootc.pod
+          - t/lib/sample-tests/header_at_end
+          - t/lib/sample-tests/header_at_end_fail
+         !> (integrate 174 files)
+____________________________________________________________________________
+[ 12154] By: ams                                   on 2001/09/23  07:11:46
+        Log: Mention $ENV{SYS$LOGIN} in chdir() documentation, as suggested
+             by Blair Zajac.
+     Branch: perl
+          ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 12153] By: ams                                   on 2001/09/23  06:56:32
+        Log: Subject: [PATCH pp.c t/op/gv.t pod/perlref.pod pod/perldiag.pod] Re:
+             Forgotten deprecation of *glob{FILEHANDLE}?
+             From: "chromatic" <chromatic@rmci.net>
+             Date: Sat, 22 Sep 2001 21:27:56 -0600
+             Message-Id: <20010923033252.33085.qmail@onion.perl.org>
+     Branch: perl
+          ! pod/perldiag.pod pod/perlref.pod pp.c t/op/gv.t
+____________________________________________________________________________
+[ 12152] By: ams                                   on 2001/09/23  06:42:58
+        Log: Subject: [PATCH lib/File/Find.pm] Fixing lib/File/Find/t/taint.t on VMS
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Sun, 23 Sep 2001 03:34:39 -0400
+             Message-Id: <20010923033439.E7005@blackrider>
+     Branch: perl
+          ! lib/File/Find.pm
+____________________________________________________________________________
+[ 12151] By: ams                                   on 2001/09/23  06:37:57
+        Log: Subject: Re: t/op/magic.t missing tests on Win32
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Sat, 22 Sep 2001 20:29:09 -0400
+             Message-Id: <20010922202909.I18223@blackrider>
+     Branch: perl
+          ! t/op/magic.t
+____________________________________________________________________________
+[ 12150] By: ams                                   on 2001/09/23  06:36:26
+        Log: Subject: [PATCH MANIFEST lib/Dumpvalue.t lib/Dumpvalue.pm] Add tests for
+             Dumpvalue.pm
+             From: "chromatic" <chromatic@rmci.net>
+             Date: Sat, 22 Sep 2001 19:41:31 -0600
+             Message-Id: <20010923014628.7739.qmail@onion.perl.org>
+     Branch: perl
+          + lib/Dumpvalue.t
+          ! MANIFEST lib/Dumpvalue.pm
+____________________________________________________________________________
+[ 12149] By: ams                                   on 2001/09/23  06:25:35
+        Log: Subject: [PATCH perl@12088] 2022-cn.enc of Encode.pm
+             From: SADAHIRO Tomoyuki <BQW10602@nifty.com>
+             Date: Sun, 23 Sep 2001 15:27:56 +0900
+             Message-Id: <20010923152641.5E26.BQW10602@nifty.com>
+     Branch: perl
+          ! ext/Encode/Encode/2022-cn.enc
+____________________________________________________________________________
+[ 12148] By: jhi                                   on 2001/09/22  23:33:42
+        Log: Manual eror in #12147.
+     Branch: perl
+          ! win32/win32.c
+____________________________________________________________________________
+[ 12147] By: jhi                                   on 2001/09/22  23:25:02
+        Log: Integrate change #12146 from maintperl;
+             win32_chdir() et al don't handle a NULL argument gracefully
+     Branch: perl
+         !> win32/perlhost.h win32/win32.c
+____________________________________________________________________________
+[ 12146] By: gsar                                  on 2001/09/22  23:18:47
+        Log: win32_chdir() et al don't handle a NULL argument gracefully
+     Branch: maint-5.6/perl
+          ! win32/perlhost.h win32/win32.c
+____________________________________________________________________________
+[ 12145] By: gsar                                  on 2001/09/22  23:17:42
+        Log: typo in change#12026
+     Branch: maint-5.6/perl
+          ! op.c
+____________________________________________________________________________
+[ 12144] By: jhi                                   on 2001/09/22  21:22:28
+        Log: Subject: [PATCH] Re: scalar context unpack bugs
+             From: Nicholas Clark <nick@ccl4.org>
+             Date: Sat, 22 Sep 2001 23:07:56 +0100
+             Message-ID: <20010922230755.O4971@plum.flirble.org>
+     Branch: perl
+          ! pp_pack.c t/op/pack.t
+____________________________________________________________________________
+[ 12143] By: jhi                                   on 2001/09/22  21:18:43
+        Log: Try ExtUtils::Command.t everywhere, not just on Win32
+             (as suggested by NI-S).  Also allow running it either
+             in t/ or in the main directory.
+     Branch: perl
+          ! lib/ExtUtils/Command.t
+____________________________________________________________________________
+[ 12142] By: jhi                                   on 2001/09/22  21:04:39
+        Log: Update the test on warnings/register.t.
+     Branch: perl
+          ! t/lib/1_compile.t
+____________________________________________________________________________
+[ 12141] By: jhi                                   on 2001/09/22  20:40:06
+        Log: The code is now almost tidy enough to keep the IRIX cc happy.
+     Branch: perl
+          ! hints/irix_6.sh
+____________________________________________________________________________
+[ 12140] By: ams                                   on 2001/09/22  17:26:32
+        Log: Subject: [PATCH perl@12088] configure.com: don't build 'threads" w/out
+             use_ithreads
+             From: "Craig A. Berry" <craigberry@mac.com>
+             Date: Sat, 22 Sep 2001 13:15:32 -0500
+             Message-Id: <a05101005b7d284f5192c@[172.16.52.1]>
+     Branch: perl
+          ! configure.com
+____________________________________________________________________________
+[ 12139] By: ams                                   on 2001/09/22  16:44:08
+        Log: Do what perl_clone() does for sharedsv functions.
+     Branch: perl
+          ! embed.pl proto.h
+____________________________________________________________________________
+[ 12138] By: jhi                                   on 2001/09/22  16:42:04
+        Log: Retract #12134; reintroduce #11949: PADOFFSETs are now UVs
+             (suggested by Sarathy, extensions shouldn't be dabbling with
+             op structures, so binary backward compatibility should not be
+             an issue.)
+     Branch: perl
+          ! hints/irix_6.sh op.h
+____________________________________________________________________________
+[ 12137] By: ams                                   on 2001/09/22  16:21:05
+        Log: More cleanups. (What's PERL_DECL_PROT?)
+     Branch: perl
+          ! embed.pl proto.h sharedsv.h
+____________________________________________________________________________
+[ 12136] By: ams                                   on 2001/09/22  15:14:34
+        Log: Subject: [PATCH MANIFEST lib/warnings/register.t lib/warnings/register.pm]
+             Add Tests for warnings::register, Doc Update
+             From: "chromatic" <chromatic@rmci.net>
+             Date: Sat, 22 Sep 2001 09:43:20 -0600
+             Message-Id: <20010922154815.32004.qmail@onion.perl.org>
+     Branch: perl
+          + lib/warnings/register.t
+          ! MANIFEST lib/warnings/register.pm
+____________________________________________________________________________
+[ 12135] By: ams                                   on 2001/09/22  15:07:50
+        Log: `@foo' should be @foo for consistency.
+     Branch: perl
+          ! pod/perldiag.pod
+____________________________________________________________________________
+[ 12134] By: jhi                                   on 2001/09/22  14:20:47
+        Log: (Retracted by #12138)
+             
+             Add -woff (turn warning off) 3187:
+             "A pointer is converted to a smaller integer."
+             This happens when your pointers are 64-bit: then every case
+             of converting pointers to PADOFFSETs (explicitly 32-bit)
+             faces truncation (even explicit use of INT2PTR doesn't help).
+             CxITERVAR(), POPLOOP(), and PUSHLOOP() are afflicted.
+             Changing PADOFFSET from U32 to UV would help, but that
+             would break binary backward compatibility of BASEOP and padop
+             (assuming you have been using 64-bit pointers).
+     Branch: perl
+          ! hints/irix_6.sh
+____________________________________________________________________________
+[ 12133] By: jhi                                   on 2001/09/22  13:53:49
+        Log: More 8.3-cleanup: there isn't an encoding called macRumanian,
+             but the name comes from the inside the file, not from the file
+             name, and Rumanian is the name of the language.
+     Branch: perl
+          + ext/Encode/Encode/macRumanian.enc
+          - ext/Encode/Encode/macRomania.enc
+          ! MANIFEST
+____________________________________________________________________________
+[ 12132] By: jhi                                   on 2001/09/22  13:48:29
+        Log: Rename perltootc as perltooc for 8.3-friedliness.
+     Branch: perl
+          + pod/perltooc.pod
+          - pod/perltootc.pod
+          ! MANIFEST pod/buildtoc.PL pod/perl.pod pod/perlboot.pod
+          ! pod/perlmod.pod pod/perlobj.pod pod/perltoc.pod
+          ! pod/perltoot.pod
+____________________________________________________________________________
+[ 12131] By: jhi                                   on 2001/09/22  13:38:49
+        Log: Find more conflicts by lowercasing.
+     Branch: perl
+          + Porting/check83.pl
+          - check83.pl
+          ! MANIFEST
+____________________________________________________________________________
+[ 12130] By: jhi                                   on 2001/09/22  13:20:20
+        Log: The AIX cc 5.0.0.0 is simply too buggy.
+     Branch: perl
+          ! hints/aix.sh
+____________________________________________________________________________
+[ 12129] By: ams                                   on 2001/09/22  12:35:38
+        Log: Uninteresting cleanup.
+     Branch: perl
+          ! form.h
+____________________________________________________________________________
+[ 12128] By: ams                                   on 2001/09/22  12:28:48
+        Log: Subject: [PATCH@12110] Missing ")" in CvFILEGV
+             From: "Paul Marquess" <Paul_Marquess@Yahoo.co.uk>
+             Date: Sat, 22 Sep 2001 14:29:13 +0100
+             Message-Id: <AIEAJICLCBDNAAOLLOKLAEGADAAA.Paul_Marquess@Yahoo.co.uk>
+     Branch: perl
+          ! cv.h
+____________________________________________________________________________
+[ 12127] By: ams                                   on 2001/09/22  12:04:28
+        Log: What's a backet?
+     Branch: perl
+          ! dump.c
+____________________________________________________________________________
+[ 12126] By: ams                                   on 2001/09/22  10:02:34
+        Log: Removed duplicated tests #19 and #20.
+     Branch: perl
+          ! t/op/do.t
+____________________________________________________________________________
+[ 12125] By: ams                                   on 2001/09/22  03:58:41
+        Log: Subject: Re: [ID 20010919.001] local() fails on imported variables
+             From: Michael Carman <mjcarman@home.com>
+             Date: Fri, 21 Sep 2001 17:54:05 -0500
+             Message-Id: <3BABC50D.6040202@home.com>
+             (Applied with some changes.)
+     Branch: perl
+          ! pod/perlmod.pod
+____________________________________________________________________________
+[ 12124] By: ams                                   on 2001/09/22  03:44:19
+        Log: Subject: [PATCH t/op/chdir.t] Reconciling the Cwd/File::Spec differences
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Fri, 21 Sep 2001 19:20:40 -0400
+             Message-Id: <20010921192040.E5494@blackrider>
+     Branch: perl
+          ! t/op/chdir.t
+____________________________________________________________________________
+[ 12123] By: ams                                   on 2001/09/22  03:41:08
+        Log: Subject: [PATCH] t/op/chdir.t won't pass on VMS
+             From: Blair Zajac <blair@orcaware.com>
+             Date: Fri, 21 Sep 2001 15:13:04 -0700
+             Message-Id: <3BABBB70.55FD41DC@orcaware.com>
+     Branch: perl
+          ! t/op/chdir.t
+____________________________________________________________________________
+[ 12122] By: ams                                   on 2001/09/22  03:37:07
+        Log: Subject: [REPATCH] Re: [PATCH t/op/do.t] new regression tests for bug ID
+             20010920.007
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Fri, 21 Sep 2001 17:59:03 -0400
+             Message-Id: <20010921175903.V5494@blackrider>
+     Branch: perl
+          ! t/op/do.t
+____________________________________________________________________________
+[ 12121] By: ams                                   on 2001/09/22  03:30:38
+        Log: Subject: [PATCH pod/perlport.pod] expand DOS-like table (was Re: test
+             suite on WinCE)
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Fri, 21 Sep 2001 19:41:03 -0400
+             Message-Id: <20010921194103.G5494@blackrider>
+     Branch: perl
+          ! pod/perlport.pod
+____________________________________________________________________________
+[ 12120] By: ams                                   on 2001/09/22  03:28:06
+        Log: Subject: [PATCH t/op/magic.t] Re: Weird $ENV{FOO} = undef warning
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Fri, 21 Sep 2001 17:33:35 -0400
+             Message-Id: <20010921173335.T5494@blackrider>
+             ($ENV{FOO}=undef hunk not applied.)
+     Branch: perl
+          ! t/op/magic.t
+____________________________________________________________________________
+[ 12119] By: ams                                   on 2001/09/22  03:02:26
+        Log: Subject: [PATCH] perldiag.pod
+             From: Peter Scott <Peter@PSDT.com>
+             Date: Fri, 21 Sep 2001 18:54:50 -0700
+             Message-Id: <4.3.2.7.2.20010921183823.00aa9890@mail.webquarry.com>
+             (Moved to the right place.)
+     Branch: perl
+          ! pod/perldiag.pod
+____________________________________________________________________________
+[ 12118] By: ams                                   on 2001/09/21  20:05:29
+        Log: Subject: [PATCH t/op/do.t] new regression tests for bug ID 20010920.007
+             From: Rafael Garcia-Suarez <rgarciasuarez@free.fr>
+             Date: Fri, 21 Sep 2001 22:36:54 +0200
+             Message-Id: <20010921223654.A12742@rafael>
+     Branch: perl
+          ! t/op/do.t
+____________________________________________________________________________
+[ 12117] By: jhi                                   on 2001/09/21  20:05:23
+        Log: Restore things as they were before
+             the backward compatibility police notices.
+     Branch: perl
+          ! lib/Cwd.pm
+____________________________________________________________________________
+[ 12116] By: jhi                                   on 2001/09/21  17:52:28
+        Log: More Cwd from Schwern: make also OS/2 and DOS
+             Cwd agree with File::Spec (that is, native path
+             syntax using \ instead of / -- backward compatibility
+             polic warning) and stop Win32 from using bsd_realpath().
+     Branch: perl
+          ! lib/Cwd.pm
+____________________________________________________________________________
+[ 12115] By: jhi                                   on 2001/09/21  17:19:03
+        Log: Subject: [PATCH @12110] RE: Untested libraries update
+             From: "Paul Marquess" <Paul_Marquess@Yahoo.co.uk>
+             Date: Fri, 21 Sep 2001 18:21:07 +0100
+             Message-ID: <AIEAJICLCBDNAAOLLOKLOEENDAAA.Paul_Marquess@Yahoo.co.uk>
+     Branch: perl
+          ! lib/warnings/register.pm
+____________________________________________________________________________
+[ 12114] By: jhi                                   on 2001/09/21  17:09:52
+        Log: Subject: Re: And now the Cwd problem (was Re: chdir.t problem...)
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Thu, 20 Sep 2001 22:54:02 -0400
+             Message-ID: <20010920225402.A3611@blackrider>
+     Branch: perl
+          ! lib/Cwd.pm
+____________________________________________________________________________
+[ 12113] By: ams                                   on 2001/09/21  17:08:24
+        Log: Subject: [PATCH] avoid v-strings with require/use
+             From: Ronald J Kimball <rjk@linguist.Thayer.dartmouth.edu>
+             Date: Fri, 21 Sep 2001 12:34:40 -0400
+             Message-Id: <20010921123440.A148500@linguist.thayer.dartmouth.edu>
+     Branch: perl
+          ! ext/ByteLoader/bytecode.h ext/Data/Dumper/Dumper.pm
+          ! ext/Devel/DProf/DProf.pm ext/IO/lib/IO/Dir.pm
+          ! ext/IO/lib/IO/File.pm ext/IO/lib/IO/Handle.pm
+          ! ext/IO/lib/IO/Pipe.pm ext/IO/lib/IO/Seekable.pm
+          ! ext/Opcode/Opcode.pm lib/AnyDBM_File.pm lib/AutoLoader.pm
+          ! lib/AutoSplit.pm lib/Class/Struct.pm lib/Cwd.pm
+          ! lib/Dumpvalue.pm lib/ExtUtils/Command.pm
+          ! lib/ExtUtils/Install.pm lib/ExtUtils/Installed.pm
+          ! lib/ExtUtils/Liblist.pm lib/ExtUtils/Mksymlists.pm
+          ! lib/ExtUtils/Packlist.pm lib/Fatal.pm lib/File/Basename.pm
+          ! lib/File/CheckTree.pm lib/File/Compare.pm lib/File/Copy.pm
+          ! lib/File/Find.pm lib/File/Path.pm lib/File/stat.pm
+          ! lib/FileHandle.pm lib/Math/Trig.pm lib/Net/Ping.pm
+          ! lib/Net/hostent.pm lib/Net/netent.pm lib/Net/protoent.pm
+          ! lib/Net/servent.pm lib/Shell.pm lib/Tie/Array.pm
+          ! lib/Tie/Handle.pm lib/Time/Local.pm lib/Time/gmtime.pm
+          ! lib/Time/localtime.pm lib/User/grent.pm lib/base.pm
+          ! lib/diagnostics.pm lib/fields.pm lib/vars.pm
+          ! pod/perl56delta.pod pod/perlfunc.pod pp_ctl.c utils/pl2pm.PL
+____________________________________________________________________________
+[ 12110] By: jhi                                   on 2001/09/21  13:59:13
+        Log: Update Changes.
+     Branch: perl
+          ! Changes patchlevel.h
+____________________________________________________________________________
 [ 12109] By: jhi                                   on 2001/09/21  13:44:43
         Log: Make AIX and Tru64 compilers happy.  
      Branch: perl
index dce7a06..3f3491a 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
 #
-# Generated on Thu Sep 20 17:20:27 EET DST 2001 [metaconfig 3.0 PL70]
+# Generated on Mon Sep 24 15:24:44 EET DST 2001 [metaconfig 3.0 PL70]
 # (with additional metaconfig patches by perlbug@perl.org)
 
 cat >c1$$ <<EOF
@@ -15924,9 +15924,10 @@ BSD_4_3 BSD_4_4 BSD_NET2 BSD_TIME BSD_TYPES BSDCOMPAT bsdi
 bull c cadmus clipper CMU COFF COMPILER_VERSION
 concurrent convex cpu cray CRAY CRAYMPP ctix CX_UX
 CYGWIN DGUX DGUX_SOURCE DJGPP dmert DOLPHIN DPX2 DSO
-Dynix DynixPTX ELF encore EPI EXTENSIONS FILE_OFFSET_BITS
-FreeBSD GCC_NEW_VARARGS gcos gcx gimpel
-GNU_SOURCE GNUC GNUC_MINOR GO32 gould GOULD_PN
+Dynix DynixPTX ELF encore EPI EXTENSIONS FAVOR_BSD
+FILE_OFFSET_BITS FreeBSD GCC_NEW_VARARGS gcos gcx gimpel
+GLIBC GLIBC_MINOR
+GNU_SOURCE GNUC GNUC_MINOR GNU_LIBRARY GO32 gould GOULD_PN
 H3050R H3050RX hbullx20 hcx host_mips
 hp200 hp300 hp700 HP700 hp800 hp9000
 hp9000s200 hp9000s300 hp9000s400 hp9000s500
@@ -15969,7 +15970,11 @@ tower tower32 tower32_200 tower32_600 tower32_700
 tower32_800 tower32_850 tss
 u370 u3b u3b2 u3b20 u3b200 u3b20d u3b5
 ultrix UMAXV UnicomPBB UnicomPBD UNICOS UNICOSMK
-unix UNIX95 UNIX99 unixpc unos USGr4 USGr4_2
+unix UNIX95 UNIX99 unixpc unos
+USE_BSD USE_FILE_OFFSET64 USE_GNU USE_ISOC9X USE_LARGEFILE USE_LARGEFILE64
+USE_MISC USE_POSIX USE_POSIX199309 USE_POSIX199506 USE_POSIX2
+USE_REENTRANT USE_SVID USE_UNIX98 USE_XOPEN USE_XOPEN_EXTENDED
+USGr4 USGr4_2
 Utek UTek UTS UWIN uxpm uxps vax venix VMESA vms xenix Xenix286
 XOPEN_SOURCE XOPEN_SOURCE_EXTENDED XPG2 XPG2_EXTENDED
 XPG3 XPG3_EXTENDED XPG4 XPG4_EXTENDED
index a7686d9..fd13369 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -339,6 +339,8 @@ ext/GDBM_File/GDBM_File.xs  GDBM extension external subroutines
 ext/GDBM_File/hints/sco.pl     Hint for GDBM_File for named architecture
 ext/GDBM_File/Makefile.PL      GDBM extension makefile writer
 ext/GDBM_File/typemap          GDBM extension interface types
+ext/I18N/Langinfo/fallback.c   I18N::Langinfo
+ext/I18N/Langinfo/fallback.xs  I18N::Langinfo
 ext/I18N/Langinfo/Langinfo.pm  I18N::Langinfo
 ext/I18N/Langinfo/Langinfo.t   I18N::Langinfo
 ext/I18N/Langinfo/Langinfo.xs  I18N::Langinfo
@@ -940,6 +942,7 @@ lib/FileCache.t                     See if FileCache works
 lib/FileHandle.pm              Backward-compatible front end to IO extension
 lib/FileHandle.t               See if FileHandle works
 lib/filetest.pm                        For "use filetest"
+lib/filetest.t                 See if filetest works
 lib/Filter/Simple.pm           Simple frontend to Filter::Util::Call
 lib/Filter/Simple/Changes      Filter::Simple
 lib/Filter/Simple/README       Filter::Simple
index 76911fd..bb35eb0 100644 (file)
@@ -46,3 +46,4 @@ sed -e $SPACKLIST lib/ExtUtils/Installed.pm >s; mv -f s lib/ExtUtils/Installed.p
 sed -e $SPACKLIST lib/ExtUtils/Packlist.pm >s; mv -f s lib/ExtUtils/Packlist.pm
 sed -e $SPACKLIST lib/ExtUtils/inst >s; mv -f s lib/ExtUtils/inst
 sed -e $SABC t/io/iprefix.t >s; mv -f s t/io/iprefix.t
+sed -e 's=L_ctermid==g' ext/POSIX/Makefile.PL >s; mv -f s ext/POSIX/Makefile.PL
index 0b0a35e..a3d5d13 100644 (file)
--- a/dosish.h
+++ b/dosish.h
@@ -13,6 +13,7 @@
 #  define HAS_UTIME
 #  define HAS_KILL
    char *djgpp_pathexp (const char*);
+   void Perl_DJGPP_init (int *argcp,char ***argvp);
 #  if (DJGPP==2 && DJGPP_MINOR < 2)
 #    define NO_LOCALECONV_MON_THOUSANDS_SEP
 #  endif
index 813d7a6..3ebb32c 100644 (file)
@@ -4,7 +4,7 @@ D
 21
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
-000030003001300230FB02C902C700A8300330052015FF5E2225202620182019
+000030003001300230FB02C902C700A8300330052015FF5E2016202620182019
 201C201D3014301530083009300A300B300C300D300E300F3016301730103011
 00B100D700F72236222722282211220F222A222922082237221A22A522252220
 23122299222B222E2261224C2248223D221D2260226E226F22642265221E2235
index 3dd0738..d335eec 100644 (file)
 #   include <langinfo.h>
 #endif
 
-#define PERL_constant_NOTFOUND 1
-#define PERL_constant_NOTDEF   2
-#define PERL_constant_ISIV     3
-#define PERL_constant_ISNO     4
-#define PERL_constant_ISNV     5
-#define PERL_constant_ISPV     6
-#define PERL_constant_ISPVN    7
-#define PERL_constant_ISSV     8
-#define PERL_constant_ISUNDEF  9
-#define PERL_constant_ISUV     10
-#define PERL_constant_ISYES    11
-
-#ifndef NVTYPE
-typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it.  */
-#endif
-static int
-constant_5 (pTHX_ const char *name, IV *iv_return) {
-  /* When generated this function returned values for the list of names given
-     here.  However, subsequent manual editing may have added or removed some.
-     DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7 D_FMT MON_1 MON_2 MON_3 MON_4
-     MON_5 MON_6 MON_7 MON_8 MON_9 NOSTR T_FMT */
-  /* Offset 4 gives the best switch position.  */
-  switch (name[4]) {
-  case '1':
-    if (memEQ(name, "DAY_1", 5)) {
-    /*                   ^      */
-#ifdef DAY_1
-      *iv_return = DAY_1;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "MON_1", 5)) {
-    /*                   ^      */
-#ifdef MON_1
-      *iv_return = MON_1;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '2':
-    if (memEQ(name, "DAY_2", 5)) {
-    /*                   ^      */
-#ifdef DAY_2
-      *iv_return = DAY_2;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "MON_2", 5)) {
-    /*                   ^      */
-#ifdef MON_2
-      *iv_return = MON_2;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '3':
-    if (memEQ(name, "DAY_3", 5)) {
-    /*                   ^      */
-#ifdef DAY_3
-      *iv_return = DAY_3;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "MON_3", 5)) {
-    /*                   ^      */
-#ifdef MON_3
-      *iv_return = MON_3;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '4':
-    if (memEQ(name, "DAY_4", 5)) {
-    /*                   ^      */
-#ifdef DAY_4
-      *iv_return = DAY_4;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "MON_4", 5)) {
-    /*                   ^      */
-#ifdef MON_4
-      *iv_return = MON_4;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '5':
-    if (memEQ(name, "DAY_5", 5)) {
-    /*                   ^      */
-#ifdef DAY_5
-      *iv_return = DAY_5;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "MON_5", 5)) {
-    /*                   ^      */
-#ifdef MON_5
-      *iv_return = MON_5;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '6':
-    if (memEQ(name, "DAY_6", 5)) {
-    /*                   ^      */
-#ifdef DAY_6
-      *iv_return = DAY_6;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "MON_6", 5)) {
-    /*                   ^      */
-#ifdef MON_6
-      *iv_return = MON_6;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '7':
-    if (memEQ(name, "DAY_7", 5)) {
-    /*                   ^      */
-#ifdef DAY_7
-      *iv_return = DAY_7;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "MON_7", 5)) {
-    /*                   ^      */
-#ifdef MON_7
-      *iv_return = MON_7;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '8':
-    if (memEQ(name, "MON_8", 5)) {
-    /*                   ^      */
-#ifdef MON_8
-      *iv_return = MON_8;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '9':
-    if (memEQ(name, "MON_9", 5)) {
-    /*                   ^      */
-#ifdef MON_9
-      *iv_return = MON_9;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'R':
-    if (memEQ(name, "NOSTR", 5)) {
-    /*                   ^      */
-#ifdef NOSTR
-      *iv_return = NOSTR;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'T':
-    if (memEQ(name, "D_FMT", 5)) {
-    /*                   ^      */
-#ifdef D_FMT
-      *iv_return = D_FMT;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "T_FMT", 5)) {
-    /*                   ^      */
-#ifdef T_FMT
-      *iv_return = T_FMT;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  }
-  return PERL_constant_NOTFOUND;
-}
-
-static int
-constant_6 (pTHX_ const char *name, IV *iv_return) {
-  /* When generated this function returned values for the list of names given
-     here.  However, subsequent manual editing may have added or removed some.
-     AM_STR MON_10 MON_11 MON_12 NOEXPR PM_STR YESSTR */
-  /* Offset 0 gives the best switch position.  */
-  switch (name[0]) {
-  case 'A':
-    if (memEQ(name, "AM_STR", 6)) {
-    /*               ^           */
-#ifdef AM_STR
-      *iv_return = AM_STR;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'M':
-    if (memEQ(name, "MON_10", 6)) {
-    /*               ^           */
-#ifdef MON_10
-      *iv_return = MON_10;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "MON_11", 6)) {
-    /*               ^           */
-#ifdef MON_11
-      *iv_return = MON_11;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "MON_12", 6)) {
-    /*               ^           */
-#ifdef MON_12
-      *iv_return = MON_12;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'N':
-    if (memEQ(name, "NOEXPR", 6)) {
-    /*               ^           */
-#ifdef NOEXPR
-      *iv_return = NOEXPR;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'P':
-    if (memEQ(name, "PM_STR", 6)) {
-    /*               ^           */
-#ifdef PM_STR
-      *iv_return = PM_STR;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'Y':
-    if (memEQ(name, "YESSTR", 6)) {
-    /*               ^           */
-#ifdef YESSTR
-      *iv_return = YESSTR;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  }
-  return PERL_constant_NOTFOUND;
-}
-
-static int
-constant_7 (pTHX_ const char *name, IV *iv_return) {
-  /* When generated this function returned values for the list of names given
-     here.  However, subsequent manual editing may have added or removed some.
-     ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7 ABMON_1 ABMON_2
-     ABMON_3 ABMON_4 ABMON_5 ABMON_6 ABMON_7 ABMON_8 ABMON_9 CODESET D_T_FMT
-     THOUSEP YESEXPR */
-  /* Offset 6 gives the best switch position.  */
-  switch (name[6]) {
-  case '1':
-    if (memEQ(name, "ABDAY_1", 7)) {
-    /*                     ^      */
-#ifdef ABDAY_1
-      *iv_return = ABDAY_1;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "ABMON_1", 7)) {
-    /*                     ^      */
-#ifdef ABMON_1
-      *iv_return = ABMON_1;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '2':
-    if (memEQ(name, "ABDAY_2", 7)) {
-    /*                     ^      */
-#ifdef ABDAY_2
-      *iv_return = ABDAY_2;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "ABMON_2", 7)) {
-    /*                     ^      */
-#ifdef ABMON_2
-      *iv_return = ABMON_2;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '3':
-    if (memEQ(name, "ABDAY_3", 7)) {
-    /*                     ^      */
-#ifdef ABDAY_3
-      *iv_return = ABDAY_3;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "ABMON_3", 7)) {
-    /*                     ^      */
-#ifdef ABMON_3
-      *iv_return = ABMON_3;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '4':
-    if (memEQ(name, "ABDAY_4", 7)) {
-    /*                     ^      */
-#ifdef ABDAY_4
-      *iv_return = ABDAY_4;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "ABMON_4", 7)) {
-    /*                     ^      */
-#ifdef ABMON_4
-      *iv_return = ABMON_4;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '5':
-    if (memEQ(name, "ABDAY_5", 7)) {
-    /*                     ^      */
-#ifdef ABDAY_5
-      *iv_return = ABDAY_5;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "ABMON_5", 7)) {
-    /*                     ^      */
-#ifdef ABMON_5
-      *iv_return = ABMON_5;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '6':
-    if (memEQ(name, "ABDAY_6", 7)) {
-    /*                     ^      */
-#ifdef ABDAY_6
-      *iv_return = ABDAY_6;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "ABMON_6", 7)) {
-    /*                     ^      */
-#ifdef ABMON_6
-      *iv_return = ABMON_6;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '7':
-    if (memEQ(name, "ABDAY_7", 7)) {
-    /*                     ^      */
-#ifdef ABDAY_7
-      *iv_return = ABDAY_7;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "ABMON_7", 7)) {
-    /*                     ^      */
-#ifdef ABMON_7
-      *iv_return = ABMON_7;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '8':
-    if (memEQ(name, "ABMON_8", 7)) {
-    /*                     ^      */
-#ifdef ABMON_8
-      *iv_return = ABMON_8;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '9':
-    if (memEQ(name, "ABMON_9", 7)) {
-    /*                     ^      */
-#ifdef ABMON_9
-      *iv_return = ABMON_9;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'P':
-    if (memEQ(name, "THOUSEP", 7)) {
-    /*                     ^      */
-#ifdef THOUSEP
-      *iv_return = THOUSEP;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'R':
-    if (memEQ(name, "YESEXPR", 7)) {
-    /*                     ^      */
-#ifdef YESEXPR
-      *iv_return = YESEXPR;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'T':
-    if (memEQ(name, "CODESET", 7)) {
-    /*                     ^      */
-#ifdef CODESET
-      *iv_return = CODESET;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    if (memEQ(name, "D_T_FMT", 7)) {
-    /*                     ^      */
-#ifdef D_T_FMT
-      *iv_return = D_T_FMT;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  }
-  return PERL_constant_NOTFOUND;
-}
-
-static int
-constant_8 (pTHX_ const char *name, IV *iv_return) {
-  /* When generated this function returned values for the list of names given
-     here.  However, subsequent manual editing may have added or removed some.
-     ABMON_10 ABMON_11 ABMON_12 CRNCYSTR */
-  /* Offset 7 gives the best switch position.  */
-  switch (name[7]) {
-  case '0':
-    if (memEQ(name, "ABMON_10", 8)) {
-    /*                      ^      */
-#ifdef ABMON_10
-      *iv_return = ABMON_10;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '1':
-    if (memEQ(name, "ABMON_11", 8)) {
-    /*                      ^      */
-#ifdef ABMON_11
-      *iv_return = ABMON_11;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '2':
-    if (memEQ(name, "ABMON_12", 8)) {
-    /*                      ^      */
-#ifdef ABMON_12
-      *iv_return = ABMON_12;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'R':
-    if (memEQ(name, "CRNCYSTR", 8)) {
-    /*                      ^      */
-#ifdef CRNCYSTR
-      *iv_return = CRNCYSTR;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  }
-  return PERL_constant_NOTFOUND;
-}
-
-static int
-constant_9 (pTHX_ const char *name, IV *iv_return) {
-  /* When generated this function returned values for the list of names given
-     here.  However, subsequent manual editing may have added or removed some.
-     ERA_D_FMT ERA_T_FMT RADIXCHAR */
-  /* Offset 4 gives the best switch position.  */
-  switch (name[4]) {
-  case 'D':
-    if (memEQ(name, "ERA_D_FMT", 9)) {
-    /*                   ^          */
-#ifdef ERA_D_FMT
-      *iv_return = ERA_D_FMT;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'T':
-    if (memEQ(name, "ERA_T_FMT", 9)) {
-    /*                   ^          */
-#ifdef ERA_T_FMT
-      *iv_return = ERA_T_FMT;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'X':
-    if (memEQ(name, "RADIXCHAR", 9)) {
-    /*                   ^          */
-#ifdef RADIXCHAR
-      *iv_return = RADIXCHAR;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  }
-  return PERL_constant_NOTFOUND;
-}
-
-static int
-constant (pTHX_ const char *name, STRLEN len, IV *iv_return) {
-  /* Initially switch on the length of the name.  */
-  /* When generated this function returned values for the list of names given
-     in this section of perl code.  Rather than manually editing these functions
-     to add or remove constants, which would result in this comment and section
-     of code becoming inaccurate, we recommend that you edit this section of
-     code, and use it to regenerate a new set of constant functions which you
-     then use to replace the originals.
-
-     Regenerate these constant functions by feeding this entire source file to
-     perl -x
-
-#!../../../perl -w
-use ExtUtils::Constant qw (constant_types C_constant XS_constant);
-
-my $types = {map {($_, 1)} qw(IV)};
-my @names = (qw(ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7 ABMON_1
-              ABMON_10 ABMON_11 ABMON_12 ABMON_2 ABMON_3 ABMON_4 ABMON_5
-              ABMON_6 ABMON_7 ABMON_8 ABMON_9 ALT_DIGITS AM_STR CODESET
-              CRNCYSTR DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7 D_FMT D_T_FMT
-              ERA ERA_D_FMT ERA_D_T_FMT ERA_T_FMT MON_1 MON_10 MON_11 MON_12
-              MON_2 MON_3 MON_4 MON_5 MON_6 MON_7 MON_8 MON_9 NOEXPR NOSTR
-              PM_STR RADIXCHAR THOUSEP T_FMT T_FMT_AMPM YESEXPR YESSTR));
-
-print constant_types(); # macro defs
-foreach (C_constant ("I18N::Langinfo", 'constant', 'IV', $types, undef, 3, @names) ) {
-    print $_, "\n"; # C constant subs
-}
-print "#### XS Section:\n";
-print XS_constant ("I18N::Langinfo", $types);
-__END__
-   */
-
-  switch (len) {
-  case 3:
-    if (memEQ(name, "ERA", 3)) {
-#ifdef ERA
-      *iv_return = ERA;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 5:
-    return constant_5 (aTHX_ name, iv_return);
-    break;
-  case 6:
-    return constant_6 (aTHX_ name, iv_return);
-    break;
-  case 7:
-    return constant_7 (aTHX_ name, iv_return);
-    break;
-  case 8:
-    return constant_8 (aTHX_ name, iv_return);
-    break;
-  case 9:
-    return constant_9 (aTHX_ name, iv_return);
-    break;
-  case 10:
-    /* Names all of length 10.  */
-    /* ALT_DIGITS T_FMT_AMPM */
-    /* Offset 7 gives the best switch position.  */
-    switch (name[7]) {
-    case 'I':
-      if (memEQ(name, "ALT_DIGITS", 10)) {
-      /*                      ^         */
-#ifdef ALT_DIGITS
-        *iv_return = ALT_DIGITS;
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'M':
-      if (memEQ(name, "T_FMT_AMPM", 10)) {
-      /*                      ^         */
-#ifdef T_FMT_AMPM
-        *iv_return = T_FMT_AMPM;
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    }
-    break;
-  case 11:
-    if (memEQ(name, "ERA_D_T_FMT", 11)) {
-#ifdef ERA_D_T_FMT
-      *iv_return = ERA_D_T_FMT;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  }
-  return PERL_constant_NOTFOUND;
-}
+#include "constants.c"
 
 MODULE = I18N::Langinfo        PACKAGE = I18N::Langinfo
 
 PROTOTYPES: ENABLE
 
-void
-constant(sv)
-    PREINIT:
-#ifdef dXSTARG
-       dXSTARG; /* Faster if we have it.  */
-#else
-       dTARGET;
-#endif
-       STRLEN          len;
-        int            type;
-       IV              iv;
-       /* NV           nv;     Uncomment this if you need to return NVs */
-       /* const char   *pv;    Uncomment this if you need to return PVs */
-    INPUT:
-       SV *            sv;
-        const char *   s = SvPV(sv, len);
-    PPCODE:
-        /* Change this to constant(aTHX_ s, len, &iv, &nv);
-           if you need to return both NVs and IVs */
-       type = constant(aTHX_ s, len, &iv);
-      /* Return 1 or 2 items. First is error message, or undef if no error.
-           Second, if present, is found value */
-        switch (type) {
-        case PERL_constant_NOTFOUND:
-          sv = sv_2mortal(newSVpvf("%s is not a valid I18N::Langinfo macro", s));
-          PUSHs(sv);
-          break;
-        case PERL_constant_NOTDEF:
-          sv = sv_2mortal(newSVpvf(
-           "Your vendor has not defined I18N::Langinfo macro %s, used", s));
-          PUSHs(sv);
-          break;
-        case PERL_constant_ISIV:
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHi(iv);
-          break;
-       /* Uncomment this if you need to return NOs
-        case PERL_constant_ISNO:
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHs(&PL_sv_no);
-          break; */
-       /* Uncomment this if you need to return NVs
-        case PERL_constant_ISNV:
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHn(nv);
-          break; */
-       /* Uncomment this if you need to return PVs
-        case PERL_constant_ISPV:
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHp(pv, strlen(pv));
-          break; */
-       /* Uncomment this if you need to return PVNs
-        case PERL_constant_ISPVN:
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHp(pv, iv);
-          break; */
-       /* Uncomment this if you need to return SVs
-        case PERL_constant_ISSV:
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHs(sv);
-          break; */
-       /* Uncomment this if you need to return UNDEFs
-        case PERL_constant_ISUNDEF:
-          break; */
-       /* Uncomment this if you need to return UVs
-        case PERL_constant_ISUV:
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHu((UV)iv);
-          break; */
-       /* Uncomment this if you need to return YESs
-        case PERL_constant_ISYES:
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHs(&PL_sv_yes);
-          break; */
-        default:
-          sv = sv_2mortal(newSVpvf(
-           "Unexpected return type %d while processing I18N::Langinfo macro %s, used",
-               type, s));
-          PUSHs(sv);
-        }
+INCLUDE: constants.xs
 
 SV*
 langinfo(code)
index aff6f87..63137ff 100644 (file)
@@ -12,6 +12,30 @@ WriteMakefile(
     'DEFINE'           => '', # e.g., '-DHAVE_SOMETHING'
        # Insert -I. if you add *.h files later:
     'INC'              => '', # e.g., '-I/usr/include/other'
+    # Without this the constants xs files are spotted, and cause rules to be
+    # added to delete the similarly named C files, which isn't what we want.
+    XS => {'Langinfo.xs' => 'Langinfo.c'},
+    realclean => {FILES=> 'constants.c constants.xs'},
        # Un-comment this if you add C files to link with later:
     # 'OBJECT'         => '$(O_FILES)', # link all the C files too
 );
+if (eval {require ExtUtils::Constant; 1}) {
+  my @names = (qw(ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7
+                  ABMON_1 ABMON_10 ABMON_11 ABMON_12 ABMON_2 ABMON_3 ABMON_4
+                  ABMON_5 ABMON_6 ABMON_7 ABMON_8 ABMON_9 ALT_DIGITS AM_STR
+                  CODESET CRNCYSTR DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7
+                  D_FMT D_T_FMT ERA ERA_D_FMT ERA_D_T_FMT ERA_T_FMT MON_1
+                  MON_10 MON_11 MON_12 MON_2 MON_3 MON_4 MON_5 MON_6 MON_7
+                  MON_8 MON_9 NOEXPR NOSTR PM_STR RADIXCHAR THOUSEP T_FMT
+                  T_FMT_AMPM YESEXPR YESSTR));
+  ExtUtils::Constant::WriteConstants(
+                                     NAME => 'I18N::Langinfo',
+                                     NAMES => \@names,
+                                    );
+} else {
+  use File::Copy;
+  copy ('fallback.c', 'constants.c')
+    or die "Can't copy fallback.c to constants.c: $!";
+  copy ('fallback.xs', 'constants.xs')
+    or die "Can't copy fallback.xs to constants.xs: $!";
+}
diff --git a/ext/I18N/Langinfo/fallback.c b/ext/I18N/Langinfo/fallback.c
new file mode 100644 (file)
index 0000000..538a9f7
--- /dev/null
@@ -0,0 +1,724 @@
+#define PERL_constant_NOTFOUND 1
+#define PERL_constant_NOTDEF   2
+#define PERL_constant_ISIV     3
+#define PERL_constant_ISNO     4
+#define PERL_constant_ISNV     5
+#define PERL_constant_ISPV     6
+#define PERL_constant_ISPVN    7
+#define PERL_constant_ISSV     8
+#define PERL_constant_ISUNDEF  9
+#define PERL_constant_ISUV     10
+#define PERL_constant_ISYES    11
+
+#ifndef NVTYPE
+typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it.  */
+#endif
+
+static int
+constant_5 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7 D_FMT MON_1 MON_2 MON_3 MON_4
+     MON_5 MON_6 MON_7 MON_8 MON_9 NOSTR T_FMT */
+  /* Offset 4 gives the best switch position.  */
+  switch (name[4]) {
+  case '1':
+    if (memEQ(name, "DAY_1", 5)) {
+    /*                   ^      */
+#ifdef DAY_1
+      *iv_return = DAY_1;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "MON_1", 5)) {
+    /*                   ^      */
+#ifdef MON_1
+      *iv_return = MON_1;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '2':
+    if (memEQ(name, "DAY_2", 5)) {
+    /*                   ^      */
+#ifdef DAY_2
+      *iv_return = DAY_2;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "MON_2", 5)) {
+    /*                   ^      */
+#ifdef MON_2
+      *iv_return = MON_2;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '3':
+    if (memEQ(name, "DAY_3", 5)) {
+    /*                   ^      */
+#ifdef DAY_3
+      *iv_return = DAY_3;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "MON_3", 5)) {
+    /*                   ^      */
+#ifdef MON_3
+      *iv_return = MON_3;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '4':
+    if (memEQ(name, "DAY_4", 5)) {
+    /*                   ^      */
+#ifdef DAY_4
+      *iv_return = DAY_4;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "MON_4", 5)) {
+    /*                   ^      */
+#ifdef MON_4
+      *iv_return = MON_4;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '5':
+    if (memEQ(name, "DAY_5", 5)) {
+    /*                   ^      */
+#ifdef DAY_5
+      *iv_return = DAY_5;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "MON_5", 5)) {
+    /*                   ^      */
+#ifdef MON_5
+      *iv_return = MON_5;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '6':
+    if (memEQ(name, "DAY_6", 5)) {
+    /*                   ^      */
+#ifdef DAY_6
+      *iv_return = DAY_6;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "MON_6", 5)) {
+    /*                   ^      */
+#ifdef MON_6
+      *iv_return = MON_6;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '7':
+    if (memEQ(name, "DAY_7", 5)) {
+    /*                   ^      */
+#ifdef DAY_7
+      *iv_return = DAY_7;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "MON_7", 5)) {
+    /*                   ^      */
+#ifdef MON_7
+      *iv_return = MON_7;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '8':
+    if (memEQ(name, "MON_8", 5)) {
+    /*                   ^      */
+#ifdef MON_8
+      *iv_return = MON_8;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '9':
+    if (memEQ(name, "MON_9", 5)) {
+    /*                   ^      */
+#ifdef MON_9
+      *iv_return = MON_9;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'R':
+    if (memEQ(name, "NOSTR", 5)) {
+    /*                   ^      */
+#ifdef NOSTR
+      *iv_return = NOSTR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'T':
+    if (memEQ(name, "D_FMT", 5)) {
+    /*                   ^      */
+#ifdef D_FMT
+      *iv_return = D_FMT;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "T_FMT", 5)) {
+    /*                   ^      */
+#ifdef T_FMT
+      *iv_return = T_FMT;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_6 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     AM_STR MON_10 MON_11 MON_12 NOEXPR PM_STR YESSTR */
+  /* Offset 0 gives the best switch position.  */
+  switch (name[0]) {
+  case 'A':
+    if (memEQ(name, "AM_STR", 6)) {
+    /*               ^           */
+#ifdef AM_STR
+      *iv_return = AM_STR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'M':
+    if (memEQ(name, "MON_10", 6)) {
+    /*               ^           */
+#ifdef MON_10
+      *iv_return = MON_10;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "MON_11", 6)) {
+    /*               ^           */
+#ifdef MON_11
+      *iv_return = MON_11;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "MON_12", 6)) {
+    /*               ^           */
+#ifdef MON_12
+      *iv_return = MON_12;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'N':
+    if (memEQ(name, "NOEXPR", 6)) {
+    /*               ^           */
+#ifdef NOEXPR
+      *iv_return = NOEXPR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'P':
+    if (memEQ(name, "PM_STR", 6)) {
+    /*               ^           */
+#ifdef PM_STR
+      *iv_return = PM_STR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'Y':
+    if (memEQ(name, "YESSTR", 6)) {
+    /*               ^           */
+#ifdef YESSTR
+      *iv_return = YESSTR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_7 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7 ABMON_1 ABMON_2
+     ABMON_3 ABMON_4 ABMON_5 ABMON_6 ABMON_7 ABMON_8 ABMON_9 CODESET D_T_FMT
+     THOUSEP YESEXPR */
+  /* Offset 6 gives the best switch position.  */
+  switch (name[6]) {
+  case '1':
+    if (memEQ(name, "ABDAY_1", 7)) {
+    /*                     ^      */
+#ifdef ABDAY_1
+      *iv_return = ABDAY_1;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "ABMON_1", 7)) {
+    /*                     ^      */
+#ifdef ABMON_1
+      *iv_return = ABMON_1;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '2':
+    if (memEQ(name, "ABDAY_2", 7)) {
+    /*                     ^      */
+#ifdef ABDAY_2
+      *iv_return = ABDAY_2;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "ABMON_2", 7)) {
+    /*                     ^      */
+#ifdef ABMON_2
+      *iv_return = ABMON_2;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '3':
+    if (memEQ(name, "ABDAY_3", 7)) {
+    /*                     ^      */
+#ifdef ABDAY_3
+      *iv_return = ABDAY_3;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "ABMON_3", 7)) {
+    /*                     ^      */
+#ifdef ABMON_3
+      *iv_return = ABMON_3;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '4':
+    if (memEQ(name, "ABDAY_4", 7)) {
+    /*                     ^      */
+#ifdef ABDAY_4
+      *iv_return = ABDAY_4;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "ABMON_4", 7)) {
+    /*                     ^      */
+#ifdef ABMON_4
+      *iv_return = ABMON_4;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '5':
+    if (memEQ(name, "ABDAY_5", 7)) {
+    /*                     ^      */
+#ifdef ABDAY_5
+      *iv_return = ABDAY_5;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "ABMON_5", 7)) {
+    /*                     ^      */
+#ifdef ABMON_5
+      *iv_return = ABMON_5;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '6':
+    if (memEQ(name, "ABDAY_6", 7)) {
+    /*                     ^      */
+#ifdef ABDAY_6
+      *iv_return = ABDAY_6;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "ABMON_6", 7)) {
+    /*                     ^      */
+#ifdef ABMON_6
+      *iv_return = ABMON_6;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '7':
+    if (memEQ(name, "ABDAY_7", 7)) {
+    /*                     ^      */
+#ifdef ABDAY_7
+      *iv_return = ABDAY_7;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "ABMON_7", 7)) {
+    /*                     ^      */
+#ifdef ABMON_7
+      *iv_return = ABMON_7;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '8':
+    if (memEQ(name, "ABMON_8", 7)) {
+    /*                     ^      */
+#ifdef ABMON_8
+      *iv_return = ABMON_8;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '9':
+    if (memEQ(name, "ABMON_9", 7)) {
+    /*                     ^      */
+#ifdef ABMON_9
+      *iv_return = ABMON_9;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'P':
+    if (memEQ(name, "THOUSEP", 7)) {
+    /*                     ^      */
+#ifdef THOUSEP
+      *iv_return = THOUSEP;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'R':
+    if (memEQ(name, "YESEXPR", 7)) {
+    /*                     ^      */
+#ifdef YESEXPR
+      *iv_return = YESEXPR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'T':
+    if (memEQ(name, "CODESET", 7)) {
+    /*                     ^      */
+#ifdef CODESET
+      *iv_return = CODESET;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    if (memEQ(name, "D_T_FMT", 7)) {
+    /*                     ^      */
+#ifdef D_T_FMT
+      *iv_return = D_T_FMT;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_8 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     ABMON_10 ABMON_11 ABMON_12 CRNCYSTR */
+  /* Offset 7 gives the best switch position.  */
+  switch (name[7]) {
+  case '0':
+    if (memEQ(name, "ABMON_10", 8)) {
+    /*                      ^      */
+#ifdef ABMON_10
+      *iv_return = ABMON_10;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '1':
+    if (memEQ(name, "ABMON_11", 8)) {
+    /*                      ^      */
+#ifdef ABMON_11
+      *iv_return = ABMON_11;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '2':
+    if (memEQ(name, "ABMON_12", 8)) {
+    /*                      ^      */
+#ifdef ABMON_12
+      *iv_return = ABMON_12;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'R':
+    if (memEQ(name, "CRNCYSTR", 8)) {
+    /*                      ^      */
+#ifdef CRNCYSTR
+      *iv_return = CRNCYSTR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_9 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     ERA_D_FMT ERA_T_FMT RADIXCHAR */
+  /* Offset 4 gives the best switch position.  */
+  switch (name[4]) {
+  case 'D':
+    if (memEQ(name, "ERA_D_FMT", 9)) {
+    /*                   ^          */
+#ifdef ERA_D_FMT
+      *iv_return = ERA_D_FMT;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'T':
+    if (memEQ(name, "ERA_T_FMT", 9)) {
+    /*                   ^          */
+#ifdef ERA_T_FMT
+      *iv_return = ERA_T_FMT;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'X':
+    if (memEQ(name, "RADIXCHAR", 9)) {
+    /*                   ^          */
+#ifdef RADIXCHAR
+      *iv_return = RADIXCHAR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant (pTHX_ const char *name, STRLEN len, IV *iv_return) {
+  /* Initially switch on the length of the name.  */
+  /* When generated this function returned values for the list of names given
+     in this section of perl code.  Rather than manually editing these functions
+     to add or remove constants, which would result in this comment and section
+     of code becoming inaccurate, we recommend that you edit this section of
+     code, and use it to regenerate a new set of constant functions which you
+     then use to replace the originals.
+
+     Regenerate these constant functions by feeding this entire source file to
+     perl -x
+
+#!../../../miniperl -w
+use ExtUtils::Constant qw (constant_types C_constant XS_constant);
+
+my $types = {map {($_, 1)} qw(IV)};
+my @names = (qw(ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7 ABMON_1
+              ABMON_10 ABMON_11 ABMON_12 ABMON_2 ABMON_3 ABMON_4 ABMON_5
+              ABMON_6 ABMON_7 ABMON_8 ABMON_9 ALT_DIGITS AM_STR CODESET
+              CRNCYSTR DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7 D_FMT D_T_FMT
+              ERA ERA_D_FMT ERA_D_T_FMT ERA_T_FMT MON_1 MON_10 MON_11 MON_12
+              MON_2 MON_3 MON_4 MON_5 MON_6 MON_7 MON_8 MON_9 NOEXPR NOSTR
+              PM_STR RADIXCHAR THOUSEP T_FMT T_FMT_AMPM YESEXPR YESSTR));
+
+print constant_types(); # macro defs
+foreach (C_constant ("I18N::Langinfo", 'constant', 'IV', $types, undef, 3, @names) ) {
+    print $_, "\n"; # C constant subs
+}
+print "#### XS Section:\n";
+print XS_constant ("I18N::Langinfo", $types);
+__END__
+   */
+
+  switch (len) {
+  case 3:
+    if (memEQ(name, "ERA", 3)) {
+#ifdef ERA
+      *iv_return = ERA;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 5:
+    return constant_5 (aTHX_ name, iv_return);
+    break;
+  case 6:
+    return constant_6 (aTHX_ name, iv_return);
+    break;
+  case 7:
+    return constant_7 (aTHX_ name, iv_return);
+    break;
+  case 8:
+    return constant_8 (aTHX_ name, iv_return);
+    break;
+  case 9:
+    return constant_9 (aTHX_ name, iv_return);
+    break;
+  case 10:
+    /* Names all of length 10.  */
+    /* ALT_DIGITS T_FMT_AMPM */
+    /* Offset 7 gives the best switch position.  */
+    switch (name[7]) {
+    case 'I':
+      if (memEQ(name, "ALT_DIGITS", 10)) {
+      /*                      ^         */
+#ifdef ALT_DIGITS
+        *iv_return = ALT_DIGITS;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    case 'M':
+      if (memEQ(name, "T_FMT_AMPM", 10)) {
+      /*                      ^         */
+#ifdef T_FMT_AMPM
+        *iv_return = T_FMT_AMPM;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    }
+    break;
+  case 11:
+    if (memEQ(name, "ERA_D_T_FMT", 11)) {
+#ifdef ERA_D_T_FMT
+      *iv_return = ERA_D_T_FMT;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
diff --git a/ext/I18N/Langinfo/fallback.xs b/ext/I18N/Langinfo/fallback.xs
new file mode 100644 (file)
index 0000000..16ae6e8
--- /dev/null
@@ -0,0 +1,88 @@
+void
+constant(sv)
+    PREINIT:
+#ifdef dXSTARG
+       dXSTARG; /* Faster if we have it.  */
+#else
+       dTARGET;
+#endif
+       STRLEN          len;
+        int            type;
+       IV              iv;
+       /* NV           nv;     Uncomment this if you need to return NVs */
+       /* const char   *pv;    Uncomment this if you need to return PVs */
+    INPUT:
+       SV *            sv;
+        const char *   s = SvPV(sv, len);
+    PPCODE:
+        /* Change this to constant(aTHX_ s, len, &iv, &nv);
+           if you need to return both NVs and IVs */
+       type = constant(aTHX_ s, len, &iv);
+      /* Return 1 or 2 items. First is error message, or undef if no error.
+           Second, if present, is found value */
+        switch (type) {
+        case PERL_constant_NOTFOUND:
+          sv = sv_2mortal(newSVpvf("%s is not a valid I18N::Langinfo macro", s));
+          PUSHs(sv);
+          break;
+        case PERL_constant_NOTDEF:
+          sv = sv_2mortal(newSVpvf(
+           "Your vendor has not defined I18N::Langinfo macro %s, used", s));
+          PUSHs(sv);
+          break;
+        case PERL_constant_ISIV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHi(iv);
+          break;
+       /* Uncomment this if you need to return NOs
+        case PERL_constant_ISNO:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(&PL_sv_no);
+          break; */
+       /* Uncomment this if you need to return NVs
+        case PERL_constant_ISNV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHn(nv);
+          break; */
+       /* Uncomment this if you need to return PVs
+        case PERL_constant_ISPV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHp(pv, strlen(pv));
+          break; */
+       /* Uncomment this if you need to return PVNs
+        case PERL_constant_ISPVN:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHp(pv, iv);
+          break; */
+       /* Uncomment this if you need to return SVs
+        case PERL_constant_ISSV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(sv);
+          break; */
+       /* Uncomment this if you need to return UNDEFs
+        case PERL_constant_ISUNDEF:
+          break; */
+       /* Uncomment this if you need to return UVs
+        case PERL_constant_ISUV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHu((UV)iv);
+          break; */
+       /* Uncomment this if you need to return YESs
+        case PERL_constant_ISYES:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(&PL_sv_yes);
+          break; */
+        default:
+          sv = sv_2mortal(newSVpvf(
+           "Unexpected return type %d while processing I18N::Langinfo macro %s, used",
+               type, s));
+          PUSHs(sv);
+        }
index 97ea559..a4bf2df 100644 (file)
@@ -70,13 +70,14 @@ gettimeofday (struct timeval *tp, int nothing)
  time_t tt;
  struct tm tmtm;
  /* mktime converts local to UTC */
- GetSystemTime (&st);
+ GetLocalTime (&st);
  tmtm.tm_sec = st.wSecond;
  tmtm.tm_min = st.wMinute;
  tmtm.tm_hour = st.wHour;
  tmtm.tm_mday = st.wDay;
  tmtm.tm_mon = st.wMonth - 1;
  tmtm.tm_year = st.wYear - 1900;
+ tmtm.tm_wday = st.wDayOfWeek;
  tmtm.tm_isdst = -1;
  tt = mktime (&tmtm);
  tp->tv_sec = tt;
index 02d5c10..1ab8bc5 100755 (executable)
@@ -6,7 +6,7 @@ use Config;
 
 
 unless($Config{'useithreads'} eq 'define') {
-    die "We need a perl that is built with USEITHREAD!\n";
+    die "We need a perl that is built with USEITHREADS!\n";
 }
 
 
index 1e6d442..5678bcb 100755 (executable)
@@ -1,14 +1,8 @@
-
 #include "threads.h"
 
-
-
-
-
-
 /*
      Starts executing the thread. Needs to clean up memory a tad better.
-*/
*     Starts executing the thread. Needs to clean up memory a tad better.
+ */
 
 #ifdef WIN32
 THREAD_RET_TYPE Perl_thread_run(LPVOID arg) {
@@ -29,8 +23,8 @@ void* Perl_thread_run(void * arg) {
 
        SHAREDSvLOCK(threads);
        SHAREDSvEDIT(threads);
-       thread_tid_ptr = Perl_newSViv(PL_sharedsv_space, (IV) thread->thr);
-       thread_ptr = Perl_newSViv(PL_sharedsv_space, (IV) thread);      
+       thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread->thr));
+       thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
        hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
        SvREFCNT_dec(thread_tid_ptr);
        SHAREDSvRELEASE(threads);
@@ -61,8 +55,6 @@ void* Perl_thread_run(void * arg) {
 
        }
 
-
-
        MUTEX_LOCK(&thread->mutex);
        perl_destruct(thread->interp);  
        perl_free(thread->interp);
@@ -80,66 +72,60 @@ void* Perl_thread_run(void * arg) {
 
 }
 
-
-
 /*
      iThread->create();
-*/
* iThread->create();
+ */
 
 SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
        ithread* thread = malloc(sizeof(ithread));
        SV*      obj_ref;
        SV*      obj;
        SV*             temp_store;
-   I32         result;
        PerlInterpreter *current_perl;
 
        MUTEX_LOCK(&create_mutex);  
        obj_ref = newSViv(0);
        obj = newSVrv(obj_ref, class);
-   sv_setiv(obj, (IV)thread);
-   SvREADONLY_on(obj);
-
+       sv_setiv(obj, (IV)thread);
+       SvREADONLY_on(obj);
 
-   current_perl = PERL_GET_CONTEXT;    
+       current_perl = PERL_GET_CONTEXT;        
 
        /*
-               here we put the values of params and function to call onto namespace, this is so perl will properly             clone them when we call perl_clone.
-       */
-       
+        * here we put the values of params and function to call onto
+        * namespace, this is so perl will properly clone them when we
+        * call perl_clone.
+        */
 
-
-       temp_store = Perl_get_sv(current_perl, "threads::paramtempstore", TRUE | GV_ADDMULTI);
+       temp_store = Perl_get_sv(current_perl, "threads::paramtempstore",
+                                TRUE | GV_ADDMULTI);
        Perl_sv_setsv(current_perl, temp_store,params);
        params = NULL;
        temp_store = NULL;
 
-       temp_store = Perl_get_sv(current_perl, "threads::calltempstore", TRUE | GV_ADDMULTI);
+       temp_store = Perl_get_sv(current_perl, "threads::calltempstore",
+                                TRUE | GV_ADDMULTI);
        Perl_sv_setsv(current_perl,temp_store, init_function);
        init_function = NULL;
        temp_store = NULL;
-       
 
 #ifdef WIN32
-       thread->interp = perl_clone(current_perl,4);
+       thread->interp = perl_clone(current_perl, 4);
 #else
-       thread->interp = perl_clone(current_perl,0);
+       thread->interp = perl_clone(current_perl, 0);
 #endif
 
-       thread->init_function = newSVsv(Perl_get_sv(thread->interp, "threads::calltempstore",FALSE));
-       thread->params = newSVsv(Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE));
-
-
-
-
+       thread->init_function = newSVsv(Perl_get_sv(thread->interp,
+                                                   "threads::calltempstore",FALSE));
+       thread->params = newSVsv(Perl_get_sv(thread->interp,
+                                            "threads::paramtempstore",FALSE));
 
        /*
-               And here we make sure we clean up the data we put in the namespace of iThread, both in the new and the calling inteprreter
-       */
+        * And here we make sure we clean up the data we put in the
+        * namespace of iThread, both in the new and the calling
+        * inteprreter */
 
-       
-
-       temp_store = Perl_get_sv(thread->interp,"threads::paramtempstore",FALSE);
+       temp_store = Perl_get_sv(thread->interp, "threads::paramtempstore",FALSE);
        Perl_sv_setsv(thread->interp,temp_store, &PL_sv_undef);
 
        temp_store = Perl_get_sv(thread->interp,"threads::calltempstore",FALSE);
@@ -153,11 +139,7 @@ SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
        temp_store = Perl_get_sv(current_perl,"threads::calltempstore",FALSE);
        Perl_sv_setsv(current_perl, temp_store, &PL_sv_undef);
 
-       /* lets init the thread */
-
-
-
-
+       /* let's init the thread */
 
        MUTEX_INIT(&thread->mutex);
        thread->tid = tid_counter++;
@@ -170,18 +152,16 @@ SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
                        (LPVOID)thread, 0, &thread->thr);
 
 #else
-       pthread_create( &thread->thr, NULL, Perl_thread_run, thread);
+       pthread_create( &thread->thr, (pthread_attr_t*)NULL, Perl_thread_run, thread);
 #endif
        MUTEX_UNLOCK(&create_mutex);    
 
-
-
-  return obj_ref;
+       return obj_ref;
 }
 
 /*
      returns the id of the thread
-*/
* returns the id of the thread
+ */
 I32 Perl_thread_tid (SV* obj) {
        ithread* thread;
        if(!SvROK(obj)) {
@@ -198,27 +178,26 @@ SV* Perl_thread_self (char* class) {
        dTHX;
        SV*      obj_ref;
        SV*      obj;
-       SV*             thread_tid_ptr;
-       SV*             thread_ptr;
-       HE*             thread_entry;
-       PerlInterpreter *old_context = PERL_GET_CONTEXT;
-
-
+       SV*     thread_tid_ptr;
+       SV*     thread_ptr;
+       HE*     thread_entry;
        
        SHAREDSvLOCK(threads);
        SHAREDSvEDIT(threads);
 #ifdef WIN32
-       thread_tid_ptr = Perl_newSViv(PL_sharedsv_space, (IV) GetCurrentThreadId());
+       thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space,
+                                     (UV) GetCurrentThreadId());
 #else
-       thread_tid_ptr = Perl_newSViv(PL_sharedsv_space, (IV) pthread_self());
+       thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space,
+                                     PTR2UV(pthread_self()));
 #endif
-       thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,(HV*) SHAREDSvGET(threads), thread_tid_ptr, 0,0);
+       thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,
+                                        (HV*) SHAREDSvGET(threads),
+                                        thread_tid_ptr, 0,0);
        thread_ptr = HeVAL(thread_entry);
        SvREFCNT_dec(thread_tid_ptr);   
        SHAREDSvRELEASE(threads);
        SHAREDSvUNLOCK(threads);
-       
-
 
        obj_ref = newSViv(0);
        obj = newSVrv(obj_ref, class);
@@ -228,9 +207,8 @@ SV* Perl_thread_self (char* class) {
 }
 
 /*
-       joins the thread
-       this code needs to take the returnvalue from the call_sv and send it back
-*/
+ * joins the thread this code needs to take the returnvalue from the
+ * call_sv and send it back */
 
 void Perl_thread_join(SV* obj) {
        ithread* thread = (ithread*)SvIV(SvRV(obj));
@@ -243,11 +221,8 @@ void Perl_thread_join(SV* obj) {
 #endif
 }
 
-
-/*
-       detaches a thread
-       needs to better clean up memory
-*/
+/* detaches a thread
+ * needs to better clean up memory */
 
 void Perl_thread_detach(SV* obj) {
        ithread* thread = (ithread*)SvIV(SvRV(obj));
@@ -259,8 +234,6 @@ void Perl_thread_detach(SV* obj) {
        MUTEX_UNLOCK(&thread->mutex);
 }
 
-
-
 void Perl_thread_DESTROY (SV* obj) {
        ithread* thread = (ithread*)SvIV(SvRV(obj));
        
@@ -268,7 +241,6 @@ void Perl_thread_DESTROY (SV* obj) {
        thread->count--;
        MUTEX_UNLOCK(&thread->mutex);
        Perl_thread_destruct(thread);
-
 }
 
 void Perl_thread_destruct (ithread* thread) {
@@ -283,7 +255,6 @@ void Perl_thread_destruct (ithread* thread) {
        /*printf("proper destruction!\n");*/
 }
 
-
 MODULE = threads               PACKAGE = threads               
 BOOT:
        Perl_sharedsv_init(aTHX);
@@ -310,8 +281,8 @@ BOOT:
 #else
                thread->thr = pthread_self();
 #endif
-               thread_tid_ptr = Perl_newSViv(PL_sharedsv_space, (IV) thread->thr);
-               thread_ptr = Perl_newSViv(PL_sharedsv_space, (IV) thread);      
+               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);
@@ -319,8 +290,6 @@ BOOT:
        }
        MUTEX_INIT(&create_mutex);
 
-
-
 PROTOTYPES: DISABLE
 
 SV *
@@ -387,10 +356,6 @@ detach (obj)
         /* must have used dXSARGS; list context implied */
         return; /* assume stack size is correct */
 
-
-
-
-
 void
 DESTROY (obj)
         SV *    obj
@@ -407,5 +372,3 @@ DESTROY (obj)
         /* must have used dXSARGS; list context implied */
         return; /* assume stack size is correct */
 
-
-
index d7e60d6..d86527f 100644 (file)
@@ -188,6 +188,8 @@ $pwd_cmd ||= 'pwd';
 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 sub _backtick_pwd {
     my $cwd = `$pwd_cmd`;
+    # Belt-and-suspenders in case someone said "undef $/".
+    local $/ = "\n";
     # `pwd` may fail e.g. if the disk is full
     chomp($cwd) if defined $cwd;
     $cwd;
index 763ae0c..4c1ee08 100644 (file)
@@ -93,7 +93,7 @@ BEGIN {
        @ARGV = ( 0600, 'ecmdfile' );
        ExtUtils::Command::chmod();
 
-       is( (stat('ecmdfile'))[2] & 07777, 0600, 'removed non-owner permissions' );
+       is( ((stat('ecmdfile'))[2] & 07777) & 0700, 0600, 'change a file to read-only' );
 
        # mkpath
        @ARGV = ( File::Spec->join( 'ecmddir', 'temp2' ) );
index 84e00ca..cb39318 100644 (file)
@@ -1,6 +1,6 @@
 package ExtUtils::Constant;
 use vars qw (@ISA $VERSION %XS_Constant %XS_TypeSet @EXPORT_OK %EXPORT_TAGS);
-$VERSION = '0.09';
+$VERSION = '0.10';
 
 =head1 NAME
 
@@ -68,7 +68,7 @@ NUL terminated string, length will be determined with C<strlen>
 A fixed length thing, given as a [pointer, length] pair. If you know the
 length of a string at compile time you may use this instead of I<PV>
 
-=item PVN
+=item SV
 
 A B<mortal> SV.
 
@@ -107,7 +107,7 @@ $Text::Wrap::columns = 80;
 
 %EXPORT_TAGS = ( 'all' => [ qw(
        XS_constant constant_types return_clause memEQ_clause C_stringify
-       C_constant autoload WriteConstants
+       C_constant autoload WriteConstants WriteMakefileSnippet
 ) ] );
 
 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@@ -465,19 +465,35 @@ sub params {
 
 =item dump_names
 
-dump_names  PACKAGE, SUBNAME, DEFAULT_TYPE, TYPES, INDENT, BREAKOUT, ITEM...
+dump_names DEFAULT_TYPE, TYPES, INDENT, OPTIONS, ITEM...
 
 An internal function to generate the embedded perl code that will regenerate
-the constant subroutines.  Parameters are the same as for C_constant.
+the constant subroutines.  I<DEFAULT_TYPE>, I<TYPES> and I<ITEM>s are the
+same as for C_constant.  I<INDENT> is treated as number of spaces to indent
+by.  I<OPTIONS> is a hashref of options. Currently only C<declare_types> is
+recognised.  If the value is true a C<$types> is always declared in the perl
+code generated, if defined and false never declared, and if undefined C<$types>
+is only declared if the values in I<TYPES> as passed in cannot be inferred from
+I<DEFAULT_TYPES> and the I<ITEM>s.
 
 =cut
 
 sub dump_names {
-  my ($package, $subname, $default_type, $what, $indent, $breakout, @items)
-    = @_;
-  my (@simple, @complex);
+  my ($default_type, $what, $indent, $options, @items) = @_;
+  my $declare_types = $options->{declare_types};
+  $indent = ' ' x ($indent || 0);
+
+  my $result;
+  my (@simple, @complex, %used_types);
   foreach (@items) {
-    my $type = $_->{type} || $default_type;
+    my $type;
+    if (ref $_) {
+      $type = $_->{type} || $default_type;
+    } else {
+      $_ = {name=>$_};
+      $type = $default_type;
+    }
+    $used_types{$type}++;
     if ($type eq $default_type and 0 == ($_->{name} =~ tr/A-Za-z0-9_//c)
         and !defined ($_->{macro}) and !defined ($_->{value})
         and !defined ($_->{default}) and !defined ($_->{pre})
@@ -489,29 +505,25 @@ sub dump_names {
       push @complex, $_;
     }
   }
-  my $result = <<"EOT";
-  /* When generated this function returned values for the list of names given
-     in this section of perl code.  Rather than manually editing these functions
-     to add or remove constants, which would result in this comment and section
-     of code becoming inaccurate, we recommend that you edit this section of
-     code, and use it to regenerate a new set of constant functions which you
-     then use to replace the originals.
-
-     Regenerate these constant functions by feeding this entire source file to
-     perl -x
 
-#!$^X -w
-use ExtUtils::Constant qw (constant_types C_constant XS_constant);
-
-EOT
-  $result .= 'my $types = {map {($_, 1)} qw(' . join (" ", sort keys %$what)
-    . ")};\n";
-  $result .= wrap ("my \@names = (qw(",
-                  "               ", join (" ", sort @simple) . ")");
+  if (!defined $declare_types) {
+    # Do they pass in any types we weren't already using?
+    foreach (keys %$what) {
+      next if $used_types{$_};
+      $declare_types++; # Found one in $what that wasn't used.
+      last; # And one is enough to terminate this loop
+    }
+  }
+  if ($declare_types) {
+    $result = $indent . 'my $types = {map {($_, 1)} qw('
+      . join (" ", sort keys %$what) . ")};\n";
+  }
+  $result .= wrap ($indent . "my \@names = (qw(",
+                  $indent . "               ", join (" ", sort @simple) . ")");
   if (@complex) {
     foreach my $item (sort {$a->{name} cmp $b->{name}} @complex) {
       my $name = C_stringify $item->{name};
-      my $line = ",\n            {name=>\"$name\"";
+      my $line = ",\n$indent            {name=>\"$name\"";
       $line .= ", type=>\"$item->{type}\"" if defined $item->{type};
       foreach my $thing (qw (macro value default pre post def_pre def_post)) {
         my $value = $item->{$thing};
@@ -535,6 +547,38 @@ EOT
   }
   $result .= ");\n";
 
+  $result;
+}
+
+
+=item dogfood
+
+dogfood PACKAGE, SUBNAME, DEFAULT_TYPE, TYPES, INDENT, BREAKOUT, ITEM...
+
+An internal function to generate the embedded perl code that will regenerate
+the constant subroutines.  Parameters are the same as for C_constant.
+
+=cut
+
+sub dogfood {
+  my ($package, $subname, $default_type, $what, $indent, $breakout, @items)
+    = @_;
+  my $result = <<"EOT";
+  /* When generated this function returned values for the list of names given
+     in this section of perl code.  Rather than manually editing these functions
+     to add or remove constants, which would result in this comment and section
+     of code becoming inaccurate, we recommend that you edit this section of
+     code, and use it to regenerate a new set of constant functions which you
+     then use to replace the originals.
+
+     Regenerate these constant functions by feeding this entire source file to
+     perl -x
+
+#!$^X -w
+use ExtUtils::Constant qw (constant_types C_constant XS_constant);
+
+EOT
+  $result .= dump_names ($default_type, $what, 0, {declare_types=>1}, @items);
   $result .= <<'EOT';
 
 print constant_types(); # macro defs
@@ -746,8 +790,8 @@ sub C_constant {
   } else {
     # We are the top level.
     $body .= "  /* Initially switch on the length of the name.  */\n";
-    $body .= dump_names ($package, $subname, $default_type, $what, $indent,
-                         $breakout, @items);
+    $body .= dogfood ($package, $subname, $default_type, $what, $indent,
+                      $breakout, @items);
     $body .= "  switch (len) {\n";
     # Need to group names of the same length
     my @by_length;
@@ -999,6 +1043,45 @@ END
 }
 
 
+=item WriteMakefileSnippet
+
+WriteMakefileSnippet ATTRIBUTE =E<gt> VALUE [, ...] 
+
+An function to generate perl code for Makefile.PL that will regenerate
+the constant subroutines.  Parameters are named as passed to C<WriteConstants>,
+with the addition of C<INDENT> to specify the number of leading spaces
+(default 2).
+
+Currently only C<INDENT>, C<NAME>, C<DEFAULT_TYPE>, C<NAMES>, C<C_FILE> and
+C<XS_FILE> are recognised.
+
+=cut
+
+sub WriteMakefileSnippet {
+  my %args = @_;
+  my $indent = $args{INDENT} || 2;
+
+  my $result = <<"EOT";
+ExtUtils::Constant::WriteConstants(
+                                   NAME         => '$args{NAME}',
+                                   NAMES        => \\\@names,
+                                   DEFAULT_TYPE => '$args{DEFAULT_TYPE}',
+EOT
+  foreach (qw (C_FILE XS_FILE)) {
+    next unless exists $args{$_};
+    $result .= sprintf "                                   %-12s => '%s',\n",
+      $_, $args{$_};
+  }
+  $result .= <<'EOT';
+                                );
+EOT
+
+  $result =~ s/^/' 'x$indent/gem;
+  return dump_names ($args{DEFAULT_TYPE}, undef, $indent, undef,
+                           @{$args{NAMES}})
+          . $result;
+}
+
 =item WriteConstants ATTRIBUTE =E<gt> VALUE [, ...]
 
 Writes a file of C code and a file of XS code which you should C<#include>
@@ -1040,7 +1123,7 @@ C<constants.xs>.
 =item SUBNAME
 
 The perl visible name of the XS subroutine generated which will return the
-constants. The default is C<constant>.  
+constants. The default is C<constant>.
 
 =item C_SUBNAME
 
index 4656ead..2d4d7e3 100644 (file)
@@ -142,15 +142,15 @@ sub maniread {
     while (<M>){
        chomp;
        next if /^#/;
+
+        my($file, $comment) = /^(\S+)\s*(.*)/;
+        next unless $file;
+
        if ($Is_MacOS) {
-           my($item,$text) = /^(\S+)\s*(.*)/;
-           $item = _macify($item);
-           $item =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
-           $read->{$item}=$text;
+           $file = _macify($file);
+           $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
        }
        elsif ($Is_VMS) {
-           my($file)= /^(\S+)/;
-           next unless $file;
            my($base,$dir) = File::Basename::fileparse($file);
            # Resolve illegal file specifications in the same way as tar
            $dir =~ tr/./_/;
@@ -158,9 +158,10 @@ sub maniread {
            if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
            my $okfile = "$dir$base";
            warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
-           $read->{"\L$okfile"}=$_;
+            $file = "\L$okfile";
        }
-       else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
+
+        $read->{$file} = $comment;
     }
     close M;
     $read;
index 6b43d73..f62665e 100644 (file)
@@ -105,6 +105,7 @@ is( join(' ', filecheck() ), 'bar', 'listing skipped with filecheck()' );
 # add a subdirectory and a file there that should be found
 ok( mkdir( 'moretest', 0777 ), 'created moretest directory' );
 my $quux = File::Spec->catfile( 'moretest', 'quux' );
+$quux =~ s#\\#/#g;
 add_file( $quux, 'quux' );
 ok( exists( ExtUtils::Manifest::manifind()->{$quux} ), "manifind found $quux" );
 
diff --git a/lib/filetest.t b/lib/filetest.t
new file mode 100644 (file)
index 0000000..096031c
--- /dev/null
@@ -0,0 +1,51 @@
+#!./perl
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+use Test::More tests => 11;
+
+# these two should be kept in sync with the pragma itself
+# if hint bits are changed there, other things *will* break
+my $hint_bits = 0x00400000;
+my $error = "filetest: the only implemented subpragma is 'access'.\n";
+
+# can't use it yet, because of the import death
+ok( require filetest, 'required pragma successfully' );
+
+# and here's one culprit, right here
+eval { filetest->import('bad subpragma') };
+is( $@, $error, 'filetest dies with bad subpragma on import' );
+
+is( $^H & $hint_bits, 0, 'hint bits not set without pragma in place' );
+
+# now try the normal usage
+# can't check $^H here; it's lexically magic (see perlvar)
+# the test harness unintentionally hoards the goodies for itself
+use_ok( 'filetest', 'access' );
+
+# and import again, to see it here
+filetest->import('access');
+ok( $^H & $hint_bits, 'hint bits set with pragma loaded' );
+
+# and now get rid of it
+filetest->unimport('access');
+is( $^H & $hint_bits, 0, 'hint bits not set with pragma unimported' );
+
+eval { filetest->unimport() };
+is( $@, $error, 'filetest dies without subpragma on unimport' );
+
+# there'll be a compilation aborted failure here, with the eval string
+eval "no filetest 'fake pragma'";
+like( $@, qr/^$error/, 'filetest dies with bad subpragma on unuse' );
+
+eval "use filetest 'bad subpragma'";
+like( $@, qr/^$error/, 'filetest dies with bad subpragma on use' );
+
+eval "use filetest";
+like( $@, qr/^$error/, 'filetest dies with missing subpragma on use' );
+
+eval "no filetest";
+like( $@, qr/^$error/, 'filetest dies with missing subpragma on unuse' );
index c237031..1b26c89 100644 (file)
@@ -43,6 +43,8 @@ my @tests = (
 "-f -n $name", <<"EOXSFILES",
 Writing $name/$name.pm
 Writing $name/$name.xs
+Writing $name/fallback.c
+Writing $name/fallback.xs
 Writing $name/Makefile.PL
 Writing $name/README
 Writing $name/t/1.t
@@ -62,6 +64,8 @@ EONOXSFILES
 "-f -n $name $header", <<"EOXSFILES",
 Writing $name/$name.pm
 Writing $name/$name.xs
+Writing $name/fallback.c
+Writing $name/fallback.xs
 Writing $name/Makefile.PL
 Writing $name/README
 Writing $name/t/1.t
index 2b8e636..7d359f1 100644 (file)
@@ -534,6 +534,8 @@ unless ($define{'USE_ITHREADS'}) {
                    PL_op_mutex
                    PL_regex_pad
                    PL_regex_padav
+                   PL_sharedsv_space
+                   PL_sharedsv_space_mutex
                    Perl_dirp_dup
                    Perl_cx_dup
                    Perl_si_dup
index 530e488..66d5a9a 100644 (file)
@@ -70,7 +70,7 @@
 #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
 static char    *local_patches[] = {
         NULL
-       ,"DEVEL12109"
+       ,"DEVEL12178"
        ,NULL
 };
 
index 340e15c..69e44ff 100644 (file)
@@ -563,9 +563,9 @@ previous time C<caller> was called.
 Changes the working directory to EXPR, if possible. If EXPR is omitted,
 changes to the directory specified by C<$ENV{HOME}>, if set; if not,
 changes to the directory specified by C<$ENV{LOGDIR}>. (Under VMS, the
-variable C<$ENV{SYS$LOGIN}> is used instead.) If neither is set,
-C<chdir> does nothing. It returns true upon success, false otherwise.
-See the example under C<die>.
+variable C<$ENV{SYS$LOGIN}> is also checked, and used if it is set.) If
+neither is set, C<chdir> does nothing. It returns true upon success,
+false otherwise. See the example under C<die>.
 
 =item chmod LIST
 
index 99d2960..e61e8ed 100644 (file)
@@ -1156,10 +1156,9 @@ value is the location of the file found.  The C<require>
 operator uses this hash to determine whether a particular file has
 already been included.
 
-If the file was loaded via a hook (see L<perlfunc/require> for a
-description of these hooks), a fake filename is inserted into %INC. It
-looks like F</loader/0x81095c8/Foo.pm>, where the hexadecimal number
-corresponds to the reference that was put in @INC.
+If the file was loaded via a hook (e.g. a subroutine reference, see
+L<perlfunc/require> for a description of these hooks), this hook is
+inserted into %INC in place of a filename.
 
 =item %ENV
 
index 5d2d10f..d488b7c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3032,6 +3032,7 @@ PP(pp_require)
     GV *filter_child_proc = 0;
     SV *filter_state = 0;
     SV *filter_sub = 0;
+    SV *hook_sv = 0;
 
     sv = POPs;
     if (SvNIOKp(sv)) {
@@ -3230,6 +3231,7 @@ trylocal: {
                    LEAVE;
 
                    if (tryrsfp) {
+                       hook_sv = dirsv;
                        break;
                    }
 
@@ -3319,7 +3321,9 @@ trylocal: {
 
     /* Assume success here to prevent recursive requirement. */
     (void)hv_store(GvHVn(PL_incgv), name, strlen(name),
-                  newSVpv(CopFILE(&PL_compiling), 0), 0 );
+                  (hook_sv ? SvREFCNT_inc(hook_sv)
+                           : newSVpv(CopFILE(&PL_compiling), 0)),
+                  0 );
 
     ENTER;
     SAVETMPS;
index ff2f8e0..021c35c 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -266,13 +266,14 @@ PP(pp_unpack)
                goto uchar_checksum;
            sv = NEWSV(35, len);
            sv_setpvn(sv, s, len);
-           s += len;
            if (datumtype == 'A' || datumtype == 'Z') {
                aptr = s;       /* borrow register */
                if (datumtype == 'Z') { /* 'Z' strips stuff after first null */
                    s = SvPVX(sv);
                    while (*s)
                        s++;
+                   if (star) /* exact for 'Z*' */
+                       len = s - SvPVX(sv) + 1;
                }
                else {          /* 'A' strips both nulls and spaces */
                    s = SvPVX(sv) + len - 1;
@@ -283,6 +284,7 @@ PP(pp_unpack)
                SvCUR_set(sv, s - SvPVX(sv));
                s = aptr;       /* unborrow register */
            }
+           s += len;
            XPUSHs(sv_2mortal(sv));
            break;
        case 'B':
index 1d3daa5..7a9536c 100644 (file)
@@ -141,7 +141,6 @@ CGI::Switch
 CGI::Util
 Carp::Heavy
 Devel::DProf
-Dumpvalue
 Exporter::Heavy
 ExtUtils::Constant
 ExtUtils::MakeMaker
index 95ee7c0..71beb3e 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
 }
 
 use File::Spec;
-use Test::More tests => 30;
+use Test::More tests => 39;
 
 my @tempfiles = ();
 
@@ -25,12 +25,6 @@ sub get_temp_fh {
 
 END { 1 while unlink @tempfiles }
 
-sub get_addr {
-    my $str = shift;
-    $str =~ /(0x[0-9a-f]+)/i;
-    return $1;
-}
-
 sub fooinc {
     my ($self, $filename) = @_;
     if (substr($filename,0,3) eq 'Foo') {
@@ -47,18 +41,18 @@ ok( !eval { require Bar; 1 },      'Trying non-magic package' );
 
 ok( eval { require Foo; 1 },       'require() magic via code ref'  ); 
 ok( exists $INC{'Foo.pm'},         '  %INC sees it' );
-is( get_addr($INC{'Foo.pm'}), get_addr(\&fooinc),
-                                  '  key is correct in %INC' );
+is( ref $INC{'Foo.pm'}, 'CODE',    '  key is a coderef in %INC' );
+is( $INC{'Foo.pm'}, \&fooinc,     '  key is correct in %INC' );
 
 ok( eval "use Foo1; 1;",           'use()' );  
 ok( exists $INC{'Foo1.pm'},        '  %INC sees it' );
-is( get_addr($INC{'Foo1.pm'}), get_addr(\&fooinc),
-                                  '  key is correct in %INC' );
+is( ref $INC{'Foo1.pm'}, 'CODE',   '  key is a coderef in %INC' );
+is( $INC{'Foo1.pm'}, \&fooinc,     '  key is correct in %INC' );
 
 ok( eval { do 'Foo2.pl'; 1 },      'do()' ); 
 ok( exists $INC{'Foo2.pl'},        '  %INC sees it' );
-is( get_addr($INC{'Foo2.pl'}), get_addr(\&fooinc),
-                                  '  key is correct in %INC' );
+is( ref $INC{'Foo2.pl'}, 'CODE',   '  key is a coderef in %INC' );
+is( $INC{'Foo2.pl'}, \&fooinc,     '  key is correct in %INC' );
 
 pop @INC;
 
@@ -81,18 +75,18 @@ ok( !eval { require Foo3; 1; },   'Original magic INC purged' );
 
 ok( eval { require Bar; 1 },      'require() magic via array ref' );
 ok( exists $INC{'Bar.pm'},        '  %INC sees it' );
-is( get_addr($INC{'Bar.pm'}), get_addr($arrayref),
-                                  '  key is correct in %INC' );
+is( ref $INC{'Bar.pm'}, 'ARRAY',  '  key is an arrayref in %INC' );
+is( $INC{'Bar.pm'}, $arrayref,    '  key is correct in %INC' );
 
 ok( eval "use Bar1; 1;",          'use()' );
 ok( exists $INC{'Bar1.pm'},       '  %INC sees it' );
-is( get_addr($INC{'Bar1.pm'}), get_addr($arrayref),
-                                  '  key is correct in %INC' );
+is( ref $INC{'Bar1.pm'}, 'ARRAY', '  key is an arrayref in %INC' );
+is( $INC{'Bar1.pm'}, $arrayref,   '  key is correct in %INC' );
 
 ok( eval { do 'Bar2.pl'; 1 },     'do()' );
 ok( exists $INC{'Bar2.pl'},       '  %INC sees it' );
-is( get_addr($INC{'Bar2.pl'}), get_addr($arrayref),
-                                  '  key is correct in %INC' );
+is( ref $INC{'Bar2.pl'}, 'ARRAY', '  key is an arrayref in %INC' );
+is( $INC{'Bar2.pl'}, $arrayref,   '  key is correct in %INC' );
 
 pop @INC;
 
@@ -111,8 +105,9 @@ push @INC, $href;
 
 ok( eval { require Quux; 1 },      'require() magic via hash object' );
 ok( exists $INC{'Quux.pm'},        '  %INC sees it' );
-is( get_addr($INC{'Quux.pm'}), get_addr($href),
-                                  '  key is correct in %INC' );
+is( ref $INC{'Quux.pm'}, 'FooLoader',
+                                  '  key is an object in %INC' );
+is( $INC{'Quux.pm'}, $href,        '  key is correct in %INC' );
 
 pop @INC;
 
@@ -121,8 +116,9 @@ push @INC, $aref;
 
 ok( eval { require Quux1; 1 },     'require() magic via array object' );
 ok( exists $INC{'Quux1.pm'},       '  %INC sees it' );
-is( get_addr($INC{'Quux1.pm'}), get_addr($aref),
-                                  '  key is correct in %INC' );
+is( ref $INC{'Quux1.pm'}, 'FooLoader',
+                                  '  key is an object in %INC' );
+is( $INC{'Quux1.pm'}, $aref,       '  key is correct in %INC' );
 
 pop @INC;
 
@@ -131,7 +127,8 @@ push @INC, $sref;
 
 ok( eval { require Quux2; 1 },     'require() magic via scalar object' );
 ok( exists $INC{'Quux2.pm'},       '  %INC sees it' );
-is( get_addr($INC{'Quux2.pm'}), get_addr($sref),
-                                  '  key is correct in %INC' );
+is( ref $INC{'Quux2.pm'}, 'FooLoader',
+                                  '  key is an object in %INC' );
+is( $INC{'Quux2.pm'}, $sref,       '  key is correct in %INC' );
 
 pop @INC;
index d5931f3..ae1b1d9 100755 (executable)
@@ -83,8 +83,8 @@ else {
     }
 
 END
+    $test += 2;
 }
-$test += 2;
 
 # can we slice ENV?
 @val1 = @ENV{keys(%ENV)};
index 02b3806..fcc2aba 100755 (executable)
@@ -1,6 +1,6 @@
-#!./perl -Tw
+#!./perl -w
 
-print "1..610\n";
+print "1..611\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -646,3 +646,12 @@ foreach (
     or printf "# scalar unpack ('$template', \"%s\") gave %s expected %s\n",
     encode ($in), encode_list ($got), encode_list ($out[0]);
 }
+
+{
+    # 611
+    my $t = 'Z*Z*';
+    my ($u, $v) = qw(foo xyzzy);
+    my $p = pack($t, $u, $v);
+    my @u = unpack($t, $p);
+    ok(@u == 2 && $u[0] eq $u && $u[1] eq $v);
+}
index 0c111ea..3ca9535 100755 (executable)
@@ -5,99 +5,117 @@ BEGIN {
     @INC = '../lib';
 }
 
+$Ok_Level = 0;
+my $test = 1;
+sub ok ($;$) {
+    my($ok, $name) = @_;
+
+    local $_;
+
+    # You have to do it this way or VMS will get confused.
+    printf "%s $test%s\n", $ok   ? 'ok' : 'not ok',
+                           $name ? " - $name" : '';
+
+    printf "# Failed test at line %d\n", (caller($Ok_Level))[2] unless $ok;
+
+    $test++;
+    return $ok;
+}
+
+sub nok ($;$) {
+    my($nok, $name) = @_;
+    local $Ok_Level = 1;
+    ok( !$nok, $name );
+}
+
+use Config;
+my $have_alarm = $Config{d_alarm};
+sub alarm_ok (&) {
+    my $test = shift;
+
+    local $SIG{ALRM} = sub { die "timeout\n" };
+    
+    my $match;
+    eval { 
+        alarm(2) if $have_alarm;
+        $match = $test->();
+        alarm(0) if $have_alarm;
+    };
+
+    local $Ok_Level = 1;
+    ok( !$match && !$@, 'testing studys that used to hang' );
+}
+
+
 print "1..26\n";
 
 $x = "abc\ndef\n";
 study($x);
 
-if ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
-if ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
+ok($x =~ /^abc/);
+ok($x !~ /^def/);
 
 $* = 1;
-if ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
+ok($x =~ /^def/);
 $* = 0;
 
 $_ = '123';
 study;
-if (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
+ok(/^([0-9][0-9]*)/);
 
-if ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
-if ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
+nok($x =~ /^xxx/);
+nok($x !~ /^abc/);
 
-if ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
-if ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
+ok($x =~ /def/);
+nok($x !~ /def/);
 
 study($x);
-if ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
-if ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
+ok($x !~ /.def/);
+nok($x =~ /.def/);
 
-if ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
-if ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
+ok($x =~ /\ndef/);
+nok($x !~ /\ndef/);
 
 $_ = 'aaabbbccc';
 study;
-if (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
-       print "ok 13\n";
-} else {
-       print "not ok 13\n";
-}
-if (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
-       print "ok 14\n";
-} else {
-       print "not ok 14\n";
-}
+ok(/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc');
+ok(/(a+b+c+)/ && $1 eq 'aaabbbccc');
 
-if (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
+nok(/a+b?c+/);
 
 $_ = 'aaabccc';
 study;
-if (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
-if (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
+ok(/a+b?c+/);
+ok(/a*b+c*/);
 
 $_ = 'aaaccc';
 study;
-if (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
-if (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
+ok(/a*b?c*/);
+nok(/a*b+c*/);
 
 $_ = 'abcdef';
 study;
-if (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
-if (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
+ok(/bcd|xyz/);
+ok(/xyz|bcd/);
 
-if (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
+ok(m|bc/*d|);
 
-if (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
+ok(/^$_$/);
 
-$* = 1;                # test 3 only tested the optimized version--this one is for real
-if ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
+$* = 1;            # test 3 only tested the optimized version--this one is for real
+ok("ab\ncd\n" =~ /^cd/);
 
 if ($^O eq 'os390') {
     # Even with the alarm() OS/390 can't manage these tests
     # (Perl just goes into a busy loop, luckily an interruptable one)
-    for (25..26) { print "not ok $_ # compiler bug?\n" }
+    for (25..26) { print "not ok $_ # TODO compiler bug?\n" }
+    $test += 2;
 } else {
     # [ID 20010618.006] tests 25..26 may loop
-    use Config;
-    my $have_alarm = $Config{d_alarm};
-    local $SIG{ALRM} = sub { die "timeout\n" };
 
     $_ = 'FGF';
     study;
-    my $ok = $have_alarm
-       ? eval { alarm(2); my $match = /G.F$/; alarm(0); !$match }
-       : eval { !/G.F$/ };
-    if ($ok && !$@) {
-       print "ok 25\n";
-    } else {
-       print "not ok 25\t# " . $@ || "should not match\n";
-    }
-    $ok = $have_alarm
-       ? eval { alarm(2); my $match = /[F]F$/; alarm(0); !$match }
-       : eval { !/[F]F$/ };
-    if ($ok && !$@) {
-       print "ok 26\n";
-    } else {
-       print "not ok 26\t# " . $@ || "should not match\n";
-    }
+    alarm_ok { /G.F$/ };
+    alarm_ok { /[F]F$/ };
 }
 
index 4e5319b..e57779c 100644 (file)
@@ -425,6 +425,7 @@ See L<perlxs> and L<perlxstut> for additional details.
 
 =cut
 
+# ' # Grr
 use strict;
 
 
@@ -438,7 +439,8 @@ use Config;
 use Text::Wrap;
 $Text::Wrap::huge = 'overflow';
 $Text::Wrap::columns = 80;
-use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload);
+use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload);
+use File::Compare;
 
 sub usage {
     warn "@_\n" if @_;
@@ -472,7 +474,7 @@ OPTIONS:
     -p, --remove-prefix   Specify a prefix which should be removed from the
                           Perl function names.
     -s, --const-subs      Create subroutines for specified macros.
-    -t, --default-type    Default type for autoloaded constants
+    -t, --default-type    Default type for autoloaded constants (default is IV)
         --use-new-tests   Use Test::More in backward compatible modules
         --use-old-tests   Use the module Test rather than Test::More
     -v, --version         Specify a version number for this extension.
@@ -562,6 +564,8 @@ $opt_c = 1 if $opt_A;
 # -X implies -c and -f
 $opt_c = $opt_f = 1 if $opt_X;
 
+$opt_t ||= 'IV';
+
 my %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
 
 my $extralibs = '';
@@ -743,7 +747,7 @@ if( @path_h ){
 # Save current directory so that C::Scan can use it
 my $cwd = File::Spec->rel2abs( File::Spec->curdir );
 
-my ($ext, $nested, @modparts, $modfname, $modpname);
+my ($ext, $nested, @modparts, $modfname, $modpname, $constsfname);
 
 $ext = chdir 'ext' ? 'ext/' : '';
 
@@ -758,6 +762,8 @@ else {
        @modparts = ();
        $modfname = $modpname = $module;
 }
+# Don't trip up if someone calls their module 'constants'
+$constsfname = $modfname eq 'constants' ? 'constdefs' : 'constants';
 
 
 if ($opt_O) {
@@ -905,23 +911,13 @@ open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n"
 $" = "\n\t";
 warn "Writing $ext$modpname/$modfname.pm\n";
 
-if ( $compat_version < 5.006 ) {
 print PM <<"END";
 package $module;
 
 use $compat_version;
 use strict;
 END
-} 
-else {
-print PM <<"END";
-package $module;
-
-use 5.006;
-use strict;
-use warnings;
-END
-}
+print PM "use warnings;\n" unless $compat_version < 5.006;
 
 unless( $opt_X || $opt_c || $opt_A ){
        # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
@@ -1227,19 +1223,24 @@ sub td_is_struct {
   return ($struct_typedefs{$otype} = $out);
 }
 
-my $types = {};
-# Important. Passing an undef scalar doesn't cause the
-# autovivified hashref to appear back out in this scope.
+print_tievar_subs(\*XS, $_, $vdecl_hash{$_}) for @vdecls;
 
 if( ! $opt_c ) {
-  print XS constant_types(), "\n";
-  foreach (C_constant ($module, undef, $opt_t, $types, undef, undef,
-           @const_names)) {
-    print XS $_, "\n";
-  }
+  # We write the "sample" files used when this module is built by perl without
+  # ExtUtils::Constant.
+  # h2xs will later check that these are the same as those generated by the
+  # code embedded into Makefile.PL
+  warn "Writing $ext$modpname/fallback.c\n";
+  warn "Writing $ext$modpname/fallback.xs\n";
+  WriteConstants ( C_FILE =>       "fallback.c",
+                   XS_FILE =>      "fallback.xs",
+                   DEFAULT_TYPE => $opt_t,
+                   NAME =>         $module,
+                   NAMES =>        \@const_names,
+                 );
+  print XS "#include \"$constsfname.c\"\n";
 }
 
-print_tievar_subs(\*XS, $_, $vdecl_hash{$_}) for @vdecls;
 
 my $prefix = defined $opt_p ? "PREFIX = $opt_p" : '';
 
@@ -1250,6 +1251,10 @@ MODULE = $module         PACKAGE = $module               $prefix
 
 END
 
+# If a constant() function was #included then output a corresponding
+# XS declaration:
+print XS "INCLUDE: $constsfname.xs\n" unless $opt_c;
+
 foreach (sort keys %const_xsub) {
     print XS <<"END";
 char *
@@ -1268,11 +1273,6 @@ $_()
 END
 }
 
-# If a constant() function was written then output a corresponding
-# XS declaration:
-# XXX IVs
-print XS XS_constant ($module, $types) unless $opt_c;
-
 my %seen_decl;
 my %typemap;
 
@@ -1663,7 +1663,8 @@ else
   $prereq_pm = '';
 }
 
-print PL <<END;
+print PL <<"END";
+use $compat_version;
 use ExtUtils::MakeMaker;
 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
 # the contents of the Makefile that is written.
@@ -1689,7 +1690,17 @@ EOC
 $Icomment    'INC'             => '$I', # e.g., '${Ihelp}-I/usr/include/other'
 END
 
-  my $C = grep $_ ne "$modfname.c", (glob '*.c'), (glob '*.cc'), (glob '*.C');
+  if (!$opt_c) {
+    print PL <<"END";
+    # Without this the constants xs files are spotted, and cause rules to be
+    # added to delete the similarly names C files, which isn't what we want.
+    'XS'               => {'$modfname.xs' => '$modfname.c'},
+    realclean          => {FILES => '$constsfname.c $constsfname.xs'},
+END
+  }
+
+  my $C = grep {$_ ne "$modfname.c" && $_ ne "fallback.c"}
+    (glob '*.c'), (glob '*.cc'), (glob '*.C');
   my $Cpre = ($C ? '' : '# ');
   my $Ccomment = ($C ? '' : <<EOC);
        # Un-comment this if you add C files to link with later:
@@ -1698,8 +1709,68 @@ EOC
   print PL <<END;
 $Ccomment    $Cpre\'OBJECT'            => '\$(O_FILES)', # link all the C files too
 END
-}
+} # ' # Grr
 print PL ");\n";
+if (!$opt_c) {
+  my $generate_code =
+    WriteMakefileSnippet ( C_FILE =>       "$constsfname.c",
+                           XS_FILE =>      "$constsfname.xs",
+                           DEFAULT_TYPE => $opt_t,
+                           NAME =>         $module,
+                           NAMES =>        \@const_names,
+                 );
+  print PL <<"END";
+if  (eval {require ExtUtils::Constant; 1}) {
+  # If you edit these definitions to change the constants used by this module,
+  # you will need to use the generated $constsfname.c and $constsfname.xs
+  # files to replace their "fallback" counterparts before distributing your
+  # changes.
+$generate_code
+}
+else {
+  use File::Copy;
+  copy ('fallback.c', '$constsfname.c')
+    or die "Can't copy fallback.c to $constsfname.c: $!";
+  copy ('fallback.xs', '$constsfname.xs')
+    or die "Can't copy fallback.xs to $constsfname.xs: $!";
+}
+END
+
+  eval $generate_code;
+  if ($@) {
+    warn <<"EOM";
+Attempting to test constant code in $ext$modpname/Makefile.PL:
+$generate_code
+__END__
+gave unexpected error $@
+Please report the circumstances of this bug in h2xs version $H2XS_VERSION
+using the perlbug script.
+EOM
+  } else {
+    my $fail;
+
+    foreach ('c', 'xs') {
+      if (compare("fallback.$_", "$constsfname.$_")) {
+        warn << "EOM";
+Files "$ext$modpname/fallback.$_" and "$ext$modpname/$constsfname.$_" differ.
+EOM
+        $fail++;
+      }
+    }
+    if ($fail) {
+      warn fill ('','', <<"EOM") . "\n";
+It appears that the code in $ext$modpname/Makefile.PL does not autogenerate
+the files $ext$modpname/$constsfname.c and $ext$modpname/$constsfname.xs
+correctly.
+Please report the circumstances of this bug in h2xs version $H2XS_VERSION
+using the perlbug script.
+EOM
+    } else {
+      unlink "$constsfname.c", "$constsfname.xs";
+    }
+  }
+}
 close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
 
 # Create a simple README since this is a CPAN requirement
@@ -1905,6 +1976,9 @@ if ($^O eq 'VMS') {
     $_ = 'Makefile.PL' if $_ eq 'makefile.pl';
   }
 }
+if (!$opt_c) {
+  @files = grep {$_ ne "$constsfname.c" and $_ ne "$constsfname.xs"} @files;
+}
 print MANI join("\n",@files), "\n";
 close MANI;
 !NO!SUBS!
index 7eb957d..ce98bff 100644 (file)
@@ -201,7 +201,7 @@ while ($test = shift) {
                next if /^\s*$/;
 
 
-                if (/^(not )?ok (\d+)(\s*#.*)?/ &&
+                if (/^(not )?ok (\d+)[^#]*(\s*#.*)?/ &&
                     $2 == $next)
                 {
                     my($not, $num, $extra) = ($1, $2, $3);