fcl-passrc: resolver: for e in constset do

git-svn-id: trunk@37776 -
2025-04-21 22:29:24 +02:00 · 2017-12-21 16:46:40 +00:00 · 2017-12-21 16:46:40 +00:00 · bc43c5e0ef
commit bc43c5e0ef
parent 65c2575883
3 changed files with 106 additions and 103 deletions
--- a/packages/fcl-passrc/src/pasresolveeval.pas
+++ b/packages/fcl-passrc/src/pasresolveeval.pas
@ -442,11 +442,11 @@ type
    ElType: TPasType; // revskEnum: TPasEnumType
    constructor Create; override;
    constructor CreateValue(const aElKind: TRESetElKind; aElType: TPasType;
-      const aRangeStart, aRangeEnd: MaxPrecInt);
+      const aRangeStart, aRangeEnd: MaxPrecInt); virtual;
    function Clone: TResEvalValue; override;
    function AsString: string; override;
    function AsDebugString: string; override;
-    function ElementAsString(El: MaxPrecInt): string;
+    function ElementAsString(El: MaxPrecInt): string; virtual;
  end;

  { TResEvalRangeUInt }
@ -462,7 +462,7 @@ type

  { TResEvalSet - Kind=revkSetOfInt }

-  TResEvalSet = class(TResEvalValue)
+  TResEvalSet = class(TResEvalRangeInt)
  public
    const MaxCount = $ffff;
    type
@ -471,17 +471,16 @@ type
      end;
      TItems = array of TItem;
  public
-    ElKind: TRESetElKind;
    Ranges: TItems; // disjunct, sorted ascending
-    ElType: TPasType; // revskEnum: TPasEnumType
    constructor Create; override;
    constructor CreateEmpty(aSet: TResEvalSet);
+    constructor CreateValue(const aElKind: TRESetElKind; aElType: TPasType;
+      const aRangeStart, aRangeEnd: MaxPrecInt); override;
    function Clone: TResEvalValue; override;
    function AsString: string; override;
-    function ElementAsString(El: MaxPrecInt): string;
-    function Add(RangeStart, RangeEnd: MaxPrecInt): boolean; // false if duplicate ignored
+    function Add(aRangeStart, aRangeEnd: MaxPrecInt): boolean; // false if duplicate ignored
    function IndexOfRange(Index: MaxPrecInt; FindInsertPos: boolean = false): integer;
-    function Intersects(RangeStart, RangeEnd: MaxPrecInt): integer; // returns index of first intersecting range
+    function Intersects(aRangeStart, aRangeEnd: MaxPrecInt): integer; // returns index of first intersecting range
    procedure ConsistencyCheck;
  end;

@ -4692,6 +4691,13 @@ begin
  ElType:=aSet.ElType;
 end;

+constructor TResEvalSet.CreateValue(const aElKind: TRESetElKind;
+  aElType: TPasType; const aRangeStart, aRangeEnd: MaxPrecInt);
+begin
+  inherited CreateValue(aElKind, aElType, aRangeStart, aRangeEnd);
+  Add(aRangeStart,aRangeEnd);
+end;
+
 function TResEvalSet.Clone: TResEvalValue;
 var
  RS: TResEvalSet;
@ -4721,43 +4727,7 @@ begin
  Result:=Result+']';
 end;

-function TResEvalSet.ElementAsString(El: MaxPrecInt): string;
-var
-  EnumType: TPasEnumType;
-  EnumValue: TPasEnumValue;
-begin
-  case ElKind of
-    revskEnum:
-      begin
-      {$IFDEF VerbosePasResEval}
-      if not (ElType is TPasEnumType) then
-        writeln('TResEvalSet.ElementAsString ',ElKind,' expected TPasEnumType, but got ',GetObjName(ElType));
-      {$ENDIF}
-      EnumType:=ElType as TPasEnumType;
-      //writeln('TResEvalSet.ElementAsString EnumType=',GetObjName(EnumType),' Values.Count=',EnumType.Values.Count,' El=',El);
-      if (El>=0) and (El<EnumType.Values.Count) then
-        begin
-        EnumValue:=TPasEnumValue(EnumType.Values[El]);
-        Result:=EnumValue.Name;
-        end
-      else
-        Result:=ElType.Name+'('+IntToStr(El)+')';
-      end;
-    revskInt: Result:=IntToStr(El);
-    revskChar:
-      if El<=$ff then
-        Result:=Chr(El)
-      else
-        Result:=String(WideChar(El));
-    revskBool:
-      if El=0 then
-        Result:='false'
-      else
-        Result:='true';
-  end;
-end;
-
-function TResEvalSet.Add(RangeStart, RangeEnd: MaxPrecInt): boolean;
+function TResEvalSet.Add(aRangeStart, aRangeEnd: MaxPrecInt): boolean;

  {$IF FPC_FULLVERSION<30101}
  procedure Insert(const Item: TItem; var Items: TItems; Index: integer);
