Andy Dougherty <doughera@lafayette.edu>
Anno Siegel <anno4000@lublin.zrz.tu-berlin.de>
Anthony David <adavid@netinfo.com.au>
-Anton Berezin <tobez@plab.ku.dk>
+Anton Berezin <tobez@tobez.org>
Art Green <Art_Green@mercmarine.com>
Artur <artur@vogon-solutions.com>
Barrie Slaymaker <barries@slaysys.com>
--------------
____________________________________________________________________________
+[ 8199] By: jhi on 2000/12/19 18:35:07
+ Log: Microperl tweaks.
+ Branch: perl
+ ! sv.c uconfig.h uconfig.sh
+____________________________________________________________________________
+[ 8198] By: jhi on 2000/12/19 18:29:59
+ Log: Regen Configure, nitfix uconfig.sh (d_vendorarch is needed).
+ Branch: perl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH pod/perltoc.pod uconfig.h uconfig.sh
+____________________________________________________________________________
+[ 8197] By: jhi on 2000/12/19 17:55:29
+ Log: In VMS embedded perls couldn't access the statically built Socket,
+ from Charles Lane.
+ Branch: perl
+ ! configure.com
+____________________________________________________________________________
+[ 8196] By: jhi on 2000/12/19 17:49:50
+ Log: Subject: [PATCH perl@8143] DB_File-1.75 (was RE: [8104] DB_File)
+ From: "Paul Marquess" <Paul_Marquess@yahoo.co.uk>
+ Date: Sun, 17 Dec 2000 19:11:44 -0000
+ Message-ID: <000801c0685d$3224e5a0$a20a140a@bfs.phone.com>
+ Branch: perl
+ ! ext/DB_File/Changes ext/DB_File/DB_File.pm
+ ! ext/DB_File/DB_File.xs ext/DB_File/dbinfo
+____________________________________________________________________________
+[ 8195] By: jhi on 2000/12/19 17:47:53
+ Log: Subject: [patch perl@8150] h2xs SYNOPSIS
+ From: Jonathan Stowe <gellyfish@gellyfish.com>
+ Date: Mon, 18 Dec 2000 10:24:38 +0000 (GMT)
+ Message-ID: <Pine.LNX.4.10.10012181021180.20731-100000@orpheus.gellyfish.com>
+ Branch: perl
+ ! utils/h2xs.PL
+____________________________________________________________________________
+[ 8194] By: jhi on 2000/12/19 17:46:28
+ Log: Subject: Re: useless use of void context work-around
+ From: andreas.koenig@anima.de (Andreas J. Koenig)
+ Date: 16 Dec 2000 15:13:36 +0100
+ Message-ID: <m3g0jofo8f.fsf@ak-71.mind.de>
+
+ Document (comment) the q(di ds ig) trick in the code.
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 8193] By: jhi on 2000/12/19 17:10:57
+ Log: Subject: [ID 20001215.004] Sys::Syslog::xlate doesn't handle LOG_EMERG
+ From: "Mark J. Reed" <mreed@strange.turner.com>
+ Date: Fri, 15 Dec 2000 21:22:29 -0500 (EST)
+ Message-Id: <200012160222.VAA13986@strange.turner.com>
+ Branch: perl
+ ! ext/Sys/Syslog/Syslog.pm
+____________________________________________________________________________
+[ 8192] By: jhi on 2000/12/19 17:07:45
+ Log: Subject: [PATCH] Re: [PATCH] strtoq, strtou(q|ll|l) testing
+ From: Nicholas Clark <nick@ccl4.org>
+ Date: Sat, 16 Dec 2000 19:03:13 +0000
+ Message-ID: <20001216190313.D68304@plum.flirble.org>
+ Branch: perl
+ ! t/op/64bitint.t
+____________________________________________________________________________
+[ 8191] By: jhi on 2000/12/19 17:06:13
+ Log: Subject: [ID 20001218.005] Not OK: perl v5.7.0 +DEVEL8148 on powerpc-machten 4.1.4
+ From: Dominic Dunlop <domo@computer.org>
+ Date: Mon, 18 Dec 2000 12:00:15 +0100
+ Message-Id: <p04320404b6639e7aa043@[192.168.1.4]>
+
+ This patchlet is needed in order that perl can be statically linked.
+ Branch: perl
+ ! regexec.c
+____________________________________________________________________________
+[ 8190] By: jhi on 2000/12/19 17:03:08
+ Log: Subject: [PATCH perl@8133] finding PerlIO symbols for VMS
+ From: "Craig A. Berry" <craig.berry@psinetcs.com>
+ Date: Sun, 17 Dec 2000 00:18:35 -0600
+ Message-Id: <p04330102b661bc01daba@[172.16.52.1]>
+ Branch: perl
+ ! perlio.h vms/gen_shrfls.pl
+____________________________________________________________________________
+[ 8189] By: jhi on 2000/12/19 16:20:28
+ Log: Subject: [DOC PATCH: perl@8150, 5.6.1-TRIAL1] update list of lang. sensitive editors/IDES
+ From: Prymmer/Kahn <pvhp@best.com>
+ Date: Tue, 19 Dec 2000 08:08:31 -0800 (PST)
+ Message-ID: <Pine.BSF.4.21.0012190804040.14656-100000@shell8.ba.best.com>
+
+ A better version of #8188.
+ Branch: perl
+ ! pod/perlfaq3.pod
+____________________________________________________________________________
+[ 8188] By: jhi on 2000/12/19 15:57:06
+ Log: (Replaced by #8189)
+
+ Subject: [DOC PATCH: perl@7953] update list of lang. sensitive editors/IDES
+ Date: Mon, 18 Dec 2000 08:03:34 -0800 (PST)
+ From: Prymmer/Kahn <pvhp@best.com>
+ Message-ID: <Pine.BSF.4.21.0012180802090.27110-100000@shell8.ba.best.com>
+ Subject: Re: [DOC PATCH: perl@7953] update list of lang. sensitive editors/IDES
+ From: Ronald J Kimball <rjk@linguist.Thayer.Dartmouth.EDU>
+ Date: Mon, 18 Dec 2000 11:10:45 -0500
+ Message-ID: <20001218111044.B180222@linguist.thayer.dartmouth.edu>
+ Branch: perl
+ ! pod/perlfaq3.pod
+____________________________________________________________________________
+[ 8187] By: jhi on 2000/12/19 15:54:19
+ Log: Email address fix for Anton Berezin.
+ Branch: perl
+ ! AUTHORS
+____________________________________________________________________________
+[ 8186] By: jhi on 2000/12/19 15:38:54
+ Log: Subject: [PATCH perl@8102] cygwin port
+ From: "Eric Fifer" <efifer@dircon.co.uk>
+ Date: Thu, 14 Dec 2000 13:41:29 -0000
+ Message-Id: <200012141340.NAA54236@mailhost1.dircon.co.uk>
+
+ When compiling modules the data item that is being imported
+ from libperl.dll needs to be tagged as imported/shared data:
+ extern __declspec(dllimport) PerlIO_funcs PerlIO_pending;
+ Branch: perl
+ ! perliol.h
+____________________________________________________________________________
+[ 8185] By: jhi on 2000/12/19 14:53:24
+ Log: Regen uconfig.h and uconfig.sh.
+ Branch: perl
+ ! uconfig.h uconfig.sh
+____________________________________________________________________________
+[ 8184] By: jhi on 2000/12/18 20:43:49
+ Log: Comments work so much better when they are closed.
+ Branch: perl
+ ! regcomp.c
+____________________________________________________________________________
+[ 8183] By: jhi on 2000/12/18 18:04:02
+ Log: Some compilers (e.g. HP-UX) can't switch on 64-bit integers.
+ Fixes the bug 20001218.016.
+ Branch: perl
+ ! regcomp.c
+____________________________________________________________________________
+[ 8182] By: gsar on 2000/12/18 09:53:47
+ Log: delete spurious files
+ Branch: maint-5.6/perl
+ - lib/CGI/eg/make_links.pl lib/CGI/eg/wilogo.gif vos/config.def
+ - vos/config.h vos/config_h.SH_orig
+____________________________________________________________________________
+[ 8181] By: gsar on 2000/12/18 09:46:08
+ Log: regen perltoc
+ Branch: maint-5.6/perl
+ ! pod/buildtoc.PL pod/perl.pod pod/perlapi.pod pod/perltoc.pod
+____________________________________________________________________________
+[ 8180] By: gsar on 2000/12/18 09:20:27
+ Log: integrate changes#7924..7926,7946,7952 from mainline
+ Branch: maint-5.6/perl
+ !> lib/CPAN.pm lib/CPAN/FirstTime.pm lib/ExtUtils/MM_Unix.pm
+ !> lib/File/stat.pm t/lib/class-struct.t
+____________________________________________________________________________
+[ 8179] By: gsar on 2000/12/18 08:55:54
+ Log: integrate changes#7889,7890,7900,7903,7904,7907,7910,7917,
+ 7918,7919,7988,8907 from mainline (various)
+ Branch: maint-5.6/perl
+ +> t/lib/class-struct.t
+ !> MANIFEST README.amiga ext/Sys/Syslog/Syslog.pm gv.c
+ !> lib/Class/Struct.pm pod/perlipc.pod pod/perltie.pod
+ !> t/lib/syslfs.t t/op/lfs.t utils/perlcc.PL
+____________________________________________________________________________
+[ 8178] By: gsar on 2000/12/18 08:16:30
+ Log: avoid redefinition warnings on windows due to sys/socket.h getting
+ #included before win32.h
+ Branch: maint-5.6/perl
+ ! win32/include/sys/socket.h
+____________________________________________________________________________
+[ 8177] By: gsar on 2000/12/18 05:24:04
+ Log: make regen_headers; fix POSIX.xs problems; remove outdated
+ code from sys/socket.h that makes build fail now
+ Branch: maint-5.6/perl
+ ! ext/POSIX/POSIX.xs global.sym objXSUB.h perlapi.c
+ ! pod/perlapi.pod
+ !> win32/include/sys/socket.h
+____________________________________________________________________________
+[ 8176] By: gsar on 2000/12/18 05:20:17
+ Log: update Changes
+ Branch: maint-5.6/perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
+[ 8175] By: gsar on 2000/12/18 04:57:48
+ Log: integrate changes#7643,7646..7649,7651..7654,7658,7659,
+ 7661..7665,7667..7669,7671,7673,7676,7677,7681..7683,
+ 7689..7697,7699..7701,7703,7705,7714,7715,7718..7723,
+ 7725,7726,7729..7732,7737,7748,7749,7758,7759,7761,7773,
+ 7775,7776,7782,7785..7787,7804,7807,7808,7810,7811,7816,
+ 7823,7825,7838
+ Branch: maint-5.6/perl
+ +> lib/File/Spec/Epoc.pm
+ !> (integrate 88 files)
+____________________________________________________________________________
+[ 8174] By: gsar on 2000/12/18 03:53:09
+ Log: integrate changes#7602,7604..7611,7614,7616..7619,7621..7623,
+ 7625..7629,7631..7634,7637,7639,7642 from mainline
+ Branch: maint-5.6/perl
+ +> README.solaris
+ !> (integrate 26 files)
+____________________________________________________________________________
+[ 8173] By: gsar on 2000/12/18 03:37:02
+ Log: integrate changes#7472,7474..7479,7481,7485,7489,7493,7494,7496,
+ 7497,7499..7503,7505..7507,7509..7513,7515..7523,7526..7534,
+ 7536,7540,7542,7544..7546,7549,7553,7556,7557,7559,7561..7563,
+ 7565,7568..7572,7576,7578..7589,9592..7594,7596..7601 from mainline
+ Branch: maint-5.6/perl
+ +> t/lib/tie-refhash.t t/lib/tie-substrhash.t
+ - MAINTAIN
+ !> (integrate 111 files)
+____________________________________________________________________________
+[ 8172] By: jhi on 2000/12/18 02:49:27
+ Log: Regen pods.
+ Branch: perl
+ ! pod/perlmodlib.pod pod/perltoc.pod
+____________________________________________________________________________
+[ 8171] By: gsar on 2000/12/18 02:49:24
+ Log: integrate changes#7447,7448,7450,7454,7456,7457,7460,7462,
+ 7465..7471 from mainline
+
+ Remains of the old UTF-8 API, utf8_to_uv_chk(): didn't link
+ in platforms that strictly require all the symbols being present
+ at link time.
+
+ Subject: [PATCH: perl@7446] restore missing d_stdio_cnt_lval to VMS
+
+ Subject: [ID 20001025.011] [PATCH] t/io/open.t perl@7369[ 7350] breaks VMS perl
+
+ Subject: [ID 20001026.006] C<use integer; $x += 1> gives uninitialized warning
+
+ Subject: [PATCH] todo
+
+ Subject: [ID 20001027.002] Patch 7380 followup - Perl_modfl *must* be defined
+
+ Use $sort, $uniq (and $tr) consistently as wondered
+ by Nicholas Clark.
+
+ Too enthusiastic editing in #7460.
+
+ The reëntrant version shouldn't be needed unless USE_PURE_BISON.
+
+ Upgrade to CPAN 1.58_55.
+ Subject: CPAN.pm status
+
+ Subject: [ID 20001027.005] Nit in perlos2.pod - space needs deleted on line 118
+
+ Make target reordering to avoid pointless re-makes.
+ Subject: Re: Total re-make of 'make okfile' after 7451 ?
+
+ Subject: [ID 20001027.010] [PATCH] Add info on building CPAN modules to README.dos
+
+ Subject: DOC PATCH 5.6.0
+
+ Add the repository doc by Malcolm, Sarathy, and by Simon,
+ name as suggested by Michael Bletzinger <mbletzin@ncsa.uiuc.edu>.
+ Branch: maint-5.6/perl
+ +> Porting/repository.pod
+ !> Configure MANIFEST Makefile.SH README.dos README.os2
+ !> config_h.SH configure.com embed.h embed.pl handy.h lib/CPAN.pm
+ !> lib/CPAN/FirstTime.pm perl.h pod/perlfunc.pod pod/perltodo.pod
+ !> pp.c proto.h t/io/open.t t/op/assignwarn.t toke.c
+____________________________________________________________________________
+[ 8169] By: gsar on 2000/12/18 02:33:34
+ Log: integrate changes#7416,7417,7420..7422,7424,7426..7429,7431..7433,
+ 7435..7441,7445 from mainline
+
+ Make the UTF-8 decoding stricter and more verbose when
+ malformation happens. This involved adding an argument
+ to utf8_to_uv_chk(), which involved changing its prototype,
+ and prefer STRLEN over I32 for the UTF-8 length, which as
+ a domino effect necessitated changing the prototypes of
+ scan_bin(), scan_oct(), scan_hex(), and reg_uni().
+ The stricter UTF-8 decoding checking uses Markus Kuhn's
+ UTF-8 Decode Stress Tester from
+ http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt
+
+ Run vms/vms_yfix.pl, should have done that after changing
+ perly.c in #7382.
+
+ Subject: [PATCH 5.7.0] static linking with uninstalled perl
+
+ (Replaced by #7440.)
+ Subject: Re: [ID 20001022.001] Not OK: perl v5.7.0 +DEVEL7368 on i686-linux 2.2.16
+
+ Fix the bug ID 20001024.005, the bug introduced by #7416.
+
+ Subject: Re: [ID 20001023.003] PATCH perlfaq5 [perl-current]
+
+ Fix the bug reported in
+ From: andreas.koenig@anima.de (Andreas J. Koenig)
+ Also make is_utf8_char() stricter.
+
+ Missed the header file changes from #7425.
+
+ Check if stdio supports tweaking lval and cnt simultaneously.
+ Subject: PATCH (Re: PerlIO - Configure tweak for Linux/glibc?)
+
+ Stratus VOS updates from Paul Green.
+
+ Podify README.epoc and README.vos.
+
+ Add targets to Makefile.SH, most importantly
+ 'regen_all' which also remembers to update vms/perly*.
+
+ Subject: Minor update to find2perl, for portability
+
+ Subject: patch 7416 breaks sv.c on AIX and HP-UX (patch included)
+
+ Subject: [ID 20001024.007] [PATCH] "Dump local *FH" causes SEGV
+
+ Rename UTF8LEN() to be UNISKIP(), too confusing to have
+ UTF8LEN() and UTF8SKIP().
+
+ Allow poking holes at the UTF-8 decoding strictness.
+
+ Continue the internal UTF-8 API tweaking.
+ Rename utf8_to_uv_chk() back to utf8_to_uv() because it's
+ used much more than the simpler API, now called utf8_to_uv_simple().
+ Still not quite happy with API, too much partial duplication
+ of functionality.
+
+ A new version of making the syslog test more robust.
+ (Replaces #7421.)
+ Subject: Re: [ID 20001022.001] Not OK: perl v5.7.0 +DEVEL7368 on i686-linux 2.2.16
+
+ buildtoc target tweaks.
+
+ Integrate with vmsperl #7430 by Charles Bailey:
+
+ Cleanup from prior patch (Charles Lane?):
+ - improve handling of MFDs in Basename and Path
+ - default to no xsubpp line # munging when building debug images
+ Branch: maint-5.6/perl
+ +> vos/config.alpha.def vos/config.alpha.h vos/config.ga.def
+ +> vos/config.ga.h vos/configure_perl.cm vos/install_perl.cm
+ !> (integrate 67 files)
+____________________________________________________________________________
+[ 8168] By: gsar on 2000/12/18 02:05:49
+ Log: integrate changes#7512,7733 from mainline (regex bugfixes)
+
+ Subject: [ID 20001031.004] Uninitialized auto variable in regcomp.c
+ From: Martin Husemann <martin@duskware.de>
+
+ Subject: [PATCH 5.7.0] restore match data on backtracing
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: maint-5.6/perl
+ !> regcomp.c regexec.c t/op/re_tests
+____________________________________________________________________________
+[ 8167] By: gsar on 2000/12/18 01:55:22
+ Log: integrate changes#7858,7986 from mainline
+
+ C<foreach my $x ...> in pseudo-fork()ed process may diddle
+ parent's memory; fix it by keeping track of the actual pad
+ offset rather than a raw pointer (this change is probably also
+ relevant to non-ithreads case to avoid fallout from reallocs of
+ the pad array, but is currently only enabled for the ithreads
+ case in the interests of minimal disruption to existing "well
+ tested" code)
+
+ fix open(FOO, ">&MYSOCK") failure under Windows 9x (problem is
+ due to the notorious GetFileType() bug in Windows 9x, which fstat()
+ tickles)
+ Branch: maint-5.6/perl
+ !> embed.h embed.pl global.sym objXSUB.h perlapi.c pp_ctl.c
+ !> proto.h scope.c scope.h sv.c t/op/fork.t win32/perlhost.h
+ !> win32/win32.c win32/win32.h win32/win32sck.c
+____________________________________________________________________________
+[ 8166] By: gsar on 2000/12/18 01:52:59
+ Log: integrate changes#7626,7632,7717,7738,7814,7817,7902,7912,7915
+ from mainline (xsubpp and ExtUtils::LibList fixups, various
+ other small items)
+ Branch: maint-5.6/perl
+ !> emacs/cperl-mode.el emacs/ptags lib/ExtUtils/Liblist.pm
+ !> lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MakeMaker.pm
+ !> lib/ExtUtils/xsubpp lib/unicode/syllables.txt minimod.pl
+ !> pod/perlfunc.pod pod/perlxs.pod pod/perlxstut.pod t/op/split.t
+ !> win32/bin/search.pl
+____________________________________________________________________________
+[ 8165] By: gsar on 2000/12/18 01:28:45
+ Log: integrate changes#7533,7563,7611,7623 from mainline (various
+ malloc.c embellishments)
+ Branch: maint-5.6/perl
+ !> malloc.c pod/perldiag.pod
+____________________________________________________________________________
+[ 8164] By: gsar on 2000/12/18 01:23:33
+ Log: integrate changes#7419,7806,8129 from mainline (various h2xs
+ fixups)
+ Branch: maint-5.6/perl
+ !> utils/h2xs.PL
+____________________________________________________________________________
+[ 8163] By: gsar on 2000/12/18 01:17:50
+ Log: integrate changes#7493,7599,7803 from mainline (various perlbug
+ fixups)
+ Branch: maint-5.6/perl
+ !> Makefile.SH utils/perlbug.PL
+____________________________________________________________________________
+[ 8162] By: gsar on 2000/12/18 00:25:43
+ Log: always export Perl_deb() (it is required by re.xs whether
+ Perl is built with or without -DDEBUGGING)
+ Branch: maint-5.6/perl
+ ! makedef.pl
+____________________________________________________________________________
+[ 8161] By: gsar on 2000/12/18 00:23:38
+ Log: integrate change#7414 from mainline
+
+ Undo the basename() part of #7412 since the lib/basename
+ tests would need upgrading too.
+
+ squelch two tests in tr.t that rely on tr/// paranoia change
+ that's not in 5.6.x
+ Branch: maint-5.6/perl
+ ! t/op/tr.t
+ !> lib/File/Basename.pm
+____________________________________________________________________________
+[ 8160] By: gsar on 2000/12/18 00:05:30
+ Log: missing change in previous integrate
+ Branch: maint-5.6/perl
+ !> README.aix
+____________________________________________________________________________
+[ 8159] By: gsar on 2000/12/18 00:03:38
+ Log: integrate changes#7205..7210,7212,7214..7219,7222,7223,7225,7226,
+ 7228,7230..7241,7243,7346,7347,7350..7354,7356,7358..7360,7362,
+ 7363,7365..7368,7370..7374,7376..7386,7391,7393..7399,7304..7408,
+ 7410..7413 from mainline
+ Branch: maint-5.6/perl
+ +> README.aix hints/nonstopux.sh lib/unicode/Is/DCmedial.pl
+ +> t/lib/tie-splice.t
+ - lib/unicode/Is/DCinital.pl
+ !> (integrate 112 files)
+____________________________________________________________________________
+[ 8158] By: jhi on 2000/12/17 23:04:24
+ Log: Subject: [PATCHES] RE: perl@8150
+ From: "Gerrit P. Haase" <gerrit.haase@t-online.de>
+ Date: Sun, 17 Dec 2000 21:46:39 +0100
+ Message-ID: <3A3D343F.13566.1ACA7D93@localhost>
+
+ Neither cygwin has a getpwuid() one can trust on.
+ Branch: perl
+ ! t/lib/glob-basic.t
+____________________________________________________________________________
+[ 8157] By: jhi on 2000/12/17 23:01:54
+ Log: More MAN.PODS => {} fixes.
+ Branch: perl
+ ! os2/OS2/ExtAttr/Makefile.PL os2/OS2/PrfDB/Makefile.PL
+ ! os2/OS2/Process/Makefile.PL os2/OS2/REXX/DLL/Makefile.PL
+ ! os2/OS2/REXX/Makefile.PL
+____________________________________________________________________________
+[ 8156] By: gsar on 2000/12/17 22:49:13
+ Log: integrate changes#7069..7077,7079,7081..7087,7090,7092,7093,
+ 7096..7104,7109..7117,7119..7124,7126,7128,7129,7133,7134,
+ 7136..7139,7141..7146,7148,7149,7151,7153..7155,7157,7158,
+ 7160,7161,7164,7165,7169..7178,7180..7191,7193..7197,7199,
+ 7201,7204 from mainline
+ Branch: maint-5.6/perl
+ !> (integrate 121 files)
+____________________________________________________________________________
+[ 8155] By: jhi on 2000/12/17 22:30:58
+ Log: Subject: [PATCH perl@8133] fix-up for VMS extensions
+ From: "Craig A. Berry" <craigberry@mac.com>
+ Date: Sun, 17 Dec 2000 13:09:28 -0600
+ Message-Id: <p04330103b6628cabe114@[172.16.52.1]>
+
+ MAN.PODS => ' ' is naughty.
+ Branch: perl
+ ! vms/ext/DCLsym/Makefile.PL vms/ext/Stdio/Makefile.PL
+____________________________________________________________________________
+[ 8154] By: nick on 2000/12/17 22:07:13
+ Log: MULTIPLICITY nit.
+ Branch: perl
+ ! mg.c
+____________________________________________________________________________
+[ 8153] By: gsar on 2000/12/17 21:23:05
+ Log: integrate changes#7017..7019,7021..7025,7027..7036,7038,7039,
+ 7041..7044,7046..7048,7050..7061,7063,7066..7067,7069..7074
+ from mainline
+
+ Document the SvIOK_.*UV().
+
+ Update Unicode todo list.
+
+ Guard against bad string->int conversion for quads.
+
+ Subject: small apidoc fix
+
+ Subject: [PATCH] Tie::StdHandle did not know about 3-arg open
+
+ Subject: [PATCH] Tied filehandle documentation
+
+ Subject: [PATCH] Modernize Opcode.pm documentation
+
+ Make Data::Dumper (non-XS) to work with changed semantics of ref().
+ Subject: Re: Undocumented(?) change to "ref" semantics in 5.7.0
+ [applied even though said semantics didn't change in 5.6.x]
+
+ Subject: [PATCH@7014] \G in non-/g is well-defined now ... right?
+
+ Subject: Re: [ID 20000905.001] Assertion failed: file "toke.c", line 202
+
+ Fix the URL, but the server is still missing in action.
+ Subject: [ID 20000905.002] perlfaq1.pod URL error
+
+ Subject: [ID 20000903.001] \w in utf8-strings
+
+ Fix the ccversion detection for 5.1 and beyond.
+ Subject: [ID 20000907.007] Not OK: perl v5.7.0 +devel-7030 on alpha-dec_osf 4.0f
+
+ Subject: [PATCH 5.7.0] perl5db.pl [Was: Re: Debugger question]
+
+ Subject: [ID 20000904.008] Tiny fix for perldiag
+
+ Subject: Re: [ID 20000906.004] segfault with bad perl statement
+
+ Subject: Re: [ID 20000907.007] Not OK: perl v5.7.0 +devel-7030 on alpha-dec_osf 4.0f
+
+ Subject: [ID 20000908.002] perlipc documentation bug.
+
+ Subject: [PATCH lib/Benchmark.pm]
+
+ Re-allow vec() for characters > 255.
+ Subject: [PATCH] Re: [ID 20000907.005] Not OK: perl v5.7.0 +devel-7030 on alpha-dec_osf-perlio 4.0f (UNINSTALLED)
+
+ Do away with memory models cruft. Sorry, PDP users.
+
+ Continue #7041.
+
+ Subject: [PATCH (or RFC): 5.7.0] make the ran_tests intermediate file 8.3 friendly
+
+ Subject: [PATCH: 5.7.0] proper setting for isnan for DECC 5.3
+
+ Upgrade to CPAN 1.57_65, from Andreas König.
+
+ Upgrade to podlators-1.03 (Pod::Man 1.07 and Pod::Text 2.05),
+ by Russ Allbery.
+
+ Silence t/pod/*.t about alternate quote-mappings now implemented
+ by Pod::Text, from Brad Appleton.
+
+ Modern Borland C now seems to have anon unions for info.wProcessorArchitecture
+ Subject: borland C++ win32.c tweak
+
+ C<@a = @b = split(...)> optimization coredumps under ithreads
+ (missed a spot when fixing up op_pmreplroot hack for ithreads)
+
+ Document the SvUTF8*().
+
+ Subject: [PATCH] Perl 5.6.0, 5.7.0 ... vms/test.com to eliminate spurious NL's in test output
+
+ Subject: RE: [Patch 5.7.0] Removing -ldb from the core build
+
+ Do in VMS as the #7054 does.
+
+ Subject: [patch] perlfunc.pod -- POSIX::sigpause should be POSIX::pause
+
+ Subject: [ID 20000911.008] Not OK: perl v5.7.0 +DEVEL7048 on os2-64int-ld 2.30 (UNINSTALLED)
+
+ Subject: [patch: perl@7045] vms updates
+
+ Test for the #7049.
+ Subject: Re: [PATCH] Re: [ID 20000910.001] Not OK: perl v5.7.0 +DEVEL7044 on i686-linux 2.2.16-raid (UNINSTALLED)
+
+ Break up the myconfig lines a bit.
+ Subject: perlbug/perl -V output format
+
+ Subject: [ID 20000911.011] misplaced typemap in perlxs.pod
+
+ The #7054 truncated Configure badly.
+
+ change#6327 didn't quite go all the way to enable USE_SOCKETS_AS_HANDLES
+ initialization in all the threads on Windows
+
+ Allow for whitespace between "#" and "line" in cpp output.
+ Subject: [PATCH] Re: Problems compiling bleadperl on Unicos 9
+
+ Remove vestiges of tr//CU.
+ Subject: [ID 20000912.009] perlunicode.pod still mentions tr///CU
+
+ The return value of setlocale must be copied away.
+ Subject: [ID 20000913.001] Heap corruption in Perl_init_i18nl10n
+
+ Allow chop() and chomp() to be overridden.
+ Subject: [PATCH] Re: [ID 20000911.006] I can override glob but not chop?
+
+ Hints optimization.
+ Subject: Minor nit
+
+ Subject: [PATCH] de-wall t/README
+
+ Subject: Re: Two advertising clauses need to be removed
+ Branch: maint-5.6/perl
+ !> (integrate 75 files)
+____________________________________________________________________________
+[ 8152] By: gsar on 2000/12/17 20:30:11
+ Log: integrate changes#6945,6947,6949..6954,6956,6958,6959,6961,
+ 6964..6972,6977..6981..6984,6987,6988,6991,6994,6997,
+ 6999..7001,7003..7005,7007,7009,7011,7012 from mainline
+
+ Don't attach -ld to the archname if pointless.
+
+ Document UNTIE in a very minimalistic way.
+
+ POSIX doesn't report long double values under -Duselongdouble
+ when the long doubles are "real" (bigger than doubles).
+
+ More author updates.
+
+ Try to deduce NV_MAX. Really should be Configure fodder.
+
+ :: not allowed in pathnames, change to .
+ Subject: [PATCH perl@6938] cygwin port
+
+ Forget about NV_MAX (#6951). Various floating point tweaks,
+ ideas from Eric Fifer, Yitzchak, Alan, and Spider.
+
+ Move the Solaris 7 scan to use64bitall, make the
+ failure to find 64-bot sparc libc to mention the
+ possibility of being in an intel, from Lupe and Alan.
+
+ Regen perltoc.
+
+ AUTHORS tweaks, from Peter Prymmer.
+
+ More address tweaking.
+
+ Small tweaks all over.
+
+ File::Temp patches from Andreas König,
+
+ Subject: [PATCH perl@6962] 2 more vms.c fix-ups and status
+
+ Subject: CPAN.pm beta 1.57_57 for the core
+
+ Part of the solution.
+ Subject: Re: [ID 20000807.004] [PATCH] conditional breakpoints leak memory
+
+ Subject: [PATCH@6961] Fix misleading example in perlretut.pod
+
+ Subject: [PATCH lib/overload.pm] Sanaty checking of arguments to overload::constant
+
+ Add the overload warnings to perldiag.
+
+ Drop unused argument.
+ Subject: Re: [ID 20000831.034] overload::constant and number of arguments.
+
+ Subject: Nit in Configure (bleadperl@6961)
+
+ Update to PodParser 1.18, from Brad Appleton.
+
+ Subject: [ID 20000901.017] [PATCH] Basic test failure in an untidy world
+
+ Subject: [PATCH: 6948] add SCNfldbl to configure.com
+
+ Document UNTIE. Also tweak implementation to suppress the 'inner references'
+ warning when UNTIE exists and instead pass the cound of extra references to
+ the UNTIE method.
+
+ Rename the PRIElfbl, PRIX64, etc, to be PRIEUfldbl, PRIXU64,
+ so that case-ignoring systems like DCL can tell them from
+ PRIefldbl and PRIx64. Apply Merijn's ccversion patches.
+
+ Subject: Re: [PATCH lib/overload.pm] Sanaty checking of arguments to overload::constant
+
+ Feature ordering tweak.
+
+ Regen perltoc.
+
+ Subject: [PATCH] Fix vec() / utf8 (was Re: bitvec ops still broken with utf8 -- or not?)
+
+ Subject: Re: [PATCH perl@6962] 2 more vms.c fix-ups and status
+
+ Subject: http:// in L<>
+
+ Detypo.
+
+ change#6791 accidentally clobbered change#6710, put it back
+
+ Only the first line, thank you very much.
+
+ Subject: [PATCH: 6996] minimal removal of 8 bit chrs from perlebcdic.pod
+ plus rework the http: spots as suggested by Tom Christiansen,
+ plus regen perltoc.
+
+ Undo part of change 6489 which looks like a bulk edit which
+ changed _all_ gv_efullname3() calls to gv_efullname4() calls.
+ The supressing of main:: on return from select() is undesirable.
+
+ Apparently avoiding the swapping is too costly.
+
+ Various Configure nits by Philip Newton,
+ plus the ebcdic one by me.
+
+ Make certain cc is set before trying to run it.
+
+ If overloaded %{} etc. return the object do not loop.
+ Thus sub deref { $_[0] } functions if object is wanted type.
+
+ Update perlhist.
+
+ More %{} and other deref special casing - do not pass to 'nomethod'.
+ Branch: maint-5.6/perl
+ !> (integrate 59 files)
+____________________________________________________________________________
+[ 8151] By: gsar on 2000/12/17 19:14:38
+ Log: integrate changes#6903,6905..6907,6909,6911..6913,6915,6917,6918,
+ 6920..6926,6928..6930,6934..6937,6939,6940,6942..6944 from mainline
+
+ Subject: [PATCH perl@6889] Chuck Lane's OpenVMS piping improvements
+
+ Make the epsilon to be relative, not absolute.
+
+ Put back the flags dump as reasoned in
+ Subject: Re: [PATCH] Glob dumping
+
+ Introduce ccname to keep track of what compiler kind of we have.
+
+ Subject: Re: [ID 20000829.020] perl -e 'package; print __PACKAGE__' core dumps
+
+ Put back the slice accidentally removed by #6907.
+
+ Reset archname and archname64 always, forcing them be
+ recomputed at each Configure run, make Configure and
+ the hints files agree on the naming of largefiles variables.
+
+ Don't say "Perl 5.0 source kit".
+
+ Subject: [PATCH] fix misc cast warnings
+
+ Subject: typos in pods
+
+ NVs not necessarily doubles, as pointed out by Yitzchak.
+
+ Subject: [PATCH 6889] add a few ldbl formats to configure.com
+
+ Subject: [ID 20000830.036] [DOC] chom?p %hash not documented
+
+ Better options for rsync.
+
+ Subject: [PATCH perl@6889] fix Storable on VMS by fixing my_fwrite()
+
+ Subject: Re: not OK, 6919 on Alpha VMS V 7.1 w/ DECC 6.0-001
+
+ Subject: [PATCH] Re: UNTIE method
+
+ A better fix for the Socket building problem from Craig Berry.
+
+ Retract the dummy test, skip the security tests (instead of failing),
+ explain what the warnings mean.
+
+ Heap decorruption.
+ Subject: [PATCH] Fix for miniperl coredump on Solaris with -Duselongdouble
+
+ Update to Unicode 3.0.1.
+
+ Missed one Unicode file.
+
+ Subject: Re: typos in pods
+
+ The #6929 was too skimpy.
+
+ sscanf() may be the only way to read long doubles from strings.
+
+ Reveal Borland's isnan.
+ Subject: build with BC++ tweak
+
+ Issue useful diagnostic on unknown pod commands.
+ Subject: [PATCH lib/Pod/Man.pm] Re: [ID 20000830.048]
+
+ Subject: [PATCH] Re: [ID 20000830.048] Not OK: perl v5.7.0 +DEVEL6938 on i686-linux 2.2.13
+
+ Clarify the third case of ftmp-security warnings.
+
+ Make -Dusemorebits find long doubles in Solaris.
+
+ Wrap the test in eval.
+ Branch: maint-5.6/perl
+ +> lib/unicode/BidiMirr.txt lib/unicode/CaseFold.txt
+ +> lib/unicode/PropList.txt lib/unicode/README.perl
+ +> lib/unicode/UCD301.html lib/unicode/UCDFF301.html
+ +> lib/unicode/Unicode.301 vms/vmspipe.com
+ - lib/unicode/Props.txt lib/unicode/UCD300.html
+ - lib/unicode/Unicode.300 lib/unicode/Unicode3.html
+ !> (integrate 305 files)
+____________________________________________________________________________
+[ 8150] By: jhi on 2000/12/17 18:47:57
+ Log: Uncheckedin generated files.
+ Branch: perl
+ ! global.sym perlapi.c pod/perlapi.pod
+____________________________________________________________________________
+[ 8149] By: jhi on 2000/12/17 18:41:22
+ Log: Update Changes.
+ Branch: perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
+[ 8148] By: jhi on 2000/12/17 18:39:16
+ Log: Subject: [PATCH] Fcntl constants speedup
+ From: Nicholas Clark <nick@ccl4.org>
+ Date: Sun, 17 Dec 2000 16:29:24 +0000
+ Message-ID: <20001217162924.E97668@plum.flirble.org>
+
+ Use IVs for the Fcntl constants instead of NVs.
+ Branch: perl
+ ! ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs t/op/goto_xs.t
+____________________________________________________________________________
+[ 8147] By: jhi on 2000/12/17 18:33:41
+ Log: Add test for #8145 (binmode() warning), add warning for
+ ioctl() and sockpair(), document them. (fileno() cannot
+ be tripwired with the same kind of warning because
+ 'defined fileno($foo)' seems to be an idiom.)
+ Branch: perl
+ ! pod/perldiag.pod pp_sys.c t/pragma/warn/pp_sys
+____________________________________________________________________________
+[ 8146] By: gsar on 2000/12/17 18:09:08
+ Log: update Changes
+ Branch: maint-5.6/perl
+ ! Changes
+____________________________________________________________________________
+[ 8145] By: jhi on 2000/12/17 17:39:35
+ Log: Subject: [PATCH] Re: The long awaited feature ...
+ From: Simon Cozens <simon@cozens.net>
+ Date: Sun, 17 Dec 2000 12:31:56 +0000
+ Message-ID: <20001217123156.A3891@deep-dark-truthful-mirror.perlhacker.org>
+
+ Add a warning to binmode() about using bad filehandles
+ (can happen e.g. if someone forgets the filehandle argument)
+ Branch: perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 8144] By: jhi on 2000/12/17 17:33:48
+ Log: Subject: [patch perl@8133] Typo in my Net::Ping doc patch :(
+ From: Jonathan Stowe <gellyfish@gellyfish.com>
+ Date: Sun, 17 Dec 2000 17:08:10 +0000 (GMT)
+ Message-ID: <Pine.LNX.4.10.10012171700010.3834-100000@orpheus.gellyfish.com>
+ Branch: perl
+ ! lib/Net/Ping.pm
+____________________________________________________________________________
+[ 8143] By: jhi on 2000/12/17 05:31:37
+ Log: Polymorphic regexps.
+
+ Fixes at least the bugs 20001028.003 (both of them...) and
+ 20001108.001. The bugs 20001114.001 and 20001205.014 seem
+ also to be fixed by now, probably already before this patch.
+ Branch: perl
+ ! embed.h embed.pl mg.c objXSUB.h pp_ctl.c pp_hot.c proto.h
+ ! regcomp.c regcomp.h regcomp.sym regexec.c regnodes.h sv.c
+ ! t/op/utf8decode.t t/pragma/utf8.t
+____________________________________________________________________________
+[ 8142] By: jhi on 2000/12/16 17:16:05
+ Log: Subject: [patch perl@8102] dos/djgpp update
+ From: Laszlo Molnar <ml1050@freemail.hu>
+ Date: Sat, 16 Dec 2000 01:40:52 +0100
+ Message-ID: <20001216014052.A335@freemail.hu>
+ Branch: perl
+ ! djgpp/config.over t/base/commonsense.t
+____________________________________________________________________________
+[ 8141] By: jhi on 2000/12/16 17:09:27
+ Log: Few uncheckedin files.
+ Branch: perl
+ ! global.sym perlapi.c pod/perlapi.pod pod/perlintern.pod
+____________________________________________________________________________
+[ 8140] By: nick on 2000/12/15 22:14:31
+ Log: Integrate mainline
+ Branch: perlio
+ !> (integrate 53 files)
+____________________________________________________________________________
+[ 8139] By: jhi on 2000/12/15 19:49:49
+ Log: One more IVUV tweak from Nicholas Clark.
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 8138] By: jhi on 2000/12/15 19:17:06
+ Log: Return of the IVUV-preservation, now seems to be happy even
+ in Digital UNIX (the broken strtoul brokenness detection
+ seems to have been the fly in the ointment).
+ Branch: perl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH configure.com embed.h embed.pl epoc/config.sh
+ ! objXSUB.h op.c perl.h pp.c pp_hot.c proto.h sv.c sv.h
+ ! t/lib/peek.t t/op/cmp.t t/op/numconvert.t uconfig.h
+ ! vos/config.alpha.def vos/config.alpha.h vos/config.ga.def
+ ! vos/config.ga.h win32/config.bc win32/config.gc
+ ! win32/config.vc
+____________________________________________________________________________
+[ 8137] By: jhi on 2000/12/15 18:12:14
+ Log: Metaconfig unit change for #8136.
+ Branch: metaconfig
+ ! U/modified/d_strtoul.U
+ Branch: metaconfig/U/perl
+ ! d_strtoull.U d_strtouq.U
+____________________________________________________________________________
+[ 8136] By: jhi on 2000/12/15 18:11:35
+ Log: I don't think it's sensible or portable to test the strtou*
+ on /^-/ strings.
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 8135] By: jhi on 2000/12/15 17:18:49
+ Log: Metaconfig unit change for #8134.
+ Branch: metaconfig
+ ! U/modified/d_strtoul.U
+____________________________________________________________________________
+[ 8134] By: jhi on 2000/12/15 17:14:13
+ Log: If longsize is 8 we don't need a LL suffix for integer constants.
+ Branch: perl
+ ! Configure config_h.SH
+____________________________________________________________________________
+[ 8133] By: jhi on 2000/12/15 16:00:23
+ Log: Update Changes.
+ Branch: perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
[ 8132] By: jhi on 2000/12/15 15:44:16
Log: Some compilers get huffy if you do not cast a const pointer
to a non-const when assigning.
# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Fri Dec 15 20:31:25 EET 2000 [metaconfig 3.0 PL70]
+# Generated on Tue Dec 19 20:00:06 EET 2000 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by perlbug@perl.org)
cat >c1$$ <<EOF
# Package name : perl5
# Source directory : /m/fs/work/work/permanent/perl/pp4/perl
-# Configuration time: Fri Dec 15 20:33:12 EET 2000
+# Configuration time: Tue Dec 19 20:04:33 EET 2000
# Configured by : jhi
# Target system : osf1 alpha.hut.fi v4.0 878 alpha
ccversion='V5.6-082'
cf_by='jhi'
cf_email='yourname@yourhost.yourplace.com'
-cf_time='Fri Dec 15 20:33:12 EET 2000'
+cf_time='Tue Dec 19 20:04:33 EET 2000'
charsize='1'
chgrp=''
chmod=''
/*
* Package name : perl5
* Source directory : /m/fs/work/work/permanent/perl/pp4/perl
- * Configuration time: Fri Dec 15 20:33:12 EET 2000
+ * Configuration time: Tue Dec 19 20:04:33 EET 2000
* Configured by : jhi
* Target system : osf1 alpha.hut.fi v4.0 878 alpha
*/
#define CPPRUN "/usr/bin/cpp"
#define CPPLAST ""
+/* HAS__FWALK:
+ * This symbol, if defined, indicates that the _fwalk system call is
+ * available to apply a function to all the file handles.
+ */
+/*#define HAS__FWALK / **/
+
/* HAS_ACCESS:
* This manifest constant lets the C program know that the access()
* system call is available to check for accessibility using real UID/GID.
*/
#define HAS_ENDSERVENT /**/
+/* FCNTL_CAN_LOCK:
+ * This symbol, if defined, indicates that fcntl() can be used
+ * for file locking. Normally on Unix systems this is defined.
+ * It may be undefined on VMS.
+ */
+#define FCNTL_CAN_LOCK /**/
+
/* HAS_FD_SET:
* This symbol, when defined, indicates presence of the fd_set typedef
* in <sys/types.h>
*/
#define HAS_FSTATFS /**/
+/* HAS_FSYNC:
+ * This symbol, if defined, indicates that the fsync routine is
+ * available to write a file's modified data and attributes to
+ * permanent storage.
+ */
+#define HAS_FSYNC /**/
+
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
#define HAS_GETPROTOENT /**/
+/* HAS_GETPGRP:
+ * This symbol, if defined, indicates that the getpgrp routine is
+ * available to get the current process group.
+ */
+/* USE_BSD_GETPGRP:
+ * This symbol, if defined, indicates that getpgrp needs one
+ * arguments whereas USG one needs none.
+ */
+#define HAS_GETPGRP /**/
+/*#define USE_BSD_GETPGRP / **/
+
/* HAS_GETPROTOBYNAME:
* This symbol, if defined, indicates that the getprotobyname()
* routine is available to look up protocols by their name.
*/
#define HAS_SANE_MEMCMP /**/
+/* HAS_SBRK_PROTO:
+ * This symbol, if defined, indicates that the system provides
+ * a prototype for the sbrk() function. Otherwise, it is up
+ * to the program to supply one. Good guesses are
+ * extern void* sbrk _((int));
+ * extern void* sbrk _((size_t));
+ */
+#define HAS_SBRK_PROTO /**/
+
/* HAS_SEM:
* This symbol, if defined, indicates that the entire sem*(2) library is
* supported.
*/
#define HAS_SETPROTOENT /**/
+/* HAS_SETPGRP:
+ * This symbol, if defined, indicates that the setpgrp routine is
+ * available to set the current process group.
+ */
+/* USE_BSD_SETPGRP:
+ * This symbol, if defined, indicates that setpgrp needs two
+ * arguments whereas USG one needs none. See also HAS_SETPGID
+ * for a POSIX interface.
+ */
+#define HAS_SETPGRP /**/
+#define USE_BSD_SETPGRP /**/
+
/* HAS_SETPROCTITLE:
* This symbol, if defined, indicates that the setproctitle routine is
* available to set process title.
*/
/*#define HAS_STRTOQ / **/
+/* HAS_STRTOUL:
+ * This symbol, if defined, indicates that the strtoul routine is
+ * available to provide conversion of strings to unsigned long.
+ */
+#define HAS_STRTOUL /**/
+
/* HAS_STRTOULL:
* This symbol, if defined, indicates that the strtoull routine is
* available to convert strings to unsigned long longs.
#define RD_NODATA -1
#define EOF_NONBLOCK
+/* NEED_VA_COPY:
+ * This symbol, if defined, indicates that the system stores
+ * the variable argument list datatype, va_list, in a format
+ * that cannot be copied by simple assignment, so that some
+ * other means must be used when copying is required.
+ * As such systems vary in their provision (or non-provision)
+ * of copying mechanisms, handy.h defines a platform-
+ * independent macro, Perl_va_copy(src, dst), to do the job.
+ */
+/*#define NEED_VA_COPY / **/
+
/* Netdb_host_t:
* This symbol holds the type used for the 1st argument
* to gethostbyaddr().
*/
#define STARTPERL "#!/opt/perl/bin/perl" /**/
+/* STDCHAR:
+ * This symbol is defined to be the type of char used in stdio.h.
+ * It has the values "unsigned char" or "char".
+ */
+#define STDCHAR unsigned char /**/
+
/* HAS_STDIO_STREAM_ARRAY:
* This symbol, if defined, tells that there is an array
* holding the stdio streams.
#define PERL_XS_APIVERSION "5.7.0"
#define PERL_PM_APIVERSION "5.005"
-/* HAS_GETPGRP:
- * This symbol, if defined, indicates that the getpgrp routine is
- * available to get the current process group.
- */
-/* USE_BSD_GETPGRP:
- * This symbol, if defined, indicates that getpgrp needs one
- * arguments whereas USG one needs none.
- */
-#define HAS_GETPGRP /**/
-/*#define USE_BSD_GETPGRP / **/
-
-/* HAS_SETPGRP:
- * This symbol, if defined, indicates that the setpgrp routine is
- * available to set the current process group.
- */
-/* USE_BSD_SETPGRP:
- * This symbol, if defined, indicates that setpgrp needs two
- * arguments whereas USG one needs none. See also HAS_SETPGID
- * for a POSIX interface.
- */
-#define HAS_SETPGRP /**/
-#define USE_BSD_SETPGRP /**/
-
-/* HAS_STRTOUL:
- * This symbol, if defined, indicates that the strtoul routine is
- * available to provide conversion of strings to unsigned long.
- */
-#define HAS_STRTOUL /**/
-
-/* STDCHAR:
- * This symbol is defined to be the type of char used in stdio.h.
- * It has the values "unsigned char" or "char".
- */
-#define STDCHAR unsigned char /**/
-
-/* HAS__FWALK:
- * This symbol, if defined, indicates that the _fwalk system call is
- * available to apply a function to all the file handles.
- */
-/*#define HAS__FWALK / **/
-
-/* FCNTL_CAN_LOCK:
- * This symbol, if defined, indicates that fcntl() can be used
- * for file locking. Normally on Unix systems this is defined.
- * It may be undefined on VMS.
- */
-#define FCNTL_CAN_LOCK /**/
-
-/* HAS_FSYNC:
- * This symbol, if defined, indicates that the fsync routine is
- * available to write a file's modified data and attributes to
- * permanent storage.
- */
-#define HAS_FSYNC /**/
-
-/* HAS_SBRK_PROTO:
- * This symbol, if defined, indicates that the system provides
- * a prototype for the sbrk() function. Otherwise, it is up
- * to the program to supply one. Good guesses are
- * extern void* sbrk _((int));
- * extern void* sbrk _((size_t));
- */
-#define HAS_SBRK_PROTO /**/
-
-/* NEED_VA_COPY:
- * This symbol, if defined, indicates that the system stores
- * the variable argument list datatype, va_list, in a format
- * that cannot be copied by simple assignment, so that some
- * other means must be used when copying is required.
- * As such systems vary in their provision (or non-provision)
- * of copying mechanisms, handy.h defines a platform-
- * independent macro, Perl_va_copy(src, dst), to do the job.
- */
-/*#define NEED_VA_COPY / **/
-
#endif
#define CPPRUN "$cpprun"
#define CPPLAST "$cpplast"
+/* HAS__FWALK:
+ * This symbol, if defined, indicates that the _fwalk system call is
+ * available to apply a function to all the file handles.
+ */
+#$d__fwalk HAS__FWALK /**/
+
/* HAS_ACCESS:
* This manifest constant lets the C program know that the access()
* system call is available to check for accessibility using real UID/GID.
*/
#$d_endsent HAS_ENDSERVENT /**/
+/* FCNTL_CAN_LOCK:
+ * This symbol, if defined, indicates that fcntl() can be used
+ * for file locking. Normally on Unix systems this is defined.
+ * It may be undefined on VMS.
+ */
+#$d_fcntl_can_lock FCNTL_CAN_LOCK /**/
+
/* HAS_FD_SET:
* This symbol, when defined, indicates presence of the fd_set typedef
* in <sys/types.h>
*/
#$d_fstatfs HAS_FSTATFS /**/
+/* HAS_FSYNC:
+ * This symbol, if defined, indicates that the fsync routine is
+ * available to write a file's modified data and attributes to
+ * permanent storage.
+ */
+#$d_fsync HAS_FSYNC /**/
+
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
#$d_getpent HAS_GETPROTOENT /**/
+/* HAS_GETPGRP:
+ * This symbol, if defined, indicates that the getpgrp routine is
+ * available to get the current process group.
+ */
+/* USE_BSD_GETPGRP:
+ * This symbol, if defined, indicates that getpgrp needs one
+ * arguments whereas USG one needs none.
+ */
+#$d_getpgrp HAS_GETPGRP /**/
+#$d_bsdgetpgrp USE_BSD_GETPGRP /**/
+
/* HAS_GETPROTOBYNAME:
* This symbol, if defined, indicates that the getprotobyname()
* routine is available to look up protocols by their name.
*/
#$d_sanemcmp HAS_SANE_MEMCMP /**/
+/* HAS_SBRK_PROTO:
+ * This symbol, if defined, indicates that the system provides
+ * a prototype for the sbrk() function. Otherwise, it is up
+ * to the program to supply one. Good guesses are
+ * extern void* sbrk _((int));
+ * extern void* sbrk _((size_t));
+ */
+#$d_sbrkproto HAS_SBRK_PROTO /**/
+
/* HAS_SEM:
* This symbol, if defined, indicates that the entire sem*(2) library is
* supported.
*/
#$d_setpent HAS_SETPROTOENT /**/
+/* HAS_SETPGRP:
+ * This symbol, if defined, indicates that the setpgrp routine is
+ * available to set the current process group.
+ */
+/* USE_BSD_SETPGRP:
+ * This symbol, if defined, indicates that setpgrp needs two
+ * arguments whereas USG one needs none. See also HAS_SETPGID
+ * for a POSIX interface.
+ */
+#$d_setpgrp HAS_SETPGRP /**/
+#$d_bsdsetpgrp USE_BSD_SETPGRP /**/
+
/* HAS_SETPROCTITLE:
* This symbol, if defined, indicates that the setproctitle routine is
* available to set process title.
*/
#$d_strtoq HAS_STRTOQ /**/
+/* HAS_STRTOUL:
+ * This symbol, if defined, indicates that the strtoul routine is
+ * available to provide conversion of strings to unsigned long.
+ */
+#$d_strtoul HAS_STRTOUL /**/
+
/* HAS_STRTOULL:
* This symbol, if defined, indicates that the strtoull routine is
* available to convert strings to unsigned long longs.
#define RD_NODATA $rd_nodata
#$d_eofnblk EOF_NONBLOCK
+/* NEED_VA_COPY:
+ * This symbol, if defined, indicates that the system stores
+ * the variable argument list datatype, va_list, in a format
+ * that cannot be copied by simple assignment, so that some
+ * other means must be used when copying is required.
+ * As such systems vary in their provision (or non-provision)
+ * of copying mechanisms, handy.h defines a platform-
+ * independent macro, Perl_va_copy(src, dst), to do the job.
+ */
+#$need_va_copy NEED_VA_COPY /**/
+
/* Netdb_host_t:
* This symbol holds the type used for the 1st argument
* to gethostbyaddr().
*/
#define STARTPERL "$startperl" /**/
+/* STDCHAR:
+ * This symbol is defined to be the type of char used in stdio.h.
+ * It has the values "unsigned char" or "char".
+ */
+#define STDCHAR $stdchar /**/
+
/* HAS_STDIO_STREAM_ARRAY:
* This symbol, if defined, tells that there is an array
* holding the stdio streams.
#define PERL_XS_APIVERSION "$xs_apiversion"
#define PERL_PM_APIVERSION "$pm_apiversion"
-/* HAS_GETPGRP:
- * This symbol, if defined, indicates that the getpgrp routine is
- * available to get the current process group.
- */
-/* USE_BSD_GETPGRP:
- * This symbol, if defined, indicates that getpgrp needs one
- * arguments whereas USG one needs none.
- */
-#$d_getpgrp HAS_GETPGRP /**/
-#$d_bsdgetpgrp USE_BSD_GETPGRP /**/
-
-/* HAS_SETPGRP:
- * This symbol, if defined, indicates that the setpgrp routine is
- * available to set the current process group.
- */
-/* USE_BSD_SETPGRP:
- * This symbol, if defined, indicates that setpgrp needs two
- * arguments whereas USG one needs none. See also HAS_SETPGID
- * for a POSIX interface.
- */
-#$d_setpgrp HAS_SETPGRP /**/
-#$d_bsdsetpgrp USE_BSD_SETPGRP /**/
-
-/* HAS_STRTOUL:
- * This symbol, if defined, indicates that the strtoul routine is
- * available to provide conversion of strings to unsigned long.
- */
-#$d_strtoul HAS_STRTOUL /**/
-
-/* STDCHAR:
- * This symbol is defined to be the type of char used in stdio.h.
- * It has the values "unsigned char" or "char".
- */
-#define STDCHAR $stdchar /**/
-
-/* HAS__FWALK:
- * This symbol, if defined, indicates that the _fwalk system call is
- * available to apply a function to all the file handles.
- */
-#$d__fwalk HAS__FWALK /**/
-
-/* FCNTL_CAN_LOCK:
- * This symbol, if defined, indicates that fcntl() can be used
- * for file locking. Normally on Unix systems this is defined.
- * It may be undefined on VMS.
- */
-#$d_fcntl_can_lock FCNTL_CAN_LOCK /**/
-
-/* HAS_FSYNC:
- * This symbol, if defined, indicates that the fsync routine is
- * available to write a file's modified data and attributes to
- * permanent storage.
- */
-#$d_fsync HAS_FSYNC /**/
-
-/* HAS_SBRK_PROTO:
- * This symbol, if defined, indicates that the system provides
- * a prototype for the sbrk() function. Otherwise, it is up
- * to the program to supply one. Good guesses are
- * extern void* sbrk _((int));
- * extern void* sbrk _((size_t));
- */
-#$d_sbrkproto HAS_SBRK_PROTO /**/
-
-/* NEED_VA_COPY:
- * This symbol, if defined, indicates that the system stores
- * the variable argument list datatype, va_list, in a format
- * that cannot be copied by simple assignment, so that some
- * other means must be used when copying is required.
- * As such systems vary in their provision (or non-provision)
- * of copying mechanisms, handy.h defines a platform-
- * independent macro, Perl_va_copy(src, dst), to do the job.
- */
-#$need_va_copy NEED_VA_COPY /**/
-
#endif
!GROK!THIS!
$ use_pack_malloc = "N"
$ use_debugmalloc = "N"
$ ccflags = ""
+$ static_ext = ""
$ vms_default_directory_name = F$ENVIRONMENT("DEFAULT")
$ max_allowed_dir_depth = 3 ! e.g. [A.B.PERLxxx] not [A.B.C.PERLxxx]
$! max_allowed_dir_depth = 2 ! e.g. [A.PERLxxx] not [A.B.PERLxxx]
$ IF ans.eqs."decc" then Has_Dec_C_Sockets = "T"
$ IF ans.eqs."socketshr" then Has_socketshr = "T"
$ ENDIF
+$ IF Has_Dec_C_Sockets .or. Has_socketshr
+$ THEN
+$ static_ext = f$edit(static_ext+" "+"Socket","trim,compress")
+$ ENDIF
$!
$!
$! Ask if they want to build with VMS_DEBUG perl
$ WC "src='" + src + "'"
$ WC "ssizetype='int'"
$ WC "startperl=" + startperl ! This one's special--no enclosing single quotes
-$ WC "static_ext='" + "'"
+$ WC "static_ext='" + static_ext + "'"
$ WC "stdchar='" + stdchar + "'"
$ WC "stdio_base='((*fp)->_base)'"
$ WC "stdio_bufsiz='((*fp)->_cnt + (*fp)->_ptr - (*fp)->_base)'"
-e 's=File/=='\
-e 's=glob=='\
-e 's=Glob=='\
- -e 's/storable/Storable/'
+ -e 's/storable/Storable/'\
+ -e 's/encode/Encode/'\
+ -e 's=filter/util/call=Filter/Util/Call='
}
static_ext=$(repair "$static_ext")
extensions=$(repair "$extensions")
#define ref Perl_ref
#define refkids Perl_refkids
#define regdump Perl_regdump
+#define regclass_swash Perl_regclass_swash
#define pregexec Perl_pregexec
#define pregfree Perl_pregfree
#define pregcomp Perl_pregcomp
#define regbranch S_regbranch
#define reguni S_reguni
#define regclass S_regclass
-#define regclassutf8 S_regclassutf8
#define regcurly S_regcurly
#define reg_node S_reg_node
#define regpiece S_regpiece
#define regrepeat_hard S_regrepeat_hard
#define regtry S_regtry
#define reginclass S_reginclass
-#define reginclassutf8 S_reginclassutf8
#define regcppush S_regcppush
#define regcppop S_regcppop
#define regcp_set_to S_regcp_set_to
#define ref(a,b) Perl_ref(aTHX_ a,b)
#define refkids(a,b) Perl_refkids(aTHX_ a,b)
#define regdump(a) Perl_regdump(aTHX_ a)
+#define regclass_swash(a,b,c) Perl_regclass_swash(aTHX_ a,b,c)
#define pregexec(a,b,c,d,e,f,g) Perl_pregexec(aTHX_ a,b,c,d,e,f,g)
#define pregfree(a) Perl_pregfree(aTHX_ a)
#define pregcomp(a,b,c) Perl_pregcomp(aTHX_ a,b,c)
#define regbranch(a,b,c) S_regbranch(aTHX_ a,b,c)
#define reguni(a,b,c,d) S_reguni(aTHX_ a,b,c,d)
#define regclass(a) S_regclass(aTHX_ a)
-#define regclassutf8(a) S_regclassutf8(aTHX_ a)
#define regcurly(a) S_regcurly(aTHX_ a)
#define reg_node(a,b) S_reg_node(aTHX_ a,b)
#define regpiece(a,b) S_regpiece(aTHX_ a,b)
#define regrepeat(a,b) S_regrepeat(aTHX_ a,b)
#define regrepeat_hard(a,b,c) S_regrepeat_hard(aTHX_ a,b,c)
#define regtry(a,b) S_regtry(aTHX_ a,b)
-#define reginclass(a,b) S_reginclass(aTHX_ a,b)
-#define reginclassutf8(a,b) S_reginclassutf8(aTHX_ a,b)
+#define reginclass(a,b,c) S_reginclass(aTHX_ a,b,c)
#define regcppush(a) S_regcppush(aTHX_ a)
#define regcppop() S_regcppop(aTHX)
#define regcp_set_to(a) S_regcp_set_to(aTHX_ a)
#define refkids Perl_refkids
#define Perl_regdump CPerlObj::Perl_regdump
#define regdump Perl_regdump
+#define Perl_regclass_swash CPerlObj::Perl_regclass_swash
+#define regclass_swash Perl_regclass_swash
#define Perl_pregexec CPerlObj::Perl_pregexec
#define pregexec Perl_pregexec
#define Perl_pregfree CPerlObj::Perl_pregfree
#define reguni S_reguni
#define S_regclass CPerlObj::S_regclass
#define regclass S_regclass
-#define S_regclassutf8 CPerlObj::S_regclassutf8
-#define regclassutf8 S_regclassutf8
#define S_regcurly CPerlObj::S_regcurly
#define regcurly S_regcurly
#define S_reg_node CPerlObj::S_reg_node
#define regtry S_regtry
#define S_reginclass CPerlObj::S_reginclass
#define reginclass S_reginclass
-#define S_reginclassutf8 CPerlObj::S_reginclassutf8
-#define reginclassutf8 S_reginclassutf8
#define S_regcppush CPerlObj::S_regcppush
#define regcppush S_regcppush
#define S_regcppop CPerlObj::S_regcppop
p |OP* |ref |OP* o|I32 type
p |OP* |refkids |OP* o|I32 type
Ap |void |regdump |regexp* r
+Ap |SV* |regclass_swash |struct regnode *n|bool doinit|SV **initsvp
Ap |I32 |pregexec |regexp* prog|char* stringarg \
|char* strend|char* strbeg|I32 minend \
|SV* screamer|U32 nosave
s |regnode*|regbranch |struct RExC_state_t*|I32 *|I32
s |void |reguni |struct RExC_state_t*|UV|char *|STRLEN*
s |regnode*|regclass |struct RExC_state_t*
-s |regnode*|regclassutf8 |struct RExC_state_t*
s |I32 |regcurly |char *
s |regnode*|reg_node |struct RExC_state_t*|U8
s |regnode*|regpiece |struct RExC_state_t*|I32 *
s |I32 |regrepeat |regnode *p|I32 max
s |I32 |regrepeat_hard |regnode *p|I32 max|I32 *lp
s |I32 |regtry |regexp *prog|char *startpos
-s |bool |reginclass |regnode *p|I32 c
-s |bool |reginclassutf8 |regnode *f|U8* p
+s |bool |reginclass |regnode *n|U8 *p|bool do_utf8sv_is_utf8
s |CHECKPOINT|regcppush |I32 parenfloor
s |char*|regcppop
s |char*|regcp_set_to |I32 ss
* Included Perl core patch 8068 -- fix for bug 20001013.009
When run with warnings enabled "$hash{XX} = undef " produced an
"Uninitialized value" warning. This has been fixed.
+
+1.75 17th December 2000
+
+ * Fixed perl core patch 7703
+
+ * Added suppport to allow DB_File to be built with Berkeley DB 3.2 --
+ btree_compare, btree_prefix and hash_cb needed to be changed.
+
+ * Updated dbinfo to support Berkeley DB 3.2 file format changes.
+
+
# DB_File.pm -- Perl 5 interface to Berkeley DB
#
# written by Paul Marquess (Paul.Marquess@btinternet.com)
-# last modified 10th December 2000
-# version 1.74
+# last modified 17th December 2000
+# version 1.75
#
# Copyright (c) 1995-2000 Paul Marquess. All rights reserved.
# This program is free software; you can redistribute it and/or
use Carp;
-$VERSION = "1.74" ;
+$VERSION = "1.75" ;
#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
$DB_BTREE = new DB_File::BTREEINFO ;
DB_File.xs -- Perl 5 interface to Berkeley DB
written by Paul Marquess <Paul.Marquess@btinternet.com>
- last modified 10 December 2000
- version 1.74
+ last modified 17 December 2000
+ version 1.75
All comments/suggestions/problems are welcome
1.74 - A call to open needed parenthesised to stop it clashing
with a win32 macro.
Added Perl core patches 7703 & 7801.
+ 1.75 - Fixed Perl core patch 7703.
+ Added suppport to allow DB_File to be built with
+ Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb
+ needed to be changed.
*/
# define BERKELEY_DB_1_OR_2
#endif
+#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
+# define AT_LEAST_DB_3_2
+#endif
+
/* map version 2 features & constants onto their version 1 equivalent */
#ifdef DB_Prefix_t
#else /* db version 1.x */
+#define BERKELEY_DB_1
#define BERKELEY_DB_1_OR_2
typedef union INFO {
static int
+#ifdef AT_LEAST_DB_3_2
+
+#ifdef CAN_PROTOTYPE
+btree_compare(DB * db, const DBT *key1, const DBT *key2)
+#else
+btree_compare(db, key1, key2)
+DB * db ;
+const DBT * key1 ;
+const DBT * key2 ;
+#endif /* CAN_PROTOTYPE */
+
+#else /* Berkeley DB < 3.2 */
+
#ifdef CAN_PROTOTYPE
btree_compare(const DBT *key1, const DBT *key2)
#else
const DBT * key1 ;
const DBT * key2 ;
#endif
+
+#endif
+
{
#ifdef dTHX
dTHX;
}
static DB_Prefix_t
+#ifdef AT_LEAST_DB_3_2
+
+#ifdef CAN_PROTOTYPE
+btree_prefix(DB * db, const DBT *key1, const DBT *key2)
+#else
+btree_prefix(db, key1, key2)
+Db * db ;
+const DBT * key1 ;
+const DBT * key2 ;
+#endif
+
+#else /* Berkeley DB < 3.2 */
+
#ifdef CAN_PROTOTYPE
btree_prefix(const DBT *key1, const DBT *key2)
#else
const DBT * key1 ;
const DBT * key2 ;
#endif
+
+#endif
{
#ifdef dTHX
dTHX;
}
-#if defined(BERKELEY_DB_1_OR_2) && !(DB_VERSION_MINOR == 7 && DB_VERSION_PATCH >= 7)
+#ifdef BERKELEY_DB_1
# define HASH_CB_SIZE_TYPE size_t
#else
# define HASH_CB_SIZE_TYPE u_int32_t
#endif
static DB_Hash_t
+#ifdef AT_LEAST_DB_3_2
+
+#ifdef CAN_PROTOTYPE
+hash_cb(DB * db, const void *data, u_int32_t size)
+#else
+hash_cb(db, data, size)
+DB * db ;
+const void * data ;
+HASH_CB_SIZE_TYPE size ;
+#endif
+
+#else /* Berkeley DB < 3.2 */
+
#ifdef CAN_PROTOTYPE
hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
#else
const void * data ;
HASH_CB_SIZE_TYPE size ;
#endif
+
+#endif
{
#ifdef dTHX
dTHX;
Type => "Queue",
Versions =>
{
- 1 => "3.0.0 or greater",
+ 1 => "3.0.x",
+ 2 => "3.1.x",
+ 3 => "3.2.x or greater",
}
},
) ;
{ die "not a Berkeley DB database file.\n" }
my $type = $Data{$magic} ;
-my $magic = sprintf "%06X", $magic ;
+$magic = sprintf "%06X", $magic ;
my $ver_string = "Unknown" ;
$ver_string = $type->{Versions}{$version}
sub AUTOLOAD {
(my $constname = $AUTOLOAD) =~ s/.*:://;
- my $val = constant($constname, 0);
+ my $val = constant($constname);
if ($! != 0) {
if ($! =~ /Invalid/ || $!{EINVAL}) {
$AutoLoader::AUTOLOAD = $AUTOLOAD;
return -1;
}
-static double
-constant(char *name, int arg)
+static IV
+constant(char *name)
{
errno = 0;
- switch (*name) {
+ switch (*(name++)) {
case '_':
- if (strEQ(name, "_S_IFMT")) /* Yes, on name _S_IFMT return S_IFMT. */
+ if (strEQ(name, "S_IFMT")) /* Yes, on name _S_IFMT return S_IFMT. */
#ifdef S_IFMT
return S_IFMT;
#else
#endif
break;
case 'F':
- if (strnEQ(name, "F_", 2)) {
- if (strEQ(name, "F_ALLOCSP"))
+ if (*name == '_') {
+ name++;
+ if (strEQ(name, "ALLOCSP"))
#ifdef F_ALLOCSP
return F_ALLOCSP;
#else
goto not_there;
#endif
- if (strEQ(name, "F_ALLOCSP64"))
+ if (strEQ(name, "ALLOCSP64"))
#ifdef F_ALLOCSP64
return F_ALLOCSP64;
#else
goto not_there;
#endif
- if (strEQ(name, "F_COMPAT"))
+ if (strEQ(name, "COMPAT"))
#ifdef F_COMPAT
return F_COMPAT;
#else
goto not_there;
#endif
- if (strEQ(name, "F_DUP2FD"))
+ if (strEQ(name, "DUP2FD"))
#ifdef F_DUP2FD
return F_DUP2FD;
#else
goto not_there;
#endif
- if (strEQ(name, "F_DUPFD"))
+ if (strEQ(name, "DUPFD"))
#ifdef F_DUPFD
return F_DUPFD;
#else
goto not_there;
#endif
- if (strEQ(name, "F_EXLCK"))
+ if (strEQ(name, "EXLCK"))
#ifdef F_EXLCK
return F_EXLCK;
#else
goto not_there;
#endif
- if (strEQ(name, "F_FREESP"))
+ if (strEQ(name, "FREESP"))
#ifdef F_FREESP
return F_FREESP;
#else
goto not_there;
#endif
- if (strEQ(name, "F_FREESP64"))
+ if (strEQ(name, "FREESP64"))
#ifdef F_FREESP64
return F_FREESP64;
#else
goto not_there;
#endif
- if (strEQ(name, "F_FSYNC"))
+ if (strEQ(name, "FSYNC"))
#ifdef F_FSYNC
return F_FSYNC;
#else
goto not_there;
#endif
- if (strEQ(name, "F_FSYNC64"))
+ if (strEQ(name, "FSYNC64"))
#ifdef F_FSYNC64
return F_FSYNC64;
#else
goto not_there;
#endif
- if (strEQ(name, "F_GETFD"))
+ if (strEQ(name, "GETFD"))
#ifdef F_GETFD
return F_GETFD;
#else
goto not_there;
#endif
- if (strEQ(name, "F_GETFL"))
+ if (strEQ(name, "GETFL"))
#ifdef F_GETFL
return F_GETFL;
#else
goto not_there;
#endif
- if (strEQ(name, "F_GETLK"))
+ if (strEQ(name, "GETLK"))
#ifdef F_GETLK
return F_GETLK;
#else
goto not_there;
#endif
- if (strEQ(name, "F_GETLK64"))
+ if (strEQ(name, "GETLK64"))
#ifdef F_GETLK64
return F_GETLK64;
#else
goto not_there;
#endif
- if (strEQ(name, "F_GETOWN"))
+ if (strEQ(name, "GETOWN"))
#ifdef F_GETOWN
return F_GETOWN;
#else
goto not_there;
#endif
- if (strEQ(name, "F_NODNY"))
+ if (strEQ(name, "NODNY"))
#ifdef F_NODNY
return F_NODNY;
#else
goto not_there;
#endif
- if (strEQ(name, "F_POSIX"))
+ if (strEQ(name, "POSIX"))
#ifdef F_POSIX
return F_POSIX;
#else
goto not_there;
#endif
- if (strEQ(name, "F_RDACC"))
+ if (strEQ(name, "RDACC"))
#ifdef F_RDACC
return F_RDACC;
#else
goto not_there;
#endif
- if (strEQ(name, "F_RDDNY"))
+ if (strEQ(name, "RDDNY"))
#ifdef F_RDDNY
return F_RDDNY;
#else
goto not_there;
#endif
- if (strEQ(name, "F_RDLCK"))
+ if (strEQ(name, "RDLCK"))
#ifdef F_RDLCK
return F_RDLCK;
#else
goto not_there;
#endif
- if (strEQ(name, "F_RWACC"))
+ if (strEQ(name, "RWACC"))
#ifdef F_RWACC
return F_RWACC;
#else
goto not_there;
#endif
- if (strEQ(name, "F_RWDNY"))
+ if (strEQ(name, "RWDNY"))
#ifdef F_RWDNY
return F_RWDNY;
#else
goto not_there;
#endif
- if (strEQ(name, "F_SETFD"))
+ if (strEQ(name, "SETFD"))
#ifdef F_SETFD
return F_SETFD;
#else
goto not_there;
#endif
- if (strEQ(name, "F_SETFL"))
+ if (strEQ(name, "SETFL"))
#ifdef F_SETFL
return F_SETFL;
#else
goto not_there;
#endif
- if (strEQ(name, "F_SETLK"))
+ if (strEQ(name, "SETLK"))
#ifdef F_SETLK
return F_SETLK;
#else
goto not_there;
#endif
- if (strEQ(name, "F_SETLK64"))
+ if (strEQ(name, "SETLK64"))
#ifdef F_SETLK64
return F_SETLK64;
#else
goto not_there;
#endif
- if (strEQ(name, "F_SETLKW"))
+ if (strEQ(name, "SETLKW"))
#ifdef F_SETLKW
return F_SETLKW;
#else
goto not_there;
#endif
- if (strEQ(name, "F_SETLKW64"))
+ if (strEQ(name, "SETLKW64"))
#ifdef F_SETLKW64
return F_SETLKW64;
#else
goto not_there;
#endif
- if (strEQ(name, "F_SETOWN"))
+ if (strEQ(name, "SETOWN"))
#ifdef F_SETOWN
return F_SETOWN;
#else
goto not_there;
#endif
- if (strEQ(name, "F_SHARE"))
+ if (strEQ(name, "SHARE"))
#ifdef F_SHARE
return F_SHARE;
#else
goto not_there;
#endif
- if (strEQ(name, "F_SHLCK"))
+ if (strEQ(name, "SHLCK"))
#ifdef F_SHLCK
return F_SHLCK;
#else
goto not_there;
#endif
- if (strEQ(name, "F_UNLCK"))
+ if (strEQ(name, "UNLCK"))
#ifdef F_UNLCK
return F_UNLCK;
#else
goto not_there;
#endif
- if (strEQ(name, "F_UNSHARE"))
+ if (strEQ(name, "UNSHARE"))
#ifdef F_UNSHARE
return F_UNSHARE;
#else
goto not_there;
#endif
- if (strEQ(name, "F_WRACC"))
+ if (strEQ(name, "WRACC"))
#ifdef F_WRACC
return F_WRACC;
#else
goto not_there;
#endif
- if (strEQ(name, "F_WRDNY"))
+ if (strEQ(name, "WRDNY"))
#ifdef F_WRDNY
return F_WRDNY;
#else
goto not_there;
#endif
- if (strEQ(name, "F_WRLCK"))
+ if (strEQ(name, "WRLCK"))
#ifdef F_WRLCK
return F_WRLCK;
#else
errno = EINVAL;
return 0;
}
- if (strEQ(name, "FAPPEND"))
+ if (strEQ(name, "APPEND"))
#ifdef FAPPEND
return FAPPEND;
#else
goto not_there;
#endif
- if (strEQ(name, "FASYNC"))
+ if (strEQ(name, "ASYNC"))
#ifdef FASYNC
return FASYNC;
#else
goto not_there;
#endif
- if (strEQ(name, "FCREAT"))
+ if (strEQ(name, "CREAT"))
#ifdef FCREAT
return FCREAT;
#else
goto not_there;
#endif
- if (strEQ(name, "FD_CLOEXEC"))
+ if (strEQ(name, "D_CLOEXEC"))
#ifdef FD_CLOEXEC
return FD_CLOEXEC;
#else
goto not_there;
#endif
- if (strEQ(name, "FDEFER"))
+ if (strEQ(name, "DEFER"))
#ifdef FDEFER
return FDEFER;
#else
goto not_there;
#endif
- if (strEQ(name, "FDSYNC"))
+ if (strEQ(name, "DSYNC"))
#ifdef FDSYNC
return FDSYNC;
#else
goto not_there;
#endif
- if (strEQ(name, "FEXCL"))
+ if (strEQ(name, "EXCL"))
#ifdef FEXCL
return FEXCL;
#else
goto not_there;
#endif
- if (strEQ(name, "FLARGEFILE"))
+ if (strEQ(name, "LARGEFILE"))
#ifdef FLARGEFILE
return FLARGEFILE;
#else
goto not_there;
#endif
- if (strEQ(name, "FNDELAY"))
+ if (strEQ(name, "NDELAY"))
#ifdef FNDELAY
return FNDELAY;
#else
goto not_there;
#endif
- if (strEQ(name, "FNONBLOCK"))
+ if (strEQ(name, "NONBLOCK"))
#ifdef FNONBLOCK
return FNONBLOCK;
#else
goto not_there;
#endif
- if (strEQ(name, "FRSYNC"))
+ if (strEQ(name, "RSYNC"))
#ifdef FRSYNC
return FRSYNC;
#else
goto not_there;
#endif
- if (strEQ(name, "FSYNC"))
+ if (strEQ(name, "SYNC"))
#ifdef FSYNC
return FSYNC;
#else
goto not_there;
#endif
- if (strEQ(name, "FTRUNC"))
+ if (strEQ(name, "TRUNC"))
#ifdef FTRUNC
return FTRUNC;
#else
#endif
break;
case 'L':
- if (strnEQ(name, "LOCK_", 5)) {
+ if (strnEQ(name, "OCK_", 4)) {
/* We support flock() on systems which don't have it, so
always supply the constants. */
- if (strEQ(name, "LOCK_SH"))
+ name += 4;
+ if (strEQ(name, "SH"))
#ifdef LOCK_SH
return LOCK_SH;
#else
return 1;
#endif
- if (strEQ(name, "LOCK_EX"))
+ if (strEQ(name, "EX"))
#ifdef LOCK_EX
return LOCK_EX;
#else
return 2;
#endif
- if (strEQ(name, "LOCK_NB"))
+ if (strEQ(name, "NB"))
#ifdef LOCK_NB
return LOCK_NB;
#else
return 4;
#endif
- if (strEQ(name, "LOCK_UN"))
+ if (strEQ(name, "UN"))
#ifdef LOCK_UN
return LOCK_UN;
#else
goto not_there;
break;
case 'O':
- if (strnEQ(name, "O_", 2)) {
- if (strEQ(name, "O_ACCMODE"))
+ if (name[0] == '_') {
+ name++;
+ if (strEQ(name, "ACCMODE"))
#ifdef O_ACCMODE
return O_ACCMODE;
#else
goto not_there;
#endif
- if (strEQ(name, "O_APPEND"))
+ if (strEQ(name, "APPEND"))
#ifdef O_APPEND
return O_APPEND;
#else
goto not_there;
#endif
- if (strEQ(name, "O_ASYNC"))
+ if (strEQ(name, "ASYNC"))
#ifdef O_ASYNC
return O_ASYNC;
#else
goto not_there;
#endif
- if (strEQ(name, "O_BINARY"))
+ if (strEQ(name, "BINARY"))
#ifdef O_BINARY
return O_BINARY;
#else
goto not_there;
#endif
- if (strEQ(name, "O_CREAT"))
+ if (strEQ(name, "CREAT"))
#ifdef O_CREAT
return O_CREAT;
#else
goto not_there;
#endif
- if (strEQ(name, "O_DEFER"))
+ if (strEQ(name, "DEFER"))
#ifdef O_DEFER
return O_DEFER;
#else
goto not_there;
#endif
- if (strEQ(name, "O_DIRECT"))
+ if (strEQ(name, "DIRECT"))
#ifdef O_DIRECT
return O_DIRECT;
#else
goto not_there;
#endif
- if (strEQ(name, "O_DIRECTORY"))
+ if (strEQ(name, "DIRECTORY"))
#ifdef O_DIRECTORY
return O_DIRECTORY;
#else
goto not_there;
#endif
- if (strEQ(name, "O_DSYNC"))
+ if (strEQ(name, "DSYNC"))
#ifdef O_DSYNC
return O_DSYNC;
#else
goto not_there;
#endif
- if (strEQ(name, "O_EXCL"))
+ if (strEQ(name, "EXCL"))
#ifdef O_EXCL
return O_EXCL;
#else
goto not_there;
#endif
- if (strEQ(name, "O_EXLOCK"))
+ if (strEQ(name, "EXLOCK"))
#ifdef O_EXLOCK
return O_EXLOCK;
#else
goto not_there;
#endif
- if (strEQ(name, "O_LARGEFILE"))
+ if (strEQ(name, "LARGEFILE"))
#ifdef O_LARGEFILE
return O_LARGEFILE;
#else
goto not_there;
#endif
- if (strEQ(name, "O_NDELAY"))
+ if (strEQ(name, "NDELAY"))
#ifdef O_NDELAY
return O_NDELAY;
#else
goto not_there;
#endif
- if (strEQ(name, "O_NOCTTY"))
+ if (strEQ(name, "NOCTTY"))
#ifdef O_NOCTTY
return O_NOCTTY;
#else
goto not_there;
#endif
- if (strEQ(name, "O_NOFOLLOW"))
+ if (strEQ(name, "NOFOLLOW"))
#ifdef O_NOFOLLOW
return O_NOFOLLOW;
#else
goto not_there;
#endif
- if (strEQ(name, "O_NOINHERIT"))
+ if (strEQ(name, "NOINHERIT"))
#ifdef O_NOINHERIT
return O_NOINHERIT;
#else
goto not_there;
#endif
- if (strEQ(name, "O_NONBLOCK"))
+ if (strEQ(name, "NONBLOCK"))
#ifdef O_NONBLOCK
return O_NONBLOCK;
#else
goto not_there;
#endif
- if (strEQ(name, "O_RANDOM"))
+ if (strEQ(name, "RANDOM"))
#ifdef O_RANDOM
return O_RANDOM;
#else
goto not_there;
#endif
- if (strEQ(name, "O_RAW"))
+ if (strEQ(name, "RAW"))
#ifdef O_RAW
return O_RAW;
#else
goto not_there;
#endif
- if (strEQ(name, "O_RDONLY"))
+ if (strEQ(name, "RDONLY"))
#ifdef O_RDONLY
return O_RDONLY;
#else
goto not_there;
#endif
- if (strEQ(name, "O_RDWR"))
+ if (strEQ(name, "RDWR"))
#ifdef O_RDWR
return O_RDWR;
#else
goto not_there;
#endif
- if (strEQ(name, "O_RSYNC"))
+ if (strEQ(name, "RSYNC"))
#ifdef O_RSYNC
return O_RSYNC;
#else
goto not_there;
#endif
- if (strEQ(name, "O_SEQUENTIAL"))
+ if (strEQ(name, "SEQUENTIAL"))
#ifdef O_SEQUENTIAL
return O_SEQUENTIAL;
#else
goto not_there;
#endif
- if (strEQ(name, "O_SHLOCK"))
+ if (strEQ(name, "SHLOCK"))
#ifdef O_SHLOCK
return O_SHLOCK;
#else
goto not_there;
#endif
- if (strEQ(name, "O_SYNC"))
+ if (strEQ(name, "SYNC"))
#ifdef O_SYNC
return O_SYNC;
#else
goto not_there;
#endif
- if (strEQ(name, "O_TEMPORARY"))
+ if (strEQ(name, "TEMPORARY"))
#ifdef O_TEMPORARY
return O_TEMPORARY;
#else
goto not_there;
#endif
- if (strEQ(name, "O_TEXT"))
+ if (strEQ(name, "TEXT"))
#ifdef O_TEXT
return O_TEXT;
#else
goto not_there;
#endif
- if (strEQ(name, "O_TRUNC"))
+ if (strEQ(name, "TRUNC"))
#ifdef O_TRUNC
return O_TRUNC;
#else
goto not_there;
#endif
- if (strEQ(name, "O_WRONLY"))
+ if (strEQ(name, "WRONLY"))
#ifdef O_WRONLY
return O_WRONLY;
#else
goto not_there;
#endif
- if (strEQ(name, "O_ALIAS"))
+ if (strEQ(name, "ALIAS"))
#ifdef O_ALIAS
return O_ALIAS;
#else
goto not_there;
#endif
- if (strEQ(name, "O_RSRC"))
+ if (strEQ(name, "RSRC"))
#ifdef O_RSRC
return O_RSRC;
#else
goto not_there;
break;
case 'S':
- switch (name[1]) {
+ switch (*(name++)) {
case '_':
- if (strEQ(name, "S_ISUID"))
+ if (strEQ(name, "ISUID"))
#ifdef S_ISUID
return S_ISUID;
#else
goto not_there;
#endif
- if (strEQ(name, "S_ISGID"))
+ if (strEQ(name, "ISGID"))
#ifdef S_ISGID
return S_ISGID;
#else
goto not_there;
#endif
- if (strEQ(name, "S_ISVTX"))
+ if (strEQ(name, "ISVTX"))
#ifdef S_ISVTX
return S_ISVTX;
#else
goto not_there;
#endif
- if (strEQ(name, "S_ISTXT"))
+ if (strEQ(name, "ISTXT"))
#ifdef S_ISTXT
return S_ISTXT;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IFREG"))
+ if (strEQ(name, "IFREG"))
#ifdef S_IFREG
return S_IFREG;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IFDIR"))
+ if (strEQ(name, "IFDIR"))
#ifdef S_IFDIR
return S_IFDIR;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IFLNK"))
+ if (strEQ(name, "IFLNK"))
#ifdef S_IFLNK
return S_IFLNK;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IFSOCK"))
+ if (strEQ(name, "IFSOCK"))
#ifdef S_IFSOCK
return S_IFSOCK;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IFBLK"))
+ if (strEQ(name, "IFBLK"))
#ifdef S_IFBLK
return S_IFBLK;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IFCHR"))
+ if (strEQ(name, "IFCHR"))
#ifdef S_IFCHR
return S_IFCHR;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IFIFO"))
+ if (strEQ(name, "IFIFO"))
#ifdef S_IFIFO
return S_IFIFO;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IFWHT"))
+ if (strEQ(name, "IFWHT"))
#ifdef S_IFWHT
return S_IFWHT;
#else
goto not_there;
#endif
- if (strEQ(name, "S_ENFMT"))
+ if (strEQ(name, "ENFMT"))
#ifdef S_ENFMT
return S_ENFMT;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IRUSR"))
+ if (strEQ(name, "IRUSR"))
#ifdef S_IRUSR
return S_IRUSR;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IWUSR"))
+ if (strEQ(name, "IWUSR"))
#ifdef S_IWUSR
return S_IWUSR;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IXUSR"))
+ if (strEQ(name, "IXUSR"))
#ifdef S_IXUSR
return S_IXUSR;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IRWXU"))
+ if (strEQ(name, "IRWXU"))
#ifdef S_IRWXU
return S_IRWXU;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IRGRP"))
+ if (strEQ(name, "IRGRP"))
#ifdef S_IRGRP
return S_IRGRP;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IWGRP"))
+ if (strEQ(name, "IWGRP"))
#ifdef S_IWGRP
return S_IWGRP;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IXGRP"))
+ if (strEQ(name, "IXGRP"))
#ifdef S_IXGRP
return S_IXGRP;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IRWXG"))
+ if (strEQ(name, "IRWXG"))
#ifdef S_IRWXG
return S_IRWXG;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IROTH"))
+ if (strEQ(name, "IROTH"))
#ifdef S_IROTH
return S_IROTH;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IWOTH"))
+ if (strEQ(name, "IWOTH"))
#ifdef S_IWOTH
return S_IWOTH;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IXOTH"))
+ if (strEQ(name, "IXOTH"))
#ifdef S_IXOTH
return S_IXOTH;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IRWXO"))
+ if (strEQ(name, "IRWXO"))
#ifdef S_IRWXO
return S_IRWXO;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IREAD"))
+ if (strEQ(name, "IREAD"))
#ifdef S_IREAD
return S_IREAD;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IWRITE"))
+ if (strEQ(name, "IWRITE"))
#ifdef S_IWRITE
return S_IWRITE;
#else
goto not_there;
#endif
- if (strEQ(name, "S_IEXEC"))
+ if (strEQ(name, "IEXEC"))
#ifdef S_IEXEC
return S_IEXEC;
#else
#endif
break;
case 'E':
- if (strEQ(name, "SEEK_CUR"))
+ if (strEQ(name, "EK_CUR"))
#ifdef SEEK_CUR
return SEEK_CUR;
#else
return 1;
#endif
- if (strEQ(name, "SEEK_END"))
+ if (strEQ(name, "EK_END"))
#ifdef SEEK_END
return SEEK_END;
#else
return 2;
#endif
- if (strEQ(name, "SEEK_SET"))
+ if (strEQ(name, "EK_SET"))
#ifdef SEEK_SET
return SEEK_SET;
#else
MODULE = Fcntl PACKAGE = Fcntl
-double
-constant(name,arg)
+IV
+constant(name)
char * name
- int arg
$name = uc $name;
$name = "LOG_$name" unless $name =~ /^LOG_/;
$name = "Sys::Syslog::$name";
- eval { &$name } || -1;
+ # Can't have just eval { &$name } || -1 because some LOG_XXX may be zero.
+ my $value = eval { &$name };
+ defined $value ? $value : -1;
}
sub connect {
Perl_set_context
Perl_amagic_call
Perl_Gv_AMupdate
+Perl_gv_handler
Perl_apply_attrs_string
Perl_avhv_delete_ent
Perl_avhv_exists_ent
Perl_pop_scope
Perl_push_scope
Perl_regdump
+Perl_regclass_swash
Perl_pregexec
Perl_pregfree
Perl_pregcomp
reachable. This protocol does not require any special privileges.
It should be borne in mind that, for both tcp and udp ping, a host
-will be reported as unreachable if if not is not running the
+will be reported as unreachable if it is not running the
appropriate echo service. For Unix-like systems see L<inetd(8)> for
more information.
case '5': case '6': case '7': case '8': case '9': case '&':
if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
- paren = atoi(mg->mg_ptr);
+ paren = atoi(mg->mg_ptr); /* $& is in [0] */
getparen:
if (paren <= rx->nparens &&
(s1 = rx->startp[paren]) != -1 &&
{
i = t1 - s1;
getlen:
- if (i > 0 && (PL_curpm->op_pmdynflags & PMdf_UTF8) && !IN_BYTE) {
- char *s = rx->subbeg + s1;
+ if (i > 0 && DO_UTF8(PL_reg_sv)) {
+ char *s = rx->subbeg + s1;
char *send = rx->subbeg + t1;
- i = 0;
- while (s < send) {
- s += UTF8SKIP(s);
- i++;
- }
+
+ i = Perl_utf8_length(aTHX_ (U8*)s, (U8*)send);
}
- if (i >= 0)
- return i;
+ if (i < 0)
+ Perl_croak(aTHX_ "panic: magic_len: %d", i);
+ return i;
}
}
return 0;
* Pre-threads, this was paren = atoi(GvENAME((GV*)mg->mg_obj));
* XXX Does the new way break anything?
*/
- paren = atoi(mg->mg_ptr);
+ paren = atoi(mg->mg_ptr); /* $& is in [0] */
getparen:
if (paren <= rx->nparens &&
(s1 = rx->startp[paren]) != -1 &&
PL_tainted = FALSE;
}
sv_setpvn(sv, s, i);
- if ((PL_curpm->op_pmdynflags & PMdf_UTF8) && !IN_BYTE)
+ if (DO_UTF8(PL_reg_sv))
SvUTF8_on(sv);
else
SvUTF8_off(sv);
#define Perl_regdump pPerl->Perl_regdump
#undef regdump
#define regdump Perl_regdump
+#undef Perl_regclass_swash
+#define Perl_regclass_swash pPerl->Perl_regclass_swash
+#undef regclass_swash
+#define regclass_swash Perl_regclass_swash
#undef Perl_pregexec
#define Perl_pregexec pPerl->Perl_pregexec
#undef pregexec
if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
useless = 0;
else if (SvPOK(sv)) {
+ /* perl4's way of mixing documentation and code
+ (before the invention of POD) was based on a
+ trick to mix nroff and perl code. The trick was
+ built upon these three nroff macros being used in
+ void context. The pink camel has the details in
+ the script wrapman near page 319. */
if (strnEQ(SvPVX(sv), "di", 2) ||
strnEQ(SvPVX(sv), "ds", 2) ||
strnEQ(SvPVX(sv), "ig", 2))
WriteMakefile(
'NAME' => 'OS2::ExtAttr',
'VERSION_FROM' => 'ExtAttr.pm', # finds $VERSION
- MAN3PODS => ' ', # Pods will be built by installman.
+ MAN3PODS => {}, # Pods will be built by installman.
'LIBS' => [''], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '', # e.g., '-I/usr/include/other'
WriteMakefile(
'NAME' => 'OS2::PrfDB',
'VERSION_FROM' => 'PrfDB.pm', # finds $VERSION
- MAN3PODS => ' ', # Pods will be built by installman.
+ MAN3PODS => {}, # Pods will be built by installman.
'LIBS' => [''], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '', # e.g., '-I/usr/include/other'
WriteMakefile(
'NAME' => 'OS2::Process',
VERSION_FROM=> 'Process.pm',
- MAN3PODS => ' ', # Pods will be built by installman.
+ MAN3PODS => {}, # Pods will be built by installman.
'LIBS' => [''], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '', # e.g., '-I/usr/include/other'
WriteMakefile(
NAME => 'OS2::DLL',
VERSION => '0.01',
- MAN3PODS => ' ', # Pods will be built by installman.
+ MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes',
PERL_MALLOC_OK => 1,
);
WriteMakefile(
NAME => 'OS2::REXX',
VERSION => '0.22',
- MAN3PODS => ' ', # Pods will be built by installman.
+ MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes',
PERL_MALLOC_OK => 1,
);
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
static char *local_patches[] = {
NULL
- ,"DEVEL8132"
+ ,"DEVEL8199"
,NULL
};
return ((CPerlObj*)pPerl)->Perl_Gv_AMupdate(stash);
}
+#undef Perl_gv_handler
+CV*
+Perl_gv_handler(pTHXo_ HV* stash, I32 id)
+{
+ return ((CPerlObj*)pPerl)->Perl_gv_handler(stash, id);
+}
+
#undef Perl_apply_attrs_string
void
Perl_apply_attrs_string(pTHXo_ char *stashpv, CV *cv, char *attrstr, STRLEN len)
((CPerlObj*)pPerl)->Perl_regdump(r);
}
+#undef Perl_regclass_swash
+SV*
+Perl_regclass_swash(pTHXo_ struct regnode *n, bool doinit, SV **initsvp)
+{
+ return ((CPerlObj*)pPerl)->Perl_regclass_swash(n, doinit, initsvp);
+}
+
#undef Perl_pregexec
I32
Perl_pregexec(pTHXo_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave)
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
# if defined(DEBUGGING)
# endif
+# if !defined(NV_PRESERVES_UV)
+# endif
#endif
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
#if 0
#ifndef PerlIO_fdupopen
extern PerlIO * PerlIO_fdupopen (pTHX_ PerlIO *);
#endif
-#ifndef PerlIO_modestr
+#if !defined(PerlIO_modestr) && !defined(PERLIO_IS_STDIO)
extern char *PerlIO_modestr (PerlIO *,char *buf);
#endif
#ifndef PerlIO_isutf8
extern int PerlIO_binmode (pTHX_ PerlIO *f, int iotype, int omode, const char *names);
#endif
+#ifndef PERLIO_IS_STDIO
+
extern void PerlIO_cleanup();
extern void PerlIO_debug(const char *fmt,...);
+#endif
+
END_EXTERN_C
#endif /* _PERLIO_H */
extern PerlIO_funcs PerlIO_perlio;
extern PerlIO_funcs PerlIO_stdio;
extern PerlIO_funcs PerlIO_crlf;
-extern PerlIO_funcs PerlIO_pending;
+/* The EXT is need for Cygwin -- but why only for _pending? --jhi */
+EXT PerlIO_funcs PerlIO_pending;
#ifdef HAS_MMAP
extern PerlIO_funcs PerlIO_mmap;
#endif
SV* cv_const_sv(CV* cv)
=for hackers
-Found in file opmini.c
+Found in file op.c
=item dMARK
=item looks_like_number
Test if an the content of an SV looks like a number (or is a
-number).
+number). C<Inf> and C<Infinity> are treated as numbers (so will not
+issue a non-numeric warning), even if your atof() doesn't grok them.
I32 looks_like_number(SV* sv)
CV* newCONSTSUB(HV* stash, char* name, SV* sv)
=for hackers
-Found in file opmini.c
+Found in file op.c
=item newHV
Used by C<xsubpp> to hook up XSUBs as Perl subs.
=for hackers
-Found in file opmini.c
+Found in file op.c
=item newXSproto
=for hackers
Found in file sv.h
+=item SvUOK
+
+Returns a boolean indicating whether the SV contains an unsigned integer.
+
+ void SvUOK(SV* sv)
+
+=for hackers
+Found in file sv.h
+
=item SvUPGRADE
Used to upgrade an SV to a more complex form. Uses C<sv_upgrade> to
(W closed) You tried to do a bind on a closed socket. Did you forget to
check the return value of your socket() call? See L<perlfunc/bind>.
+=item binmode() on closed filehandle %s
+
+(W unopened) You tried binmode() on a filehandle that was never opened.
+Check you control flow and number of arguments.
+
=item Bit vector size > 32 non-portable
(W portable) Using bit vector sizes larger than 32 is non-portable.
=item flock() on closed filehandle %s
(W closed) The filehandle you're attempting to flock() got itself closed
-some time before now. Check your logic flow. flock() operates on
+some time before now. Check your control flow. flock() operates on
filehandles. Are you attempting to call flock() on a dirhandle by the
same name?
(F) Your machine apparently doesn't implement ioctl(), which is pretty
strange for a machine that supports C.
+=item ioctl() on unopened %s
+
+(W unopened) You tried ioctl() on a filehandle that was never opened.
+Check you control flow and number of arguments.
+
=item `%s' is not a code reference
(W) The second (fourth, sixth, ...) argument of overload::constant needs
=item -%s on unopened filehandle %s
(W unopened) You tried to invoke a file test operator on a filehandle
-that isn't open. Check your
logic. See also L<perlfunc/-X>.
+that isn't open. Check your
control flow. See also L<perlfunc/-X>.
-=item %s() on unopened %s %s
+=item %s() on unopened %s
(W unopened) An I/O operation was attempted on a filehandle that was
never initialized. You need to do an open(), a sysopen(), or a socket()
=item printf() on closed filehandle %s
(W closed) The filehandle you're writing to got itself closed sometime
-before now. Check your logic flow.
+before now. Check your control flow.
=item print() on closed filehandle %s
(W closed) The filehandle you're printing on got itself closed sometime
-before now. Check your logic flow.
+before now. Check your control flow.
=item Process terminated by SIG%s
=item readline() on closed filehandle %s
(W closed) The filehandle you're reading from got itself closed sometime
-before now. Check your logic flow.
+before now. Check your control flow.
=item Reallocation too large: %lx
=item send() on closed socket %s
(W closed) The socket you're sending to got itself closed sometime
-before now. Check your logic flow.
+before now. Check your control flow.
=item Sequence (? incomplete before << HERE mark in regex m/%s/
=item syswrite() on closed filehandle %s
(W closed) The filehandle you're writing to got itself closed sometime
-before now. Check your logic flow.
+before now. Check your control flow.
=item Target of goto is too deeply nested
=item write() on closed filehandle %s
(W closed) The filehandle you're writing to got itself closed sometime
-before now. Check your logic flow.
+before now. Check your control flow.
=item X outside of string
=head2 How do I profile my Perl programs?
-You should get the Devel::DProf module from CPAN and also use
-Benchmark.pm from the standard distribution. Benchmark lets you time
-specific portions of your code, while Devel::DProf gives detailed
-breakdowns of where your code spends its time.
+You should get the Devel::DProf module from the standard distribution
+(or separately on CPAN) and also use Benchmark.pm from the standard
+distribution. The Benchmark module lets you time specific portions of
+your code, while Devel::DProf gives detailed breakdowns of where your
+code spends its time.
Here's a sample use of Benchmark:
PerlBuilder (http://www.solutionsoft.com/perl.htm) is an integrated
development environment for Windows that supports Perl development.
+VisualPerl (http://www.activestate.com/IDE) is also an integrated
+development environment for Windows, Unix, and several Open Source OSes
+that supports Perl development. Perl code magic is another IDE
+(http://www.petes-place.com/codemagic.html). CodeMagicCD
+(http://www.codemagiccd.com/) is a commercial IDE.
+
Perl programs are just plain text, though, so you could download emacs
for Windows (http://www.gnu.org/software/emacs/windows/ntemacs.html)
-or a vi clone (vim) which runs on for win32
-(http://www.cs.vu.nl/%7Etmgil/vi.html). If you're transferring
-Windows files to Unix be sure to transfer them in ASCII mode so the ends
-of lines are appropriately mangled.
+or a vi clone such as nvi (available from CPAN in src/misc/) or vim
+(http://www.vim.org/). Vim runs on win32
+(http://www.cs.vu.nl/%7Etmgil/vi.html). Vile is another widely ported
+vi clone that has a Perl language sensitivity module
+(http://www.clark.net/pub/dickey/vile/vile.html). SlickEdit
+(http://www.slickedit.com/) is a full featured commercial editor that
+has a modular architecture: it can emulate several other common
+editors and it can help with programming language sensitivity modules
+for a variety of programming languages including Perl. If you're
+transferring Windows text files to Unix be sure to transfer them in
+ASCII mode so the ends of lines are appropriately mangled. There is
+also a toyedit Text widget based editor written in Perl that is
+distributed with the Tk module on CPAN. The ptkdb
+(http://world.std.com/~aep/ptkdb/) is a Perl/tk based debugger that
+acts as a development environment of sorts. Perl Composer
+(http://perlcomposer.sourceforge.net/vperl.html) is an IDE for Perl/Tk
+GUI creation.
+
+On Mac OS the MacPerl Application comes with a simple 32k text editor
+that behaves like a rudimentary IDE. In contrast to the MacPerl Application
+the MPW Perl tool can make use of the MPW Shell itself as an editor (with
+no 32k limit). BBEdit and BBEdit Lite are text editors for Mac OS
+that have a Perl sensitivity mode (http://web.barebones.com/).
+Alpha is an editor, written and extensible in Tcl, that nonetheless has
+built in support for several popular markup and programming languages
+including Perl and HTML (http://alpha.olm.net/).
=head2 Where can I get Perl macros for vi?
=over 8
+=item djSP
+
+Declare Just C<SP>. This is actually identical to C<dSP>, and declares
+a local copy of perl's stack pointer, available via the C<SP> macro.
+See C<SP>. (Available for backward source code compatibility with the
+old (Perl 5.005) thread model.)
+
+ djSP;
+
+=for hackers
+Found in file pp.h
+
=item is_gv_magical
Returns C<TRUE> if given the name of a magical GV.
=for hackers
Found in file gv.c
+=item start_glob
+
+Function called by C<do_readline> to spawn a glob (or do the glob inside
+perl on VMS). This code used to be inline, but now perl uses C<File::Glob>
+this glob starter is only used by miniperl during the build proccess.
+Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up.
+
+ PerlIO* start_glob(SV* pattern, IO *io)
+
+=for hackers
+Found in file doio.c
+
=back
=head1 AUTHORS
Package for overloading perl operations
+=item perlio
+
+Configure C level IO
+
=item re
Alter regular expression behaviour
Warn of errors (from perspective of caller)
-=item Carp::Heavy
-
-Carp guts
-
=item Class::Struct
Declare struct-like datatypes as Perl classes
Portably perform operations on file names
+=item File::Spec::Epoc
+
+Methods for Epoc file specs
+
=item File::Spec::Functions
Portably perform operations on file names
Supply object methods for filehandles
+=item Filter::Simple
+
+Simplified source filtering
+
=item FindBin
Locate directory of original perl script
some of which require a C compiler to build. Major categories of
modules are:
-=over 4
+=over
=item *
Language Extensions and Documentation Tools
Registered CPAN sites as of this writing include the following.
You should try to choose one close to you:
-=over 4
+=over
=item Africa
standards for naming modules and the interface to methods in
those modules.
+If developing modules for private internal or project specific use,
+that will never be released to the public, then you should ensure
+that their names will not clash with any future public module. You
+can do this either by using the reserved Local::* category or by
+using a category name that includes an underscore like Foo_Corp::*.
+
To be portable each component of a module name should be limited to
11 characters. If it might be used on MS-DOS then try to ensure each is
unique in the first 8 characters. Nested modules make this easier.
I do [task] in Perl?, When shouldn't I program in Perl?, What's the
difference between "perl" and "Perl"?, Is it a Perl program or a Perl
script?, What is a JAPH?, Where can I get a list of Larry Wall witticisms?,
-How can I convince my sysadmin/supervisor/employees to use (version
-5/5.005/Perl
) instead of some other language?, L<perlfaq2>: Obtaining and
+How can I convince my sysadmin/supervisor/employees to use version
+5/5.005/Perl instead of some other language?, L<perlfaq2>: Obtaining and
Learning about Perl, What machines support Perl? Where do I get it?, How
can I get a binary version of Perl?, I don't have a C compiler on my
system. How can I compile perl?, I copied the Perl binary from one machine
it work?, What modules and extensions are available for Perl? What is
CPAN? What does CPAN/src/... mean?, Is there an ISO or ANSI certified
version of Perl?, Where can I get information on Perl?, What are the Perl
-newsgroups on USENET? Where do I post questions?, Where should I post
+newsgroups on Usenet? Where do I post questions?, Where should I post
source code?, Perl Books, Perl in Magazines, Perl on the Net: FTP and WWW
-Access, What mailing lists are there for perl?, Archives of
+Access, What mailing lists are there for Perl?, Archives of
comp.lang.perl.misc, Where can I buy a commercial version of Perl?, Where
-do I send bug reports?, What is perl.com?, L<perlfaq3>: Programming Tools,
-How do I do (anything)?, How can I use Perl interactively?, Is there a Perl
-shell?, How do I debug my Perl programs?, How do I profile my Perl
-programs?, How do I cross-reference my Perl programs?, Is there a
-pretty-printer (formatter) for Perl?, Is there a ctags for Perl?, Is there
-an IDE or Windows Perl Editor?, Where can I get Perl macros for vi?, Where
-can I get perl-mode for emacs?, How can I use curses with Perl?, How can I
-use X or Tk with Perl?, How can I generate simple menus without using CGI
-or Tk?, What is undump?, How can I make my Perl program run faster?, How
-can I make my Perl program take less memory?, Is it unsafe to return a
-pointer to local data?, How can I free an array or hash so my program
-shrinks?, How can I make my CGI script more efficient?, How can I hide the
-source for my Perl program?, How can I compile my Perl program into byte
-code or C?, How can I compile Perl into Java?, How can I get C<#!perl> to
-work on [MS-DOS,NT,...]?, Can I write useful perl programs on the command
-line?, Why don't perl one-liners work on my DOS/Mac/VMS system?, Where can
-I learn about CGI or Web programming in Perl?, Where can I learn about
-object-oriented Perl programming?, Where can I learn about linking C with
-Perl? [h2xs, xsubpp], I've read perlembed, perlguts, etc., but I can't
-embed perl in my C program; what am I doing wrong?, When I tried to run my
-script, I got this message. What does it mean?, What's MakeMaker?,
-L<perlfaq4>: Data Manipulation, Why am I getting long decimals (eg,
-19.9499999999999) instead of the numbers I should be getting (eg, 19.95)?,
-Why isn't my octal data interpreted correctly?, Does Perl have a round()
-function? What about ceil() and floor()? Trig functions?, How do I
-convert bits into ints?, Why doesn't & work the way I want it to?, How do I
-multiply matrices?, How do I perform an operation on a series of integers?,
-How can I output Roman numerals?, Why aren't my random numbers random?, How
-do I find the week-of-the-year/day-of-the-year?, How do I find the current
-century or millennium?, How can I compare two dates and find the
-difference?, How can I take a string and turn it into epoch seconds?, How
-can I find the Julian Day?, How do I find yesterday's date?, Does Perl have
-a year 2000 problem? Is Perl Y2K compliant?, How do I validate input?, How
-do I unescape a string?, How do I remove consecutive pairs of characters?,
-How do I expand function calls in a string?, How do I find matching/nesting
-anything?, How do I reverse a string?, How do I expand tabs in a string?,
-How do I reformat a paragraph?, How can I access/change the first N letters
-of a string?, How do I change the Nth occurrence of something?, How can I
-count the number of occurrences of a substring within a string?, How do I
-capitalize all the words on one line?, How can I split a [character]
-delimited string except when inside [character]? (Comma-separated files),
-How do I strip blank space from the beginning/end of a string?, How do I
-pad a string with blanks or pad a number with zeroes?, How do I extract
-selected columns from a string?, How do I find the soundex value of a
-string?, How can I expand variables in text strings?, What's wrong with
-always quoting "$vars"?, Why don't my <<HERE documents work?, What is the
-difference between a list and an array?, What is the difference between
-$array[1] and @array[1]?, How can I remove duplicate elements from a list
-or array?, How can I tell whether a list or array contains a certain
-element?, How do I compute the difference of two arrays? How do I compute
-the intersection of two arrays?, How do I test whether two arrays or hashes
-are equal?, How do I find the first array element for which a condition is
-true?, How do I handle linked lists?, How do I handle circular lists?, How
-do I shuffle an array randomly?, How do I process/modify each element of an
-array?, How do I select a random element from an array?, How do I permute N
-elements of a list?, How do I sort an array by (anything)?, How do I
-manipulate arrays of bits?, Why does defined() return true on empty arrays
-and hashes?, How do I process an entire hash?, What happens if I add or
-remove keys from a hash while iterating over it?, How do I look up a hash
-element by value?, How can I know how many entries are in a hash?, How do I
-sort a hash (optionally by value instead of key)?, How can I always keep my
-hash sorted?, What's the difference between "delete" and "undef" with
-hashes?, Why don't my tied hashes make the defined/exists distinction?, How
-do I reset an each() operation part-way through?, How can I get the unique
-keys from two hashes?, How can I store a multidimensional array in a DBM
-file?, How can I make my hash remember the order I put elements into it?,
-Why does passing a subroutine an undefined element in a hash create it?,
-How can I make the Perl equivalent of a C structure/C++ class/hash or array
-of hashes or arrays?, How can I use a reference as a hash key?, How do I
-handle binary data correctly?, How do I determine whether a scalar is a
+do I send bug reports?, What is perl.com? Perl Mongers? pm.org? perl.org?,
+L<perlfaq3>: Programming Tools, How do I do (anything)?, How can I use Perl
+interactively?, Is there a Perl shell?, How do I debug my Perl programs?,
+How do I profile my Perl programs?, How do I cross-reference my Perl
+programs?, Is there a pretty-printer (formatter) for Perl?, Is there a
+ctags for Perl?, Is there an IDE or Windows Perl Editor?, Where can I get
+Perl macros for vi?, Where can I get perl-mode for emacs?, How can I use
+curses with Perl?, How can I use X or Tk with Perl?, How can I generate
+simple menus without using CGI or Tk?, What is undump?, How can I make my
+Perl program run faster?, How can I make my Perl program take less memory?,
+Is it unsafe to return a pointer to local data?, How can I free an array or
+hash so my program shrinks?, How can I make my CGI script more efficient?,
+How can I hide the source for my Perl program?, How can I compile my Perl
+program into byte code or C?, How can I compile Perl into Java?, How can I
+get C<#!perl> to work on [MS-DOS,NT,...]?, Can I write useful Perl programs
+on the command line?, Why don't Perl one-liners work on my DOS/Mac/VMS
+system?, Where can I learn about CGI or Web programming in Perl?, Where can
+I learn about object-oriented Perl programming?, Where can I learn about
+linking C with Perl? [h2xs, xsubpp], I've read perlembed, perlguts, etc.,
+but I can't embed perl in my C program; what am I doing wrong?, When I
+tried to run my script, I got this message. What does it mean?, What's
+MakeMaker?, L<perlfaq4>: Data Manipulation, Why am I getting long decimals
+(eg, 19.9499999999999) instead of the numbers I should be getting (eg,
+19.95)?, Why isn't my octal data interpreted correctly?, Does Perl have a
+round() function? What about ceil() and floor()? Trig functions?, How do
+I convert bits into ints?, Why doesn't & work the way I want it to?, How do
+I multiply matrices?, How do I perform an operation on a series of
+integers?, How can I output Roman numerals?, Why aren't my random numbers
+random?, How do I find the week-of-the-year/day-of-the-year?, How do I find
+the current century or millennium?, How can I compare two dates and find
+the difference?, How can I take a string and turn it into epoch seconds?,
+How can I find the Julian Day?, How do I find yesterday's date?, Does Perl
+have a Year 2000 problem? Is Perl Y2K compliant?, How do I validate
+input?, How do I unescape a string?, How do I remove consecutive pairs of
+characters?, How do I expand function calls in a string?, How do I find
+matching/nesting anything?, How do I reverse a string?, How do I expand
+tabs in a string?, How do I reformat a paragraph?, How can I access/change
+the first N letters of a string?, How do I change the Nth occurrence of
+something?, How can I count the number of occurrences of a substring within
+a string?, How do I capitalize all the words on one line?, How can I split
+a [character] delimited string except when inside [character]?
+(Comma-separated files), How do I strip blank space from the beginning/end
+of a string?, How do I pad a string with blanks or pad a number with
+zeroes?, How do I extract selected columns from a string?, How do I find
+the soundex value of a string?, How can I expand variables in text
+strings?, What's wrong with always quoting "$vars"?, Why don't my <<HERE
+documents work?, What is the difference between a list and an array?, What
+is the difference between $array[1] and @array[1]?, How can I remove
+duplicate elements from a list or array?, How can I tell whether a list or
+array contains a certain element?, How do I compute the difference of two
+arrays? How do I compute the intersection of two arrays?, How do I test
+whether two arrays or hashes are equal?, How do I find the first array
+element for which a condition is true?, How do I handle linked lists?, How
+do I handle circular lists?, How do I shuffle an array randomly?, How do I
+process/modify each element of an array?, How do I select a random element
+from an array?, How do I permute N elements of a list?, How do I sort an
+array by (anything)?, How do I manipulate arrays of bits?, Why does
+defined() return true on empty arrays and hashes?, How do I process an
+entire hash?, What happens if I add or remove keys from a hash while
+iterating over it?, How do I look up a hash element by value?, How can I
+know how many entries are in a hash?, How do I sort a hash (optionally by
+value instead of key)?, How can I always keep my hash sorted?, What's the
+difference between "delete" and "undef" with hashes?, Why don't my tied
+hashes make the defined/exists distinction?, How do I reset an each()
+operation part-way through?, How can I get the unique keys from two
+hashes?, How can I store a multidimensional array in a DBM file?, How can I
+make my hash remember the order I put elements into it?, Why does passing a
+subroutine an undefined element in a hash create it?, How can I make the
+Perl equivalent of a C structure/C++ class/hash or array of hashes or
+arrays?, How can I use a reference as a hash key?, How do I handle binary
+data correctly?, How do I determine whether a scalar is a
number/whole/integer/float?, How do I keep persistent data across program
calls?, How do I print out or copy a recursive data structure?, How do I
define methods for every class/object?, How do I verify a credit card
environment} in a perl script. How come the change disappeared when I
exited the script? How do I get my changes to be visible?, How do I close
a process's filehandle without waiting for it to complete?, How do I fork a
-daemon process?, How do I make my program run with sh and csh?, How do I
-find out if I'm running interactively or not?, How do I timeout a slow
-event?, How do I set CPU limits?, How do I avoid zombies on a Unix system?,
-How do I use an SQL database?, How do I make a system() exit on control-C?,
-How do I open a file without blocking?, How do I install a module from
-CPAN?, What's the difference between require and use?, How do I keep my own
-module/library directory?, How do I add the directory my program lives in
-to the module/library search path?, How do I add a directory to my include
-path at runtime?, What is socket.ph and where do I get it?, L<perlfaq9>:
-Networking, My CGI script runs from the command line but not the browser.
-(500 Server Error), How can I get better error messages from a CGI
-program?, How do I remove HTML from a string?, How do I extract URLs?, How
-do I download a file from the user's machine? How do I open a file on
-another machine?, How do I make a pop-up menu in HTML?, How do I fetch an
-HTML file?, How do I automate an HTML form submission?, How do I decode or
-create those %-encodings on the web?, How do I redirect to another page?,
-How do I put a password on my web pages?, How do I edit my .htpasswd and
-.htgroup files with Perl?, How do I make sure users can't enter values into
-a form that cause my CGI script to do bad things?, How do I parse a mail
-header?, How do I decode a CGI form?, How do I check a valid mail address?,
-How do I decode a MIME/BASE64 string?, How do I return the user's mail
-address?, How do I send mail?, How do I read mail?, How do I find out my
-hostname/domainname/IP address?, How do I fetch a news article or the
-active newsgroups?, How do I fetch/put an FTP file?, How can I do RPC in
-Perl?
+daemon process?, How do I find out if I'm running interactively or not?,
+How do I timeout a slow event?, How do I set CPU limits?, How do I avoid
+zombies on a Unix system?, How do I use an SQL database?, How do I make a
+system() exit on control-C?, How do I open a file without blocking?, How do
+I install a module from CPAN?, What's the difference between require and
+use?, How do I keep my own module/library directory?, How do I add the
+directory my program lives in to the module/library search path?, How do I
+add a directory to my include path at runtime?, What is socket.ph and where
+do I get it?, L<perlfaq9>: Networking, My CGI script runs from the command
+line but not the browser. (500 Server Error), How can I get better error
+messages from a CGI program?, How do I remove HTML from a string?, How do I
+extract URLs?, How do I download a file from the user's machine? How do I
+open a file on another machine?, How do I make a pop-up menu in HTML?, How
+do I fetch an HTML file?, How do I automate an HTML form submission?, How
+do I decode or create those %-encodings on the web?, How do I redirect to
+another page?, How do I put a password on my web pages?, How do I edit my
+.htpasswd and .htgroup files with Perl?, How do I make sure users can't
+enter values into a form that cause my CGI script to do bad things?, How do
+I parse a mail header?, How do I decode a CGI form?, How do I check a valid
+mail address?, How do I decode a MIME/BASE64 string?, How do I return the
+user's mail address?, How do I send mail?, How do I read mail?, How do I
+find out my hostname/domainname/IP address?, How do I fetch a news article
+or the active newsgroups?, How do I fetch/put an FTP file?, How can I do
+RPC in Perl?
=over 4
=item Tying Arrays
TIEARRAY classname, LIST, FETCH this, index, STORE this, index, value,
-UNTIE this, DESTROY this
+FETCHSIZE this, STORESIZE this, count, EXTEND this, count, EXISTS this,
+key, DELETE this, key, CLEAR this, PUSH this, LIST, POP this, SHIFT this,
+UNSHIFT this, LIST, SPLICE this, offset, length, LIST, UNTIE this, DESTROY
+this
=item Tying Hashes
attributes, attrs, autouse, base, blib, bytes, charnames, constant,
diagnostics, fields, filetest, integer, less, locale, open, ops, overload,
-re, sigtrap, strict, subs, utf8, vars, warnings, warnings::register
+perlio, re, sigtrap, strict, subs, utf8, vars, warnings, warnings::register
=item Standard Modules
B::Showlex, B::Stackobj, B::Stash, B::Terse, B::Xref, Benchmark,
ByteLoader, CGI, CGI::Apache, CGI::Carp, CGI::Cookie, CGI::Fast,
CGI::Pretty, CGI::Push, CGI::Switch, CPAN, CPAN::FirstTime, CPAN::Nox,
-Carp, Carp::Heavy, Class::Struct, Cwd, DB, DB_File, Devel::SelfStubber,
-DirHandle, Dumpvalue, Encode, English, Env, Exporter, Exporter::Heavy,
+Carp, Class::Struct, Cwd, DB, DB_File, Devel::SelfStubber, DirHandle,
+Dumpvalue, Encode, English, Env, Exporter, Exporter::Heavy,
ExtUtils::Command, ExtUtils::Embed, ExtUtils::Install, ExtUtils::Installed,
ExtUtils::Liblist, ExtUtils::MM_Cygwin, ExtUtils::MM_OS2,
ExtUtils::MM_Unix, ExtUtils::MM_VMS, ExtUtils::MM_Win32,
ExtUtils::MakeMaker, ExtUtils::Manifest, ExtUtils::Mkbootstrap,
ExtUtils::Mksymlists, ExtUtils::Packlist, ExtUtils::testlib, Fatal, Fcntl,
File::Basename, File::CheckTree, File::Compare, File::Copy, File::DosGlob,
-File::Find, File::Path, File::Spec, File::Spec::Functions, File::Spec::Mac,
-File::Spec::OS2, File::Spec::Unix, File::Spec::VMS, File::Spec::Win32,
-File::Temp, File::stat, FileCache, FileHandle, FindBin, Getopt::Long,
-Getopt::Std, I18N::Collate, IO, IPC::Open2, IPC::Open3, Math::BigFloat,
-Math::BigInt, Math::Complex, Math::Trig, NDBM_File, Net::Ping,
-Net::hostent, Net::netent, Net::protoent, Net::servent, O, ODBM_File,
-Opcode, Pod::Checker, Pod::Find, Pod::Html, Pod::InputObjects, Pod::LaTeX,
-Pod::Man, Pod::ParseUtils, Pod::Parser, Pod::Plainer, Pod::Select,
-Pod::Text, Pod::Text::Color, Pod::Text::Termcap, Pod::Usage, SDBM_File,
-Safe, Search::Dict, SelectSaver, SelfLoader, Shell, Socket, Storable,
-Symbol, Term::ANSIColor, Term::Cap, Term::Complete, Term::ReadLine, Test,
-Test::Harness, Text::Abbrev, Text::ParseWords, Text::Soundex, Text::Wrap,
-Tie::Array, Tie::Handle, Tie::Hash, Tie::RefHash, Tie::Scalar,
-Tie::SubstrHash, Time::Local, Time::gmtime, Time::localtime, Time::tm,
-UNIVERSAL, User::grent, User::pwent
+File::Find, File::Path, File::Spec, File::Spec::Epoc,
+File::Spec::Functions, File::Spec::Mac, File::Spec::OS2, File::Spec::Unix,
+File::Spec::VMS, File::Spec::Win32, File::Temp, File::stat, FileCache,
+FileHandle, Filter::Simple, FindBin, Getopt::Long, Getopt::Std,
+I18N::Collate, IO, IPC::Open2, IPC::Open3, Math::BigFloat, Math::BigInt,
+Math::Complex, Math::Trig, NDBM_File, Net::Ping, Net::hostent, Net::netent,
+Net::protoent, Net::servent, O, ODBM_File, Opcode, Pod::Checker, Pod::Find,
+Pod::Html, Pod::InputObjects, Pod::LaTeX, Pod::Man, Pod::ParseUtils,
+Pod::Parser, Pod::Plainer, Pod::Select, Pod::Text, Pod::Text::Color,
+Pod::Text::Termcap, Pod::Usage, SDBM_File, Safe, Search::Dict, SelectSaver,
+SelfLoader, Shell, Socket, Storable, Symbol, Term::ANSIColor, Term::Cap,
+Term::Complete, Term::ReadLine, Test, Test::Harness, Text::Abbrev,
+Text::ParseWords, Text::Soundex, Text::Wrap, Tie::Array, Tie::Handle,
+Tie::Hash, Tie::RefHash, Tie::Scalar, Tie::SubstrHash, Time::Local,
+Time::gmtime, Time::localtime, Time::tm, UNIVERSAL, User::grent,
+User::pwent
=item Extension Modules
=item Where can I get a list of Larry Wall witticisms?
-=item How can I convince my sysadmin/supervisor/employees to use (version
-5/5.005/Perl) instead of some other language?
+=item How can I convince my sysadmin/supervisor/employees to use version
+5/5.005/Perl instead of some other language?
=back
=item What does it mean that regexes are greedy? How can I get around it?
-=item How do I process each word on each line?
+=item How do I process each word on each line?
=item How can I print out a word-frequency or line-frequency summary?
=item The INPUT: Keyword
-=item The IN/OUTLIST/IN_OUTLIST Keywords
+=item The IN/OUTLIST/IN_OUTLIST/OUT/IN_OUT Keywords
=item Variable-length Parameter Lists
=back
+=item Examining internal data structures with the C<dump> functions
+
=item How multiple interpreters and concurrency are supported
=over 4
SvPOK_off, SvPOK_on, SvPOK_only, SvPOK_only_UTF8, SvPV, SvPVX, SvPV_force,
SvPV_nolen, SvREFCNT, SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off,
SvROK_on, SvRV, SvSETMAGIC, SvSetSV, SvSetSV_nosteal, SvSTASH, SvTAINT,
-SvTAINTED, SvTAINTED_off, SvTAINTED_on, SvTRUE, SvTYPE, svtype, SVt_IV,
-SVt_NV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SvUPGRADE, SvUTF8,
-SvUTF8_off, SvUTF8_on, SvUV, SvUVX, sv_2mortal, sv_bless, sv_catpv,
+SvTAINTED, SvTAINTED_off, SvTAINTED_on, SvTRUE, svtype, SvTYPE, SVt_IV,
+SVt_NV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SvUOK, SvUPGRADE,
+SvUTF8, SvUTF8_off, SvUTF8_on, SvUV, SvUVX, sv_2mortal, sv_bless, sv_catpv,
sv_catpvf, sv_catpvf_mg, sv_catpvn, sv_catpvn_mg, sv_catpv_mg, sv_catsv,
sv_catsv_mg, sv_chop, sv_clear, sv_cmp, sv_cmp_locale, sv_dec,
sv_derived_from, sv_eq, sv_free, sv_gets, sv_grow, sv_inc, sv_insert,
sv_setpvf, sv_setpvf_mg, sv_setpviv, sv_setpviv_mg, sv_setpvn,
sv_setpvn_mg, sv_setpv_mg, sv_setref_iv, sv_setref_nv, sv_setref_pv,
sv_setref_pvn, sv_setsv, sv_setsv_mg, sv_setuv, sv_setuv_mg, sv_true,
-sv_unmagic, sv_unref, sv_upgrade, sv_usepvn, sv_usepvn_mg,
+sv_unmagic, sv_unref, sv_unref_flags, sv_upgrade, sv_usepvn, sv_usepvn_mg,
sv_utf8_downgrade, sv_utf8_encode, sv_utf8_upgrade, sv_vcatpvfn,
-sv_vsetpvfn, THIS, toLOWER, toUPPER, U8 *s, utf8_to_bytes, utf8_to_uv,
-utf8_to_uv_simple, warn, XPUSHi, XPUSHn, XPUSHp, XPUSHs, XPUSHu, XS,
-XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, XSRETURN_NO, XSRETURN_NV,
-XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES, XST_mIV, XST_mNO, XST_mNV,
-XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION, XS_VERSION_BOOTCHECK, Zero
+sv_vsetpvfn, THIS, toLOWER, toUPPER, U8 *s, utf8_distance, utf8_hop,
+utf8_length, utf8_to_bytes, utf8_to_uv, utf8_to_uv_simple, warn, XPUSHi,
+XPUSHn, XPUSHp, XPUSHs, XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV,
+XSRETURN_NO, XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES,
+XST_mIV, XST_mNO, XST_mNV, XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION,
+XS_VERSION_BOOTCHECK, Zero
=item AUTHORS
=item DESCRIPTION
-is_gv_magical
+djSP, is_gv_magical, start_glob
=item AUTHORS
=item Linux With Sfio Fails op/misc Test 48
+=item sprintf tests 129 and 130
+
=item Storable tests fail in some platforms
=item Threads Are Still Experimental
=back
-=head2 perlamiga - Perl under Amiga OS (possibly very outdated information)
+=head2 perlamiga - Perl under Amiga OS
=over 4
=item Making
+sh Configure -Dprefix=/ade -Dloclibpth=/ade/lib
+
=item Testing
=item Installing the built perl
=back
-=item AUTHOR
+=item AUTHORS
=item SEE ALSO
=item Programmer's interface
-expand($type,@things), Programming Examples
-
-=item Methods in the four Classes
+expand($type,@things), expandany(@things), Programming Examples
+
+=item Methods in the other Classes
+
+CPAN::Author::as_glimpse(), CPAN::Author::as_string(),
+CPAN::Author::email(), CPAN::Author::fullname(), CPAN::Author::name(),
+CPAN::Bundle::as_glimpse(), CPAN::Bundle::as_string(),
+CPAN::Bundle::clean(), CPAN::Bundle::contains(),
+CPAN::Bundle::force($method,@args), CPAN::Bundle::get(),
+CPAN::Bundle::inst_file(), CPAN::Bundle::inst_version(),
+CPAN::Bundle::uptodate(), CPAN::Bundle::install(), CPAN::Bundle::make(),
+CPAN::Bundle::readme(), CPAN::Bundle::test(),
+CPAN::Distribution::as_glimpse(), CPAN::Distribution::as_string(),
+CPAN::Distribution::clean(), CPAN::Distribution::containsmods(),
+CPAN::Distribution::cvs_import(), CPAN::Distribution::dir(),
+CPAN::Distribution::force($method,@args), CPAN::Distribution::get(),
+CPAN::Distribution::install(), CPAN::Distribution::isa_perl(),
+CPAN::Distribution::look(), CPAN::Distribution::make(),
+CPAN::Distribution::prereq_pm(), CPAN::Distribution::readme(),
+CPAN::Distribution::test(), CPAN::Distribution::uptodate(),
+CPAN::Index::force_reload(), CPAN::Index::reload(), CPAN::InfoObj::dump(),
+CPAN::Module::as_glimpse(), CPAN::Module::as_string(),
+CPAN::Module::clean(), CPAN::Module::cpan_file(),
+CPAN::Module::cpan_version(), CPAN::Module::cvs_import(),
+CPAN::Module::description(), CPAN::Module::force($method,@args),
+CPAN::Module::get(), CPAN::Module::inst_file(),
+CPAN::Module::inst_version(), CPAN::Module::install(),
+CPAN::Module::look(), CPAN::Module::make(),
+CPAN::Module::manpage_headline(), CPAN::Module::readme(),
+CPAN::Module::test(), CPAN::Module::uptodate(), CPAN::Module::userid()
=item Cache Manager
=back
-=head2 Carp::Heavy - Carp guts
-
-=over 4
-
-=item SYNOPIS
-
-=item DESCRIPTION
-
-=back
-
=head2 Class::Struct - declare struct-like datatypes as Perl classes
=over 4
C<d_stdio_ptr_lval_nochange_cnt>, C<d_stdio_ptr_lval_sets_cnt>,
C<d_stdio_stream_array>, C<d_stdiobase>, C<d_stdstdio>, C<d_strchr>,
C<d_strcoll>, C<d_strctcpy>, C<d_strerrm>, C<d_strerror>, C<d_strtod>,
-C<d_strtol>, C<d_strtold>, C<d_strtoll>, C<d_strtoul>, C<d_strtoull>,
-C<d_strtouq>, C<d_strxfrm>, C<d_suidsafe>, C<d_symlink>, C<d_syscall>,
-C<d_sysconf>, C<d_sysernlst>, C<d_syserrlst>, C<d_system>, C<d_tcgetpgrp>,
-C<d_tcsetpgrp>, C<d_telldir>, C<d_telldirproto>, C<d_time>, C<d_times>,
-C<d_truncate>, C<d_tzname>, C<d_umask>, C<d_uname>, C<d_union_semun>,
-C<d_ustat>, C<d_vendorarch>, C<d_vendorbin>, C<d_vendorlib>, C<d_vfork>,
-C<d_void_closedir>, C<d_voidsig>, C<d_voidtty>, C<d_volatile>,
-C<d_vprintf>, C<d_wait4>, C<d_waitpid>, C<d_wcstombs>, C<d_wctomb>,
-C<d_xenix>, C<date>, C<db_hashtype>, C<db_prefixtype>, C<defvoidused>,
-C<direntrytype>, C<dlext>, C<dlsrc>, C<doublesize>, C<drand01>,
-C<dynamic_ext>
+C<d_strtol>, C<d_strtold>, C<d_strtoll>, C<d_strtoq>, C<d_strtoul>,
+C<d_strtoull>, C<d_strtouq>, C<d_strxfrm>, C<d_suidsafe>, C<d_symlink>,
+C<d_syscall>, C<d_sysconf>, C<d_sysernlst>, C<d_syserrlst>, C<d_system>,
+C<d_tcgetpgrp>, C<d_tcsetpgrp>, C<d_telldir>, C<d_telldirproto>, C<d_time>,
+C<d_times>, C<d_truncate>, C<d_tzname>, C<d_umask>, C<d_uname>,
+C<d_union_semun>, C<d_ustat>, C<d_vendorarch>, C<d_vendorbin>,
+C<d_vendorlib>, C<d_vfork>, C<d_void_closedir>, C<d_voidsig>, C<d_voidtty>,
+C<d_volatile>, C<d_vprintf>, C<d_wait4>, C<d_waitpid>, C<d_wcstombs>,
+C<d_wctomb>, C<d_xenix>, C<date>, C<db_hashtype>, C<db_prefixtype>,
+C<defvoidused>, C<direntrytype>, C<dlext>, C<dlsrc>, C<doublesize>,
+C<drand01>, C<dynamic_ext>
=item e
=item n
-C<n>, C<netdb_hlen_type>, C<netdb_host_type>, C<netdb_name_type>,
-C<netdb_net_type>, C<nm>, C<nm_opt>, C<nm_so_opt>, C<nonxs_ext>, C<nroff>,
-C<nveformat>, C<nvEUformat>, C<nvfformat>, C<nvFUformat>, C<nvgformat>,
-C<nvGUformat>, C<nvsize>, C<nvtype>
+C<n>, C<need_va_copy>, C<netdb_hlen_type>, C<netdb_host_type>,
+C<netdb_name_type>, C<netdb_net_type>, C<nm>, C<nm_opt>, C<nm_so_opt>,
+C<nonxs_ext>, C<nroff>, C<nveformat>, C<nvEUformat>, C<nvfformat>,
+C<nvFUformat>, C<nvgformat>, C<nvGUformat>, C<nvsize>, C<nvtype>
=item o
=back
+=head2 Encode::EncodeFormat, EncodeFormat - the format of encoding tables
+of the Encode extension
+
+=over 4
+
+=item DESCRIPTION
+
+[1] B<S>, [2] B<D>, [3] B<M>, [4] B<E>
+
+=item KEYWORDS
+
+=item COPYRIGHT
+
+=back
+
+=head2 EncodeFormat - the format of encoding tables of the Encode extension
+
+=over 4
+
+=item DESCRIPTION
+
+[1] B<S>, [2] B<D>, [3] B<M>, [4] B<E>
+
+=item KEYWORDS
+
+=item COPYRIGHT
+
+=back
+
=head2 English - use nice English (or awk) names for ugly punctuation
variables
C<Not in MANIFEST:> I<file>, C<No such file:> I<file>, C<MANIFEST:> I<$!>,
C<Added to MANIFEST:> I<file>
+=item ENVIRONMENT
+
+B<PERL_MM_MANIFEST_DEBUG>
+
=item SEE ALSO
=item AUTHOR
=item WARNING
+=over 4
+
+=item Temporary files and NFS
+
+=back
+
=item HISTORY
=item SEE ALSO
=back
+=head2 Filter::Simple - Simplified source filtering
+
+=over 4
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=over 4
+
+=item The Problem
+
+=item A Solution
+
+=item How it works
+
+=back
+
+=item AUTHOR
+
+=item COPYRIGHT
+
+=back
+
+=head2 Filter::Util::Call - Perl Source Filter Utility Module
+
+=over 4
+
+=item DESCRIPTION
+
+=over 4
+
+=item B<use Filter::Util::Call>
+
+=item B<import()>
+
+=item B<filter() and anonymous sub>
+
+B<$_>, B<$status>, B<filter_read> and B<filter_read_exact>, B<filter_del>
+
+=back
+
+=item EXAMPLES
+
+=over 4
+
+=item Example 1: A simple filter.
+
+=item Example 2: Using the context
+
+=item Example 3: Using the context within the filter
+
+=item Example 4: Using filter_del
+
+=back
+
+=item AUTHOR
+
+=item DATE
+
+=back
+
=head2 FindBin - Locate directory of original perl script
=over 4
C<All tests successful.\nFiles=%d, Tests=%d, %s>, C<FAILED tests
%s\n\tFailed %d/%d tests, %.2f%% okay.>, C<Test returned status %d (wstat
%d)>, C<Failed 1 test, %.2f%% okay. %s>, C<Failed %d/%d tests, %.2f%% okay.
-%s>
+%s>, C<FAILED--Further testing stopped%s>
=item ENVIRONMENT
register char *m = cx->sb_m;
char *orig = cx->sb_orig;
register REGEXP *rx = cx->sb_rx;
-
+
rxres_restore(&cx->sb_rxres, rx);
if (cx->sb_iters++) {
: (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
{
SV *targ = cx->sb_targ;
- sv_catpvn(dstr, s, cx->sb_strend - s);
+ sv_catpvn(dstr, s, cx->sb_strend - s);
cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
(void)SvOOK_off(targ);
sv_free(dstr);
TAINT_IF(cx->sb_rxtainted & 1);
+ if (pm->op_pmdynflags & PMdf_UTF8)
+ SvUTF8_on(targ); /* could also copy SvUTF8(dstr)? */
PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
- (void)SvPOK_only(targ);
+ (void)SvPOK_only_UTF8(targ);
TAINT_IF(cx->sb_rxtainted);
SvSETMAGIC(targ);
SvTAINT(targ);
cx->sb_strend = s + (cx->sb_strend - m);
}
cx->sb_m = m = rx->startp[0] + orig;
- sv_catpvn(dstr, s, m-s);
+ if (m > s)
+ sv_catpvn(dstr, s, m-s);
cx->sb_s = rx->endp[0] + orig;
{ /* Update the pos() information. */
SV *sv = cx->sb_targ;
TARG = DEFSV;
EXTEND(SP,1);
}
+ PL_reg_sv = TARG;
PUTBACK; /* EVAL blocks need stack_sp. */
s = SvPV(TARG, len);
strend = s + len;
RX_MATCH_TAINTED_on(rx);
TAINT_IF(RX_MATCH_TAINTED(rx));
if (gimme == G_ARRAY) {
- I32 iters, i, len;
+ I32 nparens, i, len;
- iters = rx->nparens;
- if (global && !iters)
+ nparens = rx->nparens;
+ if (global && !nparens)
i = 1;
else
i = 0;
SPAGAIN; /* EVAL blocks could move the stack. */
- EXTEND(SP, iters + i);
- EXTEND_MORTAL(iters + i);
- for (i = !i; i <= iters; i++) {
+ EXTEND(SP, nparens + i);
+ EXTEND_MORTAL(nparens + i);
+ for (i = !i; i <= nparens; i++) {
PUSHs(sv_newmortal());
/*SUPPRESS 560*/
if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
len = rx->endp[i] - rx->startp[i];
s = rx->startp[i] + truebase;
sv_setpvn(*SP, s, len);
- if ((pm->op_pmdynflags & PMdf_UTF8) && !IN_BYTE) {
+ if (DO_UTF8(TARG))
SvUTF8_on(*SP);
- sv_utf8_downgrade(*SP, TRUE);
- }
}
}
if (global) {
r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
goto play_it_again;
}
- else if (!iters)
+ else if (!nparens)
XPUSHs(&PL_sv_yes);
LEAVE_SCOPE(oldsave);
RETURN;
TARG = DEFSV;
EXTEND(SP,1);
}
+ PL_reg_sv = TARG;
if (SvFAKE(TARG) && SvREADONLY(TARG))
sv_force_normal(TARG);
if (SvREADONLY(TARG)
if (PL_tainted)
rxtainted |= 2;
TAINT_NOT;
-
+
force_it:
if (!pm || !s)
DIE(aTHX_ "panic: do_subst");
rxtainted |= RX_MATCH_TAINTED(rx);
dstr = NEWSV(25, len);
sv_setpvn(dstr, m, s-m);
+ if (DO_UTF8(TARG))
+ SvUTF8_on(dstr);
PL_curpm = pm;
if (!c) {
register PERL_CONTEXT *cx;
sv_catpvn(dstr, c, clen);
if (once)
break;
- } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m, TARG, NULL, r_flags));
+ } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
+ TARG, NULL, r_flags));
sv_catpvn(dstr, s, strend - s);
(void)SvOOK_off(TARG);
RETURN;
}
- if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
+ if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) {
+ /* Can't do this because people seem to do things like
+ defined(fileno($foo)) to check whether $foo is a valid fh.
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
+ */
RETPUSHUNDEF;
+ }
+
PUSHi(PerlIO_fileno(fp));
RETURN;
}
}
EXTEND(SP, 1);
- if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
- RETPUSHUNDEF;
+ if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) {
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
+ RETPUSHUNDEF;
+ }
if (discp) {
names = SvPV(discp,len);
char *s;
IV retval;
GV *gv = (GV*)POPs;
- IO *io = GvIOn(gv);
+ IO *io = gv ? GvIOn(gv) : 0;
if (!io || !argsv || !IoIFP(io)) {
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
SETERRNO(EBADF,RMS$_IFI); /* well, sort of... */
RETPUSHUNDEF;
}
int fd;
gv = (GV*)POPs;
+ io = gv ? GvIOn(gv) : NULL;
- if (!gv) {
+ if (!gv || !io) {
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
+ if (IoIFP(io))
+ do_close(gv, FALSE);
SETERRNO(EBADF,LIB$_INVARG);
RETPUSHUNDEF;
}
- io = GvIOn(gv);
- if (IoIFP(io))
- do_close(gv, FALSE);
-
TAINT_PROPER("socket");
fd = PerlSock_socket(domain, type, protocol);
if (fd < 0)
gv2 = (GV*)POPs;
gv1 = (GV*)POPs;
- if (!gv1 || !gv2)
+ io1 = gv1 ? GvIOn(gv1) : NULL;
+ io2 = gv2 ? GvIOn(gv2) : NULL;
+ if (!gv1 || !gv2 || !io1 || !io2) {
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
+ if (!gv1 || !io1)
+ report_evil_fh(gv1, io1, PL_op->op_type);
+ if (!gv2 || !io2)
+ report_evil_fh(gv1, io2, PL_op->op_type);
+ }
+ if (IoIFP(io1))
+ do_close(gv1, FALSE);
+ if (IoIFP(io2))
+ do_close(gv2, FALSE);
RETPUSHUNDEF;
-
- io1 = GvIOn(gv1);
- io2 = GvIOn(gv2);
- if (IoIFP(io1))
- do_close(gv1, FALSE);
- if (IoIFP(io2))
- do_close(gv2, FALSE);
+ }
TAINT_PROPER("socketpair");
if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
#ifdef HAS_SOCKET
int backlog = POPi;
GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
+ register IO *io = gv ? GvIOn(gv) : NULL;
- if (!io || !IoIFP(io))
+ if (!gv || !io || !IoIFP(io))
goto nuts;
if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
PERL_CALLCONV OP* Perl_ref(pTHX_ OP* o, I32 type);
PERL_CALLCONV OP* Perl_refkids(pTHX_ OP* o, I32 type);
PERL_CALLCONV void Perl_regdump(pTHX_ regexp* r);
+PERL_CALLCONV SV* Perl_regclass_swash(pTHX_ struct regnode *n, bool doinit, SV **initsvp);
PERL_CALLCONV I32 Perl_pregexec(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave);
PERL_CALLCONV void Perl_pregfree(pTHX_ struct regexp* r);
PERL_CALLCONV regexp* Perl_pregcomp(pTHX_ char* exp, char* xend, PMOP* pm);
STATIC regnode* S_regbranch(pTHX_ struct RExC_state_t*, I32 *, I32);
STATIC void S_reguni(pTHX_ struct RExC_state_t*, UV, char *, STRLEN*);
STATIC regnode* S_regclass(pTHX_ struct RExC_state_t*);
-STATIC regnode* S_regclassutf8(pTHX_ struct RExC_state_t*);
STATIC I32 S_regcurly(pTHX_ char *);
STATIC regnode* S_reg_node(pTHX_ struct RExC_state_t*, U8);
STATIC regnode* S_regpiece(pTHX_ struct RExC_state_t*, I32 *);
STATIC I32 S_regrepeat(pTHX_ regnode *p, I32 max);
STATIC I32 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp);
STATIC I32 S_regtry(pTHX_ regexp *prog, char *startpos);
-STATIC bool S_reginclass(pTHX_ regnode *p, I32 c);
-STATIC bool S_reginclassutf8(pTHX_ regnode *f, U8* p);
+STATIC bool S_reginclass(pTHX_ regnode *n, U8 *p, bool do_utf8sv_is_utf8);
STATIC CHECKPOINT S_regcppush(pTHX_ I32 parenfloor);
STATIC char* S_regcppop(pTHX);
STATIC char* S_regcp_set_to(pTHX_ I32 ss);
char *end; /* End of input for compile */
char *parse; /* Input-scan pointer. */
I32 whilem_seen; /* number of WHILEM in this expr */
- regnode *emit; /* Code-emit pointer; ®dummy = don't */
+ regnode *emit; /* Code-emit pointer; ®dummy = don't = compiling */
I32 naughty; /* How bad is this pattern? */
I32 sawback; /* Did we see \1, ...? */
U32 seen;
#define LOC (RExC_flags16 & PMf_LOCALE)
#define FOLD (RExC_flags16 & PMf_FOLD)
-#define OOB_CHAR8 1234
-#define OOB_UTF8 123456
+#define OOB_UNICODE 12345678
#define OOB_NAMEDCLASS -1
#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
break;
}
}
- else if (strchr((char*)PL_simple,OP(scan)) || PL_regkind[(U8)OP(scan)] == ANYUTF8) {
+ else if (strchr((char*)PL_simple,OP(scan))) {
int value;
if (flags & SCF_DO_SUBSTR) {
/* Some of the logic below assumes that switching
locale on will only add false positives. */
switch (PL_regkind[(U8)OP(scan)]) {
- case ANYUTF8:
case SANY:
- case SANYUTF8:
- case ALNUMUTF8:
- case ANYOFUTF8:
- case ALNUMLUTF8:
- case NALNUMUTF8:
- case NALNUMLUTF8:
- case SPACEUTF8:
- case NSPACEUTF8:
- case SPACELUTF8:
- case NSPACELUTF8:
- case DIGITUTF8:
- case NDIGITUTF8:
default:
do_default:
/* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
/* turn .* into ^.* with an implied $*=1 */
int type = OP(NEXTOPER(first));
- if (type == REG_ANY || type == ANYUTF8)
+ if (type == REG_ANY)
type = ROPT_ANCH_MBOL;
else
type = ROPT_ANCH_SBOL;
longest_fixed_length = 0;
}
if (r->regstclass
- && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == ANYUTF8
- || OP(r->regstclass) == SANYUTF8 || OP(r->regstclass) == SANY))
+ && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == SANY))
r->regstclass = NULL;
if ((!r->anchored_substr || r->anchored_offset) && stclass_flag
&& !(data.start_class->flags & ANYOF_EOS)
struct regnode_charclass_class);
r->regstclass = (regnode*)RExC_rx->data->data[n];
r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
+ PL_regdata = r->data; /* for regprop() */
DEBUG_r((sv = sv_newmortal(),
regprop(sv, (regnode*)data.start_class),
PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n",
r->reganch |= ROPT_EVAL_SEEN;
Newz(1002, r->startp, RExC_npar, I32);
Newz(1002, r->endp, RExC_npar, I32);
- PL_regdata = r->data; /* for regprop() ANYOFUTF8 */
+ PL_regdata = r->data; /* for regprop() */
DEBUG_r(regdump(r));
return(r);
}
break;
case '.':
nextchar(pRExC_state);
- if (UTF) {
- if (RExC_flags16 & PMf_SINGLELINE)
- ret = reg_node(pRExC_state, SANYUTF8);
- else
- ret = reg_node(pRExC_state, ANYUTF8);
- *flagp |= HASWIDTH;
- }
- else {
- if (RExC_flags16 & PMf_SINGLELINE)
- ret = reg_node(pRExC_state, SANY);
- else
- ret = reg_node(pRExC_state, REG_ANY);
- *flagp |= HASWIDTH|SIMPLE;
- }
+ if (RExC_flags16 & PMf_SINGLELINE)
+ ret = reg_node(pRExC_state, SANY);
+ else
+ ret = reg_node(pRExC_state, REG_ANY);
+ *flagp |= HASWIDTH|SIMPLE;
RExC_naughty++;
break;
case '[':
{
char *oregcomp_parse = ++RExC_parse;
- ret = (UTF ? regclassutf8(pRExC_state) : regclass(pRExC_state));
+ ret = regclass(pRExC_state);
if (*RExC_parse != ']') {
RExC_parse = oregcomp_parse;
vFAIL("Unmatched [");
is_utf8_mark((U8*)"~"); /* preload table */
break;
case 'w':
- ret = reg_node(pRExC_state,
- UTF
- ? (LOC ? ALNUMLUTF8 : ALNUMUTF8)
- : (LOC ? ALNUML : ALNUM));
+ ret = reg_node(pRExC_state, LOC ? ALNUML : ALNUM);
*flagp |= HASWIDTH|SIMPLE;
nextchar(pRExC_state);
if (UTF && !PL_utf8_alnum)
is_utf8_alnum((U8*)"a"); /* preload table */
break;
case 'W':
- ret = reg_node(pRExC_state,
- UTF
- ? (LOC ? NALNUMLUTF8 : NALNUMUTF8)
- : (LOC ? NALNUML : NALNUM));
+ ret = reg_node(pRExC_state, LOC ? NALNUML : NALNUM);
*flagp |= HASWIDTH|SIMPLE;
nextchar(pRExC_state);
if (UTF && !PL_utf8_alnum)
case 'b':
RExC_seen_zerolen++;
RExC_seen |= REG_SEEN_LOOKBEHIND;
- ret = reg_node(pRExC_state,
- UTF
- ? (LOC ? BOUNDLUTF8 : BOUNDUTF8)
- : (LOC ? BOUNDL : BOUND));
+ ret = reg_node(pRExC_state, LOC ? BOUNDL : BOUND);
*flagp |= SIMPLE;
nextchar(pRExC_state);
if (UTF && !PL_utf8_alnum)
case 'B':
RExC_seen_zerolen++;
RExC_seen |= REG_SEEN_LOOKBEHIND;
- ret = reg_node(pRExC_state,
- UTF
- ? (LOC ? NBOUNDLUTF8 : NBOUNDUTF8)
- : (LOC ? NBOUNDL : NBOUND));
+ ret = reg_node(pRExC_state, LOC ? NBOUNDL : NBOUND);
*flagp |= SIMPLE;
nextchar(pRExC_state);
if (UTF && !PL_utf8_alnum)
is_utf8_alnum((U8*)"a"); /* preload table */
break;
case 's':
- ret = reg_node(pRExC_state,
- UTF
- ? (LOC ? SPACELUTF8 : SPACEUTF8)
- : (LOC ? SPACEL : SPACE));
+ ret = reg_node(pRExC_state, LOC ? SPACEL : SPACE);
*flagp |= HASWIDTH|SIMPLE;
nextchar(pRExC_state);
if (UTF && !PL_utf8_space)
is_utf8_space((U8*)" "); /* preload table */
break;
case 'S':
- ret = reg_node(pRExC_state,
- UTF
- ? (LOC ? NSPACELUTF8 : NSPACEUTF8)
- : (LOC ? NSPACEL : NSPACE));
+ ret = reg_node(pRExC_state, LOC ? NSPACEL : NSPACE);
*flagp |= HASWIDTH|SIMPLE;
nextchar(pRExC_state);
if (UTF && !PL_utf8_space)
is_utf8_space((U8*)" "); /* preload table */
break;
case 'd':
- ret = reg_node(pRExC_state, UTF ? DIGITUTF8 : DIGIT);
+ ret = reg_node(pRExC_state, DIGIT);
*flagp |= HASWIDTH|SIMPLE;
nextchar(pRExC_state);
if (UTF && !PL_utf8_digit)
is_utf8_digit((U8*)"1"); /* preload table */
break;
case 'D':
- ret = reg_node(pRExC_state, UTF ? NDIGITUTF8 : NDIGIT);
+ ret = reg_node(pRExC_state, NDIGIT);
*flagp |= HASWIDTH|SIMPLE;
nextchar(pRExC_state);
if (UTF && !PL_utf8_digit)
RExC_end = RExC_parse + 2;
RExC_parse--;
- ret = regclassutf8(pRExC_state);
+ ret = regclass(pRExC_state);
RExC_end = oldregxend;
RExC_parse--;
STATIC regnode *
S_regclass(pTHX_ RExC_state_t *pRExC_state)
{
- register U32 value;
- register I32 lastvalue = OOB_CHAR8;
- register I32 range = 0;
+ register UV value;
+ register IV lastvalue = OOB_UNICODE;
+ register IV range = 0;
register regnode *ret;
STRLEN numlen;
- I32 namedclass;
+ IV namedclass;
char *rangebegin;
bool need_class = 0;
+ SV *listsv;
+ register char *e;
+ UV n;
+
+ ret = reganode(pRExC_state, ANYOF, 0);
+
+ if (!SIZE_ONLY)
+ ANYOF_FLAGS(ret) = 0;
+
+ if (*RExC_parse == '^') { /* Complement of range. */
+ RExC_naughty++;
+ RExC_parse++;
+ if (!SIZE_ONLY)
+ ANYOF_FLAGS(ret) |= ANYOF_INVERT;
+ }
- ret = reg_node(pRExC_state, ANYOF);
if (SIZE_ONLY)
RExC_size += ANYOF_SKIP;
else {
- ret->flags = 0;
- ANYOF_BITMAP_ZERO(ret);
RExC_emit += ANYOF_SKIP;
if (FOLD)
ANYOF_FLAGS(ret) |= ANYOF_FOLD;
if (LOC)
ANYOF_FLAGS(ret) |= ANYOF_LOCALE;
- }
- if (*RExC_parse == '^') { /* Complement of range. */
- RExC_naughty++;
- RExC_parse++;
- if (!SIZE_ONLY)
- ANYOF_FLAGS(ret) |= ANYOF_INVERT;
+ ANYOF_BITMAP_ZERO(ret);
+ listsv = newSVpvn("# comment\n", 10);
}
if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
checkposixcc(pRExC_state);
if (*RExC_parse == ']' || *RExC_parse == '-')
- goto skipcond; /* allow 1st char to be ] or - */
+ goto charclassloop; /* allow 1st char to be ] or - */
+
while (RExC_parse < RExC_end && *RExC_parse != ']') {
- skipcond:
- namedclass = OOB_NAMEDCLASS;
+
+ charclassloop:
+
+ namedclass = OOB_NAMEDCLASS; /* initialize as illegal */
+
if (!range)
rangebegin = RExC_parse;
- value = UCHARAT(RExC_parse++);
+ if (UTF) {
+ value = utf8_to_uv((U8*)RExC_parse,
+ RExC_end - RExC_parse,
+ &numlen, 0);
+ RExC_parse += numlen;
+ }
+ else
+ value = UCHARAT(RExC_parse++);
if (value == '[')
namedclass = regpposixcc(pRExC_state, value);
else if (value == '\\') {
- value = UCHARAT(RExC_parse++);
+ if (UTF) {
+ value = utf8_to_uv((U8*)RExC_parse,
+ RExC_end - RExC_parse,
+ &numlen, 0);
+ RExC_parse += numlen;
+ }
+ else
+ value = UCHARAT(RExC_parse++);
/* Some compilers cannot handle switching on 64-bit integer
- * values, therefore the 'value' cannot be an UV. --jhi */
- switch (value) {
+ * values, therefore value cannot be an UV. Yes, this will
+ * be a problem later if we want switch on Unicode.
+ * A similar issue a little bit later when switching on
+ * namedclass. --jhi */
+ switch ((I32)value) {
case 'w': namedclass = ANYOF_ALNUM; break;
case 'W': namedclass = ANYOF_NALNUM; break;
case 's': namedclass = ANYOF_SPACE; break;
case 'S': namedclass = ANYOF_NSPACE; break;
case 'd': namedclass = ANYOF_DIGIT; break;
case 'D': namedclass = ANYOF_NDIGIT; break;
+ case 'p':
+ case 'P':
+ if (*RExC_parse == '{') {
+ e = strchr(RExC_parse++, '}');
+ if (!e)
+ vFAIL("Missing right brace on \\p{}");
+ n = e - RExC_parse;
+ }
+ else {
+ e = RExC_parse;
+ n = 1;
+ }
+ if (!SIZE_ONLY) {
+ if (value == 'p')
+ Perl_sv_catpvf(aTHX_ listsv,
+ "+utf8::%.*s\n", (int)n, RExC_parse);
+ else
+ Perl_sv_catpvf(aTHX_ listsv,
+ "!utf8::%.*s\n", (int)n, RExC_parse);
+ }
+ RExC_parse = e + 1;
+ ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
+ continue;
case 'n': value = '\n'; break;
case 'r': value = '\r'; break;
case 't': value = '\t'; break;
case 'a': value = '\057'; break;
#endif
case 'x':
- numlen = 0; /* disallow underscores */
- value = (UV)scan_hex(RExC_parse, 2, &numlen);
- RExC_parse += numlen;
+ if (*RExC_parse == '{') {
+ e = strchr(RExC_parse++, '}');
+ if (!e)
+ vFAIL("Missing right brace on \\x{}");
+ numlen = 1; /* allow underscores */
+ value = (UV)scan_hex(RExC_parse,
+ e - RExC_parse,
+ &numlen);
+ RExC_parse = e + 1;
+ }
+ else {
+ numlen = 0; /* disallow underscores */
+ value = (UV)scan_hex(RExC_parse, 2, &numlen);
+ RExC_parse += numlen;
+ }
break;
case 'c':
value = UCHARAT(RExC_parse++);
break;
default:
if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
-
- vWARN2(RExC_parse, "Unrecognized escape \\%c in character class passed through", (int)value);
+ vWARN2(RExC_parse,
+ "Unrecognized escape \\%c in character class passed through",
+ (int)value);
break;
}
- }
- if (namedclass > OOB_NAMEDCLASS) {
- if (!need_class && !SIZE_ONLY)
+ } /* end of \blah */
+
+ if (namedclass > OOB_NAMEDCLASS) { /* this is a named class \blah */
+
+ if (!SIZE_ONLY && !need_class)
ANYOF_CLASS_ZERO(ret);
+
need_class = 1;
- if (range) { /* a-\d, a-[:digit:] */
+
+ /* a bad range like a-\d, a-[:digit:] ? */
+ if (range) {
if (!SIZE_ONLY) {
if (ckWARN(WARN_REGEXP))
vWARN4(RExC_parse,
RExC_parse - rangebegin,
RExC_parse - rangebegin,
rangebegin);
- ANYOF_BITMAP_SET(ret, lastvalue);
- ANYOF_BITMAP_SET(ret, '-');
+ if (lastvalue < 256) {
+ ANYOF_BITMAP_SET(ret, lastvalue);
+ ANYOF_BITMAP_SET(ret, '-');
+ }
+ else {
+ ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
+ Perl_sv_catpvf(aTHX_ listsv,
+ /* 0x002D is Unicode for '-' */
+ "%04"UVxf"\n002D\n", (UV)lastvalue);
+ }
}
- range = 0; /* this is not a true range */
+
+ range = 0; /* this was not a true range */
}
+
if (!SIZE_ONLY) {
- switch (namedclass) {
+ /* Possible truncation here but in some 64-bit environments
+ * the compiler gets heartburn about switch on 64-bit values.
+ * A similar issue a little earlier when switching on value.
+ * --jhi */
+ switch ((I32)namedclass) {
case ANYOF_ALNUM:
if (LOC)
ANYOF_CLASS_SET(ret, ANYOF_ALNUM);
if (isALNUM(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsWord\n");
break;
case ANYOF_NALNUM:
if (LOC)
if (!isALNUM(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsWord\n");
break;
- case ANYOF_SPACE:
- if (LOC)
- ANYOF_CLASS_SET(ret, ANYOF_SPACE);
- else {
- for (value = 0; value < 256; value++)
- if (isSPACE(value))
- ANYOF_BITMAP_SET(ret, value);
- }
- break;
- case ANYOF_NSPACE:
+ case ANYOF_ALNUMC:
if (LOC)
- ANYOF_CLASS_SET(ret, ANYOF_NSPACE);
+ ANYOF_CLASS_SET(ret, ANYOF_ALNUMC);
else {
for (value = 0; value < 256; value++)
- if (!isSPACE(value))
+ if (isALNUMC(value))
ANYOF_BITMAP_SET(ret, value);
}
- break;
- case ANYOF_DIGIT:
- if (LOC)
- ANYOF_CLASS_SET(ret, ANYOF_DIGIT);
- else {
- for (value = '0'; value <= '9'; value++)
- ANYOF_BITMAP_SET(ret, value);
- }
- break;
- case ANYOF_NDIGIT:
- if (LOC)
- ANYOF_CLASS_SET(ret, ANYOF_NDIGIT);
- else {
- for (value = 0; value < '0'; value++)
- ANYOF_BITMAP_SET(ret, value);
- for (value = '9' + 1; value < 256; value++)
- ANYOF_BITMAP_SET(ret, value);
- }
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsAlnum\n");
break;
case ANYOF_NALNUMC:
if (LOC)
if (!isALNUMC(value))
ANYOF_BITMAP_SET(ret, value);
}
- break;
- case ANYOF_ALNUMC:
- if (LOC)
- ANYOF_CLASS_SET(ret, ANYOF_ALNUMC);
- else {
- for (value = 0; value < 256; value++)
- if (isALNUMC(value))
- ANYOF_BITMAP_SET(ret, value);
- }
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsAlnum\n");
break;
case ANYOF_ALPHA:
if (LOC)
if (isALPHA(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsAlpha\n");
break;
case ANYOF_NALPHA:
if (LOC)
if (!isALPHA(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsAlpha\n");
break;
case ANYOF_ASCII:
if (LOC)
ANYOF_BITMAP_SET(ret, value);
#endif /* EBCDIC */
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsASCII\n");
break;
case ANYOF_NASCII:
if (LOC)
ANYOF_BITMAP_SET(ret, value);
#endif /* EBCDIC */
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsASCII\n");
break;
case ANYOF_BLANK:
if (LOC)
if (isBLANK(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsBlank\n");
break;
case ANYOF_NBLANK:
if (LOC)
if (!isBLANK(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsBlank\n");
break;
case ANYOF_CNTRL:
if (LOC)
if (isCNTRL(value))
ANYOF_BITMAP_SET(ret, value);
}
- lastvalue = OOB_CHAR8;
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsCntrl\n");
break;
case ANYOF_NCNTRL:
if (LOC)
if (!isCNTRL(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsCntrl\n");
+ break;
+ case ANYOF_DIGIT:
+ if (LOC)
+ ANYOF_CLASS_SET(ret, ANYOF_DIGIT);
+ else {
+ /* consecutive digits assumed */
+ for (value = '0'; value <= '9'; value++)
+ ANYOF_BITMAP_SET(ret, value);
+ }
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsDigit\n");
+ break;
+ case ANYOF_NDIGIT:
+ if (LOC)
+ ANYOF_CLASS_SET(ret, ANYOF_NDIGIT);
+ else {
+ /* consecutive digits assumed */
+ for (value = 0; value < '0'; value++)
+ ANYOF_BITMAP_SET(ret, value);
+ for (value = '9' + 1; value < 256; value++)
+ ANYOF_BITMAP_SET(ret, value);
+ }
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsDigit\n");
break;
case ANYOF_GRAPH:
if (LOC)
if (isGRAPH(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsGraph\n");
break;
case ANYOF_NGRAPH:
if (LOC)
if (!isGRAPH(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsGraph\n");
break;
case ANYOF_LOWER:
if (LOC)
if (isLOWER(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsLower\n");
break;
case ANYOF_NLOWER:
if (LOC)
if (!isLOWER(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsLower\n");
break;
case ANYOF_PRINT:
if (LOC)
if (isPRINT(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsPrint\n");
break;
case ANYOF_NPRINT:
if (LOC)
if (!isPRINT(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPrint\n");
break;
case ANYOF_PSXSPC:
if (LOC)
if (isPSXSPC(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsSpace\n");
break;
case ANYOF_NPSXSPC:
if (LOC)
if (!isPSXSPC(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsSpace\n");
break;
case ANYOF_PUNCT:
if (LOC)
if (isPUNCT(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsPunct\n");
break;
case ANYOF_NPUNCT:
if (LOC)
if (!isPUNCT(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPunct\n");
+ break;
+ case ANYOF_SPACE:
+ if (LOC)
+ ANYOF_CLASS_SET(ret, ANYOF_SPACE);
+ else {
+ for (value = 0; value < 256; value++)
+ if (isSPACE(value))
+ ANYOF_BITMAP_SET(ret, value);
+ }
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsSpacePerl\n");
+ break;
+ case ANYOF_NSPACE:
+ if (LOC)
+ ANYOF_CLASS_SET(ret, ANYOF_NSPACE);
+ else {
+ for (value = 0; value < 256; value++)
+ if (!isSPACE(value))
+ ANYOF_BITMAP_SET(ret, value);
+ }
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsSpacePerl\n");
break;
case ANYOF_UPPER:
if (LOC)
if (isUPPER(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsUpper\n");
break;
case ANYOF_NUPPER:
if (LOC)
if (!isUPPER(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsUpper\n");
break;
case ANYOF_XDIGIT:
if (LOC)
if (isXDIGIT(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsXDigit\n");
break;
case ANYOF_NXDIGIT:
if (LOC)
if (!isXDIGIT(value))
ANYOF_BITMAP_SET(ret, value);
}
+ Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsXDigit\n");
break;
default:
vFAIL("Invalid [::] class");
ANYOF_FLAGS(ret) |= ANYOF_CLASS;
continue;
}
- }
+ } /* end of namedclass \blah */
+
if (range) {
if (lastvalue > value) /* b-a */ {
Simple_vFAIL4("Invalid [] range \"%*.*s\"",
RExC_parse - rangebegin,
rangebegin);
}
- range = 0;
+ range = 0; /* not a true range */
}
else {
- lastvalue = value;
+ lastvalue = value; /* save the beginning of the range */
if (*RExC_parse == '-' && RExC_parse+1 < RExC_end &&
RExC_parse[1] != ']') {
RExC_parse++;
- if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */
+
+ /* a bad range like \w-, [:word:]- ? */
+ if (namedclass > OOB_NAMEDCLASS) {
if (ckWARN(WARN_REGEXP))
vWARN4(RExC_parse,
"False [] range \"%*.*s\"",
if (!SIZE_ONLY)
ANYOF_BITMAP_SET(ret, '-');
} else
- range = 1;
- continue; /* do it next time */
+ range = 1; /* yeah, it's a range! */
+ continue; /* but do it the next time */
}
}
+
/* now is the next time */
if (!SIZE_ONLY) {
+ if (lastvalue < 256 && value < 256) {
#ifndef ASCIIish /* EBCDIC, for example. */
- if ((isLOWER(lastvalue) && isLOWER(value)) ||
- (isUPPER(lastvalue) && isUPPER(value)))
- {
- I32 i;
- if (isLOWER(lastvalue)) {
- for (i = lastvalue; i <= value; i++)
- if (isLOWER(i))
- ANYOF_BITMAP_SET(ret, i);
- } else {
- for (i = lastvalue; i <= value; i++)
- if (isUPPER(i))
- ANYOF_BITMAP_SET(ret, i);
+ if ((isLOWER(lastvalue) && isLOWER(value)) ||
+ (isUPPER(lastvalue) && isUPPER(value)))
+ {
+ IV i;
+ if (isLOWER(lastvalue)) {
+ for (i = lastvalue; i <= value; i++)
+ if (isLOWER(i))
+ ANYOF_BITMAP_SET(ret, i);
+ } else {
+ for (i = lastvalue; i <= value; i++)
+ if (isUPPER(i))
+ ANYOF_BITMAP_SET(ret, i);
+ }
}
- }
- else
+ else
#endif
- for ( ; lastvalue <= value; lastvalue++)
- ANYOF_BITMAP_SET(ret, lastvalue);
+ for ( ; lastvalue <= value; lastvalue++)
+ ANYOF_BITMAP_SET(ret, lastvalue);
+ } else {
+ ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
+ if (lastvalue < value)
+ Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n",
+ (UV)lastvalue, (UV)value);
+ else
+ Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n",
+ (UV)value);
+ }
}
- range = 0;
+
+ range = 0; /* this range (if it was one) is done now */
}
+
if (need_class) {
if (SIZE_ONLY)
RExC_size += ANYOF_CLASS_ADD_SKIP;
else
RExC_emit += ANYOF_CLASS_ADD_SKIP;
}
+
/* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
if (!SIZE_ONLY &&
- (ANYOF_FLAGS(ret) & (ANYOF_FLAGS_ALL ^ ANYOF_INVERT)) == ANYOF_FOLD) {
+ (ANYOF_FLAGS(ret) &
+ /* If the only flag is folding (plus possibly inversion). */
+ (ANYOF_FLAGS_ALL ^ ANYOF_INVERT) == ANYOF_FOLD)) {
for (value = 0; value < 256; ++value) {
if (ANYOF_BITMAP_TEST(ret, value)) {
- I32 cf = PL_fold[value];
- ANYOF_BITMAP_SET(ret, cf);
+ IV fold = PL_fold[value];
+
+ if (fold != value)
+ ANYOF_BITMAP_SET(ret, fold);
}
}
ANYOF_FLAGS(ret) &= ~ANYOF_FOLD;
}
+
/* optimize inverted simple patterns (e.g. [^a-z]) */
- if (!SIZE_ONLY && (ANYOF_FLAGS(ret) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) {
+ if (!SIZE_ONLY &&
+ /* If the only flag is inversion. */
+ (ANYOF_FLAGS(ret) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) {
for (value = 0; value < ANYOF_BITMAP_SIZE; ++value)
ANYOF_BITMAP(ret)[value] ^= ANYOF_FLAGS_ALL;
ANYOF_FLAGS(ret) = 0;
}
- return ret;
-}
-
-STATIC regnode *
-S_regclassutf8(pTHX_ RExC_state_t *pRExC_state)
-{
- register char *e;
- register U32 value;
- register U32 lastvalue = OOB_UTF8;
- register I32 range = 0;
- register regnode *ret;
- STRLEN numlen;
- I32 n;
- SV *listsv;
- U8 flags = 0;
- I32 namedclass;
- char *rangebegin;
-
- if (*RExC_parse == '^') { /* Complement of range. */
- RExC_naughty++;
- RExC_parse++;
- if (!SIZE_ONLY)
- flags |= ANYOF_INVERT;
- }
- if (!SIZE_ONLY) {
- if (FOLD)
- flags |= ANYOF_FOLD;
- if (LOC)
- flags |= ANYOF_LOCALE;
- listsv = newSVpvn("# comment\n", 10);
- }
- if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
- checkposixcc(pRExC_state);
-
- if (*RExC_parse == ']' || *RExC_parse == '-')
- goto skipcond; /* allow 1st char to be ] or - */
-
- while (RExC_parse < RExC_end && *RExC_parse != ']') {
- skipcond:
- namedclass = OOB_NAMEDCLASS;
- if (!range)
- rangebegin = RExC_parse;
- value = utf8_to_uv((U8*)RExC_parse,
- RExC_end - RExC_parse,
- &numlen, 0);
- RExC_parse += numlen;
- if (value == '[')
- namedclass = regpposixcc(pRExC_state, value);
- else if (value == '\\') {
- value = (U32)utf8_to_uv((U8*)RExC_parse,
- RExC_end - RExC_parse,
- &numlen, 0);
- RExC_parse += numlen;
- /* Some compilers cannot handle switching on 64-bit integer
- * values, therefore value cannot be an UV. Yes, this will
- * be a problem later if we want switch on Unicode. --jhi */
- switch (value) {
- case 'w': namedclass = ANYOF_ALNUM; break;
- case 'W': namedclass = ANYOF_NALNUM; break;
- case 's': namedclass = ANYOF_SPACE; break;
- case 'S': namedclass = ANYOF_NSPACE; break;
- case 'd': namedclass = ANYOF_DIGIT; break;
- case 'D': namedclass = ANYOF_NDIGIT; break;
- case 'p':
- case 'P':
- if (*RExC_parse == '{') {
- e = strchr(RExC_parse++, '}');
- if (!e)
- vFAIL("Missing right brace on \\p{}");
- n = e - RExC_parse;
- }
- else {
- e = RExC_parse;
- n = 1;
- }
- if (!SIZE_ONLY) {
- if (value == 'p')
- Perl_sv_catpvf(aTHX_ listsv,
- "+utf8::%.*s\n", (int)n, RExC_parse);
- else
- Perl_sv_catpvf(aTHX_ listsv,
- "!utf8::%.*s\n", (int)n, RExC_parse);
- }
- RExC_parse = e + 1;
- lastvalue = OOB_UTF8;
- continue;
- case 'n': value = '\n'; break;
- case 'r': value = '\r'; break;
- case 't': value = '\t'; break;
- case 'f': value = '\f'; break;
- case 'b': value = '\b'; break;
-#ifdef ASCIIish
- case 'e': value = '\033'; break;
- case 'a': value = '\007'; break;
-#else
- case 'e': value = '\047'; break;
- case 'a': value = '\057'; break;
-#endif
- case 'x':
- if (*RExC_parse == '{') {
- e = strchr(RExC_parse++, '}');
- if (!e)
- vFAIL("Missing right brace on \\x{}");
- numlen = 1; /* allow underscores */
- value = (UV)scan_hex(RExC_parse,
- e - RExC_parse,
- &numlen);
- RExC_parse = e + 1;
- }
- else {
- numlen = 0; /* disallow underscores */
- value = (UV)scan_hex(RExC_parse, 2, &numlen);
- RExC_parse += numlen;
- }
- break;
- case 'c':
- value = UCHARAT(RExC_parse++);
- value = toCTRL(value);
- break;
- case '0': case '1': case '2': case '3': case '4':
- case '5': case '6': case '7': case '8': case '9':
- numlen = 0; /* disallow underscores */
- value = (UV)scan_oct(--RExC_parse, 3, &numlen);
- RExC_parse += numlen;
- break;
- default:
- if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
- vWARN2(RExC_parse,
- "Unrecognized escape \\%c in character class passed through",
- (int)value);
- break;
- }
- }
- if (namedclass > OOB_NAMEDCLASS) {
- if (range) { /* a-\d, a-[:digit:] */
- if (!SIZE_ONLY) {
- if (ckWARN(WARN_REGEXP))
- vWARN4(RExC_parse,
- "False [] range \"%*.*s\"",
- RExC_parse - rangebegin,
- RExC_parse - rangebegin,
- rangebegin);
- Perl_sv_catpvf(aTHX_ listsv,
- /* 0x002D is Unicode for '-' */
- "%04"UVxf"\n002D\n", (UV)lastvalue);
- }
- range = 0;
- }
- if (!SIZE_ONLY) {
- switch (namedclass) {
- case ANYOF_ALNUM:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsWord\n"); break;
- case ANYOF_NALNUM:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsWord\n"); break;
- case ANYOF_ALNUMC:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsAlnum\n"); break;
- case ANYOF_NALNUMC:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsAlnum\n"); break;
- case ANYOF_ALPHA:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsAlpha\n"); break;
- case ANYOF_NALPHA:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsAlpha\n"); break;
- case ANYOF_ASCII:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsASCII\n"); break;
- case ANYOF_NASCII:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsASCII\n"); break;
- case ANYOF_CNTRL:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsCntrl\n"); break;
- case ANYOF_NCNTRL:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsCntrl\n"); break;
- case ANYOF_GRAPH:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsGraph\n"); break;
- case ANYOF_NGRAPH:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsGraph\n"); break;
- case ANYOF_DIGIT:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsDigit\n"); break;
- case ANYOF_NDIGIT:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsDigit\n"); break;
- case ANYOF_LOWER:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsLower\n"); break;
- case ANYOF_NLOWER:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsLower\n"); break;
- case ANYOF_PRINT:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsPrint\n"); break;
- case ANYOF_NPRINT:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPrint\n"); break;
- case ANYOF_PUNCT:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsPunct\n"); break;
- case ANYOF_NPUNCT:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPunct\n"); break;
- case ANYOF_SPACE:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsSpacePerl\n");break;
- case ANYOF_NSPACE:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsSpacePerl\n");break;
- case ANYOF_BLANK:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsBlank\n"); break;
- case ANYOF_NBLANK:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsBlank\n"); break;
- case ANYOF_PSXSPC:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsSpace\n"); break;
- case ANYOF_NPSXSPC:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsSpace\n"); break;
- case ANYOF_UPPER:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsUpper\n"); break;
- case ANYOF_NUPPER:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsUpper\n"); break;
- case ANYOF_XDIGIT:
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsXDigit\n"); break;
- case ANYOF_NXDIGIT:
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsXDigit\n"); break;
- }
- continue;
- }
- }
- if (range) {
- if (lastvalue > value) { /* b-a */
- Simple_vFAIL4("Invalid [] range \"%*.*s\"",
- RExC_parse - rangebegin,
- RExC_parse - rangebegin,
- rangebegin);
- }
- range = 0;
- }
- else {
- lastvalue = value;
- if (*RExC_parse == '-' && RExC_parse+1 < RExC_end &&
- RExC_parse[1] != ']') {
- RExC_parse++;
- if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */
- if (ckWARN(WARN_REGEXP))
- vWARN4(RExC_parse,
- "False [] range \"%*.*s\"",
- RExC_parse - rangebegin,
- RExC_parse - rangebegin,
- rangebegin);
- if (!SIZE_ONLY)
- Perl_sv_catpvf(aTHX_ listsv,
- /* 0x002D is Unicode for '-' */
- "002D\n");
- } else
- range = 1;
- continue; /* do it next time */
- }
- }
- /* now is the next time */
- if (!SIZE_ONLY)
- Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n",
- (UV)lastvalue, (UV)value);
- range = 0;
- }
-
- ret = reganode(pRExC_state, ANYOFUTF8, 0);
-
- if (!SIZE_ONLY) {
- SV *rv = swash_init("utf8", "", listsv, 1, 0);
-#ifdef DEBUGGING
+ if (!SIZE_ONLY) {
AV *av = newAV();
- av_push(av, rv);
- av_push(av, listsv);
- rv = newRV_inc((SV*)av);
-#else
- SvREFCNT_dec(listsv);
-#endif
+ SV *rv;
+
+ av_store(av, 0, listsv);
+ av_store(av, 1, NULL);
+ rv = newRV_noinc((SV*)av);
n = add_data(pRExC_state, 1, "s");
RExC_rx->data->data[n] = (void*)rv;
- ARG1_SET(ret, flags);
- ARG2_SET(ret, n);
+ ARG_SET(ret, n);
}
return ret;
STATIC void
S_put_byte(pTHX_ SV *sv, int c)
{
- if (isCNTRL(c) || c == 127 || c == 255)
+ if (isCNTRL(c) || c == 127 || c == 255 || !isPRINT(c))
Perl_sv_catpvf(aTHX_ sv, "\\%o", c);
else if (c == '-' || c == ']' || c == '\\' || c == '^')
Perl_sv_catpvf(aTHX_ sv, "\\%c", c);
Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */
else if (k == ANYOF) {
int i, rangestart = -1;
- bool anyofutf8 = OP(o) == ANYOFUTF8;
- U8 flags = anyofutf8 ? ARG1(o) : o->flags;
+ U8 flags = ANYOF_FLAGS(o);
const char * const anyofs[] = { /* Should be syncronized with
* ANYOF_ #xdefines in regcomp.h */
"\\w",
Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]);
if (flags & ANYOF_INVERT)
sv_catpv(sv, "^");
- if (OP(o) == ANYOF) {
- for (i = 0; i <= 256; i++) {
- if (i < 256 && ANYOF_BITMAP_TEST(o,i)) {
- if (rangestart == -1)
- rangestart = i;
- } else if (rangestart != -1) {
- if (i <= rangestart + 3)
- for (; rangestart < i; rangestart++)
- put_byte(sv, rangestart);
- else {
+ for (i = 0; i <= 256; i++) {
+ if (i < 256 && ANYOF_BITMAP_TEST(o,i)) {
+ if (rangestart == -1)
+ rangestart = i;
+ } else if (rangestart != -1) {
+ if (i <= rangestart + 3)
+ for (; rangestart < i; rangestart++)
put_byte(sv, rangestart);
- sv_catpv(sv, "-");
- put_byte(sv, i - 1);
- }
- rangestart = -1;
+ else {
+ put_byte(sv, rangestart);
+ sv_catpv(sv, "-");
+ put_byte(sv, i - 1);
}
+ rangestart = -1;
}
- if (o->flags & ANYOF_CLASS)
- for (i = 0; i < sizeof(anyofs)/sizeof(char*); i++)
- if (ANYOF_CLASS_TEST(o,i))
- sv_catpv(sv, anyofs[i]);
}
- else {
- SV *rv = (SV*)PL_regdata->data[ARG2(o)];
- AV *av = (AV*)SvRV((SV*)rv);
- SV *sw = *av_fetch(av, 0, FALSE);
- SV *lv = *av_fetch(av, 1, FALSE);
- UV i;
- U8 s[UTF8_MAXLEN+1];
- for (i = 0; i <= 256; i++) { /* just the first 256 */
- U8 *e = uv_to_utf8(s, i);
- if (i < 256 && swash_fetch(sw, s)) {
- if (rangestart == -1)
- rangestart = i;
- } else if (rangestart != -1) {
- U8 *p;
-
- if (i <= rangestart + 3)
- for (; rangestart < i; rangestart++) {
- for(e = uv_to_utf8(s, rangestart), p = s; p < e; p++)
- put_byte(sv, *p);
+
+ if (o->flags & ANYOF_CLASS)
+ for (i = 0; i < sizeof(anyofs)/sizeof(char*); i++)
+ if (ANYOF_CLASS_TEST(o,i))
+ sv_catpv(sv, anyofs[i]);
+
+ if (flags & ANYOF_UNICODE)
+ sv_catpv(sv, "{unicode}");
+
+ {
+ SV *lv;
+ SV *sw = regclass_swash(o, FALSE, &lv);
+
+ if (lv) {
+ if (sw) {
+ UV i;
+ U8 s[UTF8_MAXLEN+1];
+
+ for (i = 0; i <= 256; i++) { /* just the first 256 */
+ U8 *e = uv_to_utf8(s, i);
+
+ if (i < 256 && swash_fetch(sw, s)) {
+ if (rangestart == -1)
+ rangestart = i;
+ } else if (rangestart != -1) {
+ U8 *p;
+
+ if (i <= rangestart + 3)
+ for (; rangestart < i; rangestart++) {
+ for(e = uv_to_utf8(s, rangestart), p = s; p < e; p++)
+ put_byte(sv, *p);
+ }
+ else {
+ for (e = uv_to_utf8(s, rangestart), p = s; p < e; p++)
+ put_byte(sv, *p);
+ sv_catpv(sv, "-");
+ for (e = uv_to_utf8(s, i - 1), p = s; p < e; p++)
+ put_byte(sv, *p);
+ }
+ rangestart = -1;
+ }
}
- else {
- for (e = uv_to_utf8(s, rangestart), p = s; p < e; p++)
- put_byte(sv, *p);
- sv_catpv(sv, "-");
- for (e = uv_to_utf8(s, i - 1), p = s; p < e; p++)
- put_byte(sv, *p);
- }
- rangestart = -1;
+
+ sv_catpv(sv, "..."); /* et cetera */
}
- }
- sv_catpv(sv, "...");
- {
- char *s = savepv(SvPVX(lv));
-
- while(*s && *s != '\n') s++;
- if (*s == '\n') {
- char *t = ++s;
- while (*s) {
- if (*s == '\n')
- *s = ' ';
- s++;
+ {
+ char *s = savepv(SvPVX(lv));
+ char *origs = s;
+
+ while(*s && *s != '\n') s++;
+
+ if (*s == '\n') {
+ char *t = ++s;
+
+ while (*s) {
+ if (*s == '\n')
+ *s = ' ';
+ s++;
+ }
+ if (s[-1] == ' ')
+ s[-1] = 0;
+
+ sv_catpv(sv, t);
}
- if (s[-1] == ' ')
- s[-1] = 0;
-
- sv_catpv(sv, t);
+
+ Safefree(origs);
}
}
}
+
Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
}
else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH))
while (--n >= 0) {
switch (r->data->what[n]) {
case 's':
-#ifdef DEBUGGING
- {
- SV *rv = (SV*)r->data->data[n];
- AV *av = (AV*)SvRV((SV*)rv);
- SV *sw = *av_fetch(av, 0, FALSE);
- SV *lv = *av_fetch(av, 1, FALSE);
- SvREFCNT_dec(sw);
- SvREFCNT_dec(lv);
- }
-#endif
SvREFCNT_dec((SV*)r->data->data[n]);
break;
case 'f':
{
ReREFCNT_dec((regexp *)r);
}
-
};
#define ANYOF_BITMAP_SIZE 32 /* 256 b/(8 b/B) */
-#define ANYOF_CLASSBITMAP_SIZE 4
+#define ANYOF_CLASSBITMAP_SIZE 4 /* up to 32 (8*4) named classes */
struct regnode_charclass {
U8 flags;
U8 type;
U16 next_off;
+ U32 arg1;
char bitmap[ANYOF_BITMAP_SIZE];
};
U8 flags;
U8 type;
U16 next_off;
+ U32 arg1;
char bitmap[ANYOF_BITMAP_SIZE];
char classflags[ANYOF_CLASSBITMAP_SIZE];
};
/* Flags for node->flags of ANYOF */
-#define ANYOF_CLASS 0x08
-#define ANYOF_INVERT 0x04
-#define ANYOF_FOLD 0x02
-#define ANYOF_LOCALE 0x01
+#define ANYOF_CLASS 0x08
+#define ANYOF_INVERT 0x04
+#define ANYOF_FOLD 0x02
+#define ANYOF_LOCALE 0x01
/* Used for regstclass only */
-#define ANYOF_EOS 0x10 /* Can match an empty string too */
+#define ANYOF_EOS 0x10 /* Can match an empty string too */
+
+/* There is a character or a range past 0xff */
+#define ANYOF_UNICODE 0x20
+
+/* Are there any runtime flags on in this node? */
+#define ANYOF_RUNTIME(s) (ANYOF_FLAGS(s) & 0x0f)
+
+#define ANYOF_FLAGS_ALL 0xff
/* Character classes for node->classflags of ANYOF */
/* Should be synchronized with a table in regprop() */
#define ANYOF_NXDIGIT 25
#define ANYOF_PSXSPC 26 /* POSIX space: \s plus the vertical tab */
#define ANYOF_NPSXSPC 27
-#define ANYOF_BLANK 28 /* GNU extension: space and tab */
+#define ANYOF_BLANK 28 /* GNU extension: space and tab: non-vertical space */
#define ANYOF_NBLANK 29
#define ANYOF_MAX 32
#define ANYOF_CLASS_SIZE (sizeof(struct regnode_charclass_class))
#define ANYOF_FLAGS(p) ((p)->flags)
-#define ANYOF_FLAGS_ALL 0xff
#define ANYOF_BIT(c) (1 << ((c) & 7))
EXTCONST U8 PL_simple[];
#else
EXTCONST U8 PL_simple[] = {
- REG_ANY, ANYUTF8, SANY, SANYUTF8, ANYOF, ANYOFUTF8,
- ALNUM, ALNUMUTF8, ALNUML, ALNUMLUTF8,
- NALNUM, NALNUMUTF8, NALNUML, NALNUMLUTF8,
- SPACE, SPACEUTF8, SPACEL, SPACELUTF8,
- NSPACE, NSPACEUTF8, NSPACEL, NSPACELUTF8,
- DIGIT, DIGITUTF8, NDIGIT, NDIGITUTF8, 0
+ REG_ANY, SANY,
+ ANYOF,
+ ALNUM, ALNUML,
+ NALNUM, NALNUML,
+ SPACE, SPACEL,
+ NSPACE, NSPACEL,
+ DIGIT, NDIGIT,
+ 0
};
#endif
MEOL EOL, no Same, assuming multiline.
SEOL EOL, no Same, assuming singleline.
BOUND BOUND, no Match "" at any word boundary
-BOUNDUTF8 BOUND, no Match "" at any word boundary
BOUNDL BOUND, no Match "" at any word boundary
-BOUNDLUTF8 BOUND, no Match "" at any word boundary
NBOUND NBOUND, no Match "" at any word non-boundary
-NBOUNDUTF8 NBOUND, no Match "" at any word non-boundary
NBOUNDL NBOUND, no Match "" at any word non-boundary
-NBOUNDLUTF8 NBOUND, no Match "" at any word non-boundary
GPOS GPOS, no Matches where last m//g left off.
# [Special] alternatives
REG_ANY REG_ANY, no Match any one character (except newline).
-ANYUTF8 REG_ANY, no Match any one Unicode character (except newline).
SANY REG_ANY, no Match any one character.
-SANYUTF8 REG_ANY, no Match any one Unicode character.
ANYOF ANYOF, sv Match character in (or not in) this class.
-ANYOFUTF8 ANYOF, sv 1 Match character in (or not in) this class.
ALNUM ALNUM, no Match any alphanumeric character
-ALNUMUTF8 ALNUM, no Match any alphanumeric character in utf8
ALNUML ALNUM, no Match any alphanumeric char in locale
-ALNUMLUTF8 ALNUM, no Match any alphanumeric char in locale+utf8
NALNUM NALNUM, no Match any non-alphanumeric character
-NALNUMUTF8 NALNUM, no Match any non-alphanumeric character in utf8
NALNUML NALNUM, no Match any non-alphanumeric char in locale
-NALNUMLUTF8 NALNUM, no Match any non-alphanumeric char in locale+utf8
SPACE SPACE, no Match any whitespace character
-SPACEUTF8 SPACE, no Match any whitespace character in utf8
SPACEL SPACE, no Match any whitespace char in locale
-SPACELUTF8 SPACE, no Match any whitespace char in locale+utf8
NSPACE NSPACE, no Match any non-whitespace character
-NSPACEUTF8 NSPACE, no Match any non-whitespace character in utf8
NSPACEL NSPACE, no Match any non-whitespace char in locale
-NSPACELUTF8 NSPACE, no Match any non-whitespace char in locale+utf8
DIGIT DIGIT, no Match any numeric character
-DIGITUTF8 DIGIT, no Match any numeric character in utf8
DIGITL DIGIT, no Match any numeric character in locale
-DIGITLUTF8 DIGIT, no Match any numeric character in locale+utf8
NDIGIT NDIGIT, no Match any non-numeric character
-NDIGITUTF8 NDIGIT, no Match any non-numeric character in utf8
NDIGITL NDIGIT, no Match any non-numeric character in locale
-NDIGITLUTF8 NDIGIT, no Match any non-numeric character in locale+utf8
CLUMP CLUMP, no Match any combining character sequence
# BRANCH The set of branches constituting a single choice are hooked
/* *These* symbols are masked to allow static link. */
# define Perl_pregexec my_pregexec
# define Perl_reginitcolors my_reginitcolors
+# define Perl_regclass_swash my_regclass_swash
# define PERL_NO_GET_CONTEXT
#endif
* Forwards.
*/
-#define REGINCLASS(p,c) (ANYOF_FLAGS(p) ? reginclass(p,c) : ANYOF_BITMAP_TEST(p,c))
-#ifdef DEBUGGING
-# define REGINCLASSUTF8(f,p) (ARG1(f) ? reginclassutf8(f,p) : swash_fetch(*av_fetch((AV*)SvRV((SV*)PL_regdata->data[ARG2(f)]),0,FALSE),p))
-#else
-# define REGINCLASSUTF8(f,p) (ARG1(f) ? reginclassutf8(f,p) : swash_fetch((SV*)PL_regdata->data[ARG2(f)],p))
-#endif
-
#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
#define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
t = s;
if (prog->reganch & ROPT_UTF8) {
- PL_regdata = prog->data; /* Used by REGINCLASS UTF logic */
+ PL_regdata = prog->data;
PL_bostr = startpos;
}
s = find_byclass(prog, prog->regstclass, s, endpos, startpos, 1);
unsigned int c2;
char *e;
register I32 tmp = 1; /* Scratch variable? */
+ register bool do_utf8 = DO_UTF8(PL_reg_sv);
/* We know what class it must start with. */
switch (OP(c)) {
- case ANYOFUTF8:
- while (s < strend) {
- if (REGINCLASSUTF8(c, (U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += UTF8SKIP(s);
- }
- break;
case ANYOF:
while (s < strend) {
- if (REGINCLASS(c, *(U8*)s)) {
+ if (reginclass(c, (U8*)s, do_utf8)) {
if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
}
else
tmp = 1;
- s++;
+ s += do_utf8 ? UTF8SKIP(s) : 1;
}
break;
case EXACTF:
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case BOUND:
- tmp = (s != startpos) ? UCHARAT(s - 1) : '\n';
- tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
- while (s < strend) {
- if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
- tmp = !tmp;
- if ((norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ if (s == startpos)
+ tmp = '\n';
+ else {
+ U8 *r = reghop((U8*)s, -1);
+
+ tmp = (I32)utf8_to_uv(r, s - (char*)r, 0, 0);
+ }
+ tmp = ((OP(c) == BOUND ?
+ isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
+ while (s < strend) {
+ if (tmp == !(OP(c) == BOUND ?
+ swash_fetch(PL_utf8_alnum, (U8*)s) :
+ isALNUM_LC_utf8((U8*)s)))
+ {
+ tmp = !tmp;
+ if ((norun || regtry(prog, s)))
+ goto got_it;
+ }
+ s += UTF8SKIP(s);
}
- s++;
}
- if ((!prog->minlen && tmp) && (norun || regtry(prog, s)))
- goto got_it;
- break;
- case BOUNDLUTF8:
- PL_reg_flags |= RF_tainted;
- /* FALL THROUGH */
- case BOUNDUTF8:
- if (s == startpos)
- tmp = '\n';
else {
- U8 *r = reghop((U8*)s, -1);
-
- tmp = (I32)utf8_to_uv(r, s - (char*)r, 0, 0);
- }
- tmp = ((OP(c) == BOUNDUTF8 ?
- isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
- while (s < strend) {
- if (tmp == !(OP(c) == BOUNDUTF8 ?
- swash_fetch(PL_utf8_alnum, (U8*)s) :
- isALNUM_LC_utf8((U8*)s)))
- {
- tmp = !tmp;
- if ((norun || regtry(prog, s)))
- goto got_it;
+ tmp = (s != startpos) ? UCHARAT(s - 1) : '\n';
+ tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
+ while (s < strend) {
+ if (tmp ==
+ !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
+ tmp = !tmp;
+ if ((norun || regtry(prog, s)))
+ goto got_it;
+ }
+ s++;
}
- s += UTF8SKIP(s);
}
if ((!prog->minlen && tmp) && (norun || regtry(prog, s)))
goto got_it;
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NBOUND:
- tmp = (s != startpos) ? UCHARAT(s - 1) : '\n';
- tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
- while (s < strend) {
- if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
- tmp = !tmp;
- else if ((norun || regtry(prog, s)))
- goto got_it;
- s++;
+ if (do_utf8) {
+ if (s == startpos)
+ tmp = '\n';
+ else {
+ U8 *r = reghop((U8*)s, -1);
+
+ tmp = (I32)utf8_to_uv(r, s - (char*)r, 0, 0);
+ }
+ tmp = ((OP(c) == NBOUND ?
+ isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
+ while (s < strend) {
+ if (tmp == !(OP(c) == NBOUND ?
+ swash_fetch(PL_utf8_alnum, (U8*)s) :
+ isALNUM_LC_utf8((U8*)s)))
+ tmp = !tmp;
+ else if ((norun || regtry(prog, s)))
+ goto got_it;
+ s += UTF8SKIP(s);
+ }
}
- if ((!prog->minlen && !tmp) && (norun || regtry(prog, s)))
- goto got_it;
- break;
- case NBOUNDLUTF8:
- PL_reg_flags |= RF_tainted;
- /* FALL THROUGH */
- case NBOUNDUTF8:
- if (s == startpos)
- tmp = '\n';
else {
- U8 *r = reghop((U8*)s, -1);
-
- tmp = (I32)utf8_to_uv(r, s - (char*)r, 0, 0);
- }
- tmp = ((OP(c) == NBOUNDUTF8 ?
- isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
- while (s < strend) {
- if (tmp == !(OP(c) == NBOUNDUTF8 ?
- swash_fetch(PL_utf8_alnum, (U8*)s) :
- isALNUM_LC_utf8((U8*)s)))
- tmp = !tmp;
- else if ((norun || regtry(prog, s)))
- goto got_it;
- s += UTF8SKIP(s);
+ tmp = (s != startpos) ? UCHARAT(s - 1) : '\n';
+ tmp = ((OP(c) == NBOUND ?
+ isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
+ while (s < strend) {
+ if (tmp ==
+ !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
+ tmp = !tmp;
+ else if ((norun || regtry(prog, s)))
+ goto got_it;
+ s++;
+ }
}
if ((!prog->minlen && !tmp) && (norun || regtry(prog, s)))
goto got_it;
break;
case ALNUM:
- while (s < strend) {
- if (isALNUM(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (swash_fetch(PL_utf8_alnum, (U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case ALNUMUTF8:
- while (s < strend) {
- if (swash_fetch(PL_utf8_alnum, (U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (isALNUM(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case ALNUML:
PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (isALNUM_LC(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (isALNUM_LC_utf8((U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case ALNUMLUTF8:
- PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (isALNUM_LC_utf8((U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (isALNUM_LC(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case NALNUM:
- while (s < strend) {
- if (!isALNUM(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (!swash_fetch(PL_utf8_alnum, (U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case NALNUMUTF8:
- while (s < strend) {
- if (!swash_fetch(PL_utf8_alnum, (U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (!isALNUM(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case NALNUML:
PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (!isALNUM_LC(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (!isALNUM_LC_utf8((U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case NALNUMLUTF8:
- PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (!isALNUM_LC_utf8((U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (!isALNUM_LC(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case SPACE:
- while (s < strend) {
- if (isSPACE(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case SPACEUTF8:
- while (s < strend) {
- if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (isSPACE(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case SPACEL:
PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (isSPACE_LC(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case SPACELUTF8:
- PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (isSPACE_LC(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case NSPACE:
- while (s < strend) {
- if (!isSPACE(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s))) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case NSPACEUTF8:
- while (s < strend) {
- if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s))) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (!isSPACE(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case NSPACEL:
PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (!isSPACE_LC(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case NSPACELUTF8:
- PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (!isSPACE_LC(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case DIGIT:
- while (s < strend) {
- if (isDIGIT(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (swash_fetch(PL_utf8_digit,(U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case DIGITUTF8:
- while (s < strend) {
- if (swash_fetch(PL_utf8_digit,(U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (isDIGIT(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case DIGITL:
PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (isDIGIT_LC(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (isDIGIT_LC_utf8((U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case DIGITLUTF8:
- PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (isDIGIT_LC_utf8((U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (isDIGIT_LC(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case NDIGIT:
- while (s < strend) {
- if (!isDIGIT(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (!swash_fetch(PL_utf8_digit,(U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case NDIGITUTF8:
- while (s < strend) {
- if (!swash_fetch(PL_utf8_digit,(U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (!isDIGIT(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
case NDIGITL:
PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (!isDIGIT_LC(*s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ if (do_utf8) {
+ while (s < strend) {
+ if (!isDIGIT_LC_utf8((U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s += UTF8SKIP(s);
}
- else
- tmp = 1;
- s++;
}
- break;
- case NDIGITLUTF8:
- PL_reg_flags |= RF_tainted;
- while (s < strend) {
- if (!isDIGIT_LC_utf8((U8*)s)) {
- if (tmp && (norun || regtry(prog, s)))
- goto got_it;
+ else {
+ while (s < strend) {
+ if (!isDIGIT_LC(*s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
else
- tmp = doevery;
+ tmp = 1;
+ s++;
}
- else
- tmp = 1;
- s += UTF8SKIP(s);
}
break;
default:
if (minlen && PL_regkind[(U8)OP(prog->regstclass)] != EXACT)
/* don't bother with what can't match */
strend = HOPc(strend, -(minlen - 1));
+ DEBUG_r({
+ SV *prop = sv_newmortal();
+ regprop(prop, c);
+ PerlIO_printf(Perl_debug_log, "Matching stclass `%s' against `%s'\n", SvPVX(prop), s);
+ });
if (find_byclass(prog, c, s, strend, startpos, 0))
goto got_it;
DEBUG_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
last = screaminstr(sv, prog->float_substr, s - strbeg,
end_shift, &scream_pos, 1); /* last one */
if (!last)
- last = scream_olds; /* Only one occurence. */
+ last = scream_olds; /* Only one occurrence. */
}
else {
STRLEN len;
int minmod = 0, sw = 0, logical = 0;
I32 unwind = 0;
I32 firstcp = PL_savestack_ix;
+ register bool do_utf8 = DO_UTF8(PL_reg_sv);
#ifdef DEBUGGING
PL_regindent++;
if (PL_regeol != locinput)
sayNO;
break;
- case SANYUTF8:
- if (nextchr & 0x80) {
+ case SANY:
+ if (DO_UTF8(PL_reg_sv)) {
locinput += PL_utf8skip[nextchr];
if (locinput > PL_regeol)
sayNO;
sayNO;
nextchr = UCHARAT(++locinput);
break;
- case SANY:
- if (!nextchr && locinput >= PL_regeol)
- sayNO;
- nextchr = UCHARAT(++locinput);
- break;
- case ANYUTF8:
- if (nextchr & 0x80) {
+ case REG_ANY:
+ if (DO_UTF8(PL_reg_sv)) {
locinput += PL_utf8skip[nextchr];
if (locinput > PL_regeol)
sayNO;
sayNO;
nextchr = UCHARAT(++locinput);
break;
- case REG_ANY:
- if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
- sayNO;
- nextchr = UCHARAT(++locinput);
- break;
case EXACT:
s = STRING(scan);
ln = STR_LEN(scan);
locinput += ln;
nextchr = UCHARAT(locinput);
break;
- case ANYOFUTF8:
- if (!REGINCLASSUTF8(scan, (U8*)locinput))
- sayNO;
- if (locinput >= PL_regeol)
- sayNO;
- locinput += PL_utf8skip[nextchr];
- nextchr = UCHARAT(locinput);
- break;
case ANYOF:
- if (nextchr < 0)
+ if (do_utf8) {
+ if (!reginclass(scan, (U8*)locinput, do_utf8))
+ sayNO;
+ if (locinput >= PL_regeol)
+ sayNO;
+ locinput += PL_utf8skip[nextchr];
nextchr = UCHARAT(locinput);
- if (!REGINCLASS(scan, nextchr))
- sayNO;
- if (!nextchr && locinput >= PL_regeol)
- sayNO;
- nextchr = UCHARAT(++locinput);
+ }
+ else {
+ if (nextchr < 0)
+ nextchr = UCHARAT(locinput);
+ if (!reginclass(scan, (U8*)locinput, do_utf8))
+ sayNO;
+ if (!nextchr && locinput >= PL_regeol)
+ sayNO;
+ nextchr = UCHARAT(++locinput);
+ }
break;
case ALNUML:
PL_reg_flags |= RF_tainted;
case ALNUM:
if (!nextchr)
sayNO;
- if (!(OP(scan) == ALNUM
- ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
- sayNO;
- nextchr = UCHARAT(++locinput);
- break;
- case ALNUMLUTF8:
- PL_reg_flags |= RF_tainted;
- /* FALL THROUGH */
- case ALNUMUTF8:
- if (!nextchr)
- sayNO;
- if (nextchr & 0x80) {
- if (!(OP(scan) == ALNUMUTF8
+ if (do_utf8) {
+ if (!(OP(scan) == ALNUM
? swash_fetch(PL_utf8_alnum, (U8*)locinput)
: isALNUM_LC_utf8((U8*)locinput)))
{
nextchr = UCHARAT(locinput);
break;
}
- if (!(OP(scan) == ALNUMUTF8
+ if (!(OP(scan) == ALNUM
? isALNUM(nextchr) : isALNUM_LC(nextchr)))
sayNO;
nextchr = UCHARAT(++locinput);
case NALNUM:
if (!nextchr && locinput >= PL_regeol)
sayNO;
- if (OP(scan) == NALNUM
- ? isALNUM(nextchr) : isALNUM_LC(nextchr))
- sayNO;
- nextchr = UCHARAT(++locinput);
- break;
- case NALNUMLUTF8:
- PL_reg_flags |= RF_tainted;
- /* FALL THROUGH */
- case NALNUMUTF8:
- if (!nextchr && locinput >= PL_regeol)
- sayNO;
- if (nextchr & 0x80) {
- if (OP(scan) == NALNUMUTF8
+ if (do_utf8) {
+ if (OP(scan) == NALNUM
? swash_fetch(PL_utf8_alnum, (U8*)locinput)
: isALNUM_LC_utf8((U8*)locinput))
{
nextchr = UCHARAT(locinput);
break;
}
- if (OP(scan) == NALNUMUTF8
+ if (OP(scan) == NALNUM
? isALNUM(nextchr) : isALNUM_LC(nextchr))
sayNO;
nextchr = UCHARAT(++locinput);
case BOUND:
case NBOUND:
/* was last char in word? */
- ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev;
- if (OP(scan) == BOUND || OP(scan) == NBOUND) {
- ln = isALNUM(ln);
- n = isALNUM(nextchr);
- }
- else {
- ln = isALNUM_LC(ln);
- n = isALNUM_LC(nextchr);
- }
- if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
- sayNO;
- break;
- case BOUNDLUTF8:
- case NBOUNDLUTF8:
- PL_reg_flags |= RF_tainted;
- /* FALL THROUGH */
- case BOUNDUTF8:
- case NBOUNDUTF8:
- /* was last char in word? */
- if (locinput == PL_regbol)
- ln = PL_regprev;
- else {
- U8 *r = reghop((U8*)locinput, -1);
-
- ln = utf8_to_uv(r, s - (char*)r, 0, 0);
- }
- if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) {
- ln = isALNUM_uni(ln);
- n = swash_fetch(PL_utf8_alnum, (U8*)locinput);
+ if (do_utf8) {
+ if (locinput == PL_regbol)
+ ln = PL_regprev;
+ else {
+ U8 *r = reghop((U8*)locinput, -1);
+
+ ln = utf8_to_uv(r, s - (char*)r, 0, 0);
+ }
+ if (OP(scan) == BOUND || OP(scan) == NBOUND) {
+ ln = isALNUM_uni(ln);
+ n = swash_fetch(PL_utf8_alnum, (U8*)locinput);
+ }
+ else {
+ ln = isALNUM_LC_uni(ln);
+ n = isALNUM_LC_utf8((U8*)locinput);
+ }
}
else {
- ln = isALNUM_LC_uni(ln);
- n = isALNUM_LC_utf8((U8*)locinput);
+ ln = (locinput != PL_regbol) ?
+ UCHARAT(locinput - 1) : PL_regprev;
+ if (OP(scan) == BOUND || OP(scan) == NBOUND) {
+ ln = isALNUM(ln);
+ n = isALNUM(nextchr);
+ }
+ else {
+ ln = isALNUM_LC(ln);
+ n = isALNUM_LC(nextchr);
+ }
}
- if (((!ln) == (!n)) == (OP(scan) == BOUNDUTF8 || OP(scan) == BOUNDLUTF8))
- sayNO;
+ if (((!ln) == (!n)) == (OP(scan) == BOUND ||
+ OP(scan) == BOUNDL))
+ sayNO;
break;
case SPACEL:
PL_reg_flags |= RF_tainted;
case SPACE:
if (!nextchr)
sayNO;
- if (!(OP(scan) == SPACE
- ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
- sayNO;
- nextchr = UCHARAT(++locinput);
- break;
- case SPACELUTF8:
- PL_reg_flags |= RF_tainted;
- /* FALL THROUGH */
- case SPACEUTF8:
- if (!nextchr)
- sayNO;
- if (nextchr & 0x80) {
- if (!(OP(scan) == SPACEUTF8
- ? swash_fetch(PL_utf8_space, (U8*)locinput)
- : isSPACE_LC_utf8((U8*)locinput)))
- {
- sayNO;
+ if (DO_UTF8(PL_reg_sv)) {
+ if (nextchr & 0x80) {
+ if (!(OP(scan) == SPACE
+ ? swash_fetch(PL_utf8_space, (U8*)locinput)
+ : isSPACE_LC_utf8((U8*)locinput)))
+ {
+ sayNO;
+ }
+ locinput += PL_utf8skip[nextchr];
+ nextchr = UCHARAT(locinput);
+ break;
}
- locinput += PL_utf8skip[nextchr];
- nextchr = UCHARAT(locinput);
- break;
+ if (!(OP(scan) == SPACE
+ ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
+ sayNO;
+ nextchr = UCHARAT(++locinput);
+ }
+ else {
+ if (!(OP(scan) == SPACE
+ ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
+ sayNO;
+ nextchr = UCHARAT(++locinput);
}
- if (!(OP(scan) == SPACEUTF8
- ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
- sayNO;
- nextchr = UCHARAT(++locinput);
break;
case NSPACEL:
PL_reg_flags |= RF_tainted;
case NSPACE:
if (!nextchr && locinput >= PL_regeol)
sayNO;
- if (OP(scan) == NSPACE
- ? isSPACE(nextchr) : isSPACE_LC(nextchr))
- sayNO;
- nextchr = UCHARAT(++locinput);
- break;
- case NSPACELUTF8:
- PL_reg_flags |= RF_tainted;
- /* FALL THROUGH */
- case NSPACEUTF8:
- if (!nextchr && locinput >= PL_regeol)
- sayNO;
- if (nextchr & 0x80) {
- if (OP(scan) == NSPACEUTF8
+ if (DO_UTF8(PL_reg_sv)) {
+ if (OP(scan) == NSPACE
? swash_fetch(PL_utf8_space, (U8*)locinput)
: isSPACE_LC_utf8((U8*)locinput))
{
nextchr = UCHARAT(locinput);
break;
}
- if (OP(scan) == NSPACEUTF8
+ if (OP(scan) == NSPACE
? isSPACE(nextchr) : isSPACE_LC(nextchr))
sayNO;
nextchr = UCHARAT(++locinput);
case DIGIT:
if (!nextchr)
sayNO;
- if (!(OP(scan) == DIGIT
- ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
- sayNO;
- nextchr = UCHARAT(++locinput);
- break;
- case DIGITLUTF8:
- PL_reg_flags |= RF_tainted;
- /* FALL THROUGH */
- case DIGITUTF8:
- if (!nextchr)
- sayNO;
- if (nextchr & 0x80) {
- if (!(OP(scan) == DIGITUTF8
+ if (DO_UTF8(PL_reg_sv)) {
+ if (!(OP(scan) == DIGIT
? swash_fetch(PL_utf8_digit, (U8*)locinput)
: isDIGIT_LC_utf8((U8*)locinput)))
{
nextchr = UCHARAT(locinput);
break;
}
- if (!(OP(scan) == DIGITUTF8
+ if (!(OP(scan) == DIGIT
? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
sayNO;
nextchr = UCHARAT(++locinput);
case NDIGIT:
if (!nextchr && locinput >= PL_regeol)
sayNO;
- if (OP(scan) == NDIGIT
- ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
- sayNO;
- nextchr = UCHARAT(++locinput);
- break;
- case NDIGITLUTF8:
- PL_reg_flags |= RF_tainted;
- /* FALL THROUGH */
- case NDIGITUTF8:
- if (!nextchr && locinput >= PL_regeol)
- sayNO;
- if (nextchr & 0x80) {
- if (OP(scan) == NDIGITUTF8
+ if (DO_UTF8(PL_reg_sv)) {
+ if (OP(scan) == NDIGIT
? swash_fetch(PL_utf8_digit, (U8*)locinput)
: isDIGIT_LC_utf8((U8*)locinput))
{
nextchr = UCHARAT(locinput);
break;
}
- if (OP(scan) == NDIGITUTF8
+ if (OP(scan) == NDIGIT
? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
sayNO;
nextchr = UCHARAT(++locinput);
register I32 c;
register char *loceol = PL_regeol;
register I32 hardcount = 0;
+ register bool do_utf8 = DO_UTF8(PL_reg_sv);
scan = PL_reginput;
if (max != REG_INFTY && max < loceol - scan)
loceol = scan + max;
switch (OP(p)) {
case REG_ANY:
- while (scan < loceol && *scan != '\n')
- scan++;
- break;
- case SANY:
- scan = loceol;
- break;
- case ANYUTF8:
- loceol = PL_regeol;
- while (scan < loceol && *scan != '\n') {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol && *scan != '\n') {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && *scan != '\n')
+ scan++;
}
break;
- case SANYUTF8:
- loceol = PL_regeol;
- while (scan < loceol) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ case SANY:
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ scan = loceol;
}
break;
case EXACT: /* length of string is 1 */
(UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
scan++;
break;
- case ANYOFUTF8:
- loceol = PL_regeol;
- while (scan < loceol && REGINCLASSUTF8(p, (U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- break;
case ANYOF:
- while (scan < loceol && REGINCLASS(p, *scan))
- scan++;
+ if (do_utf8) {
+ loceol = PL_regeol;
+ while (scan < loceol && reginclass(p, (U8*)scan, do_utf8)) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && reginclass(p, (U8*)scan, do_utf8))
+ scan++;
+ }
break;
case ALNUM:
- while (scan < loceol && isALNUM(*scan))
- scan++;
- break;
- case ALNUMUTF8:
- loceol = PL_regeol;
- while (scan < loceol && swash_fetch(PL_utf8_alnum, (U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol && swash_fetch(PL_utf8_alnum, (U8*)scan)) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && isALNUM(*scan))
+ scan++;
}
break;
case ALNUML:
PL_reg_flags |= RF_tainted;
- while (scan < loceol && isALNUM_LC(*scan))
- scan++;
- break;
- case ALNUMLUTF8:
- PL_reg_flags |= RF_tainted;
- loceol = PL_regeol;
- while (scan < loceol && isALNUM_LC_utf8((U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol && isALNUM_LC_utf8((U8*)scan)) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && isALNUM_LC(*scan))
+ scan++;
}
break;
- break;
case NALNUM:
- while (scan < loceol && !isALNUM(*scan))
- scan++;
- break;
- case NALNUMUTF8:
- loceol = PL_regeol;
- while (scan < loceol && !swash_fetch(PL_utf8_alnum, (U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol && !swash_fetch(PL_utf8_alnum, (U8*)scan)) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && !isALNUM(*scan))
+ scan++;
}
break;
case NALNUML:
PL_reg_flags |= RF_tainted;
- while (scan < loceol && !isALNUM_LC(*scan))
- scan++;
- break;
- case NALNUMLUTF8:
- PL_reg_flags |= RF_tainted;
- loceol = PL_regeol;
- while (scan < loceol && !isALNUM_LC_utf8((U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol && !isALNUM_LC_utf8((U8*)scan)) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && !isALNUM_LC(*scan))
+ scan++;
}
break;
case SPACE:
- while (scan < loceol && isSPACE(*scan))
- scan++;
- break;
- case SPACEUTF8:
- loceol = PL_regeol;
- while (scan < loceol && (*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol &&
+ (*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && isSPACE(*scan))
+ scan++;
}
break;
case SPACEL:
PL_reg_flags |= RF_tainted;
- while (scan < loceol && isSPACE_LC(*scan))
- scan++;
- break;
- case SPACELUTF8:
- PL_reg_flags |= RF_tainted;
- loceol = PL_regeol;
- while (scan < loceol && (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol &&
+ (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && isSPACE_LC(*scan))
+ scan++;
}
break;
case NSPACE:
- while (scan < loceol && !isSPACE(*scan))
- scan++;
- break;
- case NSPACEUTF8:
- loceol = PL_regeol;
- while (scan < loceol && !(*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol &&
+ !(*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && !isSPACE(*scan))
+ scan++;
+ break;
}
- break;
case NSPACEL:
PL_reg_flags |= RF_tainted;
- while (scan < loceol && !isSPACE_LC(*scan))
- scan++;
- break;
- case NSPACELUTF8:
- PL_reg_flags |= RF_tainted;
- loceol = PL_regeol;
- while (scan < loceol && !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol &&
+ !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && !isSPACE_LC(*scan))
+ scan++;
}
break;
case DIGIT:
- while (scan < loceol && isDIGIT(*scan))
- scan++;
- break;
- case DIGITUTF8:
- loceol = PL_regeol;
- while (scan < loceol && swash_fetch(PL_utf8_digit,(U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol && swash_fetch(PL_utf8_digit,(U8*)scan)) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && isDIGIT(*scan))
+ scan++;
}
break;
- break;
case NDIGIT:
- while (scan < loceol && !isDIGIT(*scan))
- scan++;
- break;
- case NDIGITUTF8:
- loceol = PL_regeol;
- while (scan < loceol && !swash_fetch(PL_utf8_digit,(U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
+ if (DO_UTF8(PL_reg_sv)) {
+ loceol = PL_regeol;
+ while (scan < loceol && !swash_fetch(PL_utf8_digit,(U8*)scan)) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ } else {
+ while (scan < loceol && !isDIGIT(*scan))
+ scan++;
}
break;
default: /* Called on something of 0 width. */
}
/*
+- regclass_swash - prepare the utf8 swash
+*/
+
+SV *
+Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** initsvp)
+{
+ SV *sw = NULL;
+ SV *si = NULL;
+
+ if (PL_regdata && PL_regdata->count) {
+ U32 n = ARG(node);
+
+ if (PL_regdata->what[n] == 's') {
+ SV *rv = (SV*)PL_regdata->data[n];
+ AV *av = (AV*)SvRV((SV*)rv);
+ SV **a;
+
+ si = *av_fetch(av, 0, FALSE);
+ a = av_fetch(av, 1, FALSE);
+
+ if (a)
+ sw = *a;
+ else if (si && doinit) {
+ sw = swash_init("utf8", "", si, 1, 0);
+ (void)av_store(av, 1, sw);
+ }
+ }
+ }
+
+ if (initsvp)
+ *initsvp = si;
+
+ return sw;
+}
+
+/*
- reginclass - determine if a character falls into a character class
*/
STATIC bool
-S_reginclass(pTHX_ register regnode *p, register I32 c)
+S_reginclass(pTHX_ register regnode *n, register U8* p, register bool do_utf8)
{
- char flags = ANYOF_FLAGS(p);
+ char flags = ANYOF_FLAGS(n);
bool match = FALSE;
- c &= 0xFF;
- if (ANYOF_BITMAP_TEST(p, c))
- match = TRUE;
- else if (flags & ANYOF_FOLD) {
- I32 cf;
- if (flags & ANYOF_LOCALE) {
- PL_reg_flags |= RF_tainted;
- cf = PL_fold_locale[c];
+ if (do_utf8 || (flags & ANYOF_UNICODE)) {
+ if (do_utf8 && !ANYOF_RUNTIME(n)) {
+ STRLEN len;
+ UV c = utf8_to_uv_simple(p, &len);
+
+ if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
+ match = TRUE;
}
- else
- cf = PL_fold[c];
- if (ANYOF_BITMAP_TEST(p, cf))
- match = TRUE;
- }
- if (!match && (flags & ANYOF_CLASS)) {
- PL_reg_flags |= RF_tainted;
- if (
- (ANYOF_CLASS_TEST(p, ANYOF_ALNUM) && isALNUM_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NALNUM) && !isALNUM_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_SPACE) && isSPACE_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NSPACE) && !isSPACE_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_DIGIT) && isDIGIT_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NDIGIT) && !isDIGIT_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_ALNUMC) && isALNUMC_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_ALPHA) && isALPHA_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NALPHA) && !isALPHA_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_ASCII) && isASCII(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NASCII) && !isASCII(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_CNTRL) && isCNTRL_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NCNTRL) && !isCNTRL_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_GRAPH) && isGRAPH_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NGRAPH) && !isGRAPH_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_LOWER) && isLOWER_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NLOWER) && !isLOWER_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_PRINT) && isPRINT_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NPRINT) && !isPRINT_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_PUNCT) && isPUNCT_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NPUNCT) && !isPUNCT_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_UPPER) && isUPPER_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NUPPER) && !isUPPER_LC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_XDIGIT) && isXDIGIT(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NXDIGIT) && !isXDIGIT(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_PSXSPC) && isPSXSPC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NPSXSPC) && !isPSXSPC(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_BLANK) && isBLANK(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NBLANK) && !isBLANK(c))
- ) /* How's that for a conditional? */
- {
- match = TRUE;
+ if (!match) {
+ SV *sw = regclass_swash(n, TRUE, 0);
+
+ if (sw) {
+ if (swash_fetch(sw, p))
+ match = TRUE;
+ else if (flags & ANYOF_FOLD) {
+ U8 tmpbuf[UTF8_MAXLEN+1];
+
+ if (flags & ANYOF_LOCALE) {
+ PL_reg_flags |= RF_tainted;
+ uv_to_utf8(tmpbuf, toLOWER_LC_utf8(p));
+ }
+ else
+ uv_to_utf8(tmpbuf, toLOWER_utf8(p));
+ if (swash_fetch(sw, tmpbuf))
+ match = TRUE;
+ }
+ }
}
}
+ else {
+ U8 c = *p;
- return (flags & ANYOF_INVERT) ? !match : match;
-}
-
-STATIC bool
-S_reginclassutf8(pTHX_ regnode *f, U8 *p)
-{
- char flags = ARG1(f);
- bool match = FALSE;
-#ifdef DEBUGGING
- SV *rv = (SV*)PL_regdata->data[ARG2(f)];
- AV *av = (AV*)SvRV((SV*)rv);
- SV *sw = *av_fetch(av, 0, FALSE);
- SV *lv = *av_fetch(av, 1, FALSE);
-#else
- SV *sw = (SV*)PL_regdata->data[ARG2(f)];
-#endif
+ if (ANYOF_BITMAP_TEST(n, c))
+ match = TRUE;
+ else if (flags & ANYOF_FOLD) {
+ I32 f;
- if (swash_fetch(sw, p))
- match = TRUE;
- else if (flags & ANYOF_FOLD) {
- U8 tmpbuf[UTF8_MAXLEN+1];
- if (flags & ANYOF_LOCALE) {
+ if (flags & ANYOF_LOCALE) {
+ PL_reg_flags |= RF_tainted;
+ f = PL_fold_locale[c];
+ }
+ else
+ f = PL_fold[c];
+ if (f != c && ANYOF_BITMAP_TEST(n, f))
+ match = TRUE;
+ }
+
+ if (!match && (flags & ANYOF_CLASS)) {
PL_reg_flags |= RF_tainted;
- uv_to_utf8(tmpbuf, toLOWER_LC_utf8(p));
+ if (
+ (ANYOF_CLASS_TEST(n, ANYOF_ALNUM) && isALNUM_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NALNUM) && !isALNUM_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_SPACE) && isSPACE_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NSPACE) && !isSPACE_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_DIGIT) && isDIGIT_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT) && !isDIGIT_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC) && isALNUMC_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_ALPHA) && isALPHA_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NALPHA) && !isALPHA_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_ASCII) && isASCII(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NASCII) && !isASCII(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_CNTRL) && isCNTRL_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL) && !isCNTRL_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_GRAPH) && isGRAPH_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH) && !isGRAPH_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_LOWER) && isLOWER_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NLOWER) && !isLOWER_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_PRINT) && isPRINT_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NPRINT) && !isPRINT_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_PUNCT) && isPUNCT_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT) && !isPUNCT_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_UPPER) && isUPPER_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NUPPER) && !isUPPER_LC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT) && isXDIGIT(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC) && isPSXSPC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_BLANK) && isBLANK(c)) ||
+ (ANYOF_CLASS_TEST(n, ANYOF_NBLANK) && !isBLANK(c))
+ ) /* How's that for a conditional? */
+ {
+ match = TRUE;
+ }
}
- else
- uv_to_utf8(tmpbuf, toLOWER_utf8(p));
- if (swash_fetch(sw, tmpbuf))
- match = TRUE;
}
- /* UTF8 combined with ANYOF_CLASS is ill-defined. */
-
return (flags & ANYOF_INVERT) ? !match : match;
}
S_reghop(pTHX_ U8 *s, I32 off)
{
if (off >= 0) {
- while (off-- && s < (U8*)PL_regeol)
+ while (off-- && s < (U8*)PL_regeol) {
+ /* XXX could check well-formedness here */
s += UTF8SKIP(s);
+ }
}
else {
while (off++) {
if (s > (U8*)PL_bostr) {
s--;
- if (*s & 0x80) {
- while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
+ if (UTF8_IS_CONTINUED(*s)) {
+ while (s > (U8*)PL_bostr && UTF8_IS_CONTINUATION(*s))
s--;
- } /* XXX could check well-formedness here */
+ }
+ /* XXX could check well-formedness here */
}
}
}
S_reghopmaybe(pTHX_ U8* s, I32 off)
{
if (off >= 0) {
- while (off-- && s < (U8*)PL_regeol)
+ while (off-- && s < (U8*)PL_regeol) {
+ /* XXX could check well-formedness here */
s += UTF8SKIP(s);
+ }
if (off >= 0)
return 0;
}
while (off++) {
if (s > (U8*)PL_bostr) {
s--;
- if (*s & 0x80) {
- while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
+ if (UTF8_IS_CONTINUED(*s)) {
+ while (s > (U8*)PL_bostr && UTF8_IS_CONTINUATION(*s))
s--;
- } /* XXX could check well-formedness here */
+ }
+ /* XXX could check well-formedness here */
}
else
break;
#define MEOL 7 /* 0x7 Same, assuming multiline. */
#define SEOL 8 /* 0x8 Same, assuming singleline. */
#define BOUND 9 /* 0x9 Match "" at any word boundary */
-#define BOUNDUTF8 10 /* 0xa Match "" at any word boundary */
-#define BOUNDL 11 /* 0xb Match "" at any word boundary */
-#define BOUNDLUTF8 12 /* 0xc Match "" at any word boundary */
-#define NBOUND 13 /* 0xd Match "" at any word non-boundary */
-#define NBOUNDUTF8 14 /* 0xe Match "" at any word non-boundary */
-#define NBOUNDL 15 /* 0xf Match "" at any word non-boundary */
-#define NBOUNDLUTF8 16 /* 0x10 Match "" at any word non-boundary */
-#define GPOS 17 /* 0x11 Matches where last m//g left off. */
-#define REG_ANY 18 /* 0x12 Match any one character (except newline). */
-#define ANYUTF8 19 /* 0x13 Match any one Unicode character (except newline). */
-#define SANY 20 /* 0x14 Match any one character. */
-#define SANYUTF8 21 /* 0x15 Match any one Unicode character. */
-#define ANYOF 22 /* 0x16 Match character in (or not in) this class. */
-#define ANYOFUTF8 23 /* 0x17 Match character in (or not in) this class. */
-#define ALNUM 24 /* 0x18 Match any alphanumeric character */
-#define ALNUMUTF8 25 /* 0x19 Match any alphanumeric character in utf8 */
-#define ALNUML 26 /* 0x1a Match any alphanumeric char in locale */
-#define ALNUMLUTF8 27 /* 0x1b Match any alphanumeric char in locale+utf8 */
-#define NALNUM 28 /* 0x1c Match any non-alphanumeric character */
-#define NALNUMUTF8 29 /* 0x1d Match any non-alphanumeric character in utf8 */
-#define NALNUML 30 /* 0x1e Match any non-alphanumeric char in locale */
-#define NALNUMLUTF8 31 /* 0x1f Match any non-alphanumeric char in locale+utf8 */
-#define SPACE 32 /* 0x20 Match any whitespace character */
-#define SPACEUTF8 33 /* 0x21 Match any whitespace character in utf8 */
-#define SPACEL 34 /* 0x22 Match any whitespace char in locale */
-#define SPACELUTF8 35 /* 0x23 Match any whitespace char in locale+utf8 */
-#define NSPACE 36 /* 0x24 Match any non-whitespace character */
-#define NSPACEUTF8 37 /* 0x25 Match any non-whitespace character in utf8 */
-#define NSPACEL 38 /* 0x26 Match any non-whitespace char in locale */
-#define NSPACELUTF8 39 /* 0x27 Match any non-whitespace char in locale+utf8 */
-#define DIGIT 40 /* 0x28 Match any numeric character */
-#define DIGITUTF8 41 /* 0x29 Match any numeric character in utf8 */
-#define DIGITL 42 /* 0x2a Match any numeric character in locale */
-#define DIGITLUTF8 43 /* 0x2b Match any numeric character in locale+utf8 */
-#define NDIGIT 44 /* 0x2c Match any non-numeric character */
-#define NDIGITUTF8 45 /* 0x2d Match any non-numeric character in utf8 */
-#define NDIGITL 46 /* 0x2e Match any non-numeric character in locale */
-#define NDIGITLUTF8 47 /* 0x2f Match any non-numeric character in locale+utf8 */
-#define CLUMP 48 /* 0x30 Match any combining character sequence */
-#define BRANCH 49 /* 0x31 Match this alternative, or the next... */
-#define BACK 50 /* 0x32 Match "", "next" ptr points backward. */
-#define EXACT 51 /* 0x33 Match this string (preceded by length). */
-#define EXACTF 52 /* 0x34 Match this string, folded (prec. by length). */
-#define EXACTFL 53 /* 0x35 Match this string, folded in locale (w/len). */
-#define NOTHING 54 /* 0x36 Match empty string. */
-#define TAIL 55 /* 0x37 Match empty string. Can jump here from outside. */
-#define STAR 56 /* 0x38 Match this (simple) thing 0 or more times. */
-#define PLUS 57 /* 0x39 Match this (simple) thing 1 or more times. */
-#define CURLY 58 /* 0x3a Match this simple thing {n,m} times. */
-#define CURLYN 59 /* 0x3b Match next-after-this simple thing */
-#define CURLYM 60 /* 0x3c Match this medium-complex thing {n,m} times. */
-#define CURLYX 61 /* 0x3d Match this complex thing {n,m} times. */
-#define WHILEM 62 /* 0x3e Do curly processing and see if rest matches. */
-#define OPEN 63 /* 0x3f Mark this point in input as start of #n. */
-#define CLOSE 64 /* 0x40 Analogous to OPEN. */
-#define REF 65 /* 0x41 Match some already matched string */
-#define REFF 66 /* 0x42 Match already matched string, folded */
-#define REFFL 67 /* 0x43 Match already matched string, folded in loc. */
-#define IFMATCH 68 /* 0x44 Succeeds if the following matches. */
-#define UNLESSM 69 /* 0x45 Fails if the following matches. */
-#define SUSPEND 70 /* 0x46 "Independent" sub-RE. */
-#define IFTHEN 71 /* 0x47 Switch, should be preceeded by switcher . */
-#define GROUPP 72 /* 0x48 Whether the group matched. */
-#define LONGJMP 73 /* 0x49 Jump far away. */
-#define BRANCHJ 74 /* 0x4a BRANCH with long offset. */
-#define EVAL 75 /* 0x4b Execute some Perl code. */
-#define MINMOD 76 /* 0x4c Next operator is not greedy. */
-#define LOGICAL 77 /* 0x4d Next opcode should set the flag only. */
-#define RENUM 78 /* 0x4e Group with independently numbered parens. */
-#define OPTIMIZED 79 /* 0x4f Placeholder for dump. */
+#define BOUNDL 10 /* 0xa Match "" at any word boundary */
+#define NBOUND 11 /* 0xb Match "" at any word non-boundary */
+#define NBOUNDL 12 /* 0xc Match "" at any word non-boundary */
+#define GPOS 13 /* 0xd Matches where last m//g left off. */
+#define REG_ANY 14 /* 0xe Match any one character (except newline). */
+#define SANY 15 /* 0xf Match any one character. */
+#define ANYOF 16 /* 0x10 Match character in (or not in) this class. */
+#define ALNUM 17 /* 0x11 Match any alphanumeric character */
+#define ALNUML 18 /* 0x12 Match any alphanumeric char in locale */
+#define NALNUM 19 /* 0x13 Match any non-alphanumeric character */
+#define NALNUML 20 /* 0x14 Match any non-alphanumeric char in locale */
+#define SPACE 21 /* 0x15 Match any whitespace character */
+#define SPACEL 22 /* 0x16 Match any whitespace char in locale */
+#define NSPACE 23 /* 0x17 Match any non-whitespace character */
+#define NSPACEL 24 /* 0x18 Match any non-whitespace char in locale */
+#define DIGIT 25 /* 0x19 Match any numeric character */
+#define DIGITL 26 /* 0x1a Match any numeric character in locale */
+#define NDIGIT 27 /* 0x1b Match any non-numeric character */
+#define NDIGITL 28 /* 0x1c Match any non-numeric character in locale */
+#define CLUMP 29 /* 0x1d Match any combining character sequence */
+#define BRANCH 30 /* 0x1e Match this alternative, or the next... */
+#define BACK 31 /* 0x1f Match "", "next" ptr points backward. */
+#define EXACT 32 /* 0x20 Match this string (preceded by length). */
+#define EXACTF 33 /* 0x21 Match this string, folded (prec. by length). */
+#define EXACTFL 34 /* 0x22 Match this string, folded in locale (w/len). */
+#define NOTHING 35 /* 0x23 Match empty string. */
+#define TAIL 36 /* 0x24 Match empty string. Can jump here from outside. */
+#define STAR 37 /* 0x25 Match this (simple) thing 0 or more times. */
+#define PLUS 38 /* 0x26 Match this (simple) thing 1 or more times. */
+#define CURLY 39 /* 0x27 Match this simple thing {n,m} times. */
+#define CURLYN 40 /* 0x28 Match next-after-this simple thing */
+#define CURLYM 41 /* 0x29 Match this medium-complex thing {n,m} times. */
+#define CURLYX 42 /* 0x2a Match this complex thing {n,m} times. */
+#define WHILEM 43 /* 0x2b Do curly processing and see if rest matches. */
+#define OPEN 44 /* 0x2c Mark this point in input as start of #n. */
+#define CLOSE 45 /* 0x2d Analogous to OPEN. */
+#define REF 46 /* 0x2e Match some already matched string */
+#define REFF 47 /* 0x2f Match already matched string, folded */
+#define REFFL 48 /* 0x30 Match already matched string, folded in loc. */
+#define IFMATCH 49 /* 0x31 Succeeds if the following matches. */
+#define UNLESSM 50 /* 0x32 Fails if the following matches. */
+#define SUSPEND 51 /* 0x33 "Independent" sub-RE. */
+#define IFTHEN 52 /* 0x34 Switch, should be preceeded by switcher . */
+#define GROUPP 53 /* 0x35 Whether the group matched. */
+#define LONGJMP 54 /* 0x36 Jump far away. */
+#define BRANCHJ 55 /* 0x37 BRANCH with long offset. */
+#define EVAL 56 /* 0x38 Execute some Perl code. */
+#define MINMOD 57 /* 0x39 Next operator is not greedy. */
+#define LOGICAL 58 /* 0x3a Next opcode should set the flag only. */
+#define RENUM 59 /* 0x3b Group with independently numbered parens. */
+#define OPTIMIZED 60 /* 0x3c Placeholder for dump. */
#ifndef DOINIT
EXTCONST U8 PL_regkind[];
EOL, /* MEOL */
EOL, /* SEOL */
BOUND, /* BOUND */
- BOUND, /* BOUNDUTF8 */
BOUND, /* BOUNDL */
- BOUND, /* BOUNDLUTF8 */
NBOUND, /* NBOUND */
- NBOUND, /* NBOUNDUTF8 */
NBOUND, /* NBOUNDL */
- NBOUND, /* NBOUNDLUTF8 */
GPOS, /* GPOS */
REG_ANY, /* REG_ANY */
- REG_ANY, /* ANYUTF8 */
REG_ANY, /* SANY */
- REG_ANY, /* SANYUTF8 */
ANYOF, /* ANYOF */
- ANYOF, /* ANYOFUTF8 */
ALNUM, /* ALNUM */
- ALNUM, /* ALNUMUTF8 */
ALNUM, /* ALNUML */
- ALNUM, /* ALNUMLUTF8 */
NALNUM, /* NALNUM */
- NALNUM, /* NALNUMUTF8 */
NALNUM, /* NALNUML */
- NALNUM, /* NALNUMLUTF8 */
SPACE, /* SPACE */
- SPACE, /* SPACEUTF8 */
SPACE, /* SPACEL */
- SPACE, /* SPACELUTF8 */
NSPACE, /* NSPACE */
- NSPACE, /* NSPACEUTF8 */
NSPACE, /* NSPACEL */
- NSPACE, /* NSPACELUTF8 */
DIGIT, /* DIGIT */
- DIGIT, /* DIGITUTF8 */
DIGIT, /* DIGITL */
- DIGIT, /* DIGITLUTF8 */
NDIGIT, /* NDIGIT */
- NDIGIT, /* NDIGITUTF8 */
NDIGIT, /* NDIGITL */
- NDIGIT, /* NDIGITLUTF8 */
CLUMP, /* CLUMP */
BRANCH, /* BRANCH */
BACK, /* BACK */
0, /* MEOL */
0, /* SEOL */
0, /* BOUND */
- 0, /* BOUNDUTF8 */
0, /* BOUNDL */
- 0, /* BOUNDLUTF8 */
0, /* NBOUND */
- 0, /* NBOUNDUTF8 */
0, /* NBOUNDL */
- 0, /* NBOUNDLUTF8 */
0, /* GPOS */
0, /* REG_ANY */
- 0, /* ANYUTF8 */
0, /* SANY */
- 0, /* SANYUTF8 */
0, /* ANYOF */
- EXTRA_SIZE(struct regnode_1), /* ANYOFUTF8 */
0, /* ALNUM */
- 0, /* ALNUMUTF8 */
0, /* ALNUML */
- 0, /* ALNUMLUTF8 */
0, /* NALNUM */
- 0, /* NALNUMUTF8 */
0, /* NALNUML */
- 0, /* NALNUMLUTF8 */
0, /* SPACE */
- 0, /* SPACEUTF8 */
0, /* SPACEL */
- 0, /* SPACELUTF8 */
0, /* NSPACE */
- 0, /* NSPACEUTF8 */
0, /* NSPACEL */
- 0, /* NSPACELUTF8 */
0, /* DIGIT */
- 0, /* DIGITUTF8 */
0, /* DIGITL */
- 0, /* DIGITLUTF8 */
0, /* NDIGIT */
- 0, /* NDIGITUTF8 */
0, /* NDIGITL */
- 0, /* NDIGITLUTF8 */
0, /* CLUMP */
0, /* BRANCH */
0, /* BACK */
0, /* MEOL */
0, /* SEOL */
0, /* BOUND */
- 0, /* BOUNDUTF8 */
0, /* BOUNDL */
- 0, /* BOUNDLUTF8 */
0, /* NBOUND */
- 0, /* NBOUNDUTF8 */
0, /* NBOUNDL */
- 0, /* NBOUNDLUTF8 */
0, /* GPOS */
0, /* REG_ANY */
- 0, /* ANYUTF8 */
0, /* SANY */
- 0, /* SANYUTF8 */
0, /* ANYOF */
- 0, /* ANYOFUTF8 */
0, /* ALNUM */
- 0, /* ALNUMUTF8 */
0, /* ALNUML */
- 0, /* ALNUMLUTF8 */
0, /* NALNUM */
- 0, /* NALNUMUTF8 */
0, /* NALNUML */
- 0, /* NALNUMLUTF8 */
0, /* SPACE */
- 0, /* SPACEUTF8 */
0, /* SPACEL */
- 0, /* SPACELUTF8 */
0, /* NSPACE */
- 0, /* NSPACEUTF8 */
0, /* NSPACEL */
- 0, /* NSPACELUTF8 */
0, /* DIGIT */
- 0, /* DIGITUTF8 */
0, /* DIGITL */
- 0, /* DIGITLUTF8 */
0, /* NDIGIT */
- 0, /* NDIGITUTF8 */
0, /* NDIGITL */
- 0, /* NDIGITLUTF8 */
0, /* CLUMP */
0, /* BRANCH */
0, /* BACK */
"MEOL", /* 0x7 */
"SEOL", /* 0x8 */
"BOUND", /* 0x9 */
- "BOUNDUTF8", /* 0xa */
- "BOUNDL", /* 0xb */
- "BOUNDLUTF8", /* 0xc */
- "NBOUND", /* 0xd */
- "NBOUNDUTF8", /* 0xe */
- "NBOUNDL", /* 0xf */
- "NBOUNDLUTF8", /* 0x10 */
- "GPOS", /* 0x11 */
- "REG_ANY", /* 0x12 */
- "ANYUTF8", /* 0x13 */
- "SANY", /* 0x14 */
- "SANYUTF8", /* 0x15 */
- "ANYOF", /* 0x16 */
- "ANYOFUTF8", /* 0x17 */
- "ALNUM", /* 0x18 */
- "ALNUMUTF8", /* 0x19 */
- "ALNUML", /* 0x1a */
- "ALNUMLUTF8", /* 0x1b */
- "NALNUM", /* 0x1c */
- "NALNUMUTF8", /* 0x1d */
- "NALNUML", /* 0x1e */
- "NALNUMLUTF8", /* 0x1f */
- "SPACE", /* 0x20 */
- "SPACEUTF8", /* 0x21 */
- "SPACEL", /* 0x22 */
- "SPACELUTF8", /* 0x23 */
- "NSPACE", /* 0x24 */
- "NSPACEUTF8", /* 0x25 */
- "NSPACEL", /* 0x26 */
- "NSPACELUTF8", /* 0x27 */
- "DIGIT", /* 0x28 */
- "DIGITUTF8", /* 0x29 */
- "DIGITL", /* 0x2a */
- "DIGITLUTF8", /* 0x2b */
- "NDIGIT", /* 0x2c */
- "NDIGITUTF8", /* 0x2d */
- "NDIGITL", /* 0x2e */
- "NDIGITLUTF8", /* 0x2f */
- "CLUMP", /* 0x30 */
- "BRANCH", /* 0x31 */
- "BACK", /* 0x32 */
- "EXACT", /* 0x33 */
- "EXACTF", /* 0x34 */
- "EXACTFL", /* 0x35 */
- "NOTHING", /* 0x36 */
- "TAIL", /* 0x37 */
- "STAR", /* 0x38 */
- "PLUS", /* 0x39 */
- "CURLY", /* 0x3a */
- "CURLYN", /* 0x3b */
- "CURLYM", /* 0x3c */
- "CURLYX", /* 0x3d */
- "WHILEM", /* 0x3e */
- "OPEN", /* 0x3f */
- "CLOSE", /* 0x40 */
- "REF", /* 0x41 */
- "REFF", /* 0x42 */
- "REFFL", /* 0x43 */
- "IFMATCH", /* 0x44 */
- "UNLESSM", /* 0x45 */
- "SUSPEND", /* 0x46 */
- "IFTHEN", /* 0x47 */
- "GROUPP", /* 0x48 */
- "LONGJMP", /* 0x49 */
- "BRANCHJ", /* 0x4a */
- "EVAL", /* 0x4b */
- "MINMOD", /* 0x4c */
- "LOGICAL", /* 0x4d */
- "RENUM", /* 0x4e */
- "OPTIMIZED", /* 0x4f */
+ "BOUNDL", /* 0xa */
+ "NBOUND", /* 0xb */
+ "NBOUNDL", /* 0xc */
+ "GPOS", /* 0xd */
+ "REG_ANY", /* 0xe */
+ "SANY", /* 0xf */
+ "ANYOF", /* 0x10 */
+ "ALNUM", /* 0x11 */
+ "ALNUML", /* 0x12 */
+ "NALNUM", /* 0x13 */
+ "NALNUML", /* 0x14 */
+ "SPACE", /* 0x15 */
+ "SPACEL", /* 0x16 */
+ "NSPACE", /* 0x17 */
+ "NSPACEL", /* 0x18 */
+ "DIGIT", /* 0x19 */
+ "DIGITL", /* 0x1a */
+ "NDIGIT", /* 0x1b */
+ "NDIGITL", /* 0x1c */
+ "CLUMP", /* 0x1d */
+ "BRANCH", /* 0x1e */
+ "BACK", /* 0x1f */
+ "EXACT", /* 0x20 */
+ "EXACTF", /* 0x21 */
+ "EXACTFL", /* 0x22 */
+ "NOTHING", /* 0x23 */
+ "TAIL", /* 0x24 */
+ "STAR", /* 0x25 */
+ "PLUS", /* 0x26 */
+ "CURLY", /* 0x27 */
+ "CURLYN", /* 0x28 */
+ "CURLYM", /* 0x29 */
+ "CURLYX", /* 0x2a */
+ "WHILEM", /* 0x2b */
+ "OPEN", /* 0x2c */
+ "CLOSE", /* 0x2d */
+ "REF", /* 0x2e */
+ "REFF", /* 0x2f */
+ "REFFL", /* 0x30 */
+ "IFMATCH", /* 0x31 */
+ "UNLESSM", /* 0x32 */
+ "SUSPEND", /* 0x33 */
+ "IFTHEN", /* 0x34 */
+ "GROUPP", /* 0x35 */
+ "LONGJMP", /* 0x36 */
+ "BRANCHJ", /* 0x37 */
+ "EVAL", /* 0x38 */
+ "MINMOD", /* 0x39 */
+ "LOGICAL", /* 0x3a */
+ "RENUM", /* 0x3b */
+ "OPTIMIZED", /* 0x3c */
};
-static const int reg_num = 80;
+static const int reg_num = 61;
#endif /* DEBUGGING */
#endif /* REG_COMP_C */
if (!sv)
return 0;
-#ifdef NOTYET
if (SvGMAGICAL(sv))
return mg_length(sv);
else
-#endif
{
STRLEN len;
U8 *s = (U8*)SvPV(sv, len);
print "Bail out! Perl configured without IO module\n";
exit 0;
}
-if (($Config{'extensions'} !~ /\bFile\/Glob\b/) ){
+# hey, DOS users do not need this kind of common sense ;-)
+if ($^O ne 'dos' && ($Config{'extensions'} !~ /\bFile\/Glob\b/) ){
print "Bail out! Perl configured without File::Glob module\n";
exit 0;
}
# look up the user's home directory
# should return a list with one item, and not set ERROR
-if ($^O ne 'MSWin32' && $^O ne 'VMS') {
+if ($^O ne 'MSWin32' && $^O ne 'VMS' && $^O ne 'cygwin') {
eval {
($name, $home) = (getpwuid($>))[0,7];
1;
# 32+ bit integers don't cause noise
no warnings qw(overflow portable);
-print "1..55\n";
+print "1..57\n";
my $q = 12345678901;
my $r = 23456789012;
print "# $q ne\n# 18446744073709551615\nnot " unless "$q" eq "18446744073709551615";
print "ok 55\n";
+# Test that sv_2nv then sv_2iv is the same as sv_2iv direct
+# fails if whatever Atol is defined as can't actually cope with >32 bits.
+my $num = 4294967297;
+my $string = "4294967297";
+{
+ use integer;
+ $num += 0;
+ $string += 0;
+}
+if ($num eq $string) {
+ print "ok 56\n";
+} else {
+ print "not ok 56 # \"$num\" ne \"$string\"\n";
+}
+
+# Test that sv_2nv then sv_2uv is the same as sv_2uv direct
+$num = 4294967297;
+$string = "4294967297";
+$num &= 0;
+$string &= 0;
+if ($num eq $string) {
+ print "ok 57\n";
+} else {
+ print "not ok 57 # \"$num\" ne \"$string\"\n";
+}
+
# eof
### First, we check whether Fcntl::constant returns sane answers.
# Fcntl::constant("LOCK_SH",0) should always succeed.
-$value = Fcntl::constant($VALID,0);
+$value = Fcntl::constant($VALID);
print((!defined $value)
? "not ok 1\n# Sanity check broke, remaining tests will fail.\n"
: "ok 1\n");
# test "goto &function_constant"
sub goto_const { goto &Fcntl::constant; }
-$ret = goto_const($VALID,0);
+$ret = goto_const($VALID);
print(($ret == $value) ? "ok 2\n" : "not ok 2\n# ($ret != $value)\n");
# test "goto &$function_package_and_name"
$FNAME1 = 'Fcntl::constant';
sub goto_name1 { goto &$FNAME1; }
-$ret = goto_name1($VALID,0);
+$ret = goto_name1($VALID);
print(($ret == $value) ? "ok 3\n" : "not ok 3\n# ($ret != $value)\n");
# test "goto &$function_package_and_name" again, with dirtier stack
-$ret = goto_name1($VALID,0);
+$ret = goto_name1($VALID);
print(($ret == $value) ? "ok 4\n" : "not ok 4\n# ($ret != $value)\n");
-$ret = goto_name1($VALID,0);
+$ret = goto_name1($VALID);
print(($ret == $value) ? "ok 5\n" : "not ok 5\n# ($ret != $value)\n");
# test "goto &$function_name" from local package
sub goto_name2 { goto &$FNAME2; }
package main;
-$ret = Fcntl::goto_name2($VALID,0);
+$ret = Fcntl::goto_name2($VALID);
print(($ret == $value) ? "ok 6\n" : "not ok 6\n# ($ret != $value)\n");
# test "goto &$function_ref"
$FREF = \&Fcntl::constant;
sub goto_ref { goto &$FREF; }
-$ret = goto_ref($VALID,0);
+$ret = goto_ref($VALID);
print(($ret == $value) ? "ok 7\n" : "not ok 7\n# ($ret != $value)\n");
### tests where the args are not on stack but in GvAV(defgv) (ie, @_)
# test "goto &function_constant" from a sub called without arglist
sub call_goto_const { &goto_const; }
-$ret = call_goto_const($VALID,0);
+$ret = call_goto_const($VALID);
print(($ret == $value) ? "ok 8\n" : "not ok 8\n# ($ret != $value)\n");
# test "goto &$function_package_and_name" from a sub called without arglist
sub call_goto_name1 { &goto_name1; }
-$ret = call_goto_name1($VALID,0);
+$ret = call_goto_name1($VALID);
print(($ret == $value) ? "ok 9\n" : "not ok 9\n# ($ret != $value)\n");
# test "goto &$function_ref" from a sub called without arglist
sub call_goto_ref { &goto_ref; }
-$ret = call_goto_ref($VALID,0);
+$ret = call_goto_ref($VALID);
print(($ret == $value) ? "ok 10\n" : "not ok 10\n# ($ret != $value)\n");
@INC = '../lib';
}
+no utf8; # this test contains raw 8-bit data on purpose; don't switch to \x{}
+
print "1..78\n";
my $test = 1;
}
}
-print "1..90\n";
+print "1..104\n";
my $test = 1;
{
use utf8;
+
$_ = ">\x{263A}<";
s/([\x{80}-\x{10ffff}])/"&#".ord($1).";"/eg;
ok $_, '>☺<';
}
{
- use utf8;
-
- $_ = "\x{263A}>\x{263A}\x{263A}";
-
- ok length, 4;
- $test++; # 13
-
- ok length((m/>(.)/)[0]), 1;
- $test++; # 14
-
- ok length($&), 2;
- $test++; # 15
+ # no use utf8 needed
+ $_ = "\x{263A}\x{263A}x\x{263A}y\x{263A}";
+
+ ok length($_), 6; # 13
+ $test++;
- ok length($'), 1;
- $test++; # 16
+ ($a) = m/x(.)/;
- ok length($`), 1;
- $test++; # 17
+ ok length($a), 1; # 14
+ $test++;
- ok length($1), 1;
- $test++; # 18
+ ok length($`), 2; # 15
+ $test++;
+ ok length($&), 2; # 16
+ $test++;
+ ok length($'), 2; # 17
+ $test++;
- ok length($tmp=$&), 2;
- $test++; # 19
+ ok length($1), 1; # 18
+ $test++;
- ok length($tmp=$'), 1;
- $test++; # 20
+ ok length($b=$`), 2; # 19
+ $test++;
- ok length($tmp=$`), 1;
- $test++; # 21
+ ok length($b=$&), 2; # 20
+ $test++;
- ok length($tmp=$1), 1;
- $test++; # 22
+ ok length($b=$'), 2; # 21
+ $test++;
- {
- use bytes;
+ ok length($b=$1), 1; # 22
+ $test++;
- my $tmp = $&;
- ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272);
- $test++; # 23
+ ok $a, "\x{263A}"; # 23
+ $test++;
- $tmp = $';
- ok $tmp, pack("C*", 0342, 0230, 0272);
- $test++; # 24
+ ok $`, "\x{263A}\x{263A}"; # 24
+ $test++;
- $tmp = $`;
- ok $tmp, pack("C*", 0342, 0230, 0272);
- $test++; # 25
+ ok $&, "x\x{263A}"; # 25
+ $test++;
- $tmp = $1;
- ok $tmp, pack("C*", 0342, 0230, 0272);
- $test++; # 26
- }
+ ok $', "y\x{263A}"; # 26
+ $test++;
- ok_bytes $&, pack("C*", ord(">"), 0342, 0230, 0272);
- $test++; # 27
+ ok $1, "\x{263A}"; # 27
+ $test++;
- ok_bytes $', pack("C*", 0342, 0230, 0272);
- $test++; # 28
+ ok_bytes $a, "\342\230\272"; # 28
+ $test++;
- ok_bytes $`, pack("C*", 0342, 0230, 0272);
- $test++; # 29
+ ok_bytes $1, "\342\230\272"; # 29
+ $test++;
- ok_bytes $1, pack("C*", 0342, 0230, 0272);
- $test++; # 30
+ ok_bytes $&, "x\342\230\272"; # 30
+ $test++;
{
- use bytes;
- no utf8;
-
- ok length, 10;
- $test++; # 31
+ use utf8; # required
+ $_ = chr(0x263A) . chr(0x263A) . 'x' . chr(0x263A) . 'y' . chr(0x263A);
+ }
- ok length((m/>(.)/)[0]), 1;
- $test++; # 32
+ ok length($_), 6; # 31
+ $test++;
- ok length($&), 2;
- $test++; # 33
+ ($a) = m/x(.)/;
- ok length($'), 5;
- $test++; # 34
+ ok length($a), 1; # 32
+ $test++;
- ok length($`), 3;
- $test++; # 35
+ ok length($`), 2; # 33
+ $test++;
- ok length($1), 1;
- $test++; # 36
+ ok length($&), 2; # 34
+ $test++;
- ok $&, pack("C*", ord(">"), 0342);
- $test++; # 37
+ ok length($'), 2; # 35
+ $test++;
- ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
- $test++; # 38
+ ok length($1), 1; # 36
+ $test++;
- ok $`, pack("C*", 0342, 0230, 0272);
- $test++; # 39
+ ok length($b=$`), 2; # 37
+ $test++;
- ok $1, pack("C*", 0342);
- $test++; # 40
- }
+ ok length($b=$&), 2; # 38
+ $test++;
- {
- no utf8;
- $_="\342\230\272>\342\230\272\342\230\272";
- }
+ ok length($b=$'), 2; # 39
+ $test++;
- ok length, 10;
- $test++; # 41
+ ok length($b=$1), 1; # 40
+ $test++;
- ok length((m/>(.)/)[0]), 1;
- $test++; # 42
+ ok $a, "\x{263A}"; # 41
+ $test++;
- ok length($&), 2;
- $test++; # 43
+ ok $`, "\x{263A}\x{263A}"; # 42
+ $test++;
- ok length($'), 1;
- $test++; # 44
+ ok $&, "x\x{263A}"; # 43
+ $test++;
- ok length($`), 1;
- $test++; # 45
+ ok $', "y\x{263A}"; # 44
+ $test++;
- ok length($1), 1;
- $test++; # 46
+ ok $1, "\x{263A}"; # 45
+ $test++;
- ok length($tmp=$&), 2;
- $test++; # 47
+ ok_bytes $a, "\342\230\272"; # 46
+ $test++;
- ok length($tmp=$'), 1;
- $test++; # 48
+ ok_bytes $1, "\342\230\272"; # 47
+ $test++;
- ok length($tmp=$`), 1;
- $test++; # 49
+ ok_bytes $&, "x\342\230\272"; # 48
+ $test++;
- ok length($tmp=$1), 1;
- $test++; # 50
+ $_ = "\342\230\272\342\230\272x\342\230\272y\342\230\272";
- {
- use bytes;
+ ok length($_), 14; # 49
+ $test++;
- my $tmp = $&;
- ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272);
- $test++; # 51
+ ($a) = m/x(.)/;
- $tmp = $';
- ok $tmp, pack("C*", 0342, 0230, 0272);
- $test++; # 52
+ ok length($a), 1; # 50
+ $test++;
- $tmp = $`;
- ok $tmp, pack("C*", 0342, 0230, 0272);
- $test++; # 53
+ ok length($`), 6; # 51
+ $test++;
- $tmp = $1;
- ok $tmp, pack("C*", 0342, 0230, 0272);
- $test++; # 54
- }
+ ok length($&), 2; # 52
+ $test++;
- {
- use bytes;
- no utf8;
+ ok length($'), 6; # 53
+ $test++;
- ok length, 10;
- $test++; # 55
+ ok length($1), 1; # 54
+ $test++;
- ok length((m/>(.)/)[0]), 1;
- $test++; # 56
+ ok length($b=$`), 6; # 55
+ $test++;
- ok length($&), 2;
- $test++; # 57
+ ok length($b=$&), 2; # 56
+ $test++;
- ok length($'), 5;
- $test++; # 58
+ ok length($b=$'), 6; # 57
+ $test++;
- ok length($`), 3;
- $test++; # 59
+ ok length($b=$1), 1; # 58
+ $test++;
- ok length($1), 1;
- $test++; # 60
+ ok $a, "\342"; # 59
+ $test++;
- ok $&, pack("C*", ord(">"), 0342);
- $test++; # 61
+ ok $`, "\342\230\272\342\230\272"; # 60
+ $test++;
- ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
- $test++; # 62
+ ok $&, "x\342"; # 61
+ $test++;
- ok $`, pack("C*", 0342, 0230, 0272);
- $test++; # 63
+ ok $', "\230\272y\342\230\272"; # 62
+ $test++;
- ok $1, pack("C*", 0342);
- $test++; # 64
- }
+ ok $1, "\342"; # 63
+ $test++;
+}
+{
+ use utf8;
ok "\x{ab}" =~ /^\x{ab}$/, 1;
- $test++; # 65
+ $test++; # 64
}
{
use utf8;
ok_bytes chr(0xe2), pack("C*", 0xc3, 0xa2);
- $test++; # 66
+ $test++; # 65
}
{
use utf8;
my @a = map ord, split(//, join("", map chr, (1234, 123, 2345)));
ok "@a", "1234 123 2345";
- $test++; # 67
+ $test++; # 66
}
{
my $x = chr(123);
my @a = map ord, split(/$x/, join("", map chr, (1234, 123, 2345)));
ok "@a", "1234 2345";
- $test++; # 68
+ $test++; # 67
}
{
{ use utf8; $b = "\xe4" } # \xXX must not produce UTF-8
print "not " if $a eq $b;
- print "ok $test\n"; $test++;
+ print "ok $test\n"; $test++; # 68
{ use utf8; print "not " if $a eq $b; }
- print "ok $test\n"; $test++;
+ print "ok $test\n"; $test++; # 69
}
{
for (@x) {
s/(\d+)\s*([\w\-]+)/$1 . uc $2/e;
my($latin) = /^(.+)(?:\s+\d)/;
- print $latin eq "stra\337e" ? "ok $test\n" :
+ print $latin eq "stra\337e" ? "ok $test\n" : # 70, 71
"#latin[$latin]\nnot ok $test\n";
$test++;
$latin =~ s/stra\337e/straße/; # \303\237 after the 2nd a
}
print "not " unless $r eq " U+B36C U+5A8C U+FF5B U+5079 U+505B";
- print "ok $test\n";
+ print "ok $test\n"; # 72
$test++;
}
print "not "
unless $a eq "\x20" && $b eq "\x{80}\x{100}\x{80}" && $c eq $a;
print "ok $test\n";
- $test++;
+ $test++; # 73
my ($a, $b) = split(/\x{100}/, $s);
print "not " unless $a eq "\x20\x40\x{80}" && $b eq "\x{80}\x40\x20";
print "ok $test\n";
- $test++;
+ $test++; # 74
my ($a, $b) = split(/\x{80}\x{100}\x{80}/, $s);
print "not " unless $a eq "\x20\x40" && $b eq "\x40\x20";
print "ok $test\n";
- $test++;
+ $test++; # 75
my ($a, $b) = split(/\x40\x{80}/, $s);
print "not " unless $a eq "\x20" && $b eq "\x{100}\x{80}\x40\x20";
print "ok $test\n";
- $test++;
+ $test++; # 76
my ($a, $b, $c) = split(/[\x40\x{80}]+/, $s);
print "not " unless $a eq "\x20" && $b eq "\x{100}" && $c eq "\x20";
print "ok $test\n";
- $test++;
+ $test++; # 77
}
{
my $smiley = "\x{263a}";
- for my $s ("\x{263a}", # 1
- $smiley, # 2
+ for my $s ("\x{263a}", # 78
+ $smiley, # 79
- "" . $smiley, # 3
- "" . "\x{263a}", # 4
+ "" . $smiley, # 80
+ "" . "\x{263a}", # 81
- $smiley . "", # 5
- "\x{263a}" . "", # 6
+ $smiley . "", # 82
+ "\x{263a}" . "", # 83
) {
my $length_chars = length($s);
my $length_bytes;
$test++;
}
- for my $s ("\x{263a}" . "\x{263a}", # 7
- $smiley . $smiley, # 8
+ for my $s ("\x{263a}" . "\x{263a}", # 84
+ $smiley . $smiley, # 85
- "\x{263a}\x{263a}", # 9
- "$smiley$smiley", # 10
+ "\x{263a}\x{263a}", # 86
+ "$smiley$smiley", # 87
- "\x{263a}" x 2, # 11
- $smiley x 2, # 12
+ "\x{263a}" x 2, # 88
+ $smiley x 2, # 89
) {
my $length_chars = length($s);
my $length_bytes;
$test++;
}
}
+
+{
+ use utf8;
+
+ print "not " unless "ba\xd4c" =~ /([a\xd4]+)/ && $1 eq "a\xd4";
+ print "ok $test\n";
+ $test++; # 90
+
+ print "not " unless "ba\xd4c" =~ /([a\xd4]+)/ && $1 eq "a\x{d4}";
+ print "ok $test\n";
+ $test++; # 91
+
+ print "not " unless "ba\x{d4}c" =~ /([a\xd4]+)/ && $1 eq "a\x{d4}";
+ print "ok $test\n";
+ $test++; # 92
+
+ print "not " unless "ba\x{d4}c" =~ /([a\xd4]+)/ && $1 eq "a\xd4";
+ print "ok $test\n";
+ $test++; # 93
+
+ print "not " unless "ba\xd4c" =~ /([a\x{d4}]+)/ && $1 eq "a\xd4";
+ print "ok $test\n";
+ $test++; # 94
+
+ print "not " unless "ba\xd4c" =~ /([a\x{d4}]+)/ && $1 eq "a\x{d4}";
+ print "ok $test\n";
+ $test++; # 95
+
+ print "not " unless "ba\x{d4}c" =~ /([a\x{d4}]+)/ && $1 eq "a\x{d4}";
+ print "ok $test\n";
+ $test++; # 96
+
+ print "not " unless "ba\x{d4}c" =~ /([a\x{d4}]+)/ && $1 eq "a\xd4";
+ print "ok $test\n";
+ $test++; # 97
+}
+
+{
+ # the first half of 20001028.003
+
+ my $X = chr(1448);
+ my ($Y) = $X =~ /(.*)/;
+ print "not " unless length $Y == 1;
+ print "ok $test\n";
+ $test++; # 98
+}
+
+{
+ # 20001108.001
+
+ use utf8;
+ my $X = "Szab\x{f3},Bal\x{e1}zs";
+ my $Y = $X;
+ $Y =~ s/(B)/$1/ for 0..3;
+ print "not " unless $Y eq $X;
+ print "ok $test\n";
+ $test++; # 99
+}
+
+{
+ # 20001114.001
+
+ use utf8;
+ use charnames ':full';
+ my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}";
+ print "not " unless ord($text) == 0xc4;
+ print "ok $test\n";
+ $test++; # 100
+}
+
+{
+ # 20001205.014
+
+ use utf8;
+
+ my $a = "ABC\x{263A}";
+
+ my @b = split( //, $a );
+
+ print "not " unless @b == 4;
+ print "ok $test\n";
+ $test++; # 101
+
+ print "not " unless length($b[3]) == 1;
+ print "ok $test\n";
+ $test++; # 102
+
+ $a =~ s/^A/Z/;
+ print "not " unless length($a) == 4;
+ print "ok $test\n";
+ $test++; # 103
+}
+
+{
+ # the second half of 20001028.003
+
+ use utf8;
+ $X =~ s/^/chr(1488)/e;
+ print "not " unless length $X == 1;
+ print "ok $test\n";
+ $test++; # 104
+}
+
untie attempted while %d inner references still exist [pp_untie]
sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
+ fileno() on unopened filehandle abc [pp_fileno]
+ $a = "abc"; fileno($a)
+
+ binmode() on unopened filehandle abc [pp_binmode]
+ $a = "abc"; fileno($a)
+
+ printf() on unopened filehandle abc [pp_prtf]
+ $a = "abc"; printf $a "fred"
+
Filehandle %s opened only for input [pp_leavewrite]
format STDIN =
.
unlink $file ;
EXPECT
Filehandle F opened only for output at - line 12.
+########
+# pp_sys.c [pp_binmode]
+use warnings 'unopened' ;
+binmode(BLARG);
+$a = "BLERG";binmode($a);
+EXPECT
+binmode() on unopened filehandle BLARG at - line 3.
+binmode() on unopened filehandle at - line 4.
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-/*#define ARCHLIB "/usr/local/lib/perl5/5.6/unknown" / **/
-/*#define ARCHLIB_EXP "/usr/local/lib/perl5/5.6/unknown" / **/
+/*#define ARCHLIB "/usr/local/lib/perl5/5.7/unknown" / **/
+/*#define ARCHLIB_EXP "/usr/local/lib/perl5/5.7/unknown" / **/
/* ARCHNAME:
* This symbol holds a string representing the architecture name.
#define CPPRUN ""
#define CPPLAST ""
+/* HAS__FWALK:
+ * This symbol, if defined, indicates that the _fwalk system call is
+ * available to apply a function to all the file handles.
+ */
+/*#define HAS__FWALK / **/
+
/* HAS_ACCESS:
* This manifest constant lets the C program know that the access()
* system call is available to check for accessibility using real UID/GID.
*/
/*#define HAS_ENDSERVENT / **/
+/* FCNTL_CAN_LOCK:
+ * This symbol, if defined, indicates that fcntl() can be used
+ * for file locking. Normally on Unix systems this is defined.
+ * It may be undefined on VMS.
+ */
+/*#define FCNTL_CAN_LOCK / **/
+
/* HAS_FD_SET:
* This symbol, when defined, indicates presence of the fd_set typedef
* in <sys/types.h>
*/
/*#define HAS_FSTATFS / **/
+/* HAS_FSYNC:
+ * This symbol, if defined, indicates that the fsync routine is
+ * available to write a file's modified data and attributes to
+ * permanent storage.
+ */
+/*#define HAS_FSYNC / **/
+
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
/*#define HAS_GETPROTOENT / **/
+/* HAS_GETPGRP:
+ * This symbol, if defined, indicates that the getpgrp routine is
+ * available to get the current process group.
+ */
+/* USE_BSD_GETPGRP:
+ * This symbol, if defined, indicates that getpgrp needs one
+ * arguments whereas USG one needs none.
+ */
+/*#define HAS_GETPGRP / **/
+/*#define USE_BSD_GETPGRP / **/
+
/* HAS_GETPROTOBYNAME:
* This symbol, if defined, indicates that the getprotobyname()
* routine is available to look up protocols by their name.
*/
/*#define HAS_SANE_MEMCMP / **/
+/* HAS_SBRK_PROTO:
+ * This symbol, if defined, indicates that the system provides
+ * a prototype for the sbrk() function. Otherwise, it is up
+ * to the program to supply one. Good guesses are
+ * extern void* sbrk _((int));
+ * extern void* sbrk _((size_t));
+ */
+/*#define HAS_SBRK_PROTO / **/
+
/* HAS_SEM:
* This symbol, if defined, indicates that the entire sem*(2) library is
* supported.
*/
/*#define HAS_SETPROTOENT / **/
+/* HAS_SETPGRP:
+ * This symbol, if defined, indicates that the setpgrp routine is
+ * available to set the current process group.
+ */
+/* USE_BSD_SETPGRP:
+ * This symbol, if defined, indicates that setpgrp needs two
+ * arguments whereas USG one needs none. See also HAS_SETPGID
+ * for a POSIX interface.
+ */
+/*#define HAS_SETPGRP / **/
+/*#define USE_BSD_SETPGRP / **/
+
/* HAS_SETPROCTITLE:
* This symbol, if defined, indicates that the setproctitle routine is
* available to set process title.
/*#define USE_STDIO_PTR / **/
#ifdef USE_STDIO_PTR
#define FILE_ptr(fp) ((fp)->_IO_read_ptr)
-# STDIO_PTR_LVALUE /**/
+/*#define STDIO_PTR_LVALUE / **/
#define FILE_cnt(fp) ((fp)->_IO_read_end - (fp)->_IO_read_ptr)
/*#define STDIO_CNT_LVALUE / **/
/*#define STDIO_PTR_LVAL_SETS_CNT / **/
* This symbol, if defined, indicates that the strtoq routine is
* available to convert strings to long longs (quads).
*/
-# HAS_STRTOQ /**/
+/*#define HAS_STRTOQ / **/
-/* HAS_STRTOQ:
- * This symbol, if defined, indicates that the strtoq routine is
- * available to convert strings to long longs (quads).
+/* HAS_STRTOUL:
+ * This symbol, if defined, indicates that the strtoul routine is
+ * available to provide conversion of strings to unsigned long.
*/
-# HAS_STRTOQ /**/
+/*#define HAS_STRTOUL / **/
/* HAS_STRTOULL:
* This symbol, if defined, indicates that the strtoull routine is
#define RD_NODATA -1
#undef EOF_NONBLOCK
+/* NEED_VA_COPY:
+ * This symbol, if defined, indicates that the system stores
+ * the variable argument list datatype, va_list, in a format
+ * that cannot be copied by simple assignment, so that some
+ * other means must be used when copying is required.
+ * As such systems vary in their provision (or non-provision)
+ * of copying mechanisms, handy.h defines a platform-
+ * independent macro, Perl_va_copy(src, dst), to do the job.
+ */
+/*#define NEED_VA_COPY / **/
+
/* Netdb_host_t:
* This symbol holds the type used for the 1st argument
* to gethostbyaddr().
#endif
#define NVSIZE 8 /**/
#undef NV_PRESERVES_UV
-#define NV_PRESERVES_UV_BITS
+#define NV_PRESERVES_UV_BITS 0
/* IVdf:
* This symbol defines the format string used for printing a Perl IV
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "/usr/local/lib/perl5/5.6" /**/
-#define PRIVLIB_EXP "/usr/local/lib/perl5/5.6" /**/
+#define PRIVLIB "/usr/local/lib/perl5/5.7" /**/
+#define PRIVLIB_EXP "/usr/local/lib/perl5/5.7" /**/
/* PTRSIZE:
* This symbol contains the size of a pointer, so that the C preprocessor
*/
#define STARTPERL "" /**/
+/* STDCHAR:
+ * This symbol is defined to be the type of char used in stdio.h.
+ * It has the values "unsigned char" or "char".
+ */
+#define STDCHAR char /**/
+
/* HAS_STDIO_STREAM_ARRAY:
* This symbol, if defined, tells that there is an array
* holding the stdio streams.
#define PERL_XS_APIVERSION "5.005"
#define PERL_PM_APIVERSION "5.005"
-/* HAS_GETPGRP:
- * This symbol, if defined, indicates that the getpgrp routine is
- * available to get the current process group.
- */
-/* USE_BSD_GETPGRP:
- * This symbol, if defined, indicates that getpgrp needs one
- * arguments whereas USG one needs none.
- */
-/*#define HAS_GETPGRP / **/
-/*#define USE_BSD_GETPGRP / **/
-
-/* HAS_SETPGRP:
- * This symbol, if defined, indicates that the setpgrp routine is
- * available to set the current process group.
- */
-/* USE_BSD_SETPGRP:
- * This symbol, if defined, indicates that setpgrp needs two
- * arguments whereas USG one needs none. See also HAS_SETPGID
- * for a POSIX interface.
- */
-/*#define HAS_SETPGRP / **/
-/*#define USE_BSD_SETPGRP / **/
-
-/* HAS_STRTOUL:
- * This symbol, if defined, indicates that the strtoul routine is
- * available to provide conversion of strings to unsigned long.
- */
-/*#define HAS_STRTOUL / **/
-
-/* STDCHAR:
- * This symbol is defined to be the type of char used in stdio.h.
- * It has the values "unsigned char" or "char".
- */
-#define STDCHAR char /**/
-
-/* HAS_STRTOUL:
- * This symbol, if defined, indicates that the strtoul routine is
- * available to provide conversion of strings to unsigned long.
- */
-/*#define HAS_STRTOUL / **/
-
-/* STDCHAR:
- * This symbol is defined to be the type of char used in stdio.h.
- * It has the values "unsigned char" or "char".
- */
-#define STDCHAR char /**/
-
-/* HAS__FWALK:
- * This symbol, if defined, indicates that the _fwalk system call is
- * available to apply a function to all the file handles.
- */
-/*#define HAS__FWALK / **/
-
-/* FCNTL_CAN_LOCK:
- * This symbol, if defined, indicates that fcntl() can be used
- * for file locking. Normally on Unix systems this is defined.
- * It may be undefined on VMS.
- */
-/*#define FCNTL_CAN_LOCK / **/
-
-/* HAS_FSYNC:
- * This symbol, if defined, indicates that the fsync routine is
- * available to write a file's modified data and attributes to
- * permanent storage.
- */
-# HAS_FSYNC /**/
-
-/* HAS_SBRK_PROTO:
- * This symbol, if defined, indicates that the system provides
- * a prototype for the sbrk() function. Otherwise, it is up
- * to the program to supply one. Good guesses are
- * extern void* sbrk _((int));
- * extern void* sbrk _((size_t));
- */
-/*#define HAS_SBRK_PROTO / **/
-
-/* NEED_VA_COPY:
- * This symbol, if defined, indicates that the system stores
- * the variable argument list datatype, va_list, in a format
- * that cannot be copied by simple assignment, so that some
- * other means must be used when copying is required.
- * As such systems vary in their provision (or non-provision)
- * of copying mechanisms, handy.h defines a platform-
- * independent macro, Perl_va_copy(src, dst), to do the job.
- */
-/*#define NEED_VA_COPY / **/
-
#endif
afs='false'
alignbytes='4'
apiversion='5.005'
-archlib='/usr/local/lib/perl5/5.6/unknown'
-archlibexp='/usr/local/lib/perl5/5.6/unknown'
+archlib='/usr/local/lib/perl5/5.7/unknown'
+archlibexp='/usr/local/lib/perl5/5.7/unknown'
archname='unknown'
bin='/usr/local/bin'
bincompat5005='define'
clocktype='clock_t'
cpp_stuff='42'
crosscompile='undef'
-d__fwalk='undef'
d_Gconvert='sprintf((b),"%.*g",(n),(x))'
-d_SCNfldbl='undef'
d_PRIEUldbl='undef'
d_PRIFUldbl='undef'
d_PRIGUldbl='undef'
d_PRIo64='undef'
d_PRIu64='undef'
d_PRIx64='undef'
+d_SCNfldbl='undef'
+d__fwalk='undef'
d_access='undef'
d_accessx='undef'
d_alarm='undef'
d_endpent='undef'
d_endpwent='undef'
d_endsent='undef'
-d_endspent='undef'
d_eofnblk='undef'
d_eunice='undef'
d_fchmod='undef'
d_fork='define'
d_fpathconf='undef'
d_fpos64_t='undef'
+d_frexpl='undef'
d_fs_data_s='undef'
d_fseeko='undef'
d_fsetpos='undef'
d_fstatfs='undef'
d_fstatvfs='undef'
+d_fsync='undef'
d_ftello='undef'
d_ftime='undef'
d_getcwd='undef'
+d_getespwnam='undef'
+d_getfsstat='undef'
d_getgrent='undef'
d_getgrps='undef'
d_gethbyaddr='undef'
d_getppid='undef'
d_getprior='undef'
d_getprotoprotos='undef'
+d_getprpwnam='undef'
d_getpwent='undef'
d_getsbyname='undef'
d_getsbyport='undef'
d_iconv='undef'
d_index='undef'
d_inetaton='undef'
-d_int64t='undef'
+d_int64_t='undef'
d_isascii='undef'
+d_isnan='undef'
+d_isnanl='undef'
d_killpg='undef'
d_lchown='undef'
d_ldbl_dig='undef'
d_lockf='undef'
d_longdbl='undef'
d_longlong='undef'
+d_lseekproto='undef'
d_lstat='undef'
+d_madvise='undef'
d_mblen='undef'
d_mbstowcs='undef'
d_mbtowc='undef'
d_mkstemp='undef'
d_mkstemps='undef'
d_mktime='undef'
+d_mmap='undef'
+d_modfl='undef'
d_mprotect='undef'
d_msg='undef'
d_msg_ctrunc='undef'
d_mymalloc='undef'
d_nice='undef'
d_nv_preserves_uv='undef'
+d_nv_preserves_uv_bits='0'
d_off64_t='undef'
d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_open3='undef'
d_pathconf='undef'
d_pause='undef'
+d_perl_otherlibdirs='undef'
d_phostname='undef'
d_pipe='undef'
d_poll='undef'
d_pwgecos='undef'
d_pwpasswd='undef'
d_pwquota='undef'
+d_qgcvt='undef'
d_quad='undef'
d_readdir='undef'
d_readlink='undef'
d_setruid='undef'
d_setsent='undef'
d_setsid='undef'
-d_setspent='undef'
d_setvbuf='undef'
d_sfio='undef'
d_shm='undef'
d_sigaction='undef'
d_sigsetjmp='undef'
d_socket='undef'
+d_socklen_t='undef'
d_sockpair='undef'
d_socks5_init='undef'
d_sqrtl='undef'
d_statfs_s='undef'
d_statvfs='undef'
d_stdio_cnt_lval='undef'
-d_stdio_ptr_lval_sets_cnt='undef'
+d_stdio_ptr_lval='undef'
d_stdio_ptr_lval_nochange_cnt='undef'
+d_stdio_ptr_lval_sets_cnt='undef'
d_stdio_stream_array='undef'
d_stdiobase='undef'
d_stdstdio='undef'
d_strtol='undef'
d_strtold='undef'
d_strtoll='undef'
+d_strtoq='undef'
d_strtoul='undef'
d_strtoull='undef'
d_strtouq='undef'
d_uname='undef'
d_union_semun='undef'
d_ustat='undef'
+d_vendorarch='undef'
d_vendorbin='undef'
d_vendorlib='undef'
d_vfork='undef'
i_gdbm='undef'
i_grp='undef'
i_iconv='undef'
+i_ieeefp='undef'
i_inttypes='undef'
i_libutil='undef'
i_limits='undef'
i_netinettcp='undef'
i_niin='undef'
i_poll='undef'
+i_prot='undef'
i_pthread='undef'
i_pwd='undef'
i_rpcsvcdbm='undef'
i_stddef='undef'
i_stdlib='undef'
i_string='define'
+i_sunmath='undef'
i_sysaccess='undef'
i_sysdir='undef'
i_sysfile='undef'
i_sysin='undef'
i_sysioctl='undef'
i_syslog='undef'
+i_sysmman='undef'
+i_sysmode='undef'
i_sysmount='undef'
i_sysndir='undef'
i_sysparam='undef'
i_systypes='undef'
i_sysuio='undef'
i_sysun='undef'
+i_sysutsname='undef'
i_sysvfs='undef'
i_syswait='undef'
i_termio='undef'
i_varhdr='stdarg.h'
i_vfork='undef'
ignore_versioned_solibs='y'
+inc_version_list_init='NULL'
installstyle='lib/perl5'
installusrbinperl='undef'
intsize='4'
phostname='hostname'
pidtype=int
pm_apiversion='5.005'
-privlib='/usr/local/lib/perl5/5.6'
-privlibexp='/usr/local/lib/perl5/5.6'
+privlib='/usr/local/lib/perl5/5.7'
+privlibexp='/usr/local/lib/perl5/5.7'
prototype='undef'
ptrsize=1
quadkind='4'
sPRIo64='"Lo"'
sPRIu64='"Lu"'
sPRIx64='"Lx"'
+sSCNfldbl='"llf"'
sched_yield='sched_yield()'
scriptdir='/usr/local/bin'
scriptdirexp='/usr/local/bin'
sig_name_init='0'
sig_num_init='0'
signal_t=int
-sizetype=int
sizesize=1
-sSCNfldbl='"llf"'
+sizetype=int
+socksizetype='int'
ssizetype=int
stdchar=char
stdio_base='((fp)->_IO_read_base)'
uidtype=int
uquadtype='uint64_t'
use5005threads='undef'
-use64bits='undef'
+use64bitall='undef'
+use64bitint='undef'
usedl='undef'
useithreads='undef'
uselargefiles='undef'
uselongdouble='undef'
-uselonglong='undef'
usemorebits='undef'
usemultiplicity='undef'
usemymalloc='n'
versiononly='undef'
voidflags=1
xs_apiversion='5.005'
-d_getfsstat='undef'
-d_int64_t='undef'
-d_lseekproto='undef'
-d_madvise='undef'
-d_mmap='undef'
-use64bitint='undef'
-use64bitall='undef'
-d_vendorarch='undef'
-d_vendorarch='undef'
-i_ieeefp='undef'
-i_sunmath='undef'
-i_sysmode='undef'
-i_sysutsname='undef'
-d_frexpl='undef'
-d_modfl='undef'
-d_getespwnam='undef'
-d_getprpwnam='undef'
-d_isnan='undef'
-d_isnanl='undef'
-i_prot='undef'
-d_perl_otherlibdirs='undef'
-inc_version_list_init='NULL'
-socksizetype='int'
-
-
=head1 SYNOPSIS
-B<h2xs> [B<-ACOPXacdfkmx>] [B<-F> addflags] [B<-M> fmask] [B<-n> module_name] [B<-o> tmask] [B<-p> prefix] [B<-s> subs] [B<-v> version] [headerfile ... [extra_libraries]]
+B<h2xs> [B<-ACOPXacdfkmx>] [B<-F> addflags] [B<-M> fmask] [B<-n> module_name] [B<-o> tmask] [B<-p> prefix] [B<-s> subs] [B<-v> version] [B<-b> compat_version] [headerfile ... [extra_libraries]]
B<h2xs> B<-h>
use ExtUtils::MakeMaker;
WriteMakefile( 'VERSION_FROM' => 'DCLsym.pm',
- 'MAN3PODS' => ' ');
+ 'MAN3PODS' => {});
use ExtUtils::MakeMaker;
WriteMakefile( 'VERSION_FROM' => 'Stdio.pm',
- 'MAN3PODS' => ' ', # pods will be built later
+ 'MAN3PODS' => {}, # pods will be built later
);
else {
open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n";
}
-%checkh = map { $_,1 } qw( thread bytecode byterun proto );
+%checkh = map { $_,1 } qw( thread bytecode byterun proto perlio );
$ckfunc = 0;
LINE: while (<CPP>) {
while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
https://perl5.git.perl.org / perl5.git / commitdiff