* fixed val(s,int64) (it accepted values in the range

    high(int64+1)..high(qword) if written in decimal notation) + test
  * fixed range checking of qword constants parsed by the compiler
    (they always gave a range error if > high(int64), because the compiler
     internally stores them as int64)
  * turn off range checking flag of rdconstnodes created by the parser
    from _INTCONST, because those are already range checked by the
    way they are parsed using val()

git-svn-id: trunk@6814 -

.gitattributes

@@ -6264,6 +6264,7 @@ tests/tbs/tb0528.pp svneol=native#text/x-pascal
 tests/tbs/tb0530.pp svneol=native#text/plain
 tests/tbs/tb0531.pp svneol=native#text/plain
 tests/tbs/tb0532.pp svneol=native#text/x-pascal
+tests/tbs/tb0533.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain

compiler/defutil.pas

@@ -198,10 +198,10 @@ interface
     {# Returns true, if def is a 64 bit type }
     function is_64bit(def : tdef) : boolean;
 
-    {# If @var(l) isn't in the range of def a range check error (if not explicit) is generated and
+    {# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and
       the value is placed within the range
     }
-    procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
+    procedure testrange(fromdef, todef : tdef;var l : tconstexprint;explicit:boolean);
 
     {# Returns the range of def, where @var(l) is the low-range and @var(h) is
       the high-range.
@@ -693,9 +693,9 @@ implementation
       end;
 
 
-    { if l isn't in the range of def a range check error (if not explicit) is generated and
+    { if l isn't in the range of todef a range check error (if not explicit) is generated and
       the value is placed within the range }
-    procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
+    procedure testrange(fromdef, todef : tdef;var l : tconstexprint;explicit:boolean);
       var
          lv,hv: TConstExprInt;
          error: boolean;
@@ -703,9 +703,14 @@ implementation
          error := false;
          { for 64 bit types we need only to check if it is less than }
          { zero, if def is a qword node                              }
-         if is_64bitint(def) then
+         if is_64bitint(todef) then
            begin
-              if (l<0) and (torddef(def).ordtype=u64bit) then
+              if (l<0) and
+                 (torddef(todef).ordtype=u64bit) and
+                 { since tconstexprint is an int64, values > high(int64) will }
+                 { always be stored as negative numbers                       }
+                 (not is_64bitint(fromdef) or
+                  (torddef(fromdef).ordtype<>u64bit)) then
                 begin
                    { don't zero the result, because it may come from hex notation
                      like $ffffffffffffffff! (JM)
@@ -722,12 +727,12 @@ implementation
            end
          else
            begin
-              getrange(def,lv,hv);
+              getrange(todef,lv,hv);
               if (l<lv) or (l>hv) then
                 begin
                    if not explicit then
                     begin
-                      if ((def.typ=enumdef) and
+                      if ((todef.typ=enumdef) and
                           { delphi allows range check errors in
                            enumeration type casts FK }
                           not(m_delphi in current_settings.modeswitches)) or
@@ -742,16 +747,16 @@ implementation
          if error then
           begin
              { Fix the value to fit in the allocated space for this type of variable }
-             case longint(def.size) of
+             case longint(todef.size) of
                1: l := l and $ff;
                2: l := l and $ffff;
                { work around sign extension bug (to be fixed) (JM) }
                4: l := l and (int64($fffffff) shl 4 + $f);
              end;
              { do sign extension if necessary (JM) }
-             if is_signed(def) then
+             if is_signed(todef) then
               begin
-                case longint(def.size) of
+                case longint(todef.size) of
                   1: l := shortint(l);
                   2: l := smallint(l);
                   4: l := longint(l);

compiler/ncnv.pas

@@ -1830,10 +1830,10 @@ implementation
                       not(convtype=tc_char_2_char) then
                 begin
                    { replace the resultdef and recheck the range }
-                   left.resultdef:=resultdef;
                    if ([nf_explicit,nf_internal] * flags <> []) then
                      include(left.flags, nf_explicit);
-                   testrange(left.resultdef,tordconstnode(left).value,(nf_explicit in flags));
+                   testrange(left.resultdef,resultdef,tordconstnode(left).value,(nf_explicit in flags));
+                   left.resultdef:=resultdef;
                    result:=left;
                    left:=nil;
                    exit;

compiler/ncon.pas

@@ -623,7 +623,7 @@ implementation
         resultdef:=typedef;
         { only do range checking when explicitly asked for it }
         if rangecheck then
-           testrange(resultdef,value,false);
+           testrange(resultdef,resultdef,value,false);
       end;
 
     function tordconstnode.pass_1 : tnode;

compiler/ninl.pas

@@ -1419,9 +1419,9 @@ implementation
                  (index.left.nodetype = ordconstn) and
                  not is_special_array(unpackedarraydef) then
                 begin
-                  testrange(unpackedarraydef,tordconstnode(index.left).value,false);
+                  testrange(index.left.resultdef,unpackedarraydef,tordconstnode(index.left).value,false);
                   tempindex := tordconstnode(index.left).value + packedarraydef.highrange-packedarraydef.lowrange;
-                  testrange(unpackedarraydef,tempindex,false);
+                  testrange(index.left.resultdef,unpackedarraydef,tempindex,false);
                 end;
             end;
 

compiler/pexpr.pas

@@ -2459,7 +2459,10 @@ implementation
                         consume(_INTCONST);
                         p1:=crealconstnode.create(d,pbestrealtype^);
                      end;
-                 end;
+                 end
+               else
+                 { the necessary range checking has already been done by val }
+                 tordconstnode(p1).rangecheck:=false;
              end;
 
            _REALNUMBER :

compiler/pstatmnt.pas

@@ -183,8 +183,8 @@ implementation
                         CGMessage(parser_e_case_lower_less_than_upper_bound);
                       if not casedeferror then
                        begin
-                         testrange(casedef,hl1,false);
-                         testrange(casedef,hl2,false);
+                         testrange(casedef,casedef,hl1,false);
+                         testrange(casedef,casedef,hl2,false);
                        end;
                     end
                   else
@@ -198,7 +198,7 @@ implementation
                     CGMessage(parser_e_case_mismatch);
                   hl1:=get_ordinal_value(p);
                   if not casedeferror then
-                    testrange(casedef,hl1,false);
+                    testrange(casedef,casedef,hl1,false);
                   casenode.addlabel(blockid,hl1,hl1);
                end;
              p.free;

compiler/ptconst.pas

@@ -233,7 +233,7 @@ implementation
                 begin
                    if is_constintnode(n) then
                      begin
-                       testrange(def,tordconstnode(n).value,false);
+                       testrange(n.resultdef,def,tordconstnode(n).value,false);
                        case def.size of
                          1 :
                            list.concat(Tai_const.Create_8bit(byte(tordconstnode(n).value)));

rtl/inc/sstrings.inc

@@ -879,7 +879,7 @@ end;
 
   Function fpc_val_int64_shortstr(Const S: ShortString; out Code: ValSInt): Int64; [public, alias:'FPC_VAL_INT64_SHORTSTR']; compilerproc;
 
-  var  u, temp, prev : qword;
+  var  u, temp, prev, maxprevvalue, maxnewvalue : qword;
        base : byte;
        negative : boolean;
 
@@ -892,6 +892,11 @@ end;
     Code:=InitVal(s,negative,base);
     if Code>length(s) then
      exit;
+    maxprevvalue := maxqword div base;
+    if (base = 10) then
+      maxnewvalue := maxint64 + ord(negative)
+    else
+      maxnewvalue := maxqword;
 
     while Code<=Length(s) do
      begin
@@ -904,13 +909,10 @@ end;
         u:=16;
        end;
        Prev:=Temp;
-       Temp:=Temp*Int64(base);
+       Temp:=Temp*qword(base);
      If (u >= base) or
-        ((base = 10) and
-         (maxint64-temp+ord(negative) < u)) or
-        ((base <> 10) and
-         (qword(maxqword-temp) < u)) or
-        (prev > maxqword div qword(base)) Then
+        (qword(maxnewvalue-u) < temp) or
+        (prev > maxprevvalue) Then
        Begin
          fpc_val_int64_shortstr := 0;
          Exit

tests/tbs/tb0533.pp

@@ -0,0 +1,25 @@
+{$r+}
+
+const
+  q: qword = 18446744073709551615;
+
+var
+  i: int64;
+  code: longint;
+begin
+  val('18446744073709551615',i,code);
+  if (code = 0) then
+    halt(1);
+  val('-9223372036854775808',i,code);
+  if (code <> 0) or
+     (i <> low(int64)) then
+    halt(2);
+  val('9223372036854775807',i,code);
+  if (code <> 0) or
+     (i <> high(int64)) then
+    halt(3);
+  val('$8000000000000000',i,code);
+  if (code <> 0) or
+     (i <> low(int64)) then
+    halt(4);
+end.