Browse Source

fcl-passrc: resolver: const float typecast, operators, string[]

git-svn-id: trunk@36725 -
Mattias Gaertner 8 years ago
parent
commit
82569975c6

+ 530 - 98
packages/fcl-passrc/src/pasresolveeval.pas

@@ -19,43 +19,38 @@ Abstract:
 Works:
 Works:
 - Emitting range check warnings
 - Emitting range check warnings
 - Error on overflow
 - Error on overflow
-- bool: not, =, <>, and, or, xor, low(), high(), pred(), succ(), ord()
+- bool:
+  - not, =, <>, and, or, xor, low(), high(), pred(), succ(), ord()
+  - boolean(0), boolean(1)
 - int/uint
 - int/uint
   - unary +, -
   - unary +, -
-  - binary: +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not
+  - binary: +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not, shl, shr
   - low(), high(), pred(), succ(), ord()
   - low(), high(), pred(), succ(), ord()
-  - typecast int
+  - typecast longint(-1), word(-2), intsingle(-1), uintsingle(1)
+- float:
+  - typecast float
+  - +, -, /, *, =, <>, <, >, <=, >=
 - string:
 - string:
-  - +
+  - #65, '', 'a', 'ab'
+  - +, =, <>, <, >, <=, >=
   - pred(), succ()
   - pred(), succ()
-- float:
+  - s[]
+  - length(string)
 - enum/set
 - enum/set
 
 
 ToDo:
 ToDo:
-- enable eval via option, default off
-- bool:
-   - boolean(1)
-- int
-  - typecast intsingle(-1), uintsingle(-1), longint(-1)
 - string:
 - string:
-  - =, <>, <, >, <=, >=
   - string encoding
   - string encoding
-  - s[]
-  - length(string)
   - chr(), ord(), low(), high()
   - chr(), ord(), low(), high()
-  - #65
   - #$DC00
   - #$DC00
-- float
-  - typecast float
-  - /
-  - +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not
+  - unicodestring
 - enum
 - enum
   - low(), high(), pred(), succ(), ord(), typecast
   - low(), high(), pred(), succ(), ord(), typecast
 - sets
 - sets
   - [a,b,c..d]
   - [a,b,c..d]
   - +, -, *, =, <>, <=, >=, in, ><
   - +, -, *, =, <>, <=, >=, in, ><
 - arrays
 - arrays
-  - length(), low(), high()
+  - length(), low(), high(), []
 }
 }
 unit PasResolveEval;
 unit PasResolveEval;
 
 
@@ -478,6 +473,7 @@ type
     function EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinaryDivideExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryModExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryModExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
@@ -485,9 +481,7 @@ type
     function EvalBinaryBoolOpExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryBoolOpExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryNEqualExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryNEqualExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryLessGreaterExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
     function EvalBinaryLessGreaterExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