@ -4787,9 +4757,9 @@ var
 begin
  Result:=false;
  {$IFDEF VerbosePasResEval}
-  writeln('TResEvalSetInt.Add ',RangeStart,'..',RangeEnd);
+  writeln('TResEvalSetInt.Add ',aRangeStart,'..',aRangeEnd);
  {$ENDIF}
-  if RangeStart>RangeEnd then
+  if aRangeStart>aRangeEnd then
    raise Exception.Create('');
  if ElKind=revskNone then
    raise Exception.Create('');
@ -4798,68 +4768,75 @@ begin
  if l=0 then
    begin
    // first range
+    RangeStart:=aRangeStart;
+    RangeEnd:=aRangeEnd;
    SetLength(Ranges,1);
-    Ranges[0].RangeStart:=RangeStart;
-    Ranges[0].RangeEnd:=RangeEnd;
+    Ranges[0].RangeStart:=aRangeStart;
+    Ranges[0].RangeEnd:=aRangeEnd;
    exit(true);
    end;
+  if RangeStart>aRangeStart then
+    RangeStart:=aRangeStart;
+  if RangeEnd<aRangeEnd then
+    RangeEnd:=aRangeEnd;
+
  // find insert position
-  StartIndex:=IndexOfRange(RangeStart,true);
-  if (StartIndex>0) and (Ranges[StartIndex-1].RangeEnd=RangeStart-1) then
+  StartIndex:=IndexOfRange(aRangeStart,true);
+  if (StartIndex>0) and (Ranges[StartIndex-1].RangeEnd=aRangeStart-1) then
    dec(StartIndex);
  if StartIndex=l then
    begin
    // add new range
-    Item.RangeStart:=RangeStart;
-    Item.RangeEnd:=RangeEnd;
+    Item.RangeStart:=aRangeStart;
+    Item.RangeEnd:=aRangeEnd;
    Insert(Item,Ranges,StartIndex);
    Result:=true;
    end
  else
    begin
    // StartIndex is now the first affected range
-    EndIndex:=IndexOfRange(RangeEnd,true);
+    EndIndex:=IndexOfRange(aRangeEnd,true);
    if (EndIndex>StartIndex) then
-      if (EndIndex=l) or (Ranges[EndIndex].RangeStart>RangeEnd+1) then
+      if (EndIndex=l) or (Ranges[EndIndex].RangeStart>aRangeEnd+1) then
        dec(EndIndex);
    // EndIndex is now the last affected range
    if StartIndex>EndIndex then
      raise Exception.Create('');
    if StartIndex=EndIndex then
      begin
-      if (Ranges[StartIndex].RangeStart>RangeEnd) then
+      if (Ranges[StartIndex].RangeStart>aRangeEnd) then
        begin
        // range in front
-        if (Ranges[StartIndex].RangeStart>RangeEnd+1) then
+        if (Ranges[StartIndex].RangeStart>aRangeEnd+1) then
          begin
          // insert new range
-          Item.RangeStart:=RangeStart;
-          Item.RangeEnd:=RangeEnd;
+          Item.RangeStart:=aRangeStart;
+          Item.RangeEnd:=aRangeEnd;
          Insert(Item,Ranges,StartIndex);
          Result:=true;
          end
        else
          begin
          // enlarge range at its start
-          Ranges[StartIndex].RangeStart:=RangeStart;
+          Ranges[StartIndex].RangeStart:=aRangeStart;
          Result:=true;
          end;
        end
-      else if Ranges[StartIndex].RangeEnd<RangeStart then
+      else if Ranges[StartIndex].RangeEnd<aRangeStart then
        begin
        // range behind
-        if Ranges[StartIndex].RangeEnd+1<RangeStart then
+        if Ranges[StartIndex].RangeEnd+1<aRangeStart then
          begin
          // insert new range
-          Item.RangeStart:=RangeStart;
-          Item.RangeEnd:=RangeEnd;
+          Item.RangeStart:=aRangeStart;
+          Item.RangeEnd:=aRangeEnd;
          Insert(Item,Ranges,StartIndex+1);
          Result:=true;
          end
        else
          begin
          // enlarge range at its end
