r45591 - in /branches/upstream/libjson-xs-perl/2.23: Changes MANIFEST META.json META.yml Makefile.PL README XS.pm XS.xs t/01_utf8.t t/02_error.t t/06_pc_pretty.t t/20_faihu.t t/21_evans.t t/99_binary.t
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Sun Oct 11 22:25:33 UTC 2009
Author: angelabad-guest
Date: Sun Oct 11 22:25:27 2009
New Revision: 45591
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45591
Log:
[svn-upgrade] Integrating new upstream version, libjson-xs-perl (2.260)
Added:
branches/upstream/libjson-xs-perl/2.23/META.json
branches/upstream/libjson-xs-perl/2.23/t/20_faihu.t
branches/upstream/libjson-xs-perl/2.23/t/21_evans.t
Modified:
branches/upstream/libjson-xs-perl/2.23/Changes
branches/upstream/libjson-xs-perl/2.23/MANIFEST
branches/upstream/libjson-xs-perl/2.23/META.yml
branches/upstream/libjson-xs-perl/2.23/Makefile.PL
branches/upstream/libjson-xs-perl/2.23/README
branches/upstream/libjson-xs-perl/2.23/XS.pm
branches/upstream/libjson-xs-perl/2.23/XS.xs
branches/upstream/libjson-xs-perl/2.23/t/01_utf8.t
branches/upstream/libjson-xs-perl/2.23/t/02_error.t
branches/upstream/libjson-xs-perl/2.23/t/06_pc_pretty.t
branches/upstream/libjson-xs-perl/2.23/t/99_binary.t
Modified: branches/upstream/libjson-xs-perl/2.23/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/Changes?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/Changes (original)
+++ branches/upstream/libjson-xs-perl/2.23/Changes Sun Oct 11 22:25:27 2009
@@ -1,4 +1,45 @@
Revision history for Perl extension JSON::XS
+
+2.26 Sat Oct 10 03:26:19 CEST 2009
+ - big integers could become truncated (based on patch
+ by Strobl Anton).
+ - output format change: indent now adds a final newline, which is
+ more expected and more true to the documentation.
+
+2.25 Sat Aug 8 12:04:41 CEST 2009
+ - the perl debugger completely breaks lvalue subs - try to work
+ around the issue.
+ - ignore RMAGICAL hashes w.r.t. CANONICAL.
+ - try to work around a possible char signedness issue on aix.
+ - require common sense.
+
+2.24 Sat May 30 08:25:45 CEST 2009
+ - the incremental parser did not update its parse offset
+ pointer correctly when parsing utf8-strings (nicely
+ debugged by Martin Evans).
+ - appending a non-utf8-string to the incremental parser
+ in utf8 mode failed to upgrade the string.
+ - wording of parse error messages has been improved.
+
+2.232 Sun Feb 22 11:12:25 CET 2009
+ - use an exponential algorithm to extend strings, to
+ help platforms with bad or abysmal==windows memory
+ allocater performance, at the expense of some memory
+ wastage (use shrink to recover this extra memory).
+ (nicely analysed by Dmitry Karasik).
+
+2.2311 Thu Feb 19 02:12:54 CET 2009
+ - add a section "JSON and ECMAscript" to explain some
+ incompatibilities between the two (problem was noted by
+ various people).
+ - add t/20_faihu.t.
+
+2.231 Thu Nov 20 04:59:08 CET 2008
+ - work around 5.10.0 magic bugs where manipulating magic values
+ (such as $1) would permanently damage them as perl would
+ ignore the magicalness, by making a full copy of the string,
+ reported by Dmitry Karasik.
+ - work around spurious warnings under older perl 5.8's.
2.23 Mon Sep 29 05:08:29 CEST 2008
- fix a compilation problem when perl is not using char * as, well,
Modified: branches/upstream/libjson-xs-perl/2.23/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/MANIFEST?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/MANIFEST (original)
+++ branches/upstream/libjson-xs-perl/2.23/MANIFEST Sun Oct 11 22:25:27 2009
@@ -28,6 +28,9 @@
t/17_relaxed.t
t/18_json_checker.t
t/19_incr.t
+t/20_faihu.t
+t/21_evans.t
t/99_binary.t
typemap
META.yml Module meta-data (added by MakeMaker)
+META.json Module meta-data (added by MakeMaker)
Added: branches/upstream/libjson-xs-perl/2.23/META.json
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/META.json?rev=45591&op=file
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/META.json (added)
+++ branches/upstream/libjson-xs-perl/2.23/META.json Sun Oct 11 22:25:27 2009
@@ -1,0 +1,1 @@
+{"no_index":{"directory":["t","inc"]},"meta-spec":{"version":1.4,"url":"http://module-build.sourceforge.net/META-spec-v1.4.html"},"generated_by":"ExtUtils::MakeMaker version 6.54","distribution_type":"module","version":"2.26","name":"JSON-XS","author":[],"license":"unknown","build_requires":{"ExtUtils::MakeMaker":0},"requires":{"common::sense":0},"abstract":null,"configure_requires":{"ExtUtils::MakeMaker":0}}
Modified: branches/upstream/libjson-xs-perl/2.23/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/META.yml?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/META.yml (original)
+++ branches/upstream/libjson-xs-perl/2.23/META.yml Sun Oct 11 22:25:27 2009
@@ -1,12 +1,28 @@
---- #YAML:1.0
-name: JSON-XS
-version: 2.23
-abstract: ~
-license: ~
-author: ~
-generated_by: ExtUtils::MakeMaker version 6.44
-distribution_type: module
-requires:
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+{
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "meta-spec" : {
+ "version" : 1.4,
+ "url" : "http://module-build.sourceforge.net/META-spec-v1.4.html"
+ },
+ "generated_by" : "ExtUtils::MakeMaker version 6.54",
+ "distribution_type" : "module",
+ "version" : "2.26",
+ "name" : "JSON-XS",
+ "author" : [],
+ "license" : "unknown",
+ "build_requires" : {
+ "ExtUtils::MakeMaker" : 0
+ },
+ "requires" : {
+ "common::sense" : 0
+ },
+ "abstract" : null,
+ "configure_requires" : {
+ "ExtUtils::MakeMaker" : 0
+ }
+}
Modified: branches/upstream/libjson-xs-perl/2.23/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/Makefile.PL?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/Makefile.PL (original)
+++ branches/upstream/libjson-xs-perl/2.23/Makefile.PL Sun Oct 11 22:25:27 2009
@@ -10,5 +10,8 @@
EXE_FILES => [ "bin/json_xs" ],
VERSION_FROM => "XS.pm",
NAME => "JSON::XS",
+ PREREQ_PM => {
+ common::sense => 0,
+ },
);
Modified: branches/upstream/libjson-xs-perl/2.23/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/README?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/README (original)
+++ branches/upstream/libjson-xs-perl/2.23/README Sun Oct 11 22:25:27 2009
@@ -22,8 +22,8 @@
# Note that JSON version 2.0 and above will automatically use JSON::XS
# if available, at virtually no speed overhead either, so you should
# be able to just:
-
- use JSON;
+
+ use JSON;
# and do the same things, except that you have a pure-perl fallback now.
@@ -379,6 +379,8 @@
in Perl.
This setting has no effect when decoding JSON texts.
+
+ This setting has currently no effect on tied hashes.
$json = $json->allow_nonref ([$enable])
$enabled = $json->get_allow_nonref
@@ -686,16 +688,19 @@
$json->incr_skip
This will reset the state of the incremental parser and will remove
- the parsed text from the input buffer. This is useful after
+ the parsed text from the input buffer so far. This is useful after
"incr_parse" died, in which case the input buffer and incremental
parser state is left unchanged, to skip the text parsed so far and
to reset the parse state.
+ The difference to "incr_reset" is that only text until the parse
+ error occured is removed.
+
$json->incr_reset
This completely resets the incremental parser, that is, after this
call, it will be as if the parser had never parsed anything.
- This is useful if you want ot repeatedly parse JSON objects and want
+ This is useful if you want to repeatedly parse JSON objects and want
to ignore any trailing data, which means you have to reset the
parser after each successful decode.
@@ -1071,6 +1076,69 @@
in mail), and works because ASCII is a proper subset of most 8-bit
and multibyte encodings in use in the world.
+ JSON and ECMAscript
+ JSON syntax is based on how literals are represented in javascript (the
+ not-standardised predecessor of ECMAscript) which is presumably why it
+ is called "JavaScript Object Notation".
+
+ However, JSON is not a subset (and also not a superset of course) of
+ ECMAscript (the standard) or javascript (whatever browsers actually
+ implement).
+
+ If you want to use javascript's "eval" function to "parse" JSON, you
+ might run into parse errors for valid JSON texts, or the resulting data
+ structure might not be queryable:
+
+ One of the problems is that U+2028 and U+2029 are valid characters
+ inside JSON strings, but are not allowed in ECMAscript string literals,
+ so the following Perl fragment will not output something that can be
+ guaranteed to be parsable by javascript's "eval":
+
+ use JSON::XS;
+
+ print encode_json [chr 0x2028];
+
+ The right fix for this is to use a proper JSON parser in your javascript
+ programs, and not rely on "eval" (see for example Douglas Crockford's
+ json2.js parser).
+
+ If this is not an option, you can, as a stop-gap measure, simply encode
+ to ASCII-only JSON:
+
+ use JSON::XS;
+
+ print JSON::XS->new->ascii->encode ([chr 0x2028]);
+
+ Note that this will enlarge the resulting JSON text quite a bit if you
+ have many non-ASCII characters. You might be tempted to run some regexes
+ to only escape U+2028 and U+2029, e.g.:
+
+ # DO NOT USE THIS!
+ my $json = JSON::XS->new->utf8->encode ([chr 0x2028]);
+ $json =~ s/\xe2\x80\xa8/\\u2028/g; # escape U+2028
+ $json =~ s/\xe2\x80\xa9/\\u2029/g; # escape U+2029
+ print $json;
+
+ Note that *this is a bad idea*: the above only works for U+2028 and
+ U+2029 and thus only for fully ECMAscript-compliant parsers. Many
+ existing javascript implementations, however, have issues with other
+ characters as well - using "eval" naively simply *will* cause problems.
+
+ Another problem is that some javascript implementations reserve some
+ property names for their own purposes (which probably makes them
+ non-ECMAscript-compliant). For example, Iceweasel reserves the
+ "__proto__" property name for it's own purposes.
+
+ If that is a problem, you could parse try to filter the resulting JSON
+ output for these property strings, e.g.:
+
+ $json =~ s/"__proto__"\s*:/"__proto__renamed":/g;
+
+ This works because "__proto__" is not valid outside of strings, so every
+ occurence of ""__proto__"\s*:" must be a string used as property name.
+
+ If you know of other incompatibilities, please let me know.
+
JSON and YAML
You often hear that JSON is a subset of YAML. This is, however, a mass
hysteria(*) and very far from the truth (as of the time of this
@@ -1087,10 +1155,10 @@
This will *usually* generate JSON texts that also parse as valid YAML.
Please note that YAML has hardcoded limits on (simple) object key
lengths that JSON doesn't have and also has different and incompatible
- unicode handling, so you should make sure that your hash keys are
- noticeably shorter than the 1024 "stream characters" YAML allows and
- that you do not have characters with codepoint values outside the
- Unicode BMP (basic multilingual page). YAML also does not allow "\/"
+ unicode character escape syntax, so you should make sure that your hash
+ keys are noticeably shorter than the 1024 "stream characters" YAML
+ allows and that you do not have characters with codepoint values outside
+ the Unicode BMP (basic multilingual page). YAML also does not allow "\/"
sequences in strings (which JSON::XS does not *currently* generate, but
other JSON generators might).
@@ -1116,6 +1184,12 @@
compatible to it, and educating users about the changes, instead of
spreading lies about the real compatibility for many *years* and
trying to silence people who point out that it isn't true.
+
+ Addendum/2009: the YAML 1.2 spec is still incomaptible with JSON,
+ even though the incompatibilities have been documented (and are
+ known to Brian) for many years and the spec makes explicit claims
+ that YAML is a superset of JSON. It would be so easy to fix, but
+ apparently, bullying and corrupting userdata is so much easier.
SPEED
It seems that JSON::XS is surprisingly fast, as shown in the following
Modified: branches/upstream/libjson-xs-perl/2.23/XS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/XS.pm?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/XS.pm (original)
+++ branches/upstream/libjson-xs-perl/2.23/XS.pm Sun Oct 11 22:25:27 2009
@@ -101,10 +101,9 @@
package JSON::XS;
-no warnings;
-use strict;
-
-our $VERSION = '2.23';
+use common::sense;
+
+our $VERSION = '2.26';
our @ISA = qw(Exporter);
our @EXPORT = qw(encode_json decode_json to_json from_json);
@@ -443,6 +442,8 @@
as key-value pairs have no inherent ordering in Perl.
This setting has no effect when decoding JSON texts.
+
+This setting has currently no effect on tied hashes.
=item $json = $json->allow_nonref ([$enable])
@@ -768,17 +769,21 @@
=item $json->incr_skip
-This will reset the state of the incremental parser and will remove the
-parsed text from the input buffer. This is useful after C<incr_parse>
-died, in which case the input buffer and incremental parser state is left
-unchanged, to skip the text parsed so far and to reset the parse state.
+This will reset the state of the incremental parser and will remove
+the parsed text from the input buffer so far. This is useful after
+C<incr_parse> died, in which case the input buffer and incremental parser
+state is left unchanged, to skip the text parsed so far and to reset the
+parse state.
+
+The difference to C<incr_reset> is that only text until the parse error
+occured is removed.
=item $json->incr_reset
This completely resets the incremental parser, that is, after this call,
it will be as if the parser had never parsed anything.
-This is useful if you want ot repeatedly parse JSON objects and want to
+This is useful if you want to repeatedly parse JSON objects and want to
ignore any trailing data, which means you have to reset the parser after
each successful decode.
@@ -1183,6 +1188,71 @@
=back
+=head2 JSON and ECMAscript
+
+JSON syntax is based on how literals are represented in javascript (the
+not-standardised predecessor of ECMAscript) which is presumably why it is
+called "JavaScript Object Notation".
+
+However, JSON is not a subset (and also not a superset of course) of
+ECMAscript (the standard) or javascript (whatever browsers actually
+implement).
+
+If you want to use javascript's C<eval> function to "parse" JSON, you
+might run into parse errors for valid JSON texts, or the resulting data
+structure might not be queryable:
+
+One of the problems is that U+2028 and U+2029 are valid characters inside
+JSON strings, but are not allowed in ECMAscript string literals, so the
+following Perl fragment will not output something that can be guaranteed
+to be parsable by javascript's C<eval>:
+
+ use JSON::XS;
+
+ print encode_json [chr 0x2028];
+
+The right fix for this is to use a proper JSON parser in your javascript
+programs, and not rely on C<eval> (see for example Douglas Crockford's
+F<json2.js> parser).
+
+If this is not an option, you can, as a stop-gap measure, simply encode to
+ASCII-only JSON:
+
+ use JSON::XS;
+
+ print JSON::XS->new->ascii->encode ([chr 0x2028]);
+
+Note that this will enlarge the resulting JSON text quite a bit if you
+have many non-ASCII characters. You might be tempted to run some regexes
+to only escape U+2028 and U+2029, e.g.:
+
+ # DO NOT USE THIS!
+ my $json = JSON::XS->new->utf8->encode ([chr 0x2028]);
+ $json =~ s/\xe2\x80\xa8/\\u2028/g; # escape U+2028
+ $json =~ s/\xe2\x80\xa9/\\u2029/g; # escape U+2029
+ print $json;
+
+Note that I<this is a bad idea>: the above only works for U+2028 and
+U+2029 and thus only for fully ECMAscript-compliant parsers. Many existing
+javascript implementations, however, have issues with other characters as
+well - using C<eval> naively simply I<will> cause problems.
+
+Another problem is that some javascript implementations reserve
+some property names for their own purposes (which probably makes
+them non-ECMAscript-compliant). For example, Iceweasel reserves the
+C<__proto__> property name for it's own purposes.
+
+If that is a problem, you could parse try to filter the resulting JSON
+output for these property strings, e.g.:
+
+ $json =~ s/"__proto__"\s*:/"__proto__renamed":/g;
+
+This works because C<__proto__> is not valid outside of strings, so every
+occurence of C<"__proto__"\s*:> must be a string used as property name.
+
+If you know of other incompatibilities, please let me know.
+
+
=head2 JSON and YAML
You often hear that JSON is a subset of YAML. This is, however, a mass
@@ -1200,12 +1270,12 @@
This will I<usually> generate JSON texts that also parse as valid
YAML. Please note that YAML has hardcoded limits on (simple) object key
lengths that JSON doesn't have and also has different and incompatible
-unicode handling, so you should make sure that your hash keys are
-noticeably shorter than the 1024 "stream characters" YAML allows and that
-you do not have characters with codepoint values outside the Unicode BMP
-(basic multilingual page). YAML also does not allow C<\/> sequences in
-strings (which JSON::XS does not I<currently> generate, but other JSON
-generators might).
+unicode character escape syntax, so you should make sure that your hash
+keys are noticeably shorter than the 1024 "stream characters" YAML allows
+and that you do not have characters with codepoint values outside the
+Unicode BMP (basic multilingual page). YAML also does not allow C<\/>
+sequences in strings (which JSON::XS does not I<currently> generate, but
+other JSON generators might).
There might be other incompatibilities that I am not aware of (or the YAML
specification has been changed yet again - it does so quite often). In
@@ -1233,6 +1303,12 @@
educating users about the changes, instead of spreading lies about the
real compatibility for many I<years> and trying to silence people who
point out that it isn't true.
+
+Addendum/2009: the YAML 1.2 spec is still incomaptible with JSON, even
+though the incompatibilities have been documented (and are known to
+Brian) for many years and the spec makes explicit claims that YAML is a
+superset of JSON. It would be so easy to fix, but apparently, bullying and
+corrupting userdata is so much easier.
=back
Modified: branches/upstream/libjson-xs-perl/2.23/XS.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/XS.xs?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/XS.xs (original)
+++ branches/upstream/libjson-xs-perl/2.23/XS.xs Sun Oct 11 22:25:27 2009
@@ -14,12 +14,13 @@
#endif
// some old perls do not have this, try to make it work, no
-// guarentees, though. if it breaks, you get to keep the pieces.
+// guarantees, though. if it breaks, you get to keep the pieces.
#ifndef UTF8_MAXBYTES
# define UTF8_MAXBYTES 13
#endif
-#define IVUV_MAXCHARS (sizeof (UV) * CHAR_BIT * 28 / 93 + 2)
+// three extra for rounding, sign, and end of string
+#define IVUV_MAXCHARS (sizeof (UV) * CHAR_BIT * 28 / 93 + 3)
#define F_ASCII 0x00000001UL
#define F_LATIN1 0x00000002UL
@@ -177,6 +178,15 @@
return s;
}
+// convert offset pointer to character index, sv must be string
+static STRLEN
+ptr_to_index (SV *sv, char *offset)
+{
+ return SvUTF8 (sv)
+ ? utf8_distance (offset, SvPVX (sv))
+ : offset - SvPVX (sv);
+}
+
/////////////////////////////////////////////////////////////////////////////
// encoder
@@ -197,7 +207,7 @@
if (expect_false (enc->cur + len >= enc->end))
{
STRLEN cur = enc->cur - (char *)SvPVX (enc->sv);
- SvGROW (enc->sv, cur + len + 1);
+ SvGROW (enc->sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1);
enc->cur = SvPVX (enc->sv) + cur;
enc->end = SvPVX (enc->sv) + SvLEN (enc->sv) - 1;
}
@@ -464,7 +474,7 @@
// actually, this is mostly due to the stupid so-called
// security workaround added somewhere in 5.8.x
// that randomises hash orderings
- if (enc->json.flags & F_CANONICAL)
+ if (enc->json.flags & F_CANONICAL && !SvRMAGICAL (hv))
{
int count = hv_iterinit (hv);
@@ -752,6 +762,7 @@
SvPOK_only (enc.sv);
encode_sv (&enc, scalar);
+ encode_nl (&enc);
SvCUR_set (enc.sv, enc.cur - SvPVX (enc.sv));
*SvEND (enc.sv) = 0; // many xs functions expect a trailing 0 for text strings
@@ -941,11 +952,10 @@
else if (ch >= 0x80)
{
STRLEN clen;
- UV uch;
--dec_cur;
- uch = decode_utf8 (dec_cur, dec->end - dec_cur, &clen);
+ decode_utf8 (dec_cur, dec->end - dec_cur, &clen);
if (clen == (STRLEN)-1)
ERR ("malformed UTF-8 character in JSON string");
@@ -972,7 +982,11 @@
if (sv)
{
- SvGROW (sv, SvCUR (sv) + len + 1);
+ STRLEN cur = SvCUR (sv);
+
+ if (SvLEN (sv) <= cur + len)
+ SvGROW (sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1);
+
memcpy (SvPVX (sv) + SvCUR (sv), buf, len);
SvCUR_set (sv, SvCUR (sv) + len);
}
@@ -1073,20 +1087,20 @@
if (*start == '-')
switch (len)
{
- case 2: return newSViv (-( start [1] - '0' * 1));
- case 3: return newSViv (-( start [1] * 10 + start [2] - '0' * 11));
- case 4: return newSViv (-( start [1] * 100 + start [2] * 10 + start [3] - '0' * 111));
- case 5: return newSViv (-( start [1] * 1000 + start [2] * 100 + start [3] * 10 + start [4] - '0' * 1111));
- case 6: return newSViv (-(start [1] * 10000 + start [2] * 1000 + start [3] * 100 + start [4] * 10 + start [5] - '0' * 11111));
+ case 2: return newSViv (-(IV)( start [1] - '0' * 1));
+ case 3: return newSViv (-(IV)( start [1] * 10 + start [2] - '0' * 11));
+ case 4: return newSViv (-(IV)( start [1] * 100 + start [2] * 10 + start [3] - '0' * 111));
+ case 5: return newSViv (-(IV)( start [1] * 1000 + start [2] * 100 + start [3] * 10 + start [4] - '0' * 1111));
+ case 6: return newSViv (-(IV)(start [1] * 10000 + start [2] * 1000 + start [3] * 100 + start [4] * 10 + start [5] - '0' * 11111));
}
else
switch (len)
{
- case 1: return newSViv ( start [0] - '0' * 1);
- case 2: return newSViv ( start [0] * 10 + start [1] - '0' * 11);
- case 3: return newSViv ( start [0] * 100 + start [1] * 10 + start [2] - '0' * 111);
- case 4: return newSViv ( start [0] * 1000 + start [1] * 100 + start [2] * 10 + start [3] - '0' * 1111);
- case 5: return newSViv ( start [0] * 10000 + start [1] * 1000 + start [2] * 100 + start [3] * 10 + start [4] - '0' * 11111);
+ case 1: return newSViv ( start [0] - '0' * 1);
+ case 2: return newSViv ( start [0] * 10 + start [1] - '0' * 11);
+ case 3: return newSViv ( start [0] * 100 + start [1] * 10 + start [2] - '0' * 111);
+ case 4: return newSViv ( start [0] * 1000 + start [1] * 100 + start [2] * 10 + start [3] - '0' * 1111);
+ case 5: return newSViv ( start [0] * 10000 + start [1] * 1000 + start [2] * 100 + start [3] * 10 + start [4] - '0' * 11111);
}
{
@@ -1406,13 +1420,18 @@
}
static SV *
-decode_json (SV *string, JSON *json, STRLEN *offset_return)
+decode_json (SV *string, JSON *json, char **offset_return)
{
dec_t dec;
- STRLEN offset;
SV *sv;
- SvGETMAGIC (string);
+ /* work around bugs in 5.10 where manipulating magic values
+ * will perl ignore the magic in subsequent accesses
+ */
+ /*SvGETMAGIC (string);*/
+ if (SvMAGICAL (string))
+ string = sv_2mortal (newSVsv (string));
+
SvUPGRADE (string, SVt_PV);
/* work around a bug in perl 5.10, which causes SvCUR to fail an
@@ -1425,15 +1444,17 @@
* assertion business is seriously broken, try yet another workaround
* for the broken -DDEBUGGING.
*/
+ {
#ifdef DEBUGGING
- offset = SvOK (string) ? sv_len (string) : 0;
+ STRLEN offset = SvOK (string) ? sv_len (string) : 0;
#else
- offset = SvCUR (string);
+ STRLEN offset = SvCUR (string);
#endif
- if (offset > json->max_size && json->max_size)
- croak ("attempted decode of JSON text of %lu bytes size, but max_size is set to %lu",
- (unsigned long)SvCUR (string), (unsigned long)json->max_size);
+ if (offset > json->max_size && json->max_size)
+ croak ("attempted decode of JSON text of %lu bytes size, but max_size is set to %lu",
+ (unsigned long)SvCUR (string), (unsigned long)json->max_size);
+ }
if (json->flags & F_UTF8)
sv_utf8_downgrade (string, 0);
@@ -1455,6 +1476,9 @@
decode_ws (&dec);
sv = decode_sv (&dec);
+
+ if (offset_return)
+ *offset_return = dec.cur;
if (!(offset_return || !sv))
{
@@ -1467,16 +1491,6 @@
SvREFCNT_dec (sv);
sv = 0;
}
- }
-
- if (offset_return || !sv)
- {
- offset = dec.json.flags & F_UTF8
- ? dec.cur - SvPVX (string)
- : utf8_distance (dec.cur, SvPVX (string));
-
- if (offset_return)
- *offset_return = offset;
}
if (!sv)
@@ -1492,9 +1506,9 @@
pv_uni_display (uni, dec.cur, dec.end - dec.cur, 20, UNI_DISPLAY_QQ);
LEAVE;
- croak ("%s, at character offset %d [\"%s\"]",
+ croak ("%s, at character offset %d (before \"%s\")",
dec.err,
- (int)offset,
+ ptr_to_index (string, dec.cur),
dec.cur != dec.end ? SvPV_nolen (uni) : "(end of string)");
}
@@ -1644,6 +1658,8 @@
json_true = get_bool ("JSON::XS::true");
json_false = get_bool ("JSON::XS::false");
+
+ CvNODEBUG_on (get_cv ("JSON::XS::incr_text", 0)); /* the debugger completely breaks lvalue subs */
}
PROTOTYPES: DISABLE
@@ -1773,10 +1789,10 @@
void decode_prefix (JSON *self, SV *jsonstr)
PPCODE:
{
- STRLEN offset;
+ char *offset;
EXTEND (SP, 2);
PUSHs (decode_json (jsonstr, self, &offset));
- PUSHs (sv_2mortal (newSVuv (offset)));
+ PUSHs (sv_2mortal (newSVuv (ptr_to_index (jsonstr, offset))));
}
void incr_parse (JSON *self, SV *jsonstr = 0)
@@ -1788,20 +1804,29 @@
// append data, if any
if (jsonstr)
{
- if (SvUTF8 (jsonstr) && !SvUTF8 (self->incr_text))
+ if (SvUTF8 (jsonstr))
{
- /* utf-8-ness differs, need to upgrade */
- sv_utf8_upgrade (self->incr_text);
-
- if (self->incr_pos)
- self->incr_pos = utf8_hop ((U8 *)SvPVX (self->incr_text), self->incr_pos)
- - (U8 *)SvPVX (self->incr_text);
+ if (!SvUTF8 (self->incr_text))
+ {
+ /* utf-8-ness differs, need to upgrade */
+ sv_utf8_upgrade (self->incr_text);
+
+ if (self->incr_pos)
+ self->incr_pos = utf8_hop ((U8 *)SvPVX (self->incr_text), self->incr_pos)
+ - (U8 *)SvPVX (self->incr_text);
+ }
}
+ else if (SvUTF8 (self->incr_text))
+ sv_utf8_upgrade (jsonstr);
{
STRLEN len;
const char *str = SvPV (jsonstr, len);
- SvGROW (self->incr_text, SvCUR (self->incr_text) + len + 1);
+ STRLEN cur = SvCUR (self->incr_text);
+
+ if (SvLEN (self->incr_text) <= cur + len)
+ SvGROW (self->incr_text, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1);
+
Move (str, SvEND (self->incr_text), len, char);
SvCUR_set (self->incr_text, SvCUR (self->incr_text) + len);
*SvEND (self->incr_text) = 0; // this should basically be a nop, too, but make sure it's there
@@ -1811,7 +1836,7 @@
if (GIMME_V != G_VOID)
do
{
- STRLEN offset;
+ char *offset;
if (!INCR_DONE (self))
{
@@ -1827,10 +1852,11 @@
XPUSHs (decode_json (self->incr_text, self, &offset));
- sv_chop (self->incr_text, SvPV_nolen (self->incr_text) + offset);
- self->incr_pos -= offset;
+ self->incr_pos -= offset - SvPVX (self->incr_text);
self->incr_nest = 0;
self->incr_mode = 0;
+
+ sv_chop (self->incr_text, offset);
}
while (GIMME_V == G_ARRAY);
}
Modified: branches/upstream/libjson-xs-perl/2.23/t/01_utf8.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/t/01_utf8.t?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/t/01_utf8.t (original)
+++ branches/upstream/libjson-xs-perl/2.23/t/01_utf8.t Sun Oct 11 22:25:27 2009
@@ -11,7 +11,7 @@
ok (JSON::XS->new->allow_nonref (1)->utf8 (1)->encode ("ü") eq "\"\xc3\xbc\"");
ok (JSON::XS->new->allow_nonref (1)->encode ("ü") eq "\"ü\"");
ok (JSON::XS->new->allow_nonref (1)->ascii (1)->utf8 (1)->encode (chr 0x8000) eq '"\u8000"');
-ok (JSON::XS->new->allow_nonref (1)->ascii (1)->utf8 (1)->pretty (1)->encode (chr 0x10402) eq '"\ud801\udc02"');
+ok (JSON::XS->new->allow_nonref (1)->ascii (1)->utf8 (1)->pretty (1)->encode (chr 0x10402) eq "\"\\ud801\\udc02\"\n");
eval { JSON::XS->new->allow_nonref (1)->utf8 (1)->decode ('"ü"') };
ok $@ =~ /malformed UTF-8/;
Modified: branches/upstream/libjson-xs-perl/2.23/t/02_error.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/t/02_error.t?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/t/02_error.t (original)
+++ branches/upstream/libjson-xs-perl/2.23/t/02_error.t Sun Oct 11 22:25:27 2009
@@ -2,6 +2,7 @@
use utf8;
use JSON::XS;
+no warnings;
our $test;
sub ok($) {
Modified: branches/upstream/libjson-xs-perl/2.23/t/06_pc_pretty.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/t/06_pc_pretty.t?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/t/06_pc_pretty.t (original)
+++ branches/upstream/libjson-xs-perl/2.23/t/06_pc_pretty.t Sun Oct 11 22:25:27 2009
@@ -24,7 +24,8 @@
{
"foo" : "bar"
}
-]|);
+]
+|);
$obj = { foo => [ {a=>"b"}, 0, 1, 2 ] };
$pc->pretty(0);
@@ -44,7 +45,8 @@
1,
2
]
-}|);
+}
+|);
$obj = { foo => [ {a=>"b"}, 0, 1, 2 ] };
$pc->pretty(0);
@@ -54,11 +56,11 @@
$obj = {foo => "bar"};
$pc->indent(1);
-is($pc->encode($obj), qq|{\n "foo":"bar"\n}|, "nospace");
+is($pc->encode($obj), qq|{\n "foo":"bar"\n}\n|, "nospace");
$pc->space_after(1);
-is($pc->encode($obj), qq|{\n "foo": "bar"\n}|, "after");
+is($pc->encode($obj), qq|{\n "foo": "bar"\n}\n|, "after");
$pc->space_before(1);
-is($pc->encode($obj), qq|{\n "foo" : "bar"\n}|, "both");
+is($pc->encode($obj), qq|{\n "foo" : "bar"\n}\n|, "both");
$pc->space_after(0);
-is($pc->encode($obj), qq|{\n "foo" :"bar"\n}|, "before");
+is($pc->encode($obj), qq|{\n "foo" :"bar"\n}\n|, "before");
Added: branches/upstream/libjson-xs-perl/2.23/t/20_faihu.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/t/20_faihu.t?rev=45591&op=file
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/t/20_faihu.t (added)
+++ branches/upstream/libjson-xs-perl/2.23/t/20_faihu.t Sun Oct 11 22:25:27 2009
@@ -1,0 +1,28 @@
+#! perl
+
+# adapted from a test by Aristotle Pagaltzis (http://intertwingly.net/blog/2007/11/15/Astral-Plane-Characters-in-Json)
+
+use strict;
+use warnings;
+
+use JSON::XS;
+use Encode qw(encode decode);
+
+use Test::More tests => 3;
+
+my ($faihu, $faihu_json, $roundtrip, $js) = "\x{10346}";
+
+$js = JSON::XS->new->allow_nonref->ascii;
+$faihu_json = $js->encode($faihu);
+$roundtrip = $js->decode($faihu_json);
+is ($roundtrip, $faihu, 'JSON in ASCII roundtrips correctly');
+
+$js = JSON::XS->new->allow_nonref->utf8;
+$faihu_json = $js->encode ($faihu);
+$roundtrip = $js->decode ($faihu_json);
+is ($roundtrip, $faihu, 'JSON in UTF-8 roundtrips correctly');
+
+$js = JSON::XS->new->allow_nonref;
+$faihu_json = encode 'UTF-16BE', $js->encode ($faihu);
+$roundtrip = $js->decode( decode 'UTF-16BE', $faihu_json);
+is ($roundtrip, $faihu, 'JSON with external recoding roundtrips correctly' );
Added: branches/upstream/libjson-xs-perl/2.23/t/21_evans.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/t/21_evans.t?rev=45591&op=file
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/t/21_evans.t (added)
+++ branches/upstream/libjson-xs-perl/2.23/t/21_evans.t Sun Oct 11 22:25:27 2009
@@ -1,0 +1,23 @@
+#! perl
+
+# adapted from a test by Martin Evans
+
+use strict;
+use warnings;
+
+use JSON::XS;
+
+print "1..1\n";
+
+my $data = ["\x{53f0}\x{6240}\x{306e}\x{6d41}\x{3057}",
+ "\x{6c60}\x{306e}\x{30ab}\x{30a8}\x{30eb}"];
+my $js = JSON::XS->new->encode ($data);
+my $j = new JSON::XS;
+my $object = $j->incr_parse ($js);
+
+die "no object" if !$object;
+
+eval { $j->incr_text };
+
+print $@ ? "not " : "", "ok 1 # $@\n";
+
Modified: branches/upstream/libjson-xs-perl/2.23/t/99_binary.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-xs-perl/2.23/t/99_binary.t?rev=45591&op=diff
==============================================================================
--- branches/upstream/libjson-xs-perl/2.23/t/99_binary.t (original)
+++ branches/upstream/libjson-xs-perl/2.23/t/99_binary.t Sun Oct 11 22:25:27 2009
@@ -31,7 +31,7 @@
ok ($_[0] eq JSON::XS->new->shrink->decode ($js)->[0], 7);
}
-srand 0; # doesn't help too much, but its at leats more deterministic
+srand 0; # doesn't help too much, but its at least more deterministic
for (1..768) {
test join "", map chr ($_ & 255), 0..$_;
@@ -39,3 +39,4 @@
test join "", map chr ($_ * 97 & ~0x4000), 0..$_;
test join "", map chr (rand (2**20) & ~0x800), 0..$_;
}
+
More information about the Pkg-perl-cvs-commits
mailing list