integrate cfgperl contents into mainline; add new tests from
Gurusamy Sarathy [Sun, 5 Mar 2000 05:41:10 +0000 (05:41 +0000)]
inc.t into 64bit.t

p4raw-id: //depot/perl@5537

1  2 
t/op/64bit.t
toke.c

diff --cc t/op/64bit.t
@@@ -1,3 -1,3 +1,5 @@@
++#./perl
++
  BEGIN {
        eval { my $q = pack "q", 0 };
        if ($@) {
@@@ -17,7 -17,7 +19,7 @@@
  # 32+ bit integers don't cause noise
  no warnings qw(overflow portable);
  
--print "1..42\n";
++print "1..48\n";
  
  my $q = 12345678901;
  my $r = 23456789012;
@@@ -136,7 -136,7 +138,7 @@@ $x = 98765432109 % 12345678901
  print "not " unless $x == 901;
  print "ok 25\n";
  
--# The following six adapted from op/inc.
++# The following 12 tests adapted from op/inc.
  
  $a = 9223372036854775807;
  $c = $a++;
@@@ -168,40 -168,40 +170,76 @@@ $c = $a - 1
  print "not " unless $a == -9223372036854775808 && $c == -9223372036854775809;
  print "ok 31\n";
  
++$a = 9223372036854775808;
++$a = -$a;
++$c = $a--;
++print "not " unless $a == -9223372036854775809 && $c == -9223372036854775808;
++print "ok 32\n";
++
++$a = 9223372036854775808;
++$a = -$a;
++$c = --$a;
++print "not " unless $a == -9223372036854775809 && $c == $a;
++print "ok 33\n";
++
++$a = 9223372036854775808;
++$a = -$a;
++$c = $a - 1;
++print "not " unless $a == -9223372036854775808 && $c == -9223372036854775809;
++print "ok 34\n";
++
++$a = 9223372036854775808;
++$b = -$a;
++$c = $b--;
++print "not " unless $b == -$a-1 && $c == -$a;
++print "ok 35\n";
++
++$a = 9223372036854775808;
++$b = -$a;
++$c = --$b;
++print "not " unless $b == -$a-1 && $c == $b;
++print "ok 36\n";
++
++$a = 9223372036854775808;
++$b = -$a;
++$b = $b - 1;
++print "not " unless $b == -(++$a);
++print "ok 37\n";
++
  
  $x = '';
  print "not " unless (vec($x, 1, 64) = $q) == $q;
--print "ok 32\n";
++print "ok 38\n";
  
  print "not " unless vec($x, 1, 64) == $q && vec($x, 1, 64) > $f;
--print "ok 33\n";
++print "ok 39\n";
  
  print "not " unless vec($x, 0, 64) == 0 && vec($x, 2, 64) == 0;
--print "ok 34\n";
++print "ok 40\n";
  
  
  print "not " unless ~0 == 0xffffffffffffffff;
--print "ok 35\n";
++print "ok 41\n";
  
  print "not " unless (0xffffffff<<32) == 0xffffffff00000000;
--print "ok 36\n";
++print "ok 42\n";
  
  print "not " unless ((0xffffffff)<<32)>>32 == 0xffffffff;
--print "ok 37\n";
++print "ok 43\n";
  
  print "not " unless 1<<63 == 0x8000000000000000;
--print "ok 38\n";
++print "ok 44\n";
  
  print "not " unless (sprintf "%#Vx", 1<<63) eq '0x8000000000000000';
--print "ok 39\n";
++print "ok 45\n";
  
  print "not " unless (0x8000000000000000 | 1) == 0x8000000000000001;
--print "ok 40\n";
++print "ok 46\n";
  
  print "not " unless (0xf000000000000000 & 0x8000000000000000) == 0x8000000000000000;
--print "ok 41\n";
++print "ok 47\n";
  
  print "not " unless (0xf000000000000000 ^ 0xfffffffffffffff0) == 0x0ffffffffffffff0;
--print "ok 42\n";
++print "ok 48\n";
  
  # eof
diff --cc toke.c
--- 1/toke.c
--- 2/toke.c
+++ b/toke.c
@@@ -6683,7 -6683,13 +6683,6 @@@ Perl_scan_num(pTHX_ char *start
      register char *s = start;         /* current position in buffer */
      register char *d;                 /* destination in temp buffer */
      register char *e;                 /* end of temp buffer */
-     UV tryuv;                         /* used to see if it can be an UV */
 -    IV tryiv;                         /* used to see if it can be an IV */
 -    UV tryuv;                         /* used to see if it can be an UV */
 -#if ( defined(USE_64_BIT_INT) && \
 -      (!defined(HAS_STRTOLL)|| !defined(HAS_STRTOULL))) || \
 -    (!defined(USE_64_BIT_INT) && \
 -        (!defined(HAS_STRTOL) || !defined(HAS_STRTOUL)))
 -#endif
      NV value;                         /* number read, as a double */
      SV *sv = Nullsv;                  /* place to put the converted number */
      bool floatit;                     /* boolean: int or float? */
           Note: if floatit is true, then we don't need to do the
           conversion at all.
        */
--      tryuv = U_V(value);
--      if (!floatit && (NV)tryuv == value) {
--          if (tryuv <= IV_MAX)
--              sv_setiv(sv, (IV)tryuv);
++      {
++          UV tryuv = U_V(value);
++          if (!floatit && (NV)tryuv == value) {
++              if (tryuv <= IV_MAX)
++                  sv_setiv(sv, (IV)tryuv);
++              else
++                  sv_setuv(sv, tryuv);
++          }
            else
--              sv_setuv(sv, tryuv);
++              sv_setnv(sv, value);
        }
--      else
--          sv_setnv(sv, value);
+ #else
+       /*
+          strtol/strtoll sets errno to ERANGE if the number is too big
+          for an integer. We try to do an integer conversion first
+          if no characters indicating "float" have been found.
+        */
+       if (!floatit) {
+           char *tp;
+           IV iv;
+           UV uv;
+           errno = 0;
+ #ifdef USE_64_BIT_INT
+           if (*PL_tokenbuf == '-')
+               iv = strtoll(PL_tokenbuf,&tp,10);
+           else
+               uv = strtoull(PL_tokenbuf,&tp,10);
+ #else
+           if (*PL_tokenbuf == '-')
+               iv = strtol(PL_tokenbuf,&tp,10);
+           else
+               uv = strtoul(PL_tokenbuf,&tp,10);
+ #endif
+           if (*tp || errno)
+               floatit = TRUE; /* probably just too large */
+           else if (*PL_tokenbuf == '-')
+               sv_setiv(sv, iv);
+           else
+               sv_setuv(sv, uv);
+       }
+       if (floatit) {
+           char *tp;
+           errno = 0;
+ #ifdef USE_LONG_DOUBLE
+           value = strtold(PL_tokenbuf,&tp);
+ #else
+           value = strtod(PL_tokenbuf,&tp);
+ #endif
+           if (*tp || errno)
+               Perl_die(aTHX_ "unparseable float");
+           else
+               sv_setnv(sv, value);
+       } 
+ #endif
        if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :
                       (PL_hints & HINT_NEW_INTEGER) )
            sv = new_constant(PL_tokenbuf, d - PL_tokenbuf, 
                              (floatit ? "float" : "integer"),
                              sv, Nullsv, NULL);
        break;
-     /* if it starts with a v, it could be a version number */
 -    /* if it starts with a v, it could be a version number */
++    /* if it starts with a v, it could be a v-string */
      case 'v':
  vstring:
        {