summaryrefslogtreecommitdiff
path: root/dist
diff options
context:
space:
mode:
authorKarl Williamson <public@khwilliamson.com>2012-08-06 11:27:53 -0600
committerKarl Williamson <public@khwilliamson.com>2012-08-06 15:06:07 -0600
commit54161612423d90fe313643089d18d7a3a98460c7 (patch)
tree1ac0298f6c47db6ed614de5725b9a897fe7dc752 /dist
parent1bd358614578efacd579635d85759fe8a501763e (diff)
downloadperl-54161612423d90fe313643089d18d7a3a98460c7.tar.gz
Data::Dumper: Fix to use with earlier Perls
Commit 4b88fb76efce8c436e63b907c9842345d4fa77c7 broke Data::Dumper when it is used on Perl versions earlier than v5.16.
Diffstat (limited to 'dist')
-rw-r--r--dist/Data-Dumper/Dumper.xs28
1 files changed, 27 insertions, 1 deletions
diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs
index 71b34ca2bb..c1a7ec866e 100644
--- a/dist/Data-Dumper/Dumper.xs
+++ b/dist/Data-Dumper/Dumper.xs
@@ -28,6 +28,10 @@ static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval,
#define HvNAME_get HvNAME
#endif
+/* Perls 7 through portions of 15 used utf8_to_uvchr() which didn't have a
+ * length parameter. This wrongly allowed reading beyond the end of buffer
+ * given malformed input */
+
#if PERL_VERSION <= 6 /* Perl 5.6 and earlier */
# ifdef EBCDIC
@@ -47,11 +51,33 @@ Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen)
# if !defined(PERL_IMPLICIT_CONTEXT)
# define utf8_to_uvchr_buf Perl_utf8_to_uvchr_buf
# else
-# define utf8_to_uvchr_buf(a,b) Perl_utf8_to_uvchr_buf(aTHX_ a,b)
+# define utf8_to_uvchr_buf(a,b,c) Perl_utf8_to_uvchr_buf(aTHX_ a,b,c)
# endif
#endif /* PERL_VERSION <= 6 */
+/* Perl 5.7 through part of 5.15 */
+#if PERL_VERSION > 6 && PERL_VERSION <= 15 && ! defined(utf8_to_uvchr_buf)
+
+UV
+Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen)
+{
+ /* We have to discard <send> for these versions; hence can read off the
+ * end of the buffer if there is a malformation that indicates the
+ * character is longer than the space available */
+
+ const UV uv = utf8_to_uvchr(s, retlen);
+ return UNI_TO_NATIVE(uv);
+}
+
+# if !defined(PERL_IMPLICIT_CONTEXT)
+# define utf8_to_uvchr_buf Perl_utf8_to_uvchr_buf
+# else
+# define utf8_to_uvchr_buf(a,b,c) Perl_utf8_to_uvchr_buf(aTHX_ a,b,c)
+# endif
+
+#endif /* PERL_VERSION > 6 && <= 15 */
+
/* Changes in 5.7 series mean that now IOK is only set if scalar is
precisely integer but in 5.6 and earlier we need to do a more
complex test */