fcl-passrc: resolver: static array[bool]

git-svn-id: trunk@37171 -

packages/fcl-passrc/src/pasresolver.pp

@@ -7533,7 +7533,7 @@ begin
   {$IFDEF VerbosePasResEval}
   writeln('TPasResolver.OnExprEvalIdentifier END Result=',dbgs(Result),' refConst=',refConst in Flags);
   {$ENDIF}
-  if refConst in Flags then
+  if (Result=nil) and (refConst in Flags) then
     RaiseConstantExprExp(20170518213616,Expr);
 end;
 
@@ -13465,9 +13465,9 @@ begin
           Result:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeEnd));
       revskBool:
         if EvalLow then
-          Result:=TResEvalBool.CreateValue(low(Boolean))
+          Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeStart<>0)
         else
-          Result:=TResEvalBool.CreateValue(high(Boolean));
+          Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeEnd<>0);
     else
       RaiseNotYetImplemented(20170601195240,ErrorEl);
     end;

packages/pastojs/src/fppas2js.pp

@@ -5078,8 +5078,9 @@ var
     Ranges: TPasExprArray;
     Int: MaxPrecInt;
     Param: TPasExpr;
-    ArgAdjusted: TJSAdditiveExpression;
-    Value: TResEvalValue;
+    JSAdd: TJSAdditiveExpression;
+    LowRg: TResEvalValue;
+    JSUnaryPlus: TJSUnaryPlusExpression;
   begin
     Arg:=nil;
     B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
@@ -5106,20 +5107,59 @@ var
           if i<=length(Ranges) then
             begin
             // static array
-            Value:=ArgContext.Resolver.EvalRangeLimit(Ranges[i-1],[refConst],true,El);
-            if Value=nil then
+            LowRg:=ArgContext.Resolver.EvalRangeLimit(Ranges[i-1],[refConst],true,El);
+            if LowRg=nil then
               RaiseNotSupported(Param,ArgContext,20170910163341);
-            case Value.Kind of
+            Int:=0;
+            case LowRg.Kind of
             revkBool:
-              Int:=ord(TResEvalBool(Value).B);
+              if TResEvalBool(LowRg).B=false then
+                begin
+                // array starts at 'false'
+                if (Arg is TJSLiteral) and (TJSLiteral(Arg).Value.ValueType=jstBoolean) then
+                  begin
+                  // convert Pascal boolean literal to JS number
+                  if TJSLiteral(Arg).Value.AsBoolean then
+                    TJSLiteral(Arg).Value.AsNumber:=1
+                  else
+                    TJSLiteral(Arg).Value.AsNumber:=0;
+                  end
+                else
+                  begin
+                  // -> convert bool to int with unary plus:  +bool
+                  JSUnaryPlus:=TJSUnaryPlusExpression(CreateElement(TJSUnaryPlusExpression,Param));
+                  JSUnaryPlus.A:=Arg;
+                  Arg:=JSUnaryPlus;
+                  end;
+                end
+              else
+                begin
+                // array starts at 'true'
+                if (Arg is TJSLiteral) and (TJSLiteral(Arg).Value.ValueType=jstBoolean) then
+                  begin
+                  if TJSLiteral(Arg).Value.AsBoolean then
+                    TJSLiteral(Arg).Value.AsNumber:=0
+                  else
+                    ArgContext.Resolver.ExprEvaluator.EmitRangeCheckConst(
+                      20170910203312,'false','true','true',Param,mtError);
+                  end
+                else
+                  begin
+                  // convert bool to int with offset: 1-bool
+                  JSAdd:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,Param));
+                  JSAdd.A:=CreateLiteralNumber(Param,1);
+                  JSAdd.B:=Arg;
+                  Arg:=JSAdd;
+                  end;
+                end;
             revkEnum:
-              Int:=TResEvalEnum(Value).Index;
+              Int:=TResEvalEnum(LowRg).Index;
             revkInt:
