diff options
author | Karl Williamson <public@khwilliamson.com> | 2012-08-06 11:27:53 -0600 |
---|---|---|
committer | Karl Williamson <public@khwilliamson.com> | 2012-08-06 15:06:07 -0600 |
commit | 54161612423d90fe313643089d18d7a3a98460c7 (patch) | |
tree | 1ac0298f6c47db6ed614de5725b9a897fe7dc752 /dist | |
parent | 1bd358614578efacd579635d85759fe8a501763e (diff) | |
download | perl-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.xs | 28 |
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 */ |