diff options
| -rwxr-xr-x | genpacksizetables.pl | 12 | ||||
| -rw-r--r-- | pp_pack.c | 19 |
2 files changed, 20 insertions, 11 deletions
diff --git a/genpacksizetables.pl b/genpacksizetables.pl index b3e3a8c39c..2987499b95 100755 --- a/genpacksizetables.pl +++ b/genpacksizetables.pl @@ -7,10 +7,10 @@ use Encode; my @lines = grep {!/^#/} <DATA>; sub addline { - my ($arrays, $chrmap, $letter, $arrayname, $noone, $nocsum, $size, + my ($arrays, $chrmap, $letter, $arrayname, $spare, $nocsum, $size, $condition) = @_; my $line = "/* $letter */ $size"; - $line .= " | PACK_SIZE_CANNOT_ONLY_ONE" if $noone; + $line .= " | PACK_SIZE_SPARE" if $spare; $line .= " | PACK_SIZE_CANNOT_CSUM" if $nocsum; $line .= ","; # And then the hack @@ -24,7 +24,7 @@ sub output_tables { my $chrmap = shift; foreach (@_) { - my ($letter, $shriek, $noone, $nocsum, $size, $condition) + my ($letter, $shriek, $spare, $nocsum, $size, $condition) = /^([A-Za-z])(!?)\t(\S*)\t(\S*)\t([^\t\n]+)(?:\t+(.*))?$/; die "Can't parse '$_'" unless $size; @@ -36,7 +36,7 @@ sub output_tables { } addline (\%arrays, $chrmap, $letter, $shriek ? 'shrieking' : 'normal', - $noone, $nocsum, $size, $condition); + $spare, $nocsum, $size, $condition); } my %earliest; @@ -100,7 +100,7 @@ output_tables (\%ebcdicmap, @lines); print "#endif\n"; __DATA__ -#Symbol nooone nocsum size +#Symbol spare nocsum size c char C unsigned char U char @@ -126,7 +126,7 @@ N =SIZE32 V! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN N! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN L =SIZE32 -p * * char * +p * char * w * char q Quad_t HAS_QUAD Q Uquad_t HAS_QUAD @@ -272,7 +272,7 @@ S_mul128(pTHX_ SV *sv, U8 m) #endif #define PACK_SIZE_CANNOT_CSUM 0x80 -#define PACK_SIZE_CANNOT_ONLY_ONE 0x40 +#define PACK_SIZE_SPARE 0x40 #define PACK_SIZE_MASK 0x3F @@ -329,7 +329,7 @@ unsigned char size_normal[53] = { 0, /* n */ SIZE16, 0, - /* p */ sizeof(char *) | PACK_SIZE_CANNOT_ONLY_ONE | PACK_SIZE_CANNOT_CSUM, + /* p */ sizeof(char *) | PACK_SIZE_CANNOT_CSUM, #if defined(HAS_QUAD) /* q */ sizeof(Quad_t), #else @@ -398,7 +398,7 @@ unsigned char size_normal[99] = { 0, /* n */ SIZE16, 0, - /* p */ sizeof(char *) | PACK_SIZE_CANNOT_ONLY_ONE | PACK_SIZE_CANNOT_CSUM, + /* p */ sizeof(char *) | PACK_SIZE_CANNOT_CSUM, #if defined(HAS_QUAD) /* q */ sizeof(Quad_t), #else @@ -935,7 +935,8 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c { int which = (symptr->code & TYPE_IS_SHRIEKING) ? PACK_SIZE_SHRIEKING : PACK_SIZE_NORMAL; - int offset = TYPE_NO_MODIFIERS(datumtype) - packsize[which].first; + const int rawtype = TYPE_NO_MODIFIERS(datumtype); + int offset = rawtype - packsize[which].first; if (offset >= 0 && offset < packsize[which].size) { /* Data about this template letter */ @@ -948,9 +949,17 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c if (len > howmany) len = howmany; + /* In the old code, 'p' was the only type without shortcut + code to curtail unpacking to only one. As far as I can + see the only point of retaining this anomaly is to make + code such as $_ = unpack "p2", pack "pI", "Hi", 2 + continue to segfault. ie, it probably should be + construed as a bug. + */ + if (!checksum || (data & PACK_SIZE_CANNOT_CSUM)) { if (len && unpack_only_one && - !(data & PACK_SIZE_CANNOT_ONLY_ONE)) + rawtype != 'p') len = 1; EXTEND(SP, len); EXTEND_MORTAL(len); |