-              Int:=TResEvalInt(Value).Int;
+              Int:=TResEvalInt(LowRg).Int;
             // revkString
             // revkUnicodeString
             else
-              ReleaseEvalValue(Value);
+              ReleaseEvalValue(LowRg);
               RaiseNotSupported(Param,ArgContext,20170910170446);
             end;
             if Int<>0 then
@@ -5133,22 +5173,22 @@ var
                 if Int>0 then
                   begin
                   // Arg-Offset
-                  ArgAdjusted:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,Param));
-                  ArgAdjusted.A:=Arg;
-                  ArgAdjusted.B:=CreateLiteralNumber(Param,Int);
-                  Arg:=ArgAdjusted;
+                  JSAdd:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,Param));
+                  JSAdd.A:=Arg;
+                  JSAdd.B:=CreateLiteralNumber(Param,Int);
+                  Arg:=JSAdd;
                   end
                 else
                   begin
                   // Arg+Offset
-                  ArgAdjusted:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,Param));
-                  ArgAdjusted.A:=Arg;
-                  ArgAdjusted.B:=CreateLiteralNumber(Param,-Int);
-                  Arg:=ArgAdjusted;
+                  JSAdd:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,Param));
+                  JSAdd.A:=Arg;
+                  JSAdd.B:=CreateLiteralNumber(Param,-Int);
+                  Arg:=JSAdd;
                   end;
                 end;
               end;
-            ReleaseEvalValue(Value);
+            ReleaseEvalValue(LowRg);
             end;
 
           if B.Name<>nil then

packages/pastojs/tests/tcmodules.pas

@@ -297,6 +297,7 @@ type
     Procedure TestArray_Dynamic_Nil;
     Procedure TestArray_DynMultiDimensional;
     Procedure TestArray_StaticInt;
+    Procedure TestArray_StaticBool;
     Procedure TestArray_StaticMultiDim; // ToDo
     Procedure TestArrayOfRecord;
     // ToDo: Procedure TestArrayOfSet;
@@ -4919,6 +4920,52 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestArray_StaticBool;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TBools = array[boolean] of boolean;');
+  Add('  TBool2 = array[true..true] of boolean;');
+  Add('var');
+  Add('  Arr: TBools;');
+  Add('  Arr2: TBool2;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  b:=low(arr);');
+  Add('  b:=high(arr);');
+  Add('  arr[true]:=false;');
+  Add('  arr[false]:=arr[b] or arr[true];');
+  Add('  arr[b]:=true;');
+  Add('  arr[arr[b]]:=arr[high(arr)];');
+  Add('  b:=arr[false]=arr[true];');
+  Add('  b:=low(arr2);');
+  Add('  b:=high(arr2);');
+  Add('  arr2[true]:=true;');
+  Add('  arr2[true]:=arr2[true] and arr2[b];');
+  Add('  arr2[b]:=false;');
+  ConvertProgram;
+  CheckSource('TestArray_StaticBool',
+    LinesToStr([ // statements
+    'this.Arr = rtl.arrayNewMultiDim([2],false);',
+    'this.Arr2 = rtl.arrayNewMultiDim([1],false);',
+    'this.b = false;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.b = false;',
+    '$mod.b = true;',
+    '$mod.Arr[1] = false;',
+    '$mod.Arr[0] = $mod.Arr[+$mod.b] || $mod.Arr[1];',
+    '$mod.Arr[+$mod.b] = true;',
+    '$mod.Arr[+$mod.Arr[+$mod.b]] = $mod.Arr[1];',
+    '$mod.b = $mod.Arr[0] === $mod.Arr[1];',
+    '$mod.b = true;',
+    '$mod.b = true;',
+    '$mod.Arr2[0] = true;',
+    '$mod.Arr2[0] = $mod.Arr2[0] && $mod.Arr2[1-$mod.b];',
+    '$mod.Arr2[1-$mod.b] = false;',
+    '']));
+end;
+
 procedure TTestModule.TestArray_StaticMultiDim;
 begin
   exit;