EBCDIC: the v-string components cannot exceed 2147483647.

p4raw-id: //depot/perl@14963

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f445d2d..3cd4ece 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1690,6 +1690,12 @@ would otherwise result in the same message being repeated.
 Failure of user callbacks dispatched using the C<G_KEEPERR> flag could
 also result in this warning.  See L<perlcall/G_KEEPERR>.
 
+=item In EBCDIC the v-string components cannot exceed 2147483647
+
+(F) An error peculiar to EBCDIC.  Internally, v-strings are stored as
+Unicode code points, and encoded in EBCDIC as UTF-EBCDIC.  The UTF-EBCDIC
+encoding is limited to code points no larger than 2147483647 (0x7FFFFFFF).
+
 =item Insecure dependency in %s
 
 (F) You tried to do something that the tainting mechanism didn't like.

diff --git a/pod/perlport.pod b/pod/perlport.pod
index 8d229d6..bc3f1d9 100644 (file)
--- a/pod/perlport.pod
+++ b/pod/perlport.pod
@@ -232,6 +232,9 @@ binary, or else consider using modules like Data::Dumper (included in
 the standard distribution as of Perl 5.005) and Storable (included as
 of perl 5.8).  Keeping all data as text significantly simplifies matters.
 
+The v-strings are portable only up to v2147483647 (0x7FFFFFFF), that's
+how far EBCDIC, or more precisely UTF-EBCDIC will go.
+
 =head2 Files and Filesystems
 
 Most platforms these days structure files in a hierarchical fashion.

diff --git a/t/op/ver.t b/t/op/ver.t
index 1dc28d2..4f79acf 100755 (executable)
--- a/t/op/ver.t
+++ b/t/op/ver.t
@@ -9,10 +9,9 @@ BEGIN {
 $DOWARN = 1; # enable run-time warnings now
 
 use Config;
-$tests = $Config{'uvsize'} == 8 ? 47 : 44;
 
 require "test.pl";
-plan( tests => $tests );
+plan( tests => 47 );
 
 eval { use v5.5.640; };
 is( $@, '', "use v5.5.640; $@");
@@ -214,15 +213,24 @@ $v = $revision + $version/1000 + $subversion/1000000;
 
 ok( $v == $], "\$^V == \$] (numeric)" );
 
-# [ID 20010902.001] check if v-strings handle full UV range or not
-if ( $Config{'uvsize'} >= 4 ) {
-    is(  sprintf("%vd", v2147483647.2147483648),   '2147483647.2147483648', 'v-string > IV_MAX[32-bit]' );
-    is(  sprintf("%vd", v3141592653),              '3141592653',            'IV_MAX < v-string < UV_MAX[32-bit]');
-    is(  sprintf("%vd", v4294967295),              '4294967295',            'v-string == UV_MAX[32-bit] - 1');
-}
-
-if ( $Config{'uvsize'} >= 8 ) {
-    is(  sprintf("%vd", v9223372036854775807.9223372036854775808),   '9223372036854775807.9223372036854775808', 'v-string > IV_MAX[64-bit]' );
-    is(  sprintf("%vd", v17446744073709551615),                      '17446744073709551615',                    'IV_MAX < v-string < UV_MAX[64-bit]');
-    is(  sprintf("%vd", v18446744073709551615),                      '18446744073709551615',                    'v-string == UV_MAX[64-bit] - 1');
+SKIP: {
+  skip("In EBCDIC the v-string components cannot exceed 2147483647", 6)
+    if ord "A" == 193;
+
+  # [ID 20010902.001] check if v-strings handle full UV range or not
+  if ( $Config{'uvsize'} >= 4 ) {
+    is(  sprintf("%vd", eval 'v2147483647.2147483648'),   '2147483647.2147483648', 'v-string > IV_MAX[32-bit]' );
+    is(  sprintf("%vd", eval 'v3141592653'),              '3141592653',            'IV_MAX < v-string < UV_MAX[32-bit]');
+    is(  sprintf("%vd", eval 'v4294967295'),              '4294967295',            'v-string == UV_MAX[32-bit] - 1');
+  }
+
+  SKIP: {
+    skip("No quads", 3) if $Config{uvsize} < 8;
+
+    if ( $Config{'uvsize'} >= 8 ) {
+      is(  sprintf("%vd", eval 'v9223372036854775807.9223372036854775808'),   '9223372036854775807.9223372036854775808', 'v-string > IV_MAX[64-bit]' );
+      is(  sprintf("%vd", eval 'v17446744073709551615'),                      '17446744073709551615',                    'IV_MAX < v-string < UV_MAX[64-bit]');
+      is(  sprintf("%vd", eval 'v18446744073709551615'),                      '18446744073709551615',                    'v-string == UV_MAX[64-bit] - 1');
+    }
+  }
 }

diff --git a/util.c b/util.c
index 26b63d0..a9f9ade 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4012,35 +4012,39 @@ Perl_new_vstring(pTHX_ char *s, SV *sv)
        for (;;) {
            rev = 0;
            {
-           /* this is atoi() that tolerates underscores */
-           char *end = pos;
-           UV mult = 1;
-           if ( *(s-1) == '_') {
-               mult = 10;
-           }
-           while (--end >= s) {
-               UV orev;
-               orev = rev;
-               rev += (*end - '0') * mult;
-               mult *= 10;
-               if (orev > rev && ckWARN_d(WARN_OVERFLOW))
-               Perl_warner(aTHX_ WARN_OVERFLOW,
-                       "Integer overflow in decimal number");
-           }
+                /* this is atoi() that tolerates underscores */
+                char *end = pos;
+                UV mult = 1;
+                if ( *(s-1) == '_') {
+                     mult = 10;
+                }
+                while (--end >= s) {
+                     UV orev;
+                     orev = rev;
+                     rev += (*end - '0') * mult;
+                     mult *= 10;
+                     if (orev > rev && ckWARN_d(WARN_OVERFLOW))
+                          Perl_warner(aTHX_ WARN_OVERFLOW,
+                                      "Integer overflow in decimal number");
+                }
            }
+#ifdef EBCDIC
+           if (rev > 0x7FFFFFFF)
+                Perl_croak(aTHX "In EBCDIC the v-string components cannot exceed 2147483647");
+#endif
            /* Append native character for the rev point */
            tmpend = uvchr_to_utf8(tmpbuf, rev);
            sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
            if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev)))
-           SvUTF8_on(sv);
+                SvUTF8_on(sv);
            if ( (*pos == '.' || *pos == '_') && isDIGIT(pos[1]))
-           s = ++pos;
+                s = ++pos;
            else {
-           s = pos;
-           break;
+                s = pos;
+                break;
            }
            while (isDIGIT(*pos) )
-           pos++;
+                pos++;
        }
        SvPOK_on(sv);
        SvREADONLY_on(sv);