summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2013-07-21 00:38:28 -0700
committerFather Chrysostomos <sprout@cpan.org>2013-07-23 14:53:23 -0700
commit6174b39a88cd48740c024cfb6035edb6ffed9f2d (patch)
tree07f2c3b7d17fa361cd5fa1252b14b4a739fb2c60
parentef54055c17bc9effcdf6a8135d2b375b7c35dd62 (diff)
downloadperl-6174b39a88cd48740c024cfb6035edb6ffed9f2d.tar.gz
[perl #72766] Allow huge pos() settings
This is part of #116907, too. It also fixes #72924 as a side effect; the next commit will explain. The value of pos($foo) was being stored as an I32, not allowing values above I32_MAX. Change it to SSize_t (the signed equivalent of size_t, representing the maximum string length the OS/compiler supports). This is accomplished by changing the size of the entry in the magic struct, which is the simplest fix. Other parts of the code base can benefit from this, too. We actually cast the pos value to STRLEN (size_t) when reading it, to allow *very* long strings. Only the value -1 is special, meaning there is no pos. So the maximum supported offset is 2**sizeof(size_t)-2. The regexp engine itself still cannot handle large strings, so being able to set pos to large values is useless right now. This is but one piece in a larger puzzle. Changing the size of mg->mg_len also requires that Perl_hv_placeholders_p change its type. This function should in fact not be in the API, since it exists solely to implement the HvPLACEHOLDERS macro. See <https://rt.perl.org/rt3/Ticket/Display.html?id=116907#txn-1237043>.
-rw-r--r--MANIFEST1
-rw-r--r--embed.fnc2
-rw-r--r--hv.c2
-rw-r--r--mg.c8
-rw-r--r--mg.h2
-rw-r--r--pp.c8
-rw-r--r--proto.h2
-rw-r--r--t/bigmem/pos.t25
8 files changed, 38 insertions, 12 deletions
diff --git a/MANIFEST b/MANIFEST
index 8fb53e085b..4b68b19b76 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4848,6 +4848,7 @@ t/base/rs.t See if record-read works
t/base/term.t See if various terms work
t/base/while.t See if while work
t/benchmark/rt26188-speed-up-keys-on-empty-hash.t Benchmark if keys on empty hashes is fast enough
+t/bigmem/pos.t Check that pos() handles large offsets
t/bigmem/read.t Check read() handles large offsets
t/bigmem/vec.t Check vec() handles large offsets
t/cmd/elsif.t See if else-if works
diff --git a/embed.fnc b/embed.fnc
index f60efe2814..93944baa44 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2460,7 +2460,7 @@ poM |AV** |hv_backreferences_p |NN HV *hv
poM |void |hv_kill_backrefs |NN HV *hv
#endif
Apd |void |hv_clear_placeholders |NN HV *hv
-ApoR |I32* |hv_placeholders_p |NN HV *hv
+XpoR |SSize_t*|hv_placeholders_p |NN HV *hv
ApoR |I32 |hv_placeholders_get |NN const HV *hv
Apo |void |hv_placeholders_set |NN HV *hv|I32 ph
diff --git a/hv.c b/hv.c
index a2db86ac1d..22d5603fe0 100644
--- a/hv.c
+++ b/hv.c
@@ -2895,7 +2895,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
return HeKEY_hek(entry);
}
-I32 *
+SSize_t *
Perl_hv_placeholders_p(pTHX_ HV *hv)
{
dVAR;
diff --git a/mg.c b/mg.c
index 0dd23f6970..4ef6c255ca 100644
--- a/mg.c
+++ b/mg.c
@@ -2096,11 +2096,11 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
PERL_ARGS_ASSERT_MAGIC_GETPOS;
PERL_UNUSED_ARG(mg);
- if (found && found->mg_len >= 0) {
- I32 i = found->mg_len;
+ if (found && found->mg_len != -1) {
+ STRLEN i = found->mg_len;
if (DO_UTF8(lsv))
- sv_pos_b2u(lsv, &i);
- sv_setiv(sv, i);
+ i = sv_pos_b2u_flags(lsv, i, SV_GMAGIC|SV_CONST_RETURN);
+ sv_setuv(sv, i);
return 0;
}
SvOK_off(sv);
diff --git a/mg.h b/mg.h
index 4114941526..de673d4243 100644
--- a/mg.h
+++ b/mg.h
@@ -26,7 +26,7 @@ struct magic {
U16 mg_private;
char mg_type;
U8 mg_flags;
- I32 mg_len;
+ SSize_t mg_len;
SV* mg_obj;
char* mg_ptr;
};
diff --git a/pp.c b/pp.c
index 1aaeefcc11..cadfe96371 100644
--- a/pp.c
+++ b/pp.c
@@ -439,12 +439,12 @@ PP(pp_pos)
}
else {
const MAGIC * const mg = mg_find_mglob(sv);
- if (mg && mg->mg_len >= 0) {
+ if (mg && mg->mg_len != -1) {
dTARGET;
- I32 i = mg->mg_len;
+ STRLEN i = mg->mg_len;
if (DO_UTF8(sv))
- sv_pos_b2u(sv, &i);
- PUSHi(i);
+ i = sv_pos_b2u_flags(sv, i, SV_GMAGIC|SV_CONST_RETURN);
+ PUSHu(i);
RETURN;
}
RETPUSHUNDEF;
diff --git a/proto.h b/proto.h
index 6f5b9adc56..e1425d216a 100644
--- a/proto.h
+++ b/proto.h
@@ -1631,7 +1631,7 @@ PERL_CALLCONV I32 Perl_hv_placeholders_get(pTHX_ const HV *hv)
#define PERL_ARGS_ASSERT_HV_PLACEHOLDERS_GET \
assert(hv)
-PERL_CALLCONV I32* Perl_hv_placeholders_p(pTHX_ HV *hv)
+PERL_CALLCONV SSize_t* Perl_hv_placeholders_p(pTHX_ HV *hv)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_HV_PLACEHOLDERS_P \
diff --git a/t/bigmem/pos.t b/t/bigmem/pos.t
new file mode 100644
index 0000000000..aad93f636d
--- /dev/null
+++ b/t/bigmem/pos.t
@@ -0,0 +1,25 @@
+#!perl
+BEGIN {
+ chdir 't';
+ unshift @INC, "../lib";
+ require './test.pl';
+}
+
+use Config qw(%Config);
+
+$ENV{PERL_TEST_MEMORY} >= 2
+ or skip_all("Need ~2Gb for this test");
+$Config{ptrsize} >= 8
+ or skip_all("Need 64-bit pointers for this test");
+
+plan(3);
+
+# [perl #116907]
+# ${\2} to defeat constant folding, which in this case actually slows
+# things down
+my $x=" "x(${\2}**31+20);
+pos $x = 2**31-5;
+is pos $x, 2147483643, 'setting pos on large string';
+pos $x += 10;
+is pos $x, 2147483653, 'reading lvalue pos after setting it > 2**31';
+is scalar(pos $x), 2147483653, 'reading it with pos() in rvalue context';