summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Changes193
-rw-r--r--bytecode.pl1
-rwxr-xr-xembed.pl20
-rw-r--r--ext/B/B.xs10
-rw-r--r--ext/B/B/Asmdata.pm55
-rw-r--r--ext/B/B/Bytecode.pm9
-rw-r--r--ext/B/B/C.pm13
-rw-r--r--ext/ByteLoader/byterun.c61
-rw-r--r--ext/ByteLoader/byterun.h57
-rw-r--r--keywords.h191
-rwxr-xr-xkeywords.pl1
-rw-r--r--lib/Pod/Man.pm14
-rw-r--r--mg.c35
-rw-r--r--op.c20
-rw-r--r--op.h3
-rw-r--r--patchlevel.h2
-rw-r--r--pod/perlapi.pod90
-rw-r--r--pp.c17
-rw-r--r--pp.h2
-rw-r--r--pp_ctl.c9
-rw-r--r--pp_hot.c2
-rw-r--r--regcomp.c5
-rw-r--r--sv.c2
-rw-r--r--t/lib/charnames.t2
-rw-r--r--t/op/length.t3
-rwxr-xr-xt/op/substr.t121
-rwxr-xr-xt/pragma/utf8.t14
-rw-r--r--thrdvar.h17
-rw-r--r--toke.c30
-rw-r--r--utf8.c47
-rw-r--r--util.c4
-rw-r--r--win32/Makefile20
32 files changed, 729 insertions, 341 deletions
diff --git a/Changes b/Changes
index 001e84c01d..1ae116613b 100644
--- a/Changes
+++ b/Changes
@@ -32,6 +32,199 @@ Version v5.7.1 Development release working toward v5.8
--------------
____________________________________________________________________________
+[ 8452] By: jhi on 2001/01/16 15:42:04
+ Log: Subject: Re: API Cleanup
+ To: perl5-porters@perl.org
+ Date: Tue, 16 Jan 2001 13:42:30 +0000
+ Message-ID: <20010116134230.A13420@pembro26.pmb.ox.ac.uk>
+
+ Subject: [PATCH] utf8.c documentation
+ From: Simon Cozens <simon@cozens.net>
+ Date: Tue, 16 Jan 2001 13:52:48 +0000
+ Message-ID: <20010116135248.A13496@pembro26.pmb.ox.ac.uk>
+
+ Subject: Re: API Cleanup
+ From: Simon Cozens <simon@cozens.net>
+ Date: Tue, 16 Jan 2001 14:58:55 +0000
+ Message-ID: <20010116145855.A13794@pembro26.pmb.ox.ac.uk>
+
+ UTF-8 doc patches.
+ Branch: perl
+ ! embed.pl pod/perlapi.pod utf8.c
+____________________________________________________________________________
+[ 8451] By: jhi on 2001/01/16 14:41:39
+ Log: podlators 1.07, from Russ Allbery.
+ Branch: perl
+ ! lib/Pod/Man.pm
+____________________________________________________________________________
+[ 8450] By: jhi on 2001/01/16 14:24:19
+ Log: Subject: [PATCH: perl@8429] Win32 Makefile fixes
+ From: "Indy Singh" <indy@nusphere.com>
+ Date: Mon, 15 Jan 2001 20:59:40 -0500
+ Message-ID: <07be01c07f5f$fdadf270$d24b7018@cr637287a>
+ Branch: perl
+ ! win32/Makefile
+____________________________________________________________________________
+[ 8449] By: jhi on 2001/01/16 03:42:55
+ Log: Under 5.005 threads and debugging crashed in Debian 2.2 Linux/x86
+ at the setting of the ofs_sv in new_struct_thread() as the
+ thr->Tofs_sv (PL_ofs_sv) was still 0xabab...., SvREFCNT_inc()ing
+ that invited a core dump.
+ Branch: perl
+ ! util.c
+____________________________________________________________________________
+[ 8448] By: jhi on 2001/01/16 01:49:07
+ Log: Subject: [PATCH #3 @8436] Re: Eliminate op_children
+ From: Stephen McCamant <smcc@CSUA.Berkeley.EDU>
+ Date: Mon, 15 Jan 2001 17:14:37 -0800 (PST)
+ Message-ID: <14947.40656.841280.551785@soda.csua.berkeley.edu>
+
+ Replace #8444 and #8445.
+ Branch: perl
+ ! ext/B/B.xs ext/B/B/Debug.pm
+____________________________________________________________________________
+[ 8447] By: jhi on 2001/01/15 21:05:35
+ Log: Subject: [PATCH] API Variable documentation
+ From: Simon Cozens <simon@cozens.net>
+ Date: Mon, 15 Jan 2001 19:35:54 +0000
+ Message-ID: <20010115193554.A9919@pembro26.pmb.ox.ac.uk>
+ Branch: perl
+ ! pod/perlapi.pod thrdvar.h
+____________________________________________________________________________
+[ 8446] By: jhi on 2001/01/15 20:49:20
+ Log: Signedness nit.
+ Branch: perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 8445] By: jhi on 2001/01/15 20:28:48
+ Log: (Replaced by #8448) More op_children traces (cleanup of #8442).
+ Branch: perl
+ ! ext/B/B/Debug.pm
+____________________________________________________________________________
+[ 8444] By: jhi on 2001/01/15 13:09:10
+ Log: (Replaced by #8448) Traces of op_children (cleanup of #8442)
+ Branch: perl
+ ! ext/B/B.xs
+____________________________________________________________________________
+[ 8443] By: jhi on 2001/01/15 13:06:26
+ Log: Missing from #8439.
+ Branch: perl
+ ! keywords.h mg.c
+____________________________________________________________________________
+[ 8442] By: jhi on 2001/01/15 13:02:38
+ Log: Subject: [PATCH @8436] Eliminate op_children
+ From: Stephen McCamant <smcc@CSUA.Berkeley.EDU>
+ Date: Sun, 14 Jan 2001 03:00:13 -0800 (PST)
+ Message-ID: <14945.32919.44271.685122@soda.csua.berkeley.edu>
+
+ Subject: [PATCH @8436] Re: Eliminate op_children
+ From: Stephen McCamant <smcc@CSUA.Berkeley.EDU>
+ Date: Sun, 14 Jan 2001 03:23:56 -0800 (PST)
+ Message-ID: <14945.35680.571387.810763@soda.csua.berkeley.edu>
+ Branch: perl
+ ! bytecode.pl ext/B/B/Asmdata.pm ext/B/B/Bytecode.pm
+ ! ext/B/B/C.pm ext/ByteLoader/byterun.c ext/ByteLoader/byterun.h
+ ! op.c op.h
+____________________________________________________________________________
+[ 8441] By: jhi on 2001/01/15 12:57:08
+ Log: Use the /^Perl_/-less form of is_lvalue_sub().
+ Branch: perl
+ ! pp.h
+____________________________________________________________________________
+[ 8440] By: jhi on 2001/01/15 05:13:09
+ Log: Revert #8437 and #8438, the Linux large files story is more complex.
+ Branch: metaconfig/U/perl
+ ! d_fpos64_t.U d_off64_t.U
+ Branch: perl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH configure.com epoc/config.sh perl.h
+ ! pod/perltoc.pod uconfig.h uconfig.sh 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
+____________________________________________________________________________
+[ 8439] By: jhi on 2001/01/15 05:02:24
+ Log: More UTF-8 patches from Inaba Hiroto.
+ - The substr lval was still not okay.
+ - Now pp_stringify and sv_setsv copies source's UTF8 flag
+ even if IN_BYTE. pp_stringify is called from fold_constants
+ at optimization phase and "\x{100}" was made SvUTF8_off under
+ use bytes (the bytes pragma is for "byte semantics" and not
+ for "do not produce UTF8 data")
+ - New `qu' operator to generate UTF8 string explicitly.
+ Though I agree with the policy "0x00-0xff always produce bytes",
+ sometimes want to such a string to be coded in UTF8.
+ I can use pack"U0a*" but it requires more typing and has
+ runtime overhead.
+ - Fix pp_regcomp bug uncovered by "0x00-0xff always produce bytes"
+ change, the bug apears if a pm has PMdf_UTF8 flag but interpolated
+ string is not UTF8_on and has char 0x80-0xff.
+
+ TODO: document and test qu.
+ Branch: perl
+ ! keywords.h keywords.pl mg.c pp.c pp_ctl.c pp_hot.c sv.c
+ ! t/lib/charnames.t t/op/length.t t/op/substr.t t/pragma/utf8.t
+ ! toke.c
+____________________________________________________________________________
+[ 8438] By: jhi on 2001/01/14 05:10:23
+ Log: Metaconfig unit changes for #8437.
+ Branch: metaconfig/U/perl
+ ! d_fpos64_t.U d_off64_t.U
+____________________________________________________________________________
+[ 8437] By: jhi on 2001/01/14 04:55:34
+ Log: Add <features.h> probing, seems to be needed for (some?)
+ Linux largefileness.
+ Branch: perl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH configure.com epoc/config.sh perl.h
+ ! pod/perltoc.pod uconfig.h uconfig.sh 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
+____________________________________________________________________________
+[ 8436] By: jhi on 2001/01/13 17:47:21
+ Log: Tighten some of the tests a bit.
+ Branch: perl
+ ! t/pragma/utf8.t
+____________________________________________________________________________
+[ 8435] By: jhi on 2001/01/13 17:31:54
+ Log: Integrate perlio.
+ Branch: perl
+ !> ext/Encode/Makefile.PL ext/Encode/compile win32/config_H.bc
+ !> win32/config_H.gc win32/config_H.vc
+____________________________________________________________________________
+[ 8434] By: nick on 2001/01/13 11:36:53
+ Log: Run dmake regen_config_h for Win32
+ Branch: perlio
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+____________________________________________________________________________
+[ 8433] By: nick on 2001/01/13 11:31:55
+ Log: VMS friendly patch to Encode compile process
+ Branch: perlio
+ ! ext/Encode/Makefile.PL ext/Encode/compile
+____________________________________________________________________________
+[ 8432] By: nick on 2001/01/13 11:06:44
+ Log: Integrate mainline
+ Branch: perlio
+ +> ext/B/B/Concise.pm
+ !> (integrate 52 files)
+____________________________________________________________________________
+[ 8431] By: jhi on 2001/01/13 05:55:55
+ Log: Subject: [PATCH @8429] Re: B::Concise -- an improved replacement for B::Terse
+ From: Stephen McCamant <smcc@CSUA.Berkeley.EDU>
+ Date: Fri, 12 Jan 2001 21:45:17 -0800 (PST)
+ Message-ID: <14943.59712.993695.180189@soda.csua.berkeley.edu>
+ Branch: perl
+ ! ext/B/B/Concise.pm
+____________________________________________________________________________
+[ 8430] By: jhi on 2001/01/13 04:24:18
+ Log: The LVRET macro needed an aTHX.
+ Branch: perl
+ ! pp.h
+____________________________________________________________________________
+[ 8429] By: jhi on 2001/01/13 02:12:42
+ Log: Update Changes.
+ Branch: perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
[ 8428] By: jhi on 2001/01/13 02:08:50
Log: Subject: Re: [PATCH: perl@8342] lib/bigfloat.t FAILED at test 351
From: Peter Prymmer <pvhp@forte.com>
diff --git a/bytecode.pl b/bytecode.pl
index 8d77620be7..4b00e14b9a 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -379,7 +379,6 @@ op_private PL_op->op_private U8
op_first cUNOP->op_first opindex
op_last cBINOP->op_last opindex
op_other cLOGOP->op_other opindex
-op_children cLISTOP->op_children U32
op_pmreplroot cPMOP->op_pmreplroot opindex
op_pmreplrootgv *(SV**)&cPMOP->op_pmreplroot svindex
op_pmreplstart cPMOP->op_pmreplstart opindex
diff --git a/embed.pl b/embed.pl
index 7621f661c4..371ba583bb 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1628,8 +1628,8 @@ Ap |bool |is_uni_xdigit_lc|U32 c
Ap |U32 |to_uni_upper_lc|U32 c
Ap |U32 |to_uni_title_lc|U32 c
Ap |U32 |to_uni_lower_lc|U32 c
-Ap |STRLEN |is_utf8_char |U8 *p
-Ap |bool |is_utf8_string |U8 *s|STRLEN len
+Apd |STRLEN |is_utf8_char |U8 *p
+Apd |bool |is_utf8_string |U8 *s|STRLEN len
Ap |bool |is_utf8_alnum |U8 *p
Ap |bool |is_utf8_alnumc |U8 *p
Ap |bool |is_utf8_idfirst|U8 *p
@@ -2077,14 +2077,14 @@ p |void |unshare_hek |HEK* hek
p |void |utilize |int aver|I32 floor|OP* version|OP* id|OP* arg
Ap |U8* |utf16_to_utf8 |U8* p|U8 *d|I32 bytelen|I32 *newlen
Ap |U8* |utf16_to_utf8_reversed|U8* p|U8 *d|I32 bytelen|I32 *newlen
-Ap |STRLEN |utf8_length |U8* s|U8 *e
-Ap |IV |utf8_distance |U8 *a|U8 *b
-Ap |U8* |utf8_hop |U8 *s|I32 off
-ApM |U8* |utf8_to_bytes |U8 *s|STRLEN *len
-ApM |U8* |bytes_to_utf8 |U8 *s|STRLEN *len
-Ap |UV |utf8_to_uv_simple|U8 *s|STRLEN* retlen
-Ap |UV |utf8_to_uv |U8 *s|STRLEN curlen|STRLEN* retlen|U32 flags
-Ap |U8* |uv_to_utf8 |U8 *d|UV uv
+Adp |STRLEN |utf8_length |U8* s|U8 *e
+Apd |IV |utf8_distance |U8 *a|U8 *b
+Apd |U8* |utf8_hop |U8 *s|I32 off
+ApMd |U8* |utf8_to_bytes |U8 *s|STRLEN *len
+ApMd |U8* |bytes_to_utf8 |U8 *s|STRLEN *len
+Apd |UV |utf8_to_uv_simple|U8 *s|STRLEN* retlen
+Adp |UV |utf8_to_uv |U8 *s|STRLEN curlen|STRLEN* retlen|U32 flags
+Apd |U8* |uv_to_utf8 |U8 *d|UV uv
p |void |vivify_defelem |SV* sv
p |void |vivify_ref |SV* sv|U32 to_what
p |I32 |wait4pid |Pid_t pid|int* statusp|int flags
diff --git a/ext/B/B.xs b/ext/B/B.xs
index ec9e578020..25d69e97bd 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -648,13 +648,19 @@ B::OP
LOGOP_other(o)
B::LOGOP o
-#define LISTOP_children(o) o->op_children
-
MODULE = B PACKAGE = B::LISTOP PREFIX = LISTOP_
U32
LISTOP_children(o)
B::LISTOP o
+ OP * kid = NO_INIT
+ int i = NO_INIT
+ CODE:
+ ST(0) = sv_newmortal();
+ i = 0;
+ for (kid = o->op_first; kid; kid = kid->op_sibling)
+ i++;
+ sv_setiv(ST(0), i);
#define PMOP_pmreplroot(o) o->op_pmreplroot
#define PMOP_pmreplstart(o) o->op_pmreplstart
diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm
index b412927ab4..dc176be962 100644
--- a/ext/B/B/Asmdata.pm
+++ b/ext/B/B/Asmdata.pm
@@ -114,34 +114,33 @@ $insn_data{op_private} = [90, \&PUT_U8, "GET_U8"];
$insn_data{op_first} = [91, \&PUT_opindex, "GET_opindex"];
$insn_data{op_last} = [92, \&PUT_opindex, "GET_opindex"];
$insn_data{op_other} = [93, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_children} = [94, \&PUT_U32, "GET_U32"];
-$insn_data{op_pmreplroot} = [95, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_pmreplrootgv} = [96, \&PUT_svindex, "GET_svindex"];
-$insn_data{op_pmreplstart} = [97, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_pmnext} = [98, \&PUT_opindex, "GET_opindex"];
-$insn_data{pregcomp} = [99, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{op_pmflags} = [100, \&PUT_U16, "GET_U16"];
-$insn_data{op_pmpermflags} = [101, \&PUT_U16, "GET_U16"];
-$insn_data{op_sv} = [102, \&PUT_svindex, "GET_svindex"];
-$insn_data{op_padix} = [103, \&PUT_U32, "GET_U32"];
-$insn_data{op_pv} = [104, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{op_pv_tr} = [105, \&PUT_op_tr_array, "GET_op_tr_array"];
-$insn_data{op_redoop} = [106, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_nextop} = [107, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_lastop} = [108, \&PUT_opindex, "GET_opindex"];
-$insn_data{cop_label} = [109, \&PUT_pvindex, "GET_pvindex"];
-$insn_data{cop_stashpv} = [110, \&PUT_pvindex, "GET_pvindex"];
-$insn_data{cop_file} = [111, \&PUT_pvindex, "GET_pvindex"];
-$insn_data{cop_seq} = [112, \&PUT_U32, "GET_U32"];
-$insn_data{cop_arybase} = [113, \&PUT_I32, "GET_I32"];
-$insn_data{cop_line} = [114, \&PUT_U16, "GET_U16"];
-$insn_data{cop_warnings} = [115, \&PUT_svindex, "GET_svindex"];
-$insn_data{main_start} = [116, \&PUT_opindex, "GET_opindex"];
-$insn_data{main_root} = [117, \&PUT_opindex, "GET_opindex"];
-$insn_data{curpad} = [118, \&PUT_svindex, "GET_svindex"];
-$insn_data{push_begin} = [119, \&PUT_svindex, "GET_svindex"];
-$insn_data{push_init} = [120, \&PUT_svindex, "GET_svindex"];
-$insn_data{push_end} = [121, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_pmreplroot} = [94, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmreplrootgv} = [95, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_pmreplstart} = [96, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmnext} = [97, \&PUT_opindex, "GET_opindex"];
+$insn_data{pregcomp} = [98, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pmflags} = [99, \&PUT_U16, "GET_U16"];
+$insn_data{op_pmpermflags} = [100, \&PUT_U16, "GET_U16"];
+$insn_data{op_sv} = [101, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_padix} = [102, \&PUT_U32, "GET_U32"];
+$insn_data{op_pv} = [103, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pv_tr} = [104, \&PUT_op_tr_array, "GET_op_tr_array"];
+$insn_data{op_redoop} = [105, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_nextop} = [106, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_lastop} = [107, \&PUT_opindex, "GET_opindex"];
+$insn_data{cop_label} = [108, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_stashpv} = [109, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_file} = [110, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_seq} = [111, \&PUT_U32, "GET_U32"];
+$insn_data{cop_arybase} = [112, \&PUT_I32, "GET_I32"];
+$insn_data{cop_line} = [113, \&PUT_U16, "GET_U16"];
+$insn_data{cop_warnings} = [114, \&PUT_svindex, "GET_svindex"];
+$insn_data{main_start} = [115, \&PUT_opindex, "GET_opindex"];
+$insn_data{main_root} = [116, \&PUT_opindex, "GET_opindex"];
+$insn_data{curpad} = [117, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_begin} = [118, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_init} = [119, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_end} = [120, \&PUT_svindex, "GET_svindex"];
my ($insn_name, $insn_data);
while (($insn_name, $insn_data) = each %insn_data) {
diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
index bea023a038..54d7c533c8 100644
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -312,15 +312,6 @@ sub B::BINOP::bytecode {
}
}
-sub B::LISTOP::bytecode {
- my $op = shift;
- my $children = $op->children unless $strip_syntree;
- $op->B::BINOP::bytecode;
- if (($op->type || !$compress_nullops) && !$strip_syntree) {
- asm "op_children $children\n";
- }
-}
-
sub B::LOOP::bytecode {
my $op = shift;
my $redoopix = $op->redoop->objix;
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index dac9417806..54fa46fb4f 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -225,11 +225,10 @@ sub B::LISTOP::save {
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $listopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u",
+ $listopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
${$op->next}, ${$op->sibling},
$op->targ, $op->type, $op_seq, $op->flags,
- $op->private, ${$op->first}, ${$op->last},
- $op->children));
+ $op->private, ${$op->first}, ${$op->last}));
my $ix = $listopsect->index;
$init->add(sprintf("listop_list[$ix].op_ppaddr = %s;", $op->ppaddr));
savesym($op, "(OP*)&listop_list[$ix]");
@@ -255,11 +254,11 @@ sub B::LOOP::save {
#warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n",
# peekop($op->redoop), peekop($op->nextop),
# peekop($op->lastop)); # debug
- $loopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, s\\_%x, s\\_%x, s\\_%x",
+ $loopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x",
${$op->next}, ${$op->sibling},
$op->targ, $op->type, $op_seq, $op->flags,
$op->private, ${$op->first}, ${$op->last},
- $op->children, ${$op->redoop}, ${$op->nextop},
+ ${$op->redoop}, ${$op->nextop},
${$op->lastop}));
my $ix = $loopsect->index;
$init->add(sprintf("loop_list[$ix].op_ppaddr = %s;", $op->ppaddr));
@@ -351,10 +350,10 @@ sub B::PMOP::save {
# pmnext handling is broken in perl itself, I think. Bad op_pmnext
# fields aren't noticed in perl's runtime (unless you try reset) but we
# segfault when trying to dereference it to find op->op_pmnext->op_type
- $pmopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, 0x%x, 0x%x",
+ $pmopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %s, %s, 0, 0, 0x%x, 0x%x",
${$op->next}, ${$op->sibling}, $op->targ,
$op->type, $op_seq, $op->flags, $op->private,
- ${$op->first}, ${$op->last}, $op->children,
+ ${$op->first}, ${$op->last},
$replrootfield, $replstartfield,
$op->pmflags, $op->pmpermflags,));
my $pm = sprintf("pmop_list[%d]", $pmopsect->index);
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
index 3e12790fb0..71cd8aa084 100644
--- a/ext/ByteLoader/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -719,196 +719,189 @@ byterun(pTHXo_ register struct byteloader_state *bstate)
cLOGOP->op_other = arg;
break;
}
- case INSN_OP_CHILDREN: /* 94 */
- {
- U32 arg;
- BGET_U32(arg);
- cLISTOP->op_children = arg;
- break;
- }
- case INSN_OP_PMREPLROOT: /* 95 */
+ case INSN_OP_PMREPLROOT: /* 94 */
{
opindex arg;
BGET_opindex(arg);
cPMOP->op_pmreplroot = arg;
break;
}
- case INSN_OP_PMREPLROOTGV: /* 96 */
+ case INSN_OP_PMREPLROOTGV: /* 95 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&cPMOP->op_pmreplroot = arg;
break;
}
- case INSN_OP_PMREPLSTART: /* 97 */
+ case INSN_OP_PMREPLSTART: /* 96 */
{
opindex arg;
BGET_opindex(arg);
cPMOP->op_pmreplstart = arg;
break;
}
- case INSN_OP_PMNEXT: /* 98 */
+ case INSN_OP_PMNEXT: /* 97 */
{
opindex arg;
BGET_opindex(arg);
*(OP**)&cPMOP->op_pmnext = arg;
break;
}
- case INSN_PREGCOMP: /* 99 */
+ case INSN_PREGCOMP: /* 98 */
{
pvcontents arg;
BGET_pvcontents(arg);
BSET_pregcomp(PL_op, arg);
break;
}
- case INSN_OP_PMFLAGS: /* 100 */
+ case INSN_OP_PMFLAGS: /* 99 */
{
U16 arg;
BGET_U16(arg);
cPMOP->op_pmflags = arg;
break;
}
- case INSN_OP_PMPERMFLAGS: /* 101 */
+ case INSN_OP_PMPERMFLAGS: /* 100 */
{
U16 arg;
BGET_U16(arg);
cPMOP->op_pmpermflags = arg;
break;
}
- case INSN_OP_SV: /* 102 */
+ case INSN_OP_SV: /* 101 */
{
svindex arg;
BGET_svindex(arg);
cSVOP->op_sv = arg;
break;
}
- case INSN_OP_PADIX: /* 103 */
+ case INSN_OP_PADIX: /* 102 */
{
PADOFFSET arg;
BGET_U32(arg);
cPADOP->op_padix = arg;
break;
}
- case INSN_OP_PV: /* 104 */
+ case INSN_OP_PV: /* 103 */
{
pvcontents arg;
BGET_pvcontents(arg);
cPVOP->op_pv = arg;
break;
}
- case INSN_OP_PV_TR: /* 105 */
+ case INSN_OP_PV_TR: /* 104 */
{
op_tr_array arg;
BGET_op_tr_array(arg);
cPVOP->op_pv = arg;
break;
}
- case INSN_OP_REDOOP: /* 106 */
+ case INSN_OP_REDOOP: /* 105 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_redoop = arg;
break;
}
- case INSN_OP_NEXTOP: /* 107 */
+ case INSN_OP_NEXTOP: /* 106 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_nextop = arg;
break;
}
- case INSN_OP_LASTOP: /* 108 */
+ case INSN_OP_LASTOP: /* 107 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_lastop = arg;
break;
}
- case INSN_COP_LABEL: /* 109 */
+ case INSN_COP_LABEL: /* 108 */
{
pvindex arg;
BGET_pvindex(arg);
cCOP->cop_label = arg;
break;
}
- case INSN_COP_STASHPV: /* 110 */
+ case INSN_COP_STASHPV: /* 109 */
{
pvindex arg;
BGET_pvindex(arg);
BSET_cop_stashpv(cCOP, arg);
break;
}
- case INSN_COP_FILE: /* 111 */
+ case INSN_COP_FILE: /* 110 */
{
pvindex arg;
BGET_pvindex(arg);
BSET_cop_file(cCOP, arg);
break;
}
- case INSN_COP_SEQ: /* 112 */
+ case INSN_COP_SEQ: /* 111 */
{
U32 arg;
BGET_U32(arg);
cCOP->cop_seq = arg;
break;
}
- case INSN_COP_ARYBASE: /* 113 */
+ case INSN_COP_ARYBASE: /* 112 */
{
I32 arg;
BGET_I32(arg);
cCOP->cop_arybase = arg;
break;
}
- case INSN_COP_LINE: /* 114 */
+ case INSN_COP_LINE: /* 113 */
{
line_t arg;
BGET_U16(arg);
BSET_cop_line(cCOP, arg);
break;
}
- case INSN_COP_WARNINGS: /* 115 */
+ case INSN_COP_WARNINGS: /* 114 */
{
svindex arg;
BGET_svindex(arg);
cCOP->cop_warnings = arg;
break;
}
- case INSN_MAIN_START: /* 116 */
+ case INSN_MAIN_START: /* 115 */
{
opindex arg;
BGET_opindex(arg);
PL_main_start = arg;
break;
}
- case INSN_MAIN_ROOT: /* 117 */
+ case INSN_MAIN_ROOT: /* 116 */
{
opindex arg;
BGET_opindex(arg);
PL_main_root = arg;
break;
}
- case INSN_CURPAD: /* 118 */
+ case INSN_CURPAD: /* 117 */
{
svindex arg;
BGET_svindex(arg);
BSET_curpad(PL_curpad, arg);
break;
}
- case INSN_PUSH_BEGIN: /* 119 */
+ case INSN_PUSH_BEGIN: /* 118 */
{
svindex arg;
BGET_svindex(arg);
BSET_push_begin(PL_beginav, arg);
break;
}
- case INSN_PUSH_INIT: /* 120 */
+ case INSN_PUSH_INIT: /* 119 */
{
svindex arg;
BGET_svindex(arg);
BSET_push_init(PL_initav, arg);
break;
}
- case INSN_PUSH_END: /* 121 */
+ case INSN_PUSH_END: /* 120 */
{
svindex arg;
BGET_svindex(arg);
diff --git a/ext/ByteLoader/byterun.h b/ext/ByteLoader/byterun.h
index 1e67b8967e..f074f2d6cf 100644
--- a/ext/ByteLoader/byterun.h
+++ b/ext/ByteLoader/byterun.h
@@ -122,35 +122,34 @@ enum {
INSN_OP_FIRST, /* 91 */
INSN_OP_LAST, /* 92 */
INSN_OP_OTHER, /* 93 */
- INSN_OP_CHILDREN, /* 94 */
- INSN_OP_PMREPLROOT, /* 95 */
- INSN_OP_PMREPLROOTGV, /* 96 */
- INSN_OP_PMREPLSTART, /* 97 */
- INSN_OP_PMNEXT, /* 98 */
- INSN_PREGCOMP, /* 99 */
- INSN_OP_PMFLAGS, /* 100 */
- INSN_OP_PMPERMFLAGS, /* 101 */
- INSN_OP_SV, /* 102 */
- INSN_OP_PADIX, /* 103 */
- INSN_OP_PV, /* 104 */
- INSN_OP_PV_TR, /* 105 */
- INSN_OP_REDOOP, /* 106 */
- INSN_OP_NEXTOP, /* 107 */
- INSN_OP_LASTOP, /* 108 */
- INSN_COP_LABEL, /* 109 */
- INSN_COP_STASHPV, /* 110 */
- INSN_COP_FILE, /* 111 */
- INSN_COP_SEQ, /* 112 */
- INSN_COP_ARYBASE, /* 113 */
- INSN_COP_LINE, /* 114 */
- INSN_COP_WARNINGS, /* 115 */
- INSN_MAIN_START, /* 116 */
- INSN_MAIN_ROOT, /* 117 */
- INSN_CURPAD, /* 118 */
- INSN_PUSH_BEGIN, /* 119 */
- INSN_PUSH_INIT, /* 120 */
- INSN_PUSH_END, /* 121 */
- MAX_INSN = 121
+ INSN_OP_PMREPLROOT, /* 94 */
+ INSN_OP_PMREPLROOTGV, /* 95 */
+ INSN_OP_PMREPLSTART, /* 96 */
+ INSN_OP_PMNEXT, /* 97 */
+ INSN_PREGCOMP, /* 98 */
+ INSN_OP_PMFLAGS, /* 99 */
+ INSN_OP_PMPERMFLAGS, /* 100 */
+ INSN_OP_SV, /* 101 */
+ INSN_OP_PADIX, /* 102 */
+ INSN_OP_PV, /* 103 */
+ INSN_OP_PV_TR, /* 104 */
+ INSN_OP_REDOOP, /* 105 */
+ INSN_OP_NEXTOP, /* 106 */
+ INSN_OP_LASTOP, /* 107 */
+ INSN_COP_LABEL, /* 108 */
+ INSN_COP_STASHPV, /* 109 */
+ INSN_COP_FILE, /* 110 */
+ INSN_COP_SEQ, /* 111 */
+ INSN_COP_ARYBASE, /* 112 */
+ INSN_COP_LINE, /* 113 */
+ INSN_COP_WARNINGS, /* 114 */
+ INSN_MAIN_START, /* 115 */
+ INSN_MAIN_ROOT, /* 116 */
+ INSN_CURPAD, /* 117 */
+ INSN_PUSH_BEGIN, /* 118 */
+ INSN_PUSH_INIT, /* 119 */
+ INSN_PUSH_END, /* 120 */
+ MAX_INSN = 120
};
enum {
diff --git a/keywords.h b/keywords.h
index 334304149f..75540ed5ca 100644
--- a/keywords.h
+++ b/keywords.h
@@ -155,98 +155,99 @@
#define KEY_qq 154
#define KEY_qr 155
#define KEY_quotemeta 156
-#define KEY_qw 157
-#define KEY_qx 158
-#define KEY_rand 159
-#define KEY_read 160
-#define KEY_readdir 161
-#define KEY_readline 162
-#define KEY_readlink 163
-#define KEY_readpipe 164
-#define KEY_recv 165
-#define KEY_redo 166
-#define KEY_ref 167
-#define KEY_rename 168
-#define KEY_require 169
-#define KEY_reset 170
-#define KEY_return 171
-#define KEY_reverse 172
-#define KEY_rewinddir 173
-#define KEY_rindex 174
-#define KEY_rmdir 175
-#define KEY_s 176
-#define KEY_scalar 177
-#define KEY_seek 178
-#define KEY_seekdir 179
-#define KEY_select 180
-#define KEY_semctl 181
-#define KEY_semget 182
-#define KEY_semop 183
-#define KEY_send 184
-#define KEY_setgrent 185
-#define KEY_sethostent 186
-#define KEY_setnetent 187
-#define KEY_setpgrp 188
-#define KEY_setpriority 189
-#define KEY_setprotoent 190
-#define KEY_setpwent 191
-#define KEY_setservent 192
-#define KEY_setsockopt 193
-#define KEY_shift 194
-#define KEY_shmctl 195
-#define KEY_shmget 196
-#define KEY_shmread 197
-#define KEY_shmwrite 198
-#define KEY_shutdown 199
-#define KEY_sin 200
-#define KEY_sleep 201
-#define KEY_socket 202
-#define KEY_socketpair 203
-#define KEY_sort 204
-#define KEY_splice 205
-#define KEY_split 206
-#define KEY_sprintf 207
-#define KEY_sqrt 208
-#define KEY_srand 209
-#define KEY_stat 210
-#define KEY_study 211
-#define KEY_sub 212
-#define KEY_substr 213
-#define KEY_symlink 214
-#define KEY_syscall 215
-#define KEY_sysopen 216
-#define KEY_sysread 217
-#define KEY_sysseek 218
-#define KEY_system 219
-#define KEY_syswrite 220
-#define KEY_tell 221
-#define KEY_telldir 222
-#define KEY_tie 223
-#define KEY_tied 224
-#define KEY_time 225
-#define KEY_times 226
-#define KEY_tr 227
-#define KEY_truncate 228
-#define KEY_uc 229
-#define KEY_ucfirst 230
-#define KEY_umask 231
-#define KEY_undef 232
-#define KEY_unless 233
-#define KEY_unlink 234
-#define KEY_unpack 235
-#define KEY_unshift 236
-#define KEY_untie 237
-#define KEY_until 238
-#define KEY_use 239
-#define KEY_utime 240
-#define KEY_values 241
-#define KEY_vec 242
-#define KEY_wait 243
-#define KEY_waitpid 244
-#define KEY_wantarray 245
-#define KEY_warn 246
-#define KEY_while 247
-#define KEY_write 248
-#define KEY_x 249
-#define KEY_xor 250
-#define KEY_y 251
+#define KEY_qu 157
+#define KEY_qw 158
+#define KEY_qx 159
+#define KEY_rand 160
+#define KEY_read 161
+#define KEY_readdir 162
+#define KEY_readline 163
+#define KEY_readlink 164
+#define KEY_readpipe 165
+#define KEY_recv 166
+#define KEY_redo 167
+#define KEY_ref 168
+#define KEY_rename 169
+#define KEY_require 170
+#define KEY_reset 171
+#define KEY_return 172
+#define KEY_reverse 173
+#define KEY_rewinddir 174
+#define KEY_rindex 175
+#define KEY_rmdir 176
+#define KEY_s 177
+#define KEY_scalar 178
+#define KEY_seek 179
+#define KEY_seekdir 180
+#define KEY_select 181
+#define KEY_semctl 182
+#define KEY_semget 183
+#define KEY_semop 184
+#define KEY_send 185
+#define KEY_setgrent 186
+#define KEY_sethostent 187
+#define KEY_setnetent 188
+#define KEY_setpgrp 189
+#define KEY_setpriority 190
+#define KEY_setprotoent 191
+#define KEY_setpwent 192
+#define KEY_setservent 193
+#define KEY_setsockopt 194
+#define KEY_shift 195
+#define KEY_shmctl 196
+#define KEY_shmget 197
+#define KEY_shmread 198
+#define KEY_shmwrite 199
+#define KEY_shutdown 200
+#define KEY_sin 201
+#define KEY_sleep 202
+#define KEY_socket 203
+#define KEY_socketpair 204
+#define KEY_sort 205
+#define KEY_splice 206
+#define KEY_split 207
+#define KEY_sprintf 208
+#define KEY_sqrt 209
+#define KEY_srand 210
+#define KEY_stat 211
+#define KEY_study 212
+#define KEY_sub 213
+#define KEY_substr 214
+#define KEY_symlink 215
+#define KEY_syscall 216
+#define KEY_sysopen 217
+#define KEY_sysread 218
+#define KEY_sysseek 219
+#define KEY_system 220
+#define KEY_syswrite 221
+#define KEY_tell 222
+#define KEY_telldir 223
+#define KEY_tie 224
+#define KEY_tied 225
+#define KEY_time 226
+#define KEY_times 227
+#define KEY_tr 228
+#define KEY_truncate 229
+#define KEY_uc 230
+#define KEY_ucfirst 231
+#define KEY_umask 232
+#define KEY_undef 233
+#define KEY_unless 234
+#define KEY_unlink 235
+#define KEY_unpack 236
+#define KEY_unshift 237
+#define KEY_untie 238
+#define KEY_until 239
+#define KEY_use 240
+#define KEY_utime 241
+#define KEY_values 242
+#define KEY_vec 243
+#define KEY_wait 244
+#define KEY_waitpid 245
+#define KEY_wantarray 246
+#define KEY_warn 247
+#define KEY_while 248
+#define KEY_write 249
+#define KEY_x 250
+#define KEY_xor 251
+#define KEY_y 252
diff --git a/keywords.pl b/keywords.pl
index 46dd53d70e..06ee8f3efc 100755
--- a/keywords.pl
+++ b/keywords.pl
@@ -181,6 +181,7 @@ q
qq
qr
quotemeta
+qu
qw
qx
rand
diff --git a/lib/Pod/Man.pm b/lib/Pod/Man.pm
index 84c8f6671b..2c61a9b233 100644
--- a/lib/Pod/Man.pm
+++ b/lib/Pod/Man.pm
@@ -1,7 +1,7 @@
# Pod::Man -- Convert POD data to formatted *roff input.
-# $Id: Man.pm,v 1.12 2000/12/25 12:56:12 eagle Exp $
+# $Id: Man.pm,v 1.14 2001/01/16 13:39:45 eagle Exp $
#
-# Copyright 1999, 2000 by Russ Allbery <rra@stanford.edu>
+# Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
@@ -38,7 +38,7 @@ use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION);
# Perl core and too many things could munge CVS magic revision strings.
# This number should ideally be the same as the CVS revision in podlators,
# however.
-$VERSION = 1.12;
+$VERSION = 1.14;
############################################################################
@@ -410,6 +410,10 @@ sub begin_pod {
}
}
+ # If $name contains spaces, quote it; this mostly comes up in the case
+ # of input from stdin.
+ $name = '"' . $name . '"' if ($name =~ /\s/);
+
# Modification date header. Try to use the modification time of our
# input.
if (!defined $$self{date}) {
@@ -630,6 +634,7 @@ sub cmd_head1 {
local $_ = $self->parse (@_);
s/\s+$//;
s/\\s-?\d//g;
+ s/\s*\n\s*/ /g;
if ($$self{ITEMS} > 1) {
$$self{ITEMS} = 0;
$self->output (".PD\n");
@@ -644,6 +649,7 @@ sub cmd_head2 {
my $self = shift;
local $_ = $self->parse (@_);
s/\s+$//;
+ s/\s*\n\s*/ /g;
if ($$self{ITEMS} > 1) {
$$self{ITEMS} = 0;
$self->output (".PD\n");
@@ -658,6 +664,7 @@ sub cmd_head3 {
my $self = shift;
local $_ = $self->parse (@_);
s/\s+$//;
+ s/\s*\n\s*/ /g;
if ($$self{ITEMS} > 1) {
$$self{ITEMS} = 0;
$self->output (".PD\n");
@@ -673,6 +680,7 @@ sub cmd_head4 {
my $self = shift;
local $_ = $self->parse (@_);
s/\s+$//;
+ s/\s*\n\s*/ /g;
if ($$self{ITEMS} > 1) {
$$self{ITEMS} = 0;
$self->output (".PD\n");
diff --git a/mg.c b/mg.c
index b5cae86de6..9f05d3c2c4 100644
--- a/mg.c
+++ b/mg.c
@@ -1404,12 +1404,14 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
I32 offs = LvTARGOFF(sv);
I32 rem = LvTARGLEN(sv);
+ if (SvUTF8(lsv))
+ sv_pos_u2b(lsv, &offs, &rem);
if (offs > len)
offs = len;
if (rem + offs > len)
rem = len - offs;
sv_setpvn(sv, tmps + offs, (STRLEN)rem);
- if (DO_UTF8(lsv))
+ if (SvUTF8(lsv))
SvUTF8_on(sv);
return 0;
}
@@ -1417,25 +1419,26 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
int
Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
{
- STRLEN littlelen;
- char *tmps = SvPV(sv, littlelen);
+ STRLEN len;
+ char *tmps = SvPV(sv, len);
+ SV *lsv = LvTARG(sv);
+ I32 lvoff = LvTARGOFF(sv);
+ I32 lvlen = LvTARGLEN(sv);
if (DO_UTF8(sv)) {
- I32 bigoff = LvTARGOFF(sv);
- I32 biglen = LvTARGLEN(sv);
- U8 *s, *a, *b;
-
- sv_utf8_upgrade(LvTARG(sv));
- /* sv_utf8_upgrade() might have moved and/or resized
- * the string to be replaced, we must rediscover it. --jhi */
- s = (U8*)SvPVX(LvTARG(sv));
- a = utf8_hop(s, bigoff);
- b = utf8_hop(a, biglen);
- sv_insert(LvTARG(sv), a - s, b - a, tmps, littlelen);
- SvUTF8_on(LvTARG(sv));
+ sv_utf8_upgrade(lsv);
+ sv_pos_u2b(lsv, &lvoff, &lvlen);
+ sv_insert(lsv, lvoff, lvlen, tmps, len);
+ SvUTF8_on(lsv);
+ }
+ else if (SvUTF8(lsv)) {
+ sv_pos_u2b(lsv, &lvoff, &lvlen);
+ tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
+ sv_insert(lsv, lvoff, lvlen, tmps, len);
+ Safefree(tmps);
}
else
- sv_insert(LvTARG(sv), LvTARGOFF(sv), LvTARGLEN(sv), tmps, littlelen);
+ sv_insert(lsv, lvoff, lvlen, tmps, len);
return 0;
}
diff --git a/op.c b/op.c
index 1deff89300..6729ca09f4 100644
--- a/op.c
+++ b/op.c
@@ -2410,13 +2410,6 @@ Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
if (o->op_type != type)
return o;
- if (cLISTOPo->op_children < 7) {
- /* XXX do we really need to do this if we're done appending?? */
- for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
- last = kid;
- cLISTOPo->op_last = last; /* in case check substituted last arg */
- }
-
return fold_constants(o);
}
@@ -2444,7 +2437,6 @@ Perl_append_elem(pTHX_ I32 type, OP *first, OP *last)
((LISTOP*)first)->op_first = last;
}
((LISTOP*)first)->op_last = last;
- ((LISTOP*)first)->op_children++;
return first;
}
@@ -2465,9 +2457,7 @@ Perl_append_list(pTHX_ I32 type, LISTOP *first, LISTOP *last)
first->op_last->op_sibling = last->op_first;
first->op_last = last->op_last;
- first->op_children += last->op_children;
- if (first->op_children)
- first->op_flags |= OPf_KIDS;
+ first->op_flags |= (last->op_flags & OPf_KIDS);
#ifdef PL_OP_SLAB_ALLOC
#else
@@ -2500,7 +2490,7 @@ Perl_prepend_elem(pTHX_ I32 type, OP *first, OP *last)
first->op_sibling = ((LISTOP*)last)->op_first;
((LISTOP*)last)->op_first = first;
}
- ((LISTOP*)last)->op_children++;
+ last->op_flags |= OPf_KIDS;
return last;
}
@@ -2533,7 +2523,8 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
listop->op_type = type;
listop->op_ppaddr = PL_ppaddr[type];
- listop->op_children = (first != 0) + (last != 0);
+ if (first || last)
+ flags |= OPf_KIDS;
listop->op_flags = flags;
if (!last && first)
@@ -2553,8 +2544,6 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
if (!last)
listop->op_last = pushop;
}
- else if (listop->op_children)
- listop->op_flags |= OPf_KIDS;
return (OP*)listop;
}
@@ -6309,7 +6298,6 @@ S_simplify_sort(pTHX_ OP *o)
kid = cLISTOPo->op_first->op_sibling;
cLISTOPo->op_first->op_sibling = kid->op_sibling; /* bypass old block */
op_free(kid); /* then delete it */
- cLISTOPo->op_children--;
}
OP *
diff --git a/op.h b/op.h
index a484992ff1..b1b11a511d 100644
--- a/op.h
+++ b/op.h
@@ -229,14 +229,12 @@ struct listop {
BASEOP
OP * op_first;
OP * op_last;
- U32 op_children;
};
struct pmop {
BASEOP
OP * op_first;
OP * op_last;
- U32 op_children;
OP * op_pmreplroot;
OP * op_pmreplstart;
PMOP * op_pmnext; /* list of all scanpats */
@@ -292,7 +290,6 @@ struct loop {
BASEOP
OP * op_first;
OP * op_last;
- U32 op_children;
OP * op_redoop;
OP * op_nextop;
OP * op_lastop;
diff --git a/patchlevel.h b/patchlevel.h
index ee4e7ce0ac..a1190bd8e6 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -70,7 +70,7 @@
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
static char *local_patches[] = {
NULL
- ,"DEVEL8428"
+ ,"DEVEL8452"
,NULL
};
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index ba6a8363f4..1455866f9a 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -188,7 +188,10 @@ Converts a string C<s> of length C<len> from ASCII into UTF8 encoding.
Returns a pointer to the newly-created string, and sets C<len> to
reflect the new length.
- U8 * bytes_to_utf8(U8 *s, STRLEN *len)
+NOTE: this function is experimental and may change or be
+removed without notice.
+
+ U8* bytes_to_utf8(U8 *s, STRLEN *len)
=for hackers
Found in file utf8.c
@@ -1013,6 +1016,27 @@ character.
=for hackers
Found in file handy.h
+=item is_utf8_char
+
+Tests if some arbitrary number of bytes begins in a valid UTF-8 character.
+The actual number of bytes in the UTF-8 character will be returned if it
+is valid, otherwise 0.
+
+ STRLEN is_utf8_char(U8 *p)
+
+=for hackers
+Found in file utf8.c
+
+=item is_utf8_string
+
+Returns true if first C<len> bytes of the given string form valid a UTF8
+string, false otherwise.
+
+ bool is_utf8_string(U8 *s, STRLEN len)
+
+=for hackers
+Found in file utf8.c
+
=item items
Variable which is setup by C<xsubpp> to indicate the number of
@@ -1486,6 +1510,15 @@ The C variable which corresponds to Perl's $^W warning variable.
=for hackers
Found in file intrpvar.h
+=item PL_last_in_gv
+
+The GV which was last used for a filehandle input operation. (C<< <FH> >>)
+
+ GV* PL_last_in_gv
+
+=for hackers
+Found in file thrdvar.h
+
=item PL_modglobal
C<PL_modglobal> is a general purpose, interpreter global HV for use by
@@ -1511,6 +1544,24 @@ C<SvPV_nolen> macro.
=for hackers
Found in file thrdvar.h
+=item PL_ofs_sv
+
+The output field separator - C<$,> in Perl space.
+
+ SV* PL_ofs_sv
+
+=for hackers
+Found in file thrdvar.h
+
+=item PL_rs
+
+The input record separator - C<$/> in Perl space.
+
+ SV* PL_rs
+
+=for hackers
+Found in file thrdvar.h
+
=item PL_sv_no
This is the C<false> SV. See C<PL_sv_yes>. Always refer to this as
@@ -3220,16 +3271,6 @@ Converts the specified character to uppercase.
=for hackers
Found in file handy.h
-=item U8 *s
-
-Returns true if first C<len> bytes of the given string form valid a UTF8
-string, false otherwise.
-
- is_utf8_string U8 *s(STRLEN len)
-
-=for hackers
-Found in file utf8.c
-
=item utf8_distance
Returns the number of UTF8 characters between the UTF-8 pointers C<a>
@@ -3275,7 +3316,10 @@ Unlike C<bytes_to_utf8>, this over-writes the original string, and
updates len to contain the new length.
Returns zero on failure, setting C<len> to -1.
- U8 * utf8_to_bytes(U8 *s, STRLEN *len)
+NOTE: this function is experimental and may change or be
+removed without notice.
+
+ U8* utf8_to_bytes(U8 *s, STRLEN *len)
=for hackers
Found in file utf8.c
@@ -3297,7 +3341,7 @@ length of the UTF-8 character in bytes, and zero will be returned.
The C<flags> can also contain various flags to allow deviations from
the strict UTF-8 encoding (see F<utf8.h>).
- U8* s utf8_to_uv(STRLEN curlen, STRLEN *retlen, U32 flags)
+ UV utf8_to_uv(U8 *s, STRLEN curlen, STRLEN* retlen, U32 flags)
=for hackers
Found in file utf8.c
@@ -3311,7 +3355,25 @@ length, in bytes, of that character.
If C<s> does not point to a well-formed UTF8 character, zero is
returned and retlen is set, if possible, to -1.
- U8* s utf8_to_uv_simple(STRLEN *retlen)
+ UV utf8_to_uv_simple(U8 *s, STRLEN* retlen)
+
+=for hackers
+Found in file utf8.c
+
+=item uv_to_utf8
+
+Adds the UTF8 representation of the Unicode codepoint C<uv> to the end
+of the string C<d>; C<d> should be have at least C<UTF8_MAXLEN+1> free
+bytes available. The return value is the pointer to the byte after the
+end of the new character. In other words,
+
+ d = uv_to_utf8(d, uv);
+
+is the recommended Unicode-aware way of saying
+
+ *(d++) = uv;
+
+ U8* uv_to_utf8(U8 *d, UV uv)
=for hackers
Found in file utf8.c
diff --git a/pp.c b/pp.c
index ba6c17a773..87e459e169 100644
--- a/pp.c
+++ b/pp.c
@@ -2792,6 +2792,8 @@ PP(pp_substr)
RETPUSHUNDEF;
}
else {
+ I32 upos = pos;
+ I32 urem = rem;
if (utfcurlen)
sv_pos_u2b(sv, &pos, &rem);
tmps += pos;
@@ -2826,8 +2828,8 @@ PP(pp_substr)
SvREFCNT_dec(LvTARG(TARG));
LvTARG(TARG) = SvREFCNT_inc(sv);
}
- LvTARGOFF(TARG) = pos;
- LvTARGLEN(TARG) = rem;
+ LvTARGOFF(TARG) = upos;
+ LvTARGLEN(TARG) = urem;
}
}
SPAGAIN;
@@ -2970,11 +2972,9 @@ PP(pp_chr)
(void)SvUPGRADE(TARG,SVt_PV);
- if ((value > 255 && !IN_BYTE) ||
- (UTF8_IS_CONTINUED(value) && (PL_hints & HINT_UTF8)) ) {
- SvGROW(TARG, UTF8_MAXLEN+1);
- tmps = SvPVX(TARG);
- tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
+ if (value > 255 && !IN_BYTE) {
+ SvGROW(TARG, UNISKIP(value)+1);
+ tmps = (char*)uv_to_utf8((U8*)SvPVX(TARG), value);
SvCUR_set(TARG, tmps - SvPVX(TARG));
*tmps = '\0';
(void)SvPOK_only(TARG);
@@ -2982,9 +2982,6 @@ PP(pp_chr)
XPUSHs(TARG);
RETURN;
}
- else {
- SvUTF8_off(TARG);
- }
SvGROW(TARG,2);
SvCUR_set(TARG, 1);
diff --git a/pp.h b/pp.h
index 51a61053bd..b05e6d068e 100644
--- a/pp.h
+++ b/pp.h
@@ -386,4 +386,4 @@ See C<PUSHu>.
True if this op will be the return value of an lvalue subroutine
=cut */
-#define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && Perl_is_lvalue_sub(aTHX))
+#define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && is_lvalue_sub())
diff --git a/pp_ctl.c b/pp_ctl.c
index 07545dc28a..487a8d20aa 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -116,10 +116,15 @@ PP(pp_regcomp)
pm->op_pmflags = pm->op_pmpermflags; /* reset case sensitivity */
if (DO_UTF8(tmpstr))
pm->op_pmdynflags |= PMdf_DYN_UTF8;
- else
+ else {
pm->op_pmdynflags &= ~PMdf_DYN_UTF8;
+ if (pm->op_pmdynflags & PMdf_UTF8)
+ t = (char*)bytes_to_utf8((U8*)t, &len);
+ }
pm->op_pmregexp = CALLREGCOMP(aTHX_ t, t + len, pm);
- PL_reginterp_cnt = 0; /* XXXX Be extra paranoid - needed
+ if (!DO_UTF8(tmpstr) && (pm->op_pmdynflags & PMdf_UTF8))
+ Safefree(t);
+ PL_reginterp_cnt = 0; /* XXXX Be extra paranoid - needed
inside tie/overload accessors. */
}
}
diff --git a/pp_hot.c b/pp_hot.c
index 3a1e08daaf..0f1fee980a 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -76,7 +76,7 @@ PP(pp_stringify)
char *s;
s = SvPV(TOPs,len);
sv_setpvn(TARG,s,len);
- if (SvUTF8(TOPs) && !IN_BYTE)
+ if (SvUTF8(TOPs))
SvUTF8_on(TARG);
else
SvUTF8_off(TARG);
diff --git a/regcomp.c b/regcomp.c
index c85eb5e123..96a2789888 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -154,11 +154,6 @@ typedef struct RExC_state_t {
#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
((*s) == '{' && regcurly(s)))
-#ifdef atarist
-#define PERL_META "^$.[()|?+*\\"
-#else
-#define META "^$.[()|?+*\\"
-#endif
#ifdef SPSTART
#undef SPSTART /* dratted cpp namespace... */
diff --git a/sv.c b/sv.c
index 58c6434ad6..341792412b 100644
--- a/sv.c
+++ b/sv.c
@@ -3440,7 +3440,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
*SvEND(dstr) = '\0';
(void)SvPOK_only(dstr);
}
- if ((sflags & SVf_UTF8) && !IN_BYTE)
+ if (sflags & SVf_UTF8)
SvUTF8_on(dstr);
/*SUPPRESS 560*/
if (sflags & SVp_NOK) {
diff --git a/t/lib/charnames.t b/t/lib/charnames.t
index 1d08ad0880..14da2e0f7b 100644
--- a/t/lib/charnames.t
+++ b/t/lib/charnames.t
@@ -45,7 +45,7 @@ $encoded_bet = "\327\221";
sub to_bytes {
use bytes;
- my $bytes = shift;
+ "".shift;
}
{
diff --git a/t/op/length.t b/t/op/length.t
index aec6a52871..46f0c59698 100644
--- a/t/op/length.t
+++ b/t/op/length.t
@@ -33,8 +33,7 @@ print "ok 3\n";
}
{
- use utf8; # make "\x{80}" to produce UTF-8
- my $a = "\x{80}";
+ my $a = qu"\x{80}"; # make "\x{80}" to produce UTF-8
print "not " unless length($a) == 1;
print "ok 6\n";
diff --git a/t/op/substr.t b/t/op/substr.t
index d3937fb107..12bcd00b33 100755
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -1,6 +1,6 @@
#!./perl
-print "1..149\n";
+print "1..162\n";
#P = start of string Q = start of substr R = end of substr S = end of string
@@ -429,3 +429,122 @@ ok 149, length($x) == 5 &&
substr($x, 3, 1) eq "\x{FF}" &&
substr($x, 4, 1) eq "\x{F3}";
+# And tests for already-UTF8 one
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, 0, 1) = "\x{100}";
+ok 150, length($x) == 3 &&
+ $x eq "\x{100}\xF2\xF3" &&
+ substr($x, 0, 1) eq "\x{100}" &&
+ substr($x, 1, 1) eq "\x{F2}" &&
+ substr($x, 2, 1) eq "\x{F3}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, 0, 1) = "\x{100}\x{FF}";
+ok 151, length($x) == 4 &&
+ $x eq "\x{100}\x{FF}\xF2\xF3" &&
+ substr($x, 0, 1) eq "\x{100}" &&
+ substr($x, 1, 1) eq "\x{FF}" &&
+ substr($x, 2, 1) eq "\x{F2}" &&
+ substr($x, 3, 1) eq "\x{F3}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, 0, 2) = "\x{100}\xFF";
+ok 152, length($x) == 3 &&
+ $x eq "\x{100}\xFF\xF3" &&
+ substr($x, 0, 1) eq "\x{100}" &&
+ substr($x, 1, 1) eq "\x{FF}" &&
+ substr($x, 2, 1) eq "\x{F3}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, 1, 1) = "\x{100}\xFF";
+ok 153, length($x) == 4 &&
+ $x eq "\x{101}\x{100}\xFF\xF3" &&
+ substr($x, 0, 1) eq "\x{101}" &&
+ substr($x, 1, 1) eq "\x{100}" &&
+ substr($x, 2, 1) eq "\x{FF}" &&
+ substr($x, 3, 1) eq "\x{F3}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, 2, 1) = "\x{100}\xFF";
+ok 154, length($x) == 4 &&
+ $x eq "\x{101}\xF2\x{100}\xFF" &&
+ substr($x, 0, 1) eq "\x{101}" &&
+ substr($x, 1, 1) eq "\x{F2}" &&
+ substr($x, 2, 1) eq "\x{100}" &&
+ substr($x, 3, 1) eq "\x{FF}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, 3, 1) = "\x{100}\xFF";
+ok 155, length($x) == 5 &&
+ $x eq "\x{101}\x{F2}\x{F3}\x{100}\xFF" &&
+ substr($x, 0, 1) eq "\x{101}" &&
+ substr($x, 1, 1) eq "\x{F2}" &&
+ substr($x, 2, 1) eq "\x{F3}" &&
+ substr($x, 3, 1) eq "\x{100}" &&
+ substr($x, 4, 1) eq "\x{FF}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, -1, 1) = "\x{100}\xFF";
+ok 156, length($x) == 4 &&
+ $x eq "\x{101}\xF2\x{100}\xFF" &&
+ substr($x, 0, 1) eq "\x{101}" &&
+ substr($x, 1, 1) eq "\x{F2}" &&
+ substr($x, 2, 1) eq "\x{100}" &&
+ substr($x, 3, 1) eq "\x{FF}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, -1, 0) = "\x{100}\xFF";
+ok 157, length($x) == 5 &&
+ $x eq "\x{101}\xF2\x{100}\xFF\xF3" &&
+ substr($x, 0, 1) eq "\x{101}" &&
+ substr($x, 1, 1) eq "\x{F2}" &&
+ substr($x, 2, 1) eq "\x{100}" &&
+ substr($x, 3, 1) eq "\x{FF}" &&
+ substr($x, 4, 1) eq "\x{F3}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, 0, -1) = "\x{100}\xFF";
+ok 158, length($x) == 3 &&
+ $x eq "\x{100}\xFF\xF3" &&
+ substr($x, 0, 1) eq "\x{100}" &&
+ substr($x, 1, 1) eq "\x{FF}" &&
+ substr($x, 2, 1) eq "\x{F3}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, 0, -2) = "\x{100}\xFF";
+ok 159, length($x) == 4 &&
+ $x eq "\x{100}\xFF\xF2\xF3" &&
+ substr($x, 0, 1) eq "\x{100}" &&
+ substr($x, 1, 1) eq "\x{FF}" &&
+ substr($x, 2, 1) eq "\x{F2}" &&
+ substr($x, 3, 1) eq "\x{F3}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, 0, -3) = "\x{100}\xFF";
+ok 160, length($x) == 5 &&
+ $x eq "\x{100}\xFF\x{101}\x{F2}\x{F3}" &&
+ substr($x, 0, 1) eq "\x{100}" &&
+ substr($x, 1, 1) eq "\x{FF}" &&
+ substr($x, 2, 1) eq "\x{101}" &&
+ substr($x, 3, 1) eq "\x{F2}" &&
+ substr($x, 4, 1) eq "\x{F3}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, 1, -1) = "\x{100}\xFF";
+ok 161, length($x) == 4 &&
+ $x eq "\x{101}\x{100}\xFF\xF3" &&
+ substr($x, 0, 1) eq "\x{101}" &&
+ substr($x, 1, 1) eq "\x{100}" &&
+ substr($x, 2, 1) eq "\x{FF}" &&
+ substr($x, 3, 1) eq "\x{F3}";
+
+$x = "\x{101}\x{F2}\x{F3}";
+substr($x, -1, -1) = "\x{100}\xFF";
+ok 162, length($x) == 5 &&
+ $x eq "\x{101}\xF2\x{100}\xFF\xF3" &&
+ substr($x, 0, 1) eq "\x{101}" &&
+ substr($x, 1, 1) eq "\x{F2}" &&
+ substr($x, 2, 1) eq "\x{100}" &&
+ substr($x, 3, 1) eq "\x{FF}" &&
+ substr($x, 4, 1) eq "\x{F3}";
diff --git a/t/pragma/utf8.t b/t/pragma/utf8.t
index 9137f3606b..546b217f27 100755
--- a/t/pragma/utf8.t
+++ b/t/pragma/utf8.t
@@ -283,7 +283,7 @@ sub nok_bytes {
{
use utf8;
- ok_bytes chr(0xe2), pack("C*", 0xc3, 0xa2);
+ ok_bytes chr(0x1e2), pack("C*", 0xc7, 0xa2);
$test++; # 65
}
@@ -482,7 +482,7 @@ sub nok_bytes {
my $X = chr(1448);
my ($Y) = $X =~ /(.*)/;
- print "not " unless length $Y == 1;
+ print "not " unless $Y eq v1448 && length($Y) == 1;
print "ok $test\n";
$test++; # 98
}
@@ -494,7 +494,7 @@ sub nok_bytes {
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 "not " unless $Y eq $X && $X eq "Szab\x{f3},Bal\x{e1}zs";
print "ok $test\n";
$test++; # 99
}
@@ -505,7 +505,7 @@ sub nok_bytes {
use utf8;
use charnames ':full';
my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}";
- print "not " unless ord($text) == 0xc4;
+ print "not " unless $text eq "\xc4" && ord($text) == 0xc4;
print "ok $test\n";
$test++; # 100
}
@@ -523,12 +523,12 @@ sub nok_bytes {
print "ok $test\n";
$test++; # 101
- print "not " unless length($b[3]) == 1;
+ print "not " unless length($b[3]) == 1 && $b[3] eq "\x{263A}";
print "ok $test\n";
$test++; # 102
$a =~ s/^A/Z/;
- print "not " unless length($a) == 4;
+ print "not " unless length($a) == 4 && $a eq "ZBC\x{263A}";
print "ok $test\n";
$test++; # 103
}
@@ -538,7 +538,7 @@ sub nok_bytes {
use utf8;
$X =~ s/^/chr(1488)/e;
- print "not " unless length $X == 1;
+ print "not " unless length $X == 1 && ord($X) == 1488;
print "ok $test\n";
$test++; # 104
}
diff --git a/thrdvar.h b/thrdvar.h
index 7f591d9c1a..e0fe1052f1 100644
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -82,6 +82,23 @@ PERLVAR(Ttimesbuf, struct tms)
PERLVAR(Ttainted, bool) /* using variables controlled by $< */
PERLVAR(Tcurpm, PMOP *) /* what to do \ interps in REs from */
PERLVAR(Tnrs, SV *)
+
+/*
+=for apidoc Amn|SV*|PL_rs
+
+The input record separator - C<$/> in Perl space.
+
+=for apidoc Amn|GV*|PL_last_in_gv
+
+The GV which was last used for a filehandle input operation. (C<< <FH> >>)
+
+=for apidoc Amn|SV*|PL_ofs_sv
+
+The output field separator - C<$,> in Perl space.
+
+=cut
+*/
+
PERLVAR(Trs, SV *) /* input record separator $/ */
PERLVAR(Tlast_in_gv, GV *) /* GV used in last <FH> */
PERLVAR(Tofs_sv, SV *) /* output field separator $, */
diff --git a/toke.c b/toke.c
index ea32115abd..398253c8a5 100644
--- a/toke.c
+++ b/toke.c
@@ -1045,8 +1045,11 @@ STATIC I32
S_sublex_done(pTHX)
{
if (!PL_lex_starts++) {
+ SV *sv = newSVpvn("",0);
+ if (SvUTF8(PL_linestr))
+ SvUTF8_on(sv);
PL_expect = XOPERATOR;
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn("",0));
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
return THING;
}
@@ -1173,7 +1176,8 @@ S_scan_const(pTHX_ char *start)
register char *d = SvPVX(sv); /* destination for copies */
bool dorange = FALSE; /* are we in a translit range? */
bool didrange = FALSE; /* did we just finish a range? */
- bool has_utf8 = FALSE; /* embedded \x{} */
+ bool has_utf8 = (PL_linestr && SvUTF8(PL_linestr));
+ /* the constant is UTF8 */
UV uv;
I32 utf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
@@ -1313,8 +1317,6 @@ S_scan_const(pTHX_ char *start)
/* backslashes */
if (*s == '\\' && s+1 < send) {
- bool to_be_utf8 = FALSE;
-
s++;
/* some backslashes we leave behind */
@@ -1383,8 +1385,6 @@ S_scan_const(pTHX_ char *start)
else {
STRLEN len = 1; /* allow underscores */
uv = (UV)scan_hex(s + 1, e - s - 1, &len);
- if (PL_hints & HINT_UTF8)
- to_be_utf8 = TRUE;
}
s = e + 1;
}
@@ -1408,7 +1408,7 @@ S_scan_const(pTHX_ char *start)
* repertoire. --jhi */
if (uv > 127) {
- if (!has_utf8 && (to_be_utf8 || uv > 255)) {
+ if (!has_utf8 && uv > 255) {
/* Might need to recode whatever we have
* accumulated so far if it contains any
* hibit chars.
@@ -1447,7 +1447,7 @@ S_scan_const(pTHX_ char *start)
}
}
- if (to_be_utf8 || has_utf8 || uv > 255) {
+ if (has_utf8 || uv > 255) {
d = (char*)uv_to_utf8((U8*)d, uv);
has_utf8 = TRUE;
}
@@ -4711,7 +4711,10 @@ Perl_yylex(pTHX)
TOKEN('(');
case KEY_qq:
+ case KEY_qu:
s = scan_str(s,FALSE,FALSE);
+ if (tmp == KEY_qu && is_utf8_string((U8*)s, SvCUR(PL_lex_stuff)))
+ SvUTF8_on(PL_lex_stuff);
if (!s)
missingterm((char*)0);
yylval.ival = OP_STRINGIFY;
@@ -5548,6 +5551,7 @@ Perl_keyword(pTHX_ register char *d, I32 len)
if (strEQ(d,"q")) return KEY_q;
if (strEQ(d,"qr")) return KEY_qr;
if (strEQ(d,"qq")) return KEY_qq;
+ if (strEQ(d,"qu")) return KEY_qu;
if (strEQ(d,"qw")) return KEY_qw;
if (strEQ(d,"qx")) return KEY_qx;
}
@@ -7204,10 +7208,9 @@ vstring:
while (isDIGIT(*pos) || *pos == '_')
pos++;
if (!isALPHA(*pos)) {
- UV rev;
+ UV rev, revmax = 0;
U8 tmpbuf[UTF8_MAXLEN+1];
U8 *tmpend;
- bool utf8 = FALSE;
s++; /* get past 'v' */
sv = NEWSV(92,5);
@@ -7234,7 +7237,8 @@ vstring:
}
}
tmpend = uv_to_utf8(tmpbuf, rev);
- utf8 = utf8 || rev > 127;
+ if (rev > revmax)
+ revmax = rev;
sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
if (*pos == '.' && isDIGIT(pos[1]))
s = ++pos;
@@ -7248,9 +7252,9 @@ vstring:
SvPOK_on(sv);
SvREADONLY_on(sv);
- if (utf8) {
+ if (revmax > 127) {
SvUTF8_on(sv);
- if (!UTF||IN_BYTE)
+ if (revmax < 256)
sv_utf8_downgrade(sv, TRUE);
}
}
diff --git a/utf8.c b/utf8.c
index 65f1096183..156e63f717 100644
--- a/utf8.c
+++ b/utf8.c
@@ -26,8 +26,25 @@
/* Unicode support */
+/*
+=for apidoc A|U8*|uv_to_utf8|U8 *d|UV uv
+
+Adds the UTF8 representation of the Unicode codepoint C<uv> to the end
+of the string C<d>; C<d> should be have at least C<UTF8_MAXLEN+1> free
+bytes available. The return value is the pointer to the byte after the
+end of the new character. In other words,
+
+ d = uv_to_utf8(d, uv);
+
+is the recommended Unicode-aware way of saying
+
+ *(d++) = uv;
+
+=cut
+*/
+
U8 *
-Perl_uv_to_utf8(pTHX_ U8 *d, UV uv) /* the d must be UTF8_MAXLEN+1 deep */
+Perl_uv_to_utf8(pTHX_ U8 *d, UV uv)
{
if (uv < 0x80) {
*d++ = uv;
@@ -101,9 +118,15 @@ Perl_uv_to_utf8(pTHX_ U8 *d, UV uv) /* the d must be UTF8_MAXLEN+1 deep */
#endif
}
-/* Tests if some arbitrary number of bytes begins in a valid UTF-8 character.
- * The actual number of bytes in the UTF-8 character will be returned if it
- * is valid, otherwise 0. */
+/*
+=for apidoc A|STRLEN|is_utf8_char|U8 *s
+
+Tests if some arbitrary number of bytes begins in a valid UTF-8 character.
+The actual number of bytes in the UTF-8 character will be returned if it
+is valid, otherwise 0.
+
+=cut
+*/
STRLEN
Perl_is_utf8_char(pTHX_ U8 *s)
{
@@ -143,7 +166,7 @@ Perl_is_utf8_char(pTHX_ U8 *s)
}
/*
-=for apidoc Am|is_utf8_string|U8 *s|STRLEN len
+=for apidoc A|bool|is_utf8_string|U8 *s|STRLEN len
Returns true if first C<len> bytes of the given string form valid a UTF8
string, false otherwise.
@@ -175,7 +198,7 @@ Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len)
}
/*
-=for apidoc Am|U8* s|utf8_to_uv|STRLEN curlen|STRLEN *retlen|U32 flags
+=for apidoc A|U8* s|utf8_to_uv|STRLEN curlen|STRLEN *retlen|U32 flags
Returns the character value of the first character in the string C<s>
which is assumed to be in UTF8 encoding and no longer than C<curlen>;
@@ -390,7 +413,7 @@ malformed:
}
/*
-=for apidoc Am|U8* s|utf8_to_uv_simple|STRLEN *retlen
+=for apidoc A|U8* s|utf8_to_uv_simple|STRLEN *retlen
Returns the character value of the first character in the string C<s>
which is assumed to be in UTF8 encoding; C<retlen> will be set to the
@@ -409,7 +432,7 @@ Perl_utf8_to_uv_simple(pTHX_ U8* s, STRLEN* retlen)
}
/*
-=for apidoc Am|STRLEN|utf8_length|U8* s|U8 *e
+=for apidoc A|STRLEN|utf8_length|U8* s|U8 *e
Return the length of the UTF-8 char encoded string C<s> in characters.
Stops at C<e> (inclusive). If C<e E<lt> s> or if the scan would end
@@ -442,7 +465,7 @@ Perl_utf8_length(pTHX_ U8* s, U8* e)
}
/*
-=for apidoc Am|IV|utf8_distance|U8 *a|U8 *b
+=for apidoc A|IV|utf8_distance|U8 *a|U8 *b
Returns the number of UTF8 characters between the UTF-8 pointers C<a>
and C<b>.
@@ -486,7 +509,7 @@ Perl_utf8_distance(pTHX_ U8 *a, U8 *b)
}
/*
-=for apidoc Am|U8*|utf8_hop|U8 *s|I32 off
+=for apidoc A|U8*|utf8_hop|U8 *s|I32 off
Return the UTF-8 pointer C<s> displaced by C<off> characters, either
forward or backward.
@@ -519,7 +542,7 @@ Perl_utf8_hop(pTHX_ U8 *s, I32 off)
}
/*
-=for apidoc Am|U8 *|utf8_to_bytes|U8 *s|STRLEN *len
+=for apidoc A|U8 *|utf8_to_bytes|U8 *s|STRLEN *len
Converts a string C<s> of length C<len> from UTF8 into byte encoding.
Unlike C<bytes_to_utf8>, this over-writes the original string, and
@@ -560,7 +583,7 @@ Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN *len)
}
/*
-=for apidoc Am|U8 *|bytes_to_utf8|U8 *s|STRLEN *len
+=for apidoc A|U8 *|bytes_to_utf8|U8 *s|STRLEN *len
Converts a string C<s> of length C<len> from ASCII into UTF8 encoding.
Returns a pointer to the newly-created string, and sets C<len> to
diff --git a/util.c b/util.c
index 27c6953a90..b163b05361 100644
--- a/util.c
+++ b/util.c
@@ -3645,9 +3645,9 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
PL_tainted = t->Ttainted;
PL_curpm = t->Tcurpm; /* XXX No PMOP ref count */
PL_nrs = newSVsv(t->Tnrs);
- PL_rs = SvREFCNT_inc(PL_nrs);
+ PL_rs = t->Tnrs ? SvREFCNT_inc(PL_nrs) : Nullsv;
PL_last_in_gv = Nullgv;
- PL_ofs_sv = SvREFCNT_inc(PL_ofs_sv);
+ PL_ofs_sv = t->Tofs_sv ? SvREFCNT_inc(PL_ofs_sv) : Nullsv;
PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
PL_chopset = t->Tchopset;
PL_bodytarget = newSVsv(t->Tbodytarget);
diff --git a/win32/Makefile b/win32/Makefile
index fe1b1b1690..be54204579 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -31,7 +31,7 @@ INST_TOP = $(INST_DRV)\perl
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-INST_VER = \5.7.0
+#INST_VER = \5.7.0
#
# Comment this out if you DON'T want your perl installation to have
@@ -42,27 +42,27 @@ INST_VER = \5.7.0
# the same location. Commenting it out gives you a simpler
# installation that is easier to understand for beginners.
#
-INST_ARCH = \$(ARCHNAME)
+#INST_ARCH = \$(ARCHNAME)
#
# uncomment to enable multiple interpreters. This is need for fork()
# emulation.
#
-#USE_MULTI = define
+USE_MULTI = define
#
# Beginnings of interpreter cloning/threads; still very incomplete.
# This should be enabled to get the fork() emulation. This needs
# USE_MULTI as well.
#
-#USE_ITHREADS = define
+USE_ITHREADS = define
#
# uncomment to enable the implicit "host" layer for all system calls
# made by perl. This needs USE_MULTI above. This is also needed to
# get fork().
#
-#USE_IMP_SYS = define
+USE_IMP_SYS = define
#
# uncomment to enable the experimental PerlIO I/O subsystem.
@@ -304,12 +304,6 @@ ARCHNAME = $(ARCHNAME)-thread
# VC 6.0 can load the socket dll on demand. Makes the test suite
# run in about 10% less time.
DELAYLOAD = -DELAYLOAD:wsock32.dll -DELAYLOAD:shell32.dll delayimp.lib
-
-# VC 6.0 seems capable of compiling perl correctly with optimizations
-# enabled. Anything earlier fails tests.
-!IF "$(CFG)" == ""
-CFG = Optimize
-!ENDIF
!ENDIF
ARCHDIR = ..\lib\$(ARCHNAME)
@@ -366,13 +360,9 @@ OPTIMIZE = -Od -MD -Zi -DDEBUGGING
! ENDIF
LINK_DBG = -debug -pdb:none
!ELSE
-! IF "$(CFG)" == "Optimize"
# -O1 yields smaller code, which turns out to be faster than -O2
#OPTIMIZE = -O2 -MD -DNDEBUG
OPTIMIZE = -O1 -MD -DNDEBUG
-! ELSE
-OPTIMIZE = -Od -MD -DNDEBUG
-! ENDIF
LINK_DBG = -release
!ENDIF
View Lorry Controller Status