-    function EvalArrayParams(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
-    function EvalFuncParams(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
-    function EvalSetParams(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
+    function EvalParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
     function ExprStringToOrd(Value: TResEvalValue; PosEl: TPasElement): longword; virtual;
     function ExprStringToOrd(Value: TResEvalValue; PosEl: TPasElement): longword; virtual;
     function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
     function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
     procedure PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
     procedure PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
@@ -510,9 +504,9 @@ type
     function IsConst(Expr: TPasExpr): boolean;
     function IsConst(Expr: TPasExpr): boolean;
     function IsSimpleExpr(Expr: TPasExpr): boolean; // true = no need to store result
     function IsSimpleExpr(Expr: TPasExpr): boolean; // true = no need to store result
     procedure EmitRangeCheckConst(id: int64; const aValue, MinVal, MaxVal: String;
     procedure EmitRangeCheckConst(id: int64; const aValue, MinVal, MaxVal: String;
-      PosEl: TPasElement); virtual;
+      PosEl: TPasElement; MsgType: TMessageType = mtWarning); virtual;
     procedure EmitRangeCheckConst(id: int64; const aValue: String;
     procedure EmitRangeCheckConst(id: int64; const aValue: String;
-      MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement);
+      MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement; MsgType: TMessageType = mtWarning);
     function OrdValue(Value: TResEvalValue; ErrorEl: TPasElement): TResEvalInt; virtual;
     function OrdValue(Value: TResEvalValue; ErrorEl: TPasElement): TResEvalInt; virtual;
     procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
@@ -938,6 +932,13 @@ begin
           Result:=Result.Clone;
           Result:=Result.Clone;
         TResEvalUInt(Result).UInt:=-TResEvalUInt(Result).UInt;
         TResEvalUInt(Result).UInt:=-TResEvalUInt(Result).UInt;
         end;
         end;
+      revkFloat:
+        begin
+        if TResEvalFloat(Result).FloatValue=0 then exit;
+        if Result.Element<>nil then
+          Result:=Result.Clone;
+        TResEvalFloat(Result).FloatValue:=-TResEvalFloat(Result).FloatValue;
+        end
       else
       else
         begin
         begin
         if Result.Element=nil then
         if Result.Element=nil then
@@ -1021,6 +1022,8 @@ begin
         Result:=EvalBinarySubExpr(Expr,LeftValue,RightValue);
         Result:=EvalBinarySubExpr(Expr,LeftValue,RightValue);
       eopMultiply:
       eopMultiply:
         Result:=EvalBinaryMulExpr(Expr,LeftValue,RightValue);
         Result:=EvalBinaryMulExpr(Expr,LeftValue,RightValue);
+      eopDivide:
+        Result:=EvalBinaryDivideExpr(Expr,LeftValue,RightValue);
       eopDiv:
       eopDiv:
         Result:=EvalBinaryDivExpr(Expr,LeftValue,RightValue);
         Result:=EvalBinaryDivExpr(Expr,LeftValue,RightValue);
       eopMod:
       eopMod:
@@ -1196,6 +1199,7 @@ function TResExprEvaluator.EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue,
 var
 var
   Int: MaxPrecInt;
   Int: MaxPrecInt;
   UInt: MaxPrecUInt;
   UInt: MaxPrecUInt;
+  Flo: MaxPrecFloat;
   LeftCP, RightCP: TSystemCodePage;
   LeftCP, RightCP: TSystemCodePage;
 begin
 begin
   Result:=nil;
   Result:=nil;
@@ -1204,42 +1208,68 @@ begin
     {$R+}
     {$R+}
     case LeftValue.Kind of
     case LeftValue.Kind of
     revkInt:
     revkInt:
+      begin
+      Int:=TResEvalInt(LeftValue).Int;
       case RightValue.Kind of
       case RightValue.Kind of
-      revkInt:
-        // int+int
-        if (TResEvalInt(LeftValue).Int>0) and (TResEvalInt(RightValue).Int>0) then
+      revkInt: // int + int
+        if (Int>0) and (TResEvalInt(RightValue).Int>0) then
           begin
           begin
-          UInt:=MaxPrecUInt(TResEvalInt(LeftValue).Int)+MaxPrecUInt(TResEvalInt(RightValue).Int);
+          UInt:=MaxPrecUInt(Int)+MaxPrecUInt(TResEvalInt(RightValue).Int);
           Result:=CreateResEvalInt(UInt);
           Result:=CreateResEvalInt(UInt);
           end
           end
         else
         else
           begin
           begin
-          Int:=TResEvalInt(LeftValue).Int + TResEvalInt(RightValue).Int;
+          Int:=Int + TResEvalInt(RightValue).Int;
           Result:=TResEvalInt.CreateValue(Int);
           Result:=TResEvalInt.CreateValue(Int);
           end;
           end;
-      revkUInt:
-        IntAddUInt(TResEvalInt(LeftValue).Int,TResEvalUInt(RightValue).UInt);
+      revkUInt: // int + uint
+        IntAddUInt(Int,TResEvalUInt(RightValue).UInt);
+      revkFloat: // int + float
+        Result:=TResEvalFloat.CreateValue(Int + TResEvalFloat(RightValue).FloatValue);
       else
       else
         {$IFDEF VerbosePasResolver}
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryAddExpr int+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
         writeln('TResExprEvaluator.EvalBinaryAddExpr int+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
         {$ENDIF}
         {$ENDIF}
         RaiseNotYetImplemented(20170525115537,Expr);
         RaiseNotYetImplemented(20170525115537,Expr);
       end;
       end;
+      end;
     revkUInt:
     revkUInt:
+      begin
+      UInt:=TResEvalUInt(LeftValue).UInt;
       case RightValue.Kind of
       case RightValue.Kind of
-      revkInt:
-        IntAddUInt(TResEvalUInt(LeftValue).UInt,TResEvalInt(RightValue).Int);
-      revkUInt:
+      revkInt: // uint + int
+        IntAddUInt(UInt,TResEvalInt(RightValue).Int);
+      revkUInt: // uint + uint
         begin
         begin
-        UInt:=TResEvalUInt(LeftValue).UInt+TResEvalUInt(RightValue).UInt;
+        UInt:=UInt+TResEvalUInt(RightValue).UInt;
         Result:=TResEvalUInt.CreateValue(UInt);
         Result:=TResEvalUInt.CreateValue(UInt);
-        end
+        end;
+      revkFloat: // uint + float
+        Result:=TResEvalFloat.CreateValue(UInt + TResEvalFloat(RightValue).FloatValue);
       else
       else
         {$IFDEF VerbosePasResolver}
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryAddExpr uint+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
         writeln('TResExprEvaluator.EvalBinaryAddExpr uint+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
         {$ENDIF}
         {$ENDIF}
         RaiseNotYetImplemented(20170601141031,Expr);
         RaiseNotYetImplemented(20170601141031,Expr);
       end;
       end;
+      end;
+    revkFloat:
+      begin
+      Flo:=TResEvalFloat(LeftValue).FloatValue;
+      case RightValue.Kind of
+      revkInt: // float + int
+        Result:=TResEvalFloat.CreateValue(Flo + TResEvalInt(RightValue).Int);
+      revkUInt: // float + uint
+        Result:=TResEvalFloat.CreateValue(Flo + TResEvalUInt(RightValue).UInt);
+      revkFloat: // float + float
+        Result:=TResEvalFloat.CreateValue(Flo + TResEvalFloat(RightValue).FloatValue);
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryAddExpr float+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        RaiseNotYetImplemented(20170711145637,Expr);
+      end;
+      end;
     revkString:
     revkString:
       case RightValue.Kind of
       case RightValue.Kind of
       revkString:
       revkString:
@@ -1307,36 +1337,148 @@ function TResExprEvaluator.EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue,
 var
 var
   Int: MaxPrecInt;
   Int: MaxPrecInt;
   UInt: MaxPrecUInt;
   UInt: MaxPrecUInt;
+  Flo: MaxPrecFloat;
 begin
 begin
   Result:=nil;
   Result:=nil;
   case LeftValue.Kind of
   case LeftValue.Kind of
   revkInt:
   revkInt:
+    begin
+    Int:=TResEvalInt(LeftValue).Int;
     case RightValue.Kind of
     case RightValue.Kind of
     revkInt:
     revkInt:
-      // int-int
+      // int - int
       try
       try
         {$Q+}
         {$Q+}
-        Int:=TResEvalInt(LeftValue).Int - TResEvalInt(RightValue).Int;
+        Int:=Int - TResEvalInt(RightValue).Int;
         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
         Result:=TResEvalInt.CreateValue(Int);
         Result:=TResEvalInt.CreateValue(Int);
       except
       except
         on E: EOverflow do
         on E: EOverflow do
-          if (TResEvalInt(LeftValue).Int>0) and (TResEvalInt(RightValue).Int<0) then
+          if (Int>0) and (TResEvalInt(RightValue).Int<0) then
             begin
             begin
-            UInt:=MaxPrecUInt(TResEvalInt(LeftValue).Int)+MaxPrecUInt(-TResEvalInt(RightValue).Int);
+            UInt:=MaxPrecUInt(Int)+MaxPrecUInt(-TResEvalInt(RightValue).Int);
             Result:=CreateResEvalInt(UInt);
             Result:=CreateResEvalInt(UInt);
             end
             end
           else
           else
             RaiseOverflowArithmetic(20170525230247,Expr);
             RaiseOverflowArithmetic(20170525230247,Expr);
       end;
       end;
-    // ToDo: int-uint
+    revkUInt:
+      // int - uint
+      try
+        {$Q+}
+        Int:=Int - TResEvalUInt(RightValue).UInt;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalInt.CreateValue(Int);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20170711151201,Expr);
+      end;
+    revkFloat:
+      // int - float
+      try
+        {$Q+}
+        Flo:=MaxPrecFloat(Int) - TResEvalFloat(RightValue).FloatValue;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20170711151313,Expr);
+      end;
     else
     else
       {$IFDEF VerbosePasResolver}
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinarySubExpr sub int-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
       writeln('TResExprEvaluator.EvalBinarySubExpr sub int-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
       {$ENDIF}
       {$ENDIF}
       RaiseNotYetImplemented(20170525230028,Expr);
       RaiseNotYetImplemented(20170525230028,Expr);
     end;
     end;
-  // ToDo: uint-int, uint-uint
+    end;
+  revkUInt:
+    begin
+    UInt:=TResEvalUInt(LeftValue).UInt;
+    case RightValue.Kind of
+    revkInt:
+      // uint - int
+      try
+        {$Q+}
+        UInt:=UInt - TResEvalInt(RightValue).Int;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalUInt.CreateValue(UInt);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20170711151405,Expr);
+      end;
+    revkUInt:
+      // uint - uint
+      try
+        {$Q+}
+        UInt:=UInt - TResEvalUInt(RightValue).UInt;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalUInt.CreateValue(UInt);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20170711151419,Expr);
+      end;
+    revkFloat:
+      // uint - float
+      try
+        {$Q+}
+        Flo:=MaxPrecFloat(UInt) - TResEvalFloat(RightValue).FloatValue;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20170711151428,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinarySubExpr sub uint-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170711151435,Expr);
+    end;
+    end;
+  revkFloat:
+    begin
+    Flo:=TResEvalFloat(LeftValue).FloatValue;
+    case RightValue.Kind of
+    revkInt:
+      // float - int
+      try
+        {$Q+}
+        Flo:=Flo - TResEvalInt(RightValue).Int;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20170711151519,Expr);
+      end;
+    revkUInt:
+      // float - uint
+      try
+        {$Q+}
+        Flo:=Flo - TResEvalUInt(RightValue).UInt;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20170711151538,Expr);
+      end;
+    revkFloat:
+      // float - float
+      try
+        {$Q+}
+        Flo:=Flo - TResEvalFloat(RightValue).FloatValue;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20170711151552,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinarySubExpr sub float-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170711151600,Expr);
+    end;
+    end;
   else
   else
     {$IFDEF VerbosePasResolver}
     {$IFDEF VerbosePasResolver}
     writeln('TResExprEvaluator.EvalBinarySubExpr sub ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
     writeln('TResExprEvaluator.EvalBinarySubExpr sub ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1350,25 +1492,28 @@ function TResExprEvaluator.EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue,
 var
 var
   Int: MaxPrecInt;
   Int: MaxPrecInt;
   UInt: MaxPrecUInt;
   UInt: MaxPrecUInt;
+  Flo: MaxPrecFloat;
 begin
 begin
   Result:=nil;
   Result:=nil;
   case LeftValue.Kind of
   case LeftValue.Kind of
   revkInt:
   revkInt:
+    begin
+    Int:=TResEvalInt(LeftValue).Int;
     case RightValue.Kind of
     case RightValue.Kind of
     revkInt:
     revkInt:
-      // int*int
+      // int * int
       try
       try
         {$Q+}
         {$Q+}
-        Int:=TResEvalInt(LeftValue).Int * TResEvalInt(RightValue).Int;
+        Int:=Int * TResEvalInt(RightValue).Int;
         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
         Result:=TResEvalInt.CreateValue(Int);
         Result:=TResEvalInt.CreateValue(Int);
       except
       except
         on E: EOverflow do
         on E: EOverflow do
-          if (TResEvalInt(LeftValue).Int>0) and (TResEvalInt(RightValue).Int>0) then
+          if (Int>0) and (TResEvalInt(RightValue).Int>0) then
             try
             try
               // try uint*uint
               // try uint*uint
               {$Q+}
               {$Q+}
-              UInt:=MaxPrecUInt(TResEvalInt(LeftValue).Int) * MaxPrecUInt(TResEvalInt(RightValue).Int);
+              UInt:=MaxPrecUInt(Int) * MaxPrecUInt(TResEvalInt(RightValue).Int);
               {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
               {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
               Result:=CreateResEvalInt(UInt);
               Result:=CreateResEvalInt(UInt);
             except
             except
@@ -1378,14 +1523,128 @@ begin
           else
           else
             RaiseOverflowArithmetic(20170525230247,Expr);
             RaiseOverflowArithmetic(20170525230247,Expr);
       end;
       end;
-    // ToDo: int*uint
+    revkUInt:
+      // int * uint
+      try
+        {$Q+}
+        Int:=Int * TResEvalUInt(RightValue).UInt;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalInt.CreateValue(Int);
+      except
+        RaiseOverflowArithmetic(20170711164445,Expr);
+      end;
+    revkFloat:
+      // int * float
+      try
+        {$Q+}
+        Flo:=Int * TResEvalFloat(RightValue).FloatValue;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        RaiseOverflowArithmetic(20170711164541,Expr);
+      end;
     else
     else
       {$IFDEF VerbosePasResolver}
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryMulExpr mul int*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
       writeln('TResExprEvaluator.EvalBinaryMulExpr mul int*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
       {$ENDIF}
       {$ENDIF}
       RaiseNotYetImplemented(20170525230028,Expr);
       RaiseNotYetImplemented(20170525230028,Expr);
     end;
     end;
-  // ToDo: uint*int, uint*uint
+    end;
+  revkUInt:
+    begin
+    UInt:=TResEvalUInt(LeftValue).UInt;
+    case RightValue.Kind of
+    revkInt:
+      // uint * int
+      if TResEvalInt(RightValue).Int>=0 then
+        try
+          {$Q+}
+          UInt:=UInt * TResEvalInt(RightValue).Int;
+          {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+          Result:=TResEvalUInt.CreateValue(UInt);
+        except
+          on E: EOverflow do
+            RaiseOverflowArithmetic(20170711164714,Expr);
+        end
+      else
+        try
+          {$Q+}
+          Int:=UInt * TResEvalInt(RightValue).Int;
+          {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+          Result:=TResEvalInt.CreateValue(Int);
+        except
+          on E: EOverflow do
+            RaiseOverflowArithmetic(20170711164736,Expr);
+        end;
+    revkUInt:
+      // uint * uint
+      try
+        {$Q+}
+        UInt:=UInt * TResEvalUInt(RightValue).UInt;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalUInt.CreateValue(UInt);
+      except
+        RaiseOverflowArithmetic(20170711164751,Expr);
+      end;
+    revkFloat:
+      // uint * float
+      try
+        {$Q+}
+        Flo:=UInt * TResEvalFloat(RightValue).FloatValue;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        RaiseOverflowArithmetic(20170711164800,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryMulExpr mul uint*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170711164810,Expr);
+    end;
+    end;
+  revkFloat:
+    begin
+    Flo:=TResEvalFloat(LeftValue).FloatValue;
+    case RightValue.Kind of
+    revkInt:
+      // float * int
+      try
+        {$Q+}
+        Flo:=Flo * TResEvalInt(RightValue).Int;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20170711164920,Expr);
+      end;
+    revkUInt:
+      // float * uint
+      try
+        {$Q+}
+        Flo:=Flo * TResEvalUInt(RightValue).UInt;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        RaiseOverflowArithmetic(20170711164940,Expr);
+      end;
+    revkFloat:
+      // float * float
+      try
+        {$Q+}
+        Flo:=Flo * TResEvalFloat(RightValue).FloatValue;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        RaiseOverflowArithmetic(20170711164955,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryMulExpr mul float*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170711165004,Expr);
+    end;
+    end;
   else
   else
     {$IFDEF VerbosePasResolver}
     {$IFDEF VerbosePasResolver}
     writeln('TResExprEvaluator.EvalBinaryMulExpr mul ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
     writeln('TResExprEvaluator.EvalBinaryMulExpr mul ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1394,6 +1653,122 @@ begin
   end;
   end;
 end;
 end;
 
 
+function TResExprEvaluator.EvalBinaryDivideExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+var
+  Int: MaxPrecInt;
+  UInt: MaxPrecUInt;
+  Flo: MaxPrecFloat;
+begin
+  Result:=nil;
+  case LeftValue.Kind of
+  revkInt:
+    begin
+    Int:=TResEvalInt(LeftValue).Int;
+    case RightValue.Kind of
+    revkInt:
+      // int / int
+      if TResEvalInt(RightValue).Int=0 then
+        RaiseDivByZero(20170711143925,Expr)
+      else
+        Result:=TResEvalFloat.CreateValue(Int / TResEvalInt(RightValue).Int);
+    revkUInt:
+      // int / uint
+      if TResEvalUInt(RightValue).UInt=0 then
+        RaiseDivByZero(20170711144013,Expr)
+      else
+        Result:=TResEvalFloat.CreateValue(Int / TResEvalUInt(RightValue).UInt);
+    revkFloat:
+      begin
+      // int / float
+      try
+        Flo:=Int / TResEvalFloat(RightValue).FloatValue;
+      except
+        RaiseMsg(20170711144525,nDivByZero,sDivByZero,[],Expr);
+      end;
+      Result:=TResEvalFloat.CreateValue(Flo);
+      end
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryDivideExpr int / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170711144057,Expr);
+    end;
+    end;
+  revkUInt:
+    begin
+    UInt:=TResEvalUInt(LeftValue).UInt;
+    case RightValue.Kind of
+    revkInt:
+      // uint / int
+      if TResEvalInt(RightValue).Int=0 then
+        RaiseDivByZero(20170711144103,Expr)
+      else
+        Result:=TResEvalFloat.CreateValue(UInt / TResEvalInt(RightValue).Int);
+    revkUInt:
+      // uint / uint
+      if TResEvalUInt(RightValue).UInt=0 then
+        RaiseDivByZero(20170711144203,Expr)
+      else
+        Result:=TResEvalFloat.CreateValue(UInt / TResEvalUInt(RightValue).UInt);
+    revkFloat:
+      begin
+      // uint / float
+      try
+        Flo:=UInt / TResEvalFloat(RightValue).FloatValue;
+      except
+        RaiseMsg(20170711144912,nDivByZero,sDivByZero,[],Expr);
+      end;
+      Result:=TResEvalFloat.CreateValue(Flo);
+      end
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryDivideExpr uint / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170711144239,Expr);
+    end;
+    end;
+  revkFloat:
+    begin
+    Flo:=TResEvalFloat(LeftValue).FloatValue;
+    case RightValue.Kind of
+    revkInt:
+      // float / int
+      if TResEvalInt(RightValue).Int=0 then
+        RaiseDivByZero(20170711144954,Expr)
+      else
+        Result:=TResEvalFloat.CreateValue(Flo / TResEvalInt(RightValue).Int);
+    revkUInt:
+      // float / uint
+      if TResEvalUInt(RightValue).UInt=0 then
+        RaiseDivByZero(20170711145023,Expr)
+      else
+        Result:=TResEvalFloat.CreateValue(Flo / TResEvalUInt(RightValue).UInt);
+    revkFloat:
+      begin
+      // float / float
+      try
+        Flo:=Flo / TResEvalFloat(RightValue).FloatValue;
+      except
+        RaiseMsg(20170711145040,nDivByZero,sDivByZero,[],Expr);
+      end;
+      Result:=TResEvalFloat.CreateValue(Flo);
+      end
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryDivideExpr float / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170711145050,Expr);
+    end;
+    end;
+  else
+    {$IFDEF VerbosePasResolver}
+    writeln('TResExprEvaluator.EvalBinaryDivExpr div ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+    {$ENDIF}
+    RaiseNotYetImplemented(20170530102352,Expr);
+  end;
+end;
+
 function TResExprEvaluator.EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue,
 function TResExprEvaluator.EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue,
   RightValue: TResEvalValue): TResEvalValue;
   RightValue: TResEvalValue): TResEvalValue;
 var
 var
@@ -1766,6 +2141,17 @@ begin
         Result.Free;
         Result.Free;
         RaiseNotYetImplemented(20170601122806,Expr);
         RaiseNotYetImplemented(20170601122806,Expr);
       end;
       end;
+    revkString:
+      case RightValue.Kind of
+      revkString:
+        TResEvalBool(Result).B:=TResEvalString(LeftValue).S=TResEvalString(RightValue).S;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryNEqualExpr string ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20170711175409,Expr);
+      end;
     else
     else
       {$IFDEF VerbosePasResolver}
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryNEqualExpr ',Expr.OpCode,' ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
       writeln('TResExprEvaluator.EvalBinaryNEqualExpr ',Expr.OpCode,' ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1919,6 +2305,26 @@ begin
         Result.Free;
         Result.Free;
         RaiseNotYetImplemented(20170601133421,Expr);
         RaiseNotYetImplemented(20170601133421,Expr);
       end;
       end;
+    revkString:
+      case RightValue.Kind of
+      revkString:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalString(LeftValue).S < TResEvalString(RightValue).S;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalString(LeftValue).S > TResEvalString(RightValue).S;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalString(LeftValue).S <= TResEvalString(RightValue).S;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalString(LeftValue).S >= TResEvalString(RightValue).S;
+        end;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr string ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20170711175629,Expr);
+      end;
     else
     else
       {$IFDEF VerbosePasResolver}
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr ? ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
       writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr ? ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1934,6 +2340,76 @@ begin
   end;
   end;
 end;
 end;
 
 
+function TResExprEvaluator.EvalParamsExpr(Expr: TParamsExpr;
+  Flags: TResEvalFlags): TResEvalValue;
+var
+  ArrayValue, IndexValue: TResEvalValue;
+  Int: MaxPrecInt;
+  Param0: TPasExpr;
+  MaxIndex: Integer;
+begin
+  Result:=OnEvalParams(Self,Expr,Flags);
+  if Result<>nil then exit;
+  ArrayValue:=Eval(Expr.Value,Flags);
+  if ArrayValue=nil then
+    begin
+    if (refConst in Flags) then
+      RaiseConstantExprExp(20170711181321,Expr.Value);
+    exit;
+    end;
+  IndexValue:=nil;
+  try
+    case ArrayValue.Kind of
+    revkString,revkUnicodeString:
+      begin
+      Param0:=Expr.Params[0];
+      IndexValue:=Eval(Param0,Flags);
+      if IndexValue=nil then
+        begin
+        if (refConst in Flags) then
+          RaiseConstantExprExp(20170711181603,Param0);
+        exit;
+        end;
+      case IndexValue.Kind of
+        revkInt: Int:=TResEvalInt(IndexValue).Int;
+        revkUInt:
+          if TResEvalUInt(IndexValue).UInt>High(MaxPrecInt) then
+            RaiseRangeCheck(20170711182006,Param0)
+          else
+            Int:=TResEvalUInt(IndexValue).UInt;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalParamsExpr string[',IndexValue.AsDebugString,']');
+        {$ENDIF}
+        RaiseNotYetImplemented(20170711182100,Expr);
+      end;
+      if ArrayValue.Kind=revkString then
+        MaxIndex:=length(TResEvalString(ArrayValue).S)
+      else
+        MaxIndex:=length(TResEvalUTF16(ArrayValue).S);
+      if (Int<1) or (Int>MaxIndex) then
+        EmitRangeCheckConst(20170711183058,IntToStr(Int),'1',IntToStr(MaxIndex),Param0,mtError);
+      if ArrayValue.Kind=revkString then
+        Result:=TResEvalString.CreateValue(TResEvalString(ArrayValue).S[Int])
+      else
+        Result:=TResEvalUTF16.CreateValue(TResEvalUTF16(ArrayValue).S[Int]);
+      exit;
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalParamsExpr Array=',ArrayValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170711181507,Expr);
+    end;
+
+    if (refConst in Flags) then
+      RaiseConstantExprExp(20170522173150,Expr);
+  finally
+    ReleaseEvalValue(ArrayValue);
+    ReleaseEvalValue(IndexValue);
+  end;
+end;
+
 function TResExprEvaluator.EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue,
 function TResExprEvaluator.EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue,
   RightValue: TResEvalValue): TResEvalValue;
   RightValue: TResEvalValue): TResEvalValue;
 var
 var
@@ -2009,45 +2485,6 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TResExprEvaluator.EvalArrayParams(Expr: TParamsExpr;
-  Flags: TResEvalFlags): TResEvalValue;
-begin
-  Result:=nil;
-  {$IFDEF VerbosePasResEval}
-  writeln('TResExprEvaluator.EvalArrayParams ');
-  {$ENDIF}
-  if refConst in Flags then
-    RaiseConstantExprExp(20170522173151,Expr);
-end;
-
-function TResExprEvaluator.EvalFuncParams(Expr: TParamsExpr;
-  Flags: TResEvalFlags): TResEvalValue;
-begin
-  Result:=nil;
-  {$IFDEF VerbosePasResEval}
-  writeln('TResExprEvaluator.EvalFuncParams ');
-  {$ENDIF}
-  Result:=OnEvalParams(Self,Expr,Flags);
-  if (refConst in Flags) and (Result=nil) then
-    RaiseConstantExprExp(20170522173150,Expr);
-end;
-
-function TResExprEvaluator.EvalSetParams(Expr: TParamsExpr; Flags: TResEvalFlags
-  ): TResEvalValue;
-begin
-  Result:=nil;
-  {$IFDEF VerbosePasResEval}
-  writeln('TResExprEvaluator.EvalSetParams ');
-  {$ENDIF}
-  if length(Expr.Params)=0 then
-    begin
-    Result:=TResEvalValue.CreateKind(revkSetEmpty);
-    exit;
-    end;
-  if refConst in Flags then
-    RaiseConstantExprExp(20170522173152,Expr);
-end;
-
 function TResExprEvaluator.ExprStringToOrd(Value: TResEvalValue;
 function TResExprEvaluator.ExprStringToOrd(Value: TResEvalValue;
   PosEl: TPasElement): longword;
   PosEl: TPasElement): longword;
 var
 var
@@ -2339,13 +2776,7 @@ begin
   else if C=TBinaryExpr then
   else if C=TBinaryExpr then
     Result:=EvalBinaryExpr(TBinaryExpr(Expr),Flags)
     Result:=EvalBinaryExpr(TBinaryExpr(Expr),Flags)
   else if C=TParamsExpr then
   else if C=TParamsExpr then
-    case TParamsExpr(Expr).Kind of
-    pekArrayParams: Result:=EvalArrayParams(TParamsExpr(Expr),Flags);
-    pekFuncParams: Result:=EvalFuncParams(TParamsExpr(Expr),Flags);
-    pekSet: Result:=EvalSetParams(TParamsExpr(Expr),Flags);
-    else
-      RaiseInternalError(20170522173013);
-    end
+    Result:=EvalParamsExpr(TParamsExpr(Expr),Flags)
   else if refConst in Flags then
   else if refConst in Flags then
     RaiseConstantExprExp(20170518213800,Expr);
     RaiseConstantExprExp(20170518213800,Expr);
 end;
 end;
@@ -2535,16 +2966,17 @@ begin
 end;
 end;
 
 
 procedure TResExprEvaluator.EmitRangeCheckConst(id: int64; const aValue,
 procedure TResExprEvaluator.EmitRangeCheckConst(id: int64; const aValue,
-  MinVal, MaxVal: String; PosEl: TPasElement);
+  MinVal, MaxVal: String; PosEl: TPasElement; MsgType: TMessageType);
 begin
 begin
-  LogMsg(id,mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
+  LogMsg(id,MsgType,nRangeCheckEvaluatingConstantsVMinMax,
     sRangeCheckEvaluatingConstantsVMinMax,[aValue,MinVal,MaxVal],PosEl);
     sRangeCheckEvaluatingConstantsVMinMax,[aValue,MinVal,MaxVal],PosEl);
 end;
 end;
 
 
 procedure TResExprEvaluator.EmitRangeCheckConst(id: int64;
 procedure TResExprEvaluator.EmitRangeCheckConst(id: int64;
-  const aValue: String; MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement);
+  const aValue: String; MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement;
+  MsgType: TMessageType);
 begin
 begin
-  EmitRangeCheckConst(id,aValue,IntToStr(MinVal),IntToStr(MaxVal),PosEl);
+  EmitRangeCheckConst(id,aValue,IntToStr(MinVal),IntToStr(MaxVal),PosEl,MsgType);
 end;
 end;
 
 
 function TResExprEvaluator.OrdValue(Value: TResEvalValue; ErrorEl: TPasElement
 function TResExprEvaluator.OrdValue(Value: TResEvalValue; ErrorEl: TPasElement

+ 95 - 14
packages/fcl-passrc/src/pasresolver.pp

@@ -5769,7 +5769,7 @@ begin
     end
     end
   else if (C=TSelfExpr) or ((C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent)) then
   else if (C=TSelfExpr) or ((C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent)) then
     // ok
     // ok
-  else if (Access=rraRead)
+  else if (Access in [rraRead,rraParamToUnknownProc])
       and ((C=TPrimitiveExpr)
       and ((C=TPrimitiveExpr)
         or (C=TNilExpr)
         or (C=TNilExpr)
         or (C=TBoolConstExpr)) then
         or (C=TBoolConstExpr)) then
@@ -7513,6 +7513,7 @@ var
   Value: TResEvalValue;
   Value: TResEvalValue;
   Int: MaxPrecInt;
   Int: MaxPrecInt;
   MinIntVal, MaxIntVal: int64;
   MinIntVal, MaxIntVal: int64;
+  Flo: MaxPrecFloat;
 begin
 begin
   Result:=nil;
   Result:=nil;
   {$IFDEF VerbosePasResEval}
   {$IFDEF VerbosePasResEval}
@@ -7528,9 +7529,6 @@ begin
       if bt=btQWord then
       if bt=btQWord then
         begin
         begin
         // int to qword
         // int to qword
-        if (Int<0) then
-          fExprEvaluator.EmitRangeCheckConst(20170624195049,
-            Value.AsString,'0',IntToStr(High(qword)),Params);
         {$R-}
         {$R-}
         Result:=TResEvalUInt.CreateValue(MaxPrecUInt(Int));
         Result:=TResEvalUInt.CreateValue(MaxPrecUInt(Int));
         {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
         {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
@@ -7541,21 +7539,21 @@ begin
         GetIntegerRange(bt,MinIntVal,MaxIntVal);
         GetIntegerRange(bt,MinIntVal,MaxIntVal);
         if (Int<MinIntVal) or (Int>MaxIntVal) then
         if (Int<MinIntVal) or (Int>MaxIntVal) then
           begin
           begin
-          fExprEvaluator.EmitRangeCheckConst(20170624194534,
-            Value.AsString,MinIntVal,MaxIntVal,Params);
           {$R-}
           {$R-}
           case bt of
           case bt of
             btByte: Result:=TResEvalInt.CreateValue(byte(Int),reitByte);
             btByte: Result:=TResEvalInt.CreateValue(byte(Int),reitByte);
-            btShortInt: Result:=TResEvalInt.CreateValue(shortint(Int),reitShortInt);// ToDo: negative
+            btShortInt: Result:=TResEvalInt.CreateValue(shortint(Int),reitShortInt);
             btWord: Result:=TResEvalInt.CreateValue(word(Int),reitWord);
             btWord: Result:=TResEvalInt.CreateValue(word(Int),reitWord);
-            btSmallInt: Result:=TResEvalInt.CreateValue(smallint(Int),reitSmallInt);// ToDo: negative
-            btUIntSingle: Result:=TResEvalInt.CreateValue(Int and MaskUIntSingle,reitUIntSingle);// ToDo: negative
-            btIntSingle: Result:=TResEvalInt.CreateValue(Int and MaskUIntSingle,reitIntSingle);// ToDo: negative
+            btSmallInt: Result:=TResEvalInt.CreateValue(smallint(Int),reitSmallInt);
             btLongWord: Result:=TResEvalInt.CreateValue(longword(Int),reitLongWord);
             btLongWord: Result:=TResEvalInt.CreateValue(longword(Int),reitLongWord);
-            btLongint: Result:=TResEvalInt.CreateValue(longint(Int),reitLongInt);// ToDo: negative
-            btUIntDouble: Result:=TResEvalInt.CreateValue(Int and MaskUIntDouble,reitUIntDouble);// ToDo: negative
-            btIntDouble: Result:=TResEvalInt.CreateValue(Int and MaskUIntDouble,reitIntDouble);// ToDo: negative
+            btLongint: Result:=TResEvalInt.CreateValue(longint(Int),reitLongInt);
             btInt64: Result:=TResEvalInt.CreateValue(Int);
             btInt64: Result:=TResEvalInt.CreateValue(Int);
+            btUIntSingle,
+            btIntSingle,
+            btUIntDouble,
+            btIntDouble:
+              fExprEvaluator.EmitRangeCheckConst(20170624194534,
+                Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
           else
           else
             RaiseNotYetImplemented(20170624200109,Params);
             RaiseNotYetImplemented(20170624200109,Params);
           end;
           end;
@@ -7583,6 +7581,26 @@ begin
           end;
           end;
         exit;
         exit;
         end
         end
+      else if bt=btboolean then
+        case Int of
+        0: Result:=TResEvalBool.CreateValue(false);
+        1: Result:=TResEvalBool.CreateValue(true);
+        else
+          fExprEvaluator.EmitRangeCheckConst(20170710203254,
+            Value.AsString,0,1,Params,mtError);
+        end
+      else if bt=btSingle then
+        try
+          Result:=TResEvalFloat.CreateValue(Single(Int))
+        except
+          RaiseMsg(20170711002015,nRangeCheckError,sRangeCheckError,[],Params);
+        end
+      else if bt=btDouble then
+        try
+          Result:=TResEvalFloat.CreateValue(Double(Int))
+        except
+          RaiseMsg(20170711002016,nRangeCheckError,sRangeCheckError,[],Params);
+        end
       else
       else
         begin
         begin
         {$IFDEF VerbosePasResEval}
         {$IFDEF VerbosePasResEval}
@@ -7591,6 +7609,66 @@ begin
         RaiseNotYetImplemented(20170624194308,Params);
         RaiseNotYetImplemented(20170624194308,Params);
         end;
         end;
       end;
       end;
+    revkFloat:
+      begin
+      Flo:=TResEvalFloat(Value).FloatValue;
+      if bt in (btAllInteger-[btQWord]) then
+        begin
+        // float to int
+        GetIntegerRange(bt,MinIntVal,MaxIntVal);
+        if (Flo<MinIntVal) or (Flo>MaxIntVal) then
+          fExprEvaluator.EmitRangeCheckConst(20170711001228,
+            Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
+        {$R-}
+        try
+          Int:=Round(Flo);
+        except
+          RaiseMsg(20170711002218,nRangeCheckError,sRangeCheckError,[],Params);
+        end;
+        case bt of
+          btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
+          btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
+          btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
+          btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
+          btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
+          btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
+          btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
+          btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
+          btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
+          btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
+          btInt64: Result:=TResEvalInt.CreateValue(Int);
+        else
+          RaiseNotYetImplemented(20170711001513,Params);
+        end;
+        {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
+        exit;
+        end
+      else if bt=btSingle then
+        begin
+        // float to single
+        try
+          Result:=TResEvalFloat.CreateValue(single(Flo));
+        except
+          RaiseMsg(20170711002315,nRangeCheckError,sRangeCheckError,[],Params);
+        end;
+        end
+      else if bt=btDouble then
+        begin
+        // float to double
+        try
+          Result:=TResEvalFloat.CreateValue(double(Flo));
+        except
+          RaiseMsg(20170711002327,nRangeCheckError,sRangeCheckError,[],Params);
+        end;
+        end
+      else
+        begin
+        {$IFDEF VerbosePasResEval}
+        writeln('TPasResolver.OnExprEvalParams typecast float to ',bt);
+        {$ENDIF}
+        RaiseNotYetImplemented(20170711002542,Params);
+        end;
+      end
     else
     else
       {$IFDEF VerbosePasResEval}
       {$IFDEF VerbosePasResEval}
       writeln('TPasResolver.OnExprEvalParams typecast to ',bt);
       writeln('TPasResolver.OnExprEvalParams typecast to ',bt);
@@ -7613,7 +7691,7 @@ begin
   Result:=fExprEvaluator.Eval(Expr,Flags);
   Result:=fExprEvaluator.Eval(Expr,Flags);
   if Result=nil then exit;
   if Result=nil then exit;
   {$IFDEF VerbosePasResEval}
   {$IFDEF VerbosePasResEval}
-  writeln('TPasResolver.Eval Result=',Result.AsString);
+  writeln('TPasResolver.Eval Result=',Result.AsDebugString);
   {$ENDIF}
   {$ENDIF}
 
 
   if Store
   if Store
@@ -10716,6 +10794,9 @@ begin
       // simple type check is enough
       // simple type check is enough
     else if RValue.Kind=revkBool then
     else if RValue.Kind=revkBool then
       // simple type check is enough
       // simple type check is enough
+    else if LeftResolved.BaseType in [btSingle,btDouble] then
+      // simple type check is enough
+      // ToDo: check if precision loss
     else
     else
       begin
       begin
       {$IFDEF VerbosePasResolver}
       {$IFDEF VerbosePasResolver}

+ 151 - 74
packages/fcl-passrc/tests/tcresolver.pas

@@ -170,7 +170,7 @@ type
     Procedure TestAliasTypeNotFoundPosition;
     Procedure TestAliasTypeNotFoundPosition;
     Procedure TestTypeAliasType; // ToDo
     Procedure TestTypeAliasType; // ToDo
 
 
-    // var, const
+    // vars, const
     Procedure TestVarLongint;
     Procedure TestVarLongint;
     Procedure TestVarInteger;
     Procedure TestVarInteger;
     Procedure TestConstInteger;
     Procedure TestConstInteger;
@@ -184,15 +184,21 @@ type
     Procedure TestArgWrongExprFail;
     Procedure TestArgWrongExprFail;
     Procedure TestVarExternal;
     Procedure TestVarExternal;
     Procedure TestVarNoSemicolonBeginFail;
     Procedure TestVarNoSemicolonBeginFail;
+    Procedure TestConstIntOperators;
+    Procedure TestConstBitwiseOps;
+    Procedure TestIntegerTypeCast;
+    Procedure TestConstBoolOperators;
+    Procedure TestBoolTypeCast;
+    Procedure TestConstFloatOperators;
+    Procedure TestFloatTypeCast;
+
+    // integer range
     Procedure TestIntegerRange;
     Procedure TestIntegerRange;
     Procedure TestIntegerRangeHighLowerLowFail;
     Procedure TestIntegerRangeHighLowerLowFail;
     Procedure TestIntegerRangeLowHigh;
     Procedure TestIntegerRangeLowHigh;
     Procedure TestAssignIntRangeFail;
     Procedure TestAssignIntRangeFail;
     Procedure TestByteRangeFail;
     Procedure TestByteRangeFail;
     Procedure TestCustomIntRangeFail;
     Procedure TestCustomIntRangeFail;
-    Procedure TestConstIntOperators;
-    Procedure TestConstBitwiseOps;
-    Procedure TestConstBoolOperators;
 
 
     // strings
     // strings
     Procedure TestChar_Ord;
     Procedure TestChar_Ord;
@@ -2131,6 +2137,137 @@ begin
     nParserExpectTokenError);
     nParserExpectTokenError);
 end;
 end;
 
 
+procedure TTestResolver.TestConstIntOperators;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  'const',
+  '  a:byte=1+2;',
+  '  b:shortint=1-2;',
+  '  c:word=2*3;',
+  '  d:smallint=5 div 2;',
+  '  e:longword=5 mod 2;',
+  '  f:longint=5 shl 2;',
+  '  g:qword=5 shr 2;',
+  '  h:boolean=5=2;',
+  '  i:boolean=5<>2;',
+  '  j:boolean=5<2;',
+  '  k:boolean=5>2;',
+  '  l:boolean=5<=2;',
+  '  m:boolean=5>=2;',
+  '  n:longword=5 and 2;',
+  '  o:longword=5 or 2;',
+  '  p:longword=5 xor 2;',
+  '  q:longword=not (5 or not 2);',
+  '  r=low(word)+high(int64);',
+  '  s=low(longint)+high(integer);',
+  '  t=succ(2)+pred(2);',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestConstBitwiseOps;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a=3;',
+  '  b=not a;',
+  '  c=not word(a);',
+  '  d=1 shl 2;',
+  '  e=13 shr 1;',
+  '  f=13 and 5;',
+  '  g=10 or 5;',
+  '  h=5 xor 7;',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestIntegerTypeCast;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a=longint(-11);',
+  '  b=not shortint(-12);',
+  '  c=word(-2);',
+  '  d=word(longword(-3));',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestConstBoolOperators;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a=true and false;',
+  '  b=true or false;',
+  '  c=true xor false;',
+  '  d=not b;',
+  '  e=a=b;',
+  '  f=a<>b;',
+  '  g=low(boolean) or high(boolean);',
+  '  h=succ(false) or pred(true);',
+  '  i=ord(false)+ord(true);',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestBoolTypeCast;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  a: boolean = boolean(0);');
+  Add('  b: boolean = boolean(1);');
+  Add('begin');
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestConstFloatOperators;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a=4/2 + 6.1/3 + 8.1/4.1 + 10/5.1;',
+  '  b=(1.1+1) + (2.1+3.1) + (4+5.1);',
+  '  c=(1.1-1) + (2.1-3.1) + (4-5.1);',
+  '  d=4*2 + 6.1*3 + 8.1*4.1 + 10*5.1;',
+  '  e=a=b;',
+  '  f=a<>b;',
+  '  g=a>b;',
+  '  h=a>=b;',
+  '  i=a<b;',
+  '  j=a<=b;',
+  '  k=(1.1<1) or (2.1<3.1) or (4<5.1);',
+  '  l=(1.1=1) or (2.1=3.1) or (4=5.1);',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestFloatTypeCast;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a=-123456890123456789012345;',
+  '  b: double=-123456890123456789012345;',
+  '  c=single(double(-123456890123456789012345));',
+  '  d=single(-1);',
+  '  e=single(word(-1));',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
 procedure TTestResolver.TestIntegerRange;
 procedure TTestResolver.TestIntegerRange;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -2217,75 +2354,6 @@ begin
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
-procedure TTestResolver.TestConstIntOperators;
-begin
-  StartProgram(false);
-  Add([
-  'type',
-  '  integer = longint;',
-  'const',
-  '  a:byte=1+2;',
-  '  b:shortint=1-2;',
-  '  c:word=2*3;',
-  '  d:smallint=5 div 2;',
-  '  e:longword=5 mod 2;',
-  '  f:longint=5 shl 2;',
-  '  g:qword=5 shr 2;',
-  '  h:boolean=5=2;',
-  '  i:boolean=5<>2;',
-  '  j:boolean=5<2;',
-  '  k:boolean=5>2;',
-  '  l:boolean=5<=2;',
-  '  m:boolean=5>=2;',
-  '  n:longword=5 and 2;',
-  '  o:longword=5 or 2;',
-  '  p:longword=5 xor 2;',
-  '  q:longword=not (5 or not 2);',
-  '  r=low(word)+high(int64);',
-  '  s=low(longint)+high(integer);',
-  '  t=succ(2)+pred(2);',
-  'begin']);
-  ParseProgram;
-  CheckResolverUnexpectedHints;
-end;
-
-procedure TTestResolver.TestConstBitwiseOps;
-begin
-  StartProgram(false);
-  Add([
-  'const',
-  '  a=3;',
-  '  b=not a;',
-  '  c=not word(a);',
-  '  d=1 shl 2;',
-  '  e=13 shr 1;',
-  '  f=13 and 5;',
-  '  g=10 or 5;',
-  '  h=5 xor 7;',
-  'begin']);
-  ParseProgram;
-  CheckResolverUnexpectedHints;
-end;
-
-procedure TTestResolver.TestConstBoolOperators;
-begin
-  StartProgram(false);
-  Add([
-  'const',
-  '  a=true and false;',
-  '  b=true or false;',
-  '  c=true xor false;',
-  '  d=not b;',
-  '  e=a=b;',
-  '  f=a<>b;',
-  '  g=low(boolean) or high(boolean);',
-  '  h=succ(false) or pred(true);',
-  '  i=ord(false)+ord(true);',
-  'begin']);
-  ParseProgram;
-  CheckResolverUnexpectedHints;
-end;
-
 procedure TTestResolver.TestChar_Ord;
 procedure TTestResolver.TestChar_Ord;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -2396,7 +2464,16 @@ begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
   'const',
   'const',
-  '  a=''o''+''x'';',
+  '  a=''o''+''x''+''''+''ab'';',
+  '  b=#65#66;',
+  '  c=a=b;',
+  '  d=a<>b;',
+  '  e=a<b;',
+  '  f=a<=b;',
+  '  g=a>b;',
+  '  h=a>=b;',
+  '  i=a[1];',
+  '  j=length(a);',
   'begin']);
   'begin']);
   ParseProgram;
   ParseProgram;
   CheckResolverUnexpectedHints;
   CheckResolverUnexpectedHints;

+ 0 - 1
packages/pastojs/src/fppas2js.pp

@@ -267,7 +267,6 @@ ToDos:
 - pointer of record
 - pointer of record
 - nested types in class
 - nested types in class
 - asm: pas() - useful for overloads and protect an identifier from optimization
 - asm: pas() - useful for overloads and protect an identifier from optimization
-- source maps
 - ifthen
 - ifthen
 - stdcall of methods: pass original 'this' as first parameter
 - stdcall of methods: pass original 'this' as first parameter