-          Ranges[StartIndex].RangeEnd:=RangeEnd;
+          Ranges[StartIndex].RangeEnd:=aRangeEnd;
          Result:=true;
          end;
        end
@ -4867,21 +4844,21 @@ begin
        begin
        // intersection -> enlarge to union range
        Result:=false;
-        if (Ranges[StartIndex].RangeStart>RangeStart) then
-          Ranges[StartIndex].RangeStart:=RangeStart;
-        if (Ranges[StartIndex].RangeEnd<RangeEnd) then
-          Ranges[StartIndex].RangeEnd:=RangeEnd;
+        if (Ranges[StartIndex].RangeStart>aRangeStart) then
+          Ranges[StartIndex].RangeStart:=aRangeStart;
+        if (Ranges[StartIndex].RangeEnd<aRangeEnd) then
+          Ranges[StartIndex].RangeEnd:=aRangeEnd;
        end;
      end
    else
      begin
      // multiple ranges are merged to one
      Result:=false;
-      if Ranges[StartIndex].RangeStart>RangeStart then
-        Ranges[StartIndex].RangeStart:=RangeStart;
-      if RangeEnd<Ranges[EndIndex].RangeEnd then
-        RangeEnd:=Ranges[EndIndex].RangeEnd;
-      Ranges[StartIndex].RangeEnd:=RangeEnd;
+      if Ranges[StartIndex].RangeStart>aRangeStart then
+        Ranges[StartIndex].RangeStart:=aRangeStart;
+      if aRangeEnd<Ranges[EndIndex].RangeEnd then
+        aRangeEnd:=Ranges[EndIndex].RangeEnd;
+      Ranges[StartIndex].RangeEnd:=aRangeEnd;
      Delete(Ranges,StartIndex+1,EndIndex-StartIndex);
      end;
    end;
@ -4919,12 +4896,12 @@ begin
    exit(m);
 end;

-function TResEvalSet.Intersects(RangeStart, RangeEnd: MaxPrecInt): integer;
+function TResEvalSet.Intersects(aRangeStart, aRangeEnd: MaxPrecInt): integer;
 var
  Index: Integer;
 begin
-  Index:=IndexOfRange(RangeStart,true);
-  if (Index=length(Ranges)) or (Ranges[Index].RangeStart>RangeEnd) then
+  Index:=IndexOfRange(aRangeStart,true);
+  if (Index=length(Ranges)) or (Ranges[Index].RangeStart>aRangeEnd) then
    Result:=-1
  else
    Result:=Index;
@ -4948,6 +4925,10 @@ begin
      E('');
    if (i>0) and (Ranges[i-1].RangeEnd+1>=Ranges[i].RangeStart) then
      E('missing gap');
+    if RangeStart>Ranges[i].RangeStart then
+      E('wrong RangeStart='+IntToStr(RangeStart));
+    if RangeEnd<Ranges[i].RangeEnd then
+      E('wrong RangeEnd='+IntToStr(RangeEnd));
    end;
 end;

--- a/packages/fcl-passrc/src/pasresolver.pp
+++ b/packages/fcl-passrc/src/pasresolver.pp
@ -5247,7 +5247,7 @@ procedure TPasResolver.ResolveImplForLoop(Loop: TPasImplForLoop);
 var
  VarResolved, StartResolved, EndResolved,
    OrigStartResolved: TPasResolverResult;
-  EnumeratorFound: Boolean;
+  EnumeratorFound, HasInValues: Boolean;
  InRange, VarRange: TResEvalValue;
  InRangeInt, VarRangeInt: TResEvalRangeInt;
  bt: TResolverBaseType;
@ -5317,7 +5317,8 @@ begin
        bt:=StartResolved.BaseType;
        if bt=btSet then
          begin
-          if StartResolved.ExprEl<>nil then
+            writeln('AAA1 TPasResolver.ResolveImplForLoop ',GetObjName(StartResolved.ExprEl),' ',GetObjName(Loop.StartExpr));
+          if (StartResolved.IdentEl=nil) and (StartResolved.ExprEl<>nil) then
            InRange:=Eval(StartResolved.ExprEl,[refAutoConst])
          else
            InRange:=EvalTypeRange(StartResolved.TypeEl,[]);
@ -5347,17 +5348,18 @@ begin
        end;
      if (not EnumeratorFound) and (InRange<>nil) then
        begin
-        // in parameter is a constant
+        // for v in <constant> do
        // -> check if same type
        //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved));
        case InRange.Kind of
-        revkRangeInt:
+        revkRangeInt,revkSetOfInt:
          begin
          InRangeInt:=TResEvalRangeInt(InRange);
          case VarRange.Kind of
          revkRangeInt:
            begin
            VarRangeInt:=TResEvalRangeInt(VarRange);
+            HasInValues:=(InRange.Kind<>revkSetOfInt) or (length(TResEvalSet(InRange).Ranges)>0);
            case InRangeInt.ElKind of
              revskEnum:
                if (VarRangeInt.ElKind<>revskEnum)
@ -5377,27 +5379,31 @@ begin
                  RaiseXExpectedButYFound(20171109200754,'boolean',
                    GetResolverResultDescription(VarResolved,true),loop.VariableName);
            else
-              RaiseNotYetImplemented(20171109200954,Loop.StartExpr);
+              if HasInValues then
+                RaiseNotYetImplemented(20171109200954,Loop.StartExpr);
            end;
-            if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then
+            if HasInValues then
              begin
-              {$IFDEF VerbosePasResolver}
-              writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
-              {$ENDIF}
-              fExprEvaluator.EmitRangeCheckConst(20171109201428,
-                InRangeInt.ElementAsString(InRangeInt.RangeStart),
-                VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
-                VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
-              end;
-            if (VarRangeInt.RangeEnd<InRangeInt.RangeEnd) then
-              begin
-              {$IFDEF VerbosePasResolver}
-              writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
-              {$ENDIF}
-              fExprEvaluator.EmitRangeCheckConst(20171109201429,
-                InRangeInt.ElementAsString(InRangeInt.RangeEnd),
-                VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
-                VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
+              if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then
+                begin
+                {$IFDEF VerbosePasResolver}
+                writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
+                {$ENDIF}
+                fExprEvaluator.EmitRangeCheckConst(20171109201428,
+                  InRangeInt.ElementAsString(InRangeInt.RangeStart),
+                  VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
+                  VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
+                end;
+              if (VarRangeInt.RangeEnd<InRangeInt.RangeEnd) then
+                begin
+                {$IFDEF VerbosePasResolver}
+                writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
+                {$ENDIF}
+                fExprEvaluator.EmitRangeCheckConst(20171109201429,
+                  InRangeInt.ElementAsString(InRangeInt.RangeEnd),
+                  VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
+                  VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
+                end;
              end;
            EnumeratorFound:=true;
            end;
@ -5409,7 +5415,7 @@ begin
          end;
        else
          {$IFDEF VerbosePasResolver}
-          writeln('TPasResolver.ResolveImplForLoop ForIn RangeValue=',InRange.AsDebugString);
+          writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString);
          {$ENDIF}
        end;
        end;
@ -7807,8 +7813,7 @@ begin
      end;

    FirstResolved.IdentEl:=nil;
-    if FirstResolved.ExprEl=nil then
-      FirstResolved.ExprEl:=Params;
+    FirstResolved.ExprEl:=Params;
    FirstResolved.SubType:=FirstResolved.BaseType;
    FirstResolved.BaseType:=btSet;
    FirstResolved.Flags:=[rrfReadable];
--- a/packages/fcl-passrc/tests/tcresolver.pas
+++ b/packages/fcl-passrc/tests/tcresolver.pas
@ -257,6 +257,7 @@ type
    Procedure TestSet_IntRange_Const;
    Procedure TestEnumRange;
    Procedure TestEnum_ForIn;
+    Procedure TestEnum_ForInRangeFail;

    // operators
    Procedure TestPrgAssignment;
@ -3367,7 +3368,9 @@ begin
  '  for e in TEnumRg do;',
  '  for e in TSetOfEnum do;',
  '  for e in TSetOfEnumRg do;',
+  '  for e in [] do;',
  '  for e in [red..green] do;',
+  '  for e in [green,blue] do;',
  '  for e in TArrOfEnum do;',
  '  for e in TArrOfEnumRg do;',
  '  for er in TEnumRg do;',
@ -3378,6 +3381,20 @@ begin
  ParseProgram;
 end;

+procedure TTestResolver.TestEnum_ForInRangeFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEnum = (red,green,blue);',
+  'var',
+  '  e: TEnum;',
+  'begin',
+  '  for e in red..green do;',
+  '']);
+  CheckResolverException('Cannot find an enumerator for the type "range.."',nCannotFindEnumeratorForType);
+end;
+
 procedure TTestResolver.TestPrgAssignment;
 var
  El: TPasElement;