summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNick Ing-Simmons <nik@tiuk.ti.com>2001-09-24 19:18:17 +0000
committerNick Ing-Simmons <nik@tiuk.ti.com>2001-09-24 19:18:17 +0000
commit3ed9e235452ac04f38d3ebeb9fd58a5c777b9fff (patch)
treef4faddf9b2a5da1268700d69792c566eac55dbbd
parent5b82561c4274a5e1e753d0dede9084de567ff09f (diff)
parent7fcd0fc5f1b89986c4e176868a5363c5feb2d66d (diff)
downloadperl-3ed9e235452ac04f38d3ebeb9fd58a5c777b9fff.tar.gz
Integrate mainline
p4raw-id: //depot/perlio@12186
Diffstat
-rw-r--r--Changes526
-rwxr-xr-xConfigure15
-rw-r--r--MANIFEST3
-rw-r--r--djgpp/djgppsed.sh1
-rw-r--r--dosish.h1
-rw-r--r--ext/Encode/Encode/gb2312.enc2
-rw-r--r--ext/I18N/Langinfo/Langinfo.xs812
-rw-r--r--ext/I18N/Langinfo/Makefile.PL24
-rw-r--r--ext/I18N/Langinfo/fallback.c724
-rw-r--r--ext/I18N/Langinfo/fallback.xs88
-rw-r--r--ext/Time/HiRes/HiRes.xs3
-rwxr-xr-xext/threads/Makefile.PL2
-rwxr-xr-xext/threads/threads.xs133
-rw-r--r--lib/Cwd.pm2
-rw-r--r--lib/ExtUtils/Command.t2
-rw-r--r--lib/ExtUtils/Constant.pm145
-rw-r--r--lib/ExtUtils/Manifest.pm17
-rw-r--r--lib/ExtUtils/Manifest.t1
-rw-r--r--lib/filetest.t51
-rw-r--r--lib/h2xs.t4
-rw-r--r--makedef.pl2
-rw-r--r--patchlevel.h2
-rw-r--r--pod/perlfunc.pod6
-rw-r--r--pod/perlvar.pod7
-rw-r--r--pp_ctl.c6
-rw-r--r--pp_pack.c4
-rw-r--r--t/lib/1_compile.t1
-rw-r--r--t/op/inccode.t47
-rwxr-xr-xt/op/magic.t2
-rwxr-xr-xt/op/pack.t13
-rwxr-xr-xt/op/study.t124
-rw-r--r--utils/h2xs.PL136
-rw-r--r--vms/test.com2
33 files changed, 1841 insertions, 1067 deletions
diff --git a/Changes b/Changes
index ea6d15e25a..811cfab4ae 100644
--- 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
diff --git a/Configure b/Configure
index dce7a06753..3f3491aca6 100755
--- 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
diff --git a/MANIFEST b/MANIFEST
index a7686d968b..fd13369d4e 100644
--- 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
diff --git a/djgpp/djgppsed.sh b/djgpp/djgppsed.sh
index 76911fd230..bb35eb0720 100644
--- a/djgpp/djgppsed.sh
+++ b/djgpp/djgppsed.sh
@@ -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
diff --git a/dosish.h b/dosish.h
index 0b0a35e073..a3d5d13e5c 100644
--- 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
diff --git a/ext/Encode/Encode/gb2312.enc b/ext/Encode/Encode/gb2312.enc
index 813d7a6f37..3ebb32c2df 100644
--- a/ext/Encode/Encode/gb2312.enc
+++ b/ext/Encode/Encode/gb2312.enc
@@ -4,7 +4,7 @@ D
21
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
-000030003001300230FB02C902C700A8300330052015FF5E2225202620182019
+000030003001300230FB02C902C700A8300330052015FF5E2016202620182019
201C201D3014301530083009300A300B300C300D300E300F3016301730103011
00B100D700F72236222722282211220F222A222922082237221A22A522252220
23122299222B222E2261224C2248223D221D2260226E226F22642265221E2235
diff --git a/ext/I18N/Langinfo/Langinfo.xs b/ext/I18N/Langinfo/Langinfo.xs
index 3dd0738d5e..d335eec71e 100644
--- a/ext/I18N/Langinfo/Langinfo.xs
+++ b/ext/I18N/Langinfo/Langinfo.xs
@@ -6,821 +6,13 @@
# 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)
diff --git a/ext/I18N/Langinfo/Makefile.PL b/ext/I18N/Langinfo/Makefile.PL
index aff6f87107..63137ff90a 100644
--- a/ext/I18N/Langinfo/Makefile.PL
+++ b/ext/I18N/Langinfo/Makefile.PL
@@ -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
index 0000000000..538a9f753c
--- /dev/null
+++ b/ext/I18N/Langinfo/fallback.c
@@ -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
index 0000000000..16ae6e803d
--- /dev/null
+++ b/ext/I18N/Langinfo/fallback.xs
@@ -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);
+ }
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index 97ea55983f..a4bf2dfd0d 100644
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -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;
diff --git a/ext/threads/Makefile.PL b/ext/threads/Makefile.PL
index 02d5c10c1f..1ab8bc5e19 100755
--- a/ext/threads/Makefile.PL
+++ b/ext/threads/Makefile.PL
@@ -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";
}
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 1e6d442262..5678bcb71a 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -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 */
-
-
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index d7e60d6dc9..d86527f9e0 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -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;
diff --git a/lib/ExtUtils/Command.t b/lib/ExtUtils/Command.t
index 763ae0cbee..4c1ee08090 100644
--- a/lib/ExtUtils/Command.t
+++ b/lib/ExtUtils/Command.t
@@ -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' ) );
diff --git a/lib/ExtUtils/Constant.pm b/lib/ExtUtils/Constant.pm
index 84e00ca7bb..cb3931821d 100644
--- a/lib/ExtUtils/Constant.pm
+++ b/lib/ExtUtils/Constant.pm
@@ -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
diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm
index 4656eadf99..2d4d7e3e19 100644
--- a/lib/ExtUtils/Manifest.pm
+++ b/lib/ExtUtils/Manifest.pm
@@ -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;
diff --git a/lib/ExtUtils/Manifest.t b/lib/ExtUtils/Manifest.t
index 6b43d73d27..f62665e3c8 100644
--- a/lib/ExtUtils/Manifest.t
+++ b/lib/ExtUtils/Manifest.t
@@ -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
index 0000000000..096031c63d
--- /dev/null
+++ b/lib/filetest.t
@@ -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' );
diff --git a/lib/h2xs.t b/lib/h2xs.t
index c237031c6e..1b26c89131 100644
--- a/lib/h2xs.t
+++ b/lib/h2xs.t
@@ -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
diff --git a/makedef.pl b/makedef.pl
index 2b8e636b62..7d359f103d 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -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
diff --git a/patchlevel.h b/patchlevel.h
index 530e48861a..66d5a9a81d 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -70,7 +70,7 @@
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
static char *local_patches[] = {
NULL
- ,"DEVEL12109"
+ ,"DEVEL12178"
,NULL
};
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 340e15c285..69e44ffd01 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -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
diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index 99d29603dd..e61e8ed646 100644
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -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
diff --git a/pp_ctl.c b/pp_ctl.c
index 5d2d10f94c..d488b7ce37 100644
--- 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;
diff --git a/pp_pack.c b/pp_pack.c
index ff2f8e0ee8..021c35c737 100644
--- 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':
diff --git a/t/lib/1_compile.t b/t/lib/1_compile.t
index 1d3daa5a4c..7a9536c88a 100644
--- a/t/lib/1_compile.t
+++ b/t/lib/1_compile.t
@@ -141,7 +141,6 @@ CGI::Switch
CGI::Util
Carp::Heavy
Devel::DProf
-Dumpvalue
Exporter::Heavy
ExtUtils::Constant
ExtUtils::MakeMaker
diff --git a/t/op/inccode.t b/t/op/inccode.t
index 95ee7c0094..71beb3e9e9 100644
--- a/t/op/inccode.t
+++ b/t/op/inccode.t
@@ -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;
diff --git a/t/op/magic.t b/t/op/magic.t
index d5931f3cd9..ae1b1d9b8a 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -83,8 +83,8 @@ else {
}
END
+ $test += 2;
}
-$test += 2;
# can we slice ENV?
@val1 = @ENV{keys(%ENV)};
diff --git a/t/op/pack.t b/t/op/pack.t
index 02b3806c6d..fcc2abab03 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -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);
+}
diff --git a/t/op/study.t b/t/op/study.t
index 0c111ea9cc..3ca95355b0 100755
--- a/t/op/study.t
+++ b/t/op/study.t
@@ -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$/ };
}
diff --git a/utils/h2xs.PL b/utils/h2xs.PL
index 4e5319bad1..e57779c47f 100644
--- a/utils/h2xs.PL
+++ b/utils/h2xs.PL
@@ -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!
diff --git a/vms/test.com b/vms/test.com
index 7eb957dfd2..ce98bff0d8 100644
--- a/vms/test.com
+++ b/vms/test.com
@@ -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);
View Lorry Controller Status