paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 03:30:43 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: for e in constset do

Browse Source 
git-svn-id: trunk@37776 -
This commit is contained in:
Mattias Gaertner 2017-12-21 16:46:40 +00:00
parent 65c2575883
commit bc43c5e0ef
3 changed files with 106 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
packages/fcl-passrc/src/pasresolveeval.pas
View File

@ -442,11 +442,11 @@ type
ElType: TPasType; // revskEnum: TPasEnumType ElType: TPasType; // revskEnum: TPasEnumType
constructor Create; override; constructor Create; override;
constructor CreateValue(const aElKind: TRESetElKind; aElType: TPasType; constructor CreateValue(const aElKind: TRESetElKind; aElType: TPasType;
const aRangeStart, aRangeEnd: MaxPrecInt); const aRangeStart, aRangeEnd: MaxPrecInt); virtual;
function Clone: TResEvalValue; override; function Clone: TResEvalValue; override;
function AsString: string; override; function AsString: string; override;
function AsDebugString: string; override; function AsDebugString: string; override;
function ElementAsString(El: MaxPrecInt): string; function ElementAsString(El: MaxPrecInt): string; virtual;
end; end;
{ TResEvalRangeUInt } { TResEvalRangeUInt }
@ -462,7 +462,7 @@ type
{ TResEvalSet - Kind=revkSetOfInt } { TResEvalSet - Kind=revkSetOfInt }
TResEvalSet = class(TResEvalValue) TResEvalSet = class(TResEvalRangeInt)
public public
const MaxCount = $ffff; const MaxCount = $ffff;
type type
@ -471,17 +471,16 @@ type
end; end;
TItems = array of TItem; TItems = array of TItem;
public public
ElKind: TRESetElKind;
Ranges: TItems; // disjunct, sorted ascending Ranges: TItems; // disjunct, sorted ascending
ElType: TPasType; // revskEnum: TPasEnumType
constructor Create; override; constructor Create; override;
constructor CreateEmpty(aSet: TResEvalSet); constructor CreateEmpty(aSet: TResEvalSet);
constructor CreateValue(const aElKind: TRESetElKind; aElType: TPasType;
const aRangeStart, aRangeEnd: MaxPrecInt); override;
function Clone: TResEvalValue; override; function Clone: TResEvalValue; override;
function AsString: string; override; function AsString: string; override;
function ElementAsString(El: MaxPrecInt): string; function Add(aRangeStart, aRangeEnd: MaxPrecInt): boolean; // false if duplicate ignored
function Add(RangeStart, RangeEnd: MaxPrecInt): boolean; // false if duplicate ignored
function IndexOfRange(Index: MaxPrecInt; FindInsertPos: boolean = false): integer; 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; procedure ConsistencyCheck;
end; end;
@ -4692,6 +4691,13 @@ begin
ElType:=aSet.ElType; ElType:=aSet.ElType;
end; 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; function TResEvalSet.Clone: TResEvalValue;
var var
RS: TResEvalSet; RS: TResEvalSet;
@ -4721,43 +4727,7 @@ begin
Result:=Result+']'; Result:=Result+']';
end; end;
function TResEvalSet.ElementAsString(El: MaxPrecInt): string; function TResEvalSet.Add(aRangeStart, aRangeEnd: MaxPrecInt): boolean;
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;
{$IF FPC_FULLVERSION<30101} {$IF FPC_FULLVERSION<30101}
procedure Insert(const Item: TItem; var Items: TItems; Index: integer); procedure Insert(const Item: TItem; var Items: TItems; Index: integer);
@ -4787,9 +4757,9 @@ var
begin begin
Result:=false; Result:=false;
{$IFDEF VerbosePasResEval} {$IFDEF VerbosePasResEval}
writeln('TResEvalSetInt.Add ',RangeStart,'..',RangeEnd); writeln('TResEvalSetInt.Add ',aRangeStart,'..',aRangeEnd);
{$ENDIF} {$ENDIF}
if RangeStart>RangeEnd then if aRangeStart>aRangeEnd then
raise Exception.Create(''); raise Exception.Create('');
if ElKind=revskNone then if ElKind=revskNone then
raise Exception.Create(''); raise Exception.Create('');
@ -4798,68 +4768,75 @@ begin
if l=0 then if l=0 then
begin begin
// first range // first range
RangeStart:=aRangeStart;
RangeEnd:=aRangeEnd;
SetLength(Ranges,1); SetLength(Ranges,1);
Ranges[0].RangeStart:=RangeStart; Ranges[0].RangeStart:=aRangeStart;
Ranges[0].RangeEnd:=RangeEnd; Ranges[0].RangeEnd:=aRangeEnd;
exit(true); exit(true);
end; end;
if RangeStart>aRangeStart then
RangeStart:=aRangeStart;
if RangeEnd<aRangeEnd then
RangeEnd:=aRangeEnd;
// find insert position // find insert position
StartIndex:=IndexOfRange(RangeStart,true); StartIndex:=IndexOfRange(aRangeStart,true);
if (StartIndex>0) and (Ranges[StartIndex-1].RangeEnd=RangeStart-1) then if (StartIndex>0) and (Ranges[StartIndex-1].RangeEnd=aRangeStart-1) then
dec(StartIndex); dec(StartIndex);
if StartIndex=l then if StartIndex=l then
begin begin
// add new range // add new range
Item.RangeStart:=RangeStart; Item.RangeStart:=aRangeStart;
Item.RangeEnd:=RangeEnd; Item.RangeEnd:=aRangeEnd;
Insert(Item,Ranges,StartIndex); Insert(Item,Ranges,StartIndex);
Result:=true; Result:=true;
end end
else else
begin begin
// StartIndex is now the first affected range // StartIndex is now the first affected range
EndIndex:=IndexOfRange(RangeEnd,true); EndIndex:=IndexOfRange(aRangeEnd,true);
if (EndIndex>StartIndex) then 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); dec(EndIndex);
// EndIndex is now the last affected range // EndIndex is now the last affected range
if StartIndex>EndIndex then if StartIndex>EndIndex then
raise Exception.Create(''); raise Exception.Create('');
if StartIndex=EndIndex then if StartIndex=EndIndex then
begin begin
if (Ranges[StartIndex].RangeStart>RangeEnd) then if (Ranges[StartIndex].RangeStart>aRangeEnd) then
begin begin
// range in front // range in front
if (Ranges[StartIndex].RangeStart>RangeEnd+1) then if (Ranges[StartIndex].RangeStart>aRangeEnd+1) then
begin begin
// insert new range // insert new range
Item.RangeStart:=RangeStart; Item.RangeStart:=aRangeStart;
Item.RangeEnd:=RangeEnd; Item.RangeEnd:=aRangeEnd;
Insert(Item,Ranges,StartIndex); Insert(Item,Ranges,StartIndex);
Result:=true; Result:=true;
end end
else else
begin begin
// enlarge range at its start // enlarge range at its start
Ranges[StartIndex].RangeStart:=RangeStart; Ranges[StartIndex].RangeStart:=aRangeStart;
Result:=true; Result:=true;
end; end;
end end
else if Ranges[StartIndex].RangeEnd<RangeStart then else if Ranges[StartIndex].RangeEnd<aRangeStart then
begin begin
// range behind // range behind
if Ranges[StartIndex].RangeEnd+1<RangeStart then if Ranges[StartIndex].RangeEnd+1<aRangeStart then
begin begin
// insert new range // insert new range
Item.RangeStart:=RangeStart; Item.RangeStart:=aRangeStart;
Item.RangeEnd:=RangeEnd; Item.RangeEnd:=aRangeEnd;
Insert(Item,Ranges,StartIndex+1); Insert(Item,Ranges,StartIndex+1);
Result:=true; Result:=true;
end end
else else
begin begin
// enlarge range at its end // enlarge range at its end
Ranges[StartIndex].RangeEnd:=RangeEnd; Ranges[StartIndex].RangeEnd:=aRangeEnd;
Result:=true; Result:=true;
end; end;
end end
@ -4867,21 +4844,21 @@ begin
begin begin
// intersection -> enlarge to union range // intersection -> enlarge to union range
Result:=false; Result:=false;
if (Ranges[StartIndex].RangeStart>RangeStart) then if (Ranges[StartIndex].RangeStart>aRangeStart) then
Ranges[StartIndex].RangeStart:=RangeStart; Ranges[StartIndex].RangeStart:=aRangeStart;
if (Ranges[StartIndex].RangeEnd<RangeEnd) then if (Ranges[StartIndex].RangeEnd<aRangeEnd) then
Ranges[StartIndex].RangeEnd:=RangeEnd; Ranges[StartIndex].RangeEnd:=aRangeEnd;
end; end;
end end
else else
begin begin
// multiple ranges are merged to one // multiple ranges are merged to one
Result:=false; Result:=false;
if Ranges[StartIndex].RangeStart>RangeStart then if Ranges[StartIndex].RangeStart>aRangeStart then
Ranges[StartIndex].RangeStart:=RangeStart; Ranges[StartIndex].RangeStart:=aRangeStart;
if RangeEnd<Ranges[EndIndex].RangeEnd then if aRangeEnd<Ranges[EndIndex].RangeEnd then
RangeEnd:=Ranges[EndIndex].RangeEnd; aRangeEnd:=Ranges[EndIndex].RangeEnd;
Ranges[StartIndex].RangeEnd:=RangeEnd; Ranges[StartIndex].RangeEnd:=aRangeEnd;
Delete(Ranges,StartIndex+1,EndIndex-StartIndex); Delete(Ranges,StartIndex+1,EndIndex-StartIndex);
end; end;
end; end;
@ -4919,12 +4896,12 @@ begin
exit(m); exit(m);
end; end;
function TResEvalSet.Intersects(RangeStart, RangeEnd: MaxPrecInt): integer; function TResEvalSet.Intersects(aRangeStart, aRangeEnd: MaxPrecInt): integer;
var var
Index: Integer; Index: Integer;
begin begin
Index:=IndexOfRange(RangeStart,true); Index:=IndexOfRange(aRangeStart,true);
if (Index=length(Ranges)) or (Ranges[Index].RangeStart>RangeEnd) then if (Index=length(Ranges)) or (Ranges[Index].RangeStart>aRangeEnd) then
Result:=-1 Result:=-1
else else
Result:=Index; Result:=Index;
@ -4948,6 +4925,10 @@ begin
E(''); E('');
if (i>0) and (Ranges[i-1].RangeEnd+1>=Ranges[i].RangeStart) then if (i>0) and (Ranges[i-1].RangeEnd+1>=Ranges[i].RangeStart) then
E('missing gap'); 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;
end; end;

57
packages/fcl-passrc/src/pasresolver.pp
View File

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

17
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -257,6 +257,7 @@ type
Procedure TestSet_IntRange_Const; Procedure TestSet_IntRange_Const;
Procedure TestEnumRange; Procedure TestEnumRange;
Procedure TestEnum_ForIn; Procedure TestEnum_ForIn;
Procedure TestEnum_ForInRangeFail;
// operators // operators
Procedure TestPrgAssignment; Procedure TestPrgAssignment;
@ -3367,7 +3368,9 @@ begin
' for e in TEnumRg do;', ' for e in TEnumRg do;',
' for e in TSetOfEnum do;', ' for e in TSetOfEnum do;',
' for e in TSetOfEnumRg do;', ' for e in TSetOfEnumRg do;',
' for e in [] do;',
' for e in [red..green] do;', ' for e in [red..green] do;',
' for e in [green,blue] do;',
' for e in TArrOfEnum do;', ' for e in TArrOfEnum do;',
' for e in TArrOfEnumRg do;', ' for e in TArrOfEnumRg do;',
' for er in TEnumRg do;', ' for er in TEnumRg do;',
@ -3378,6 +3381,20 @@ begin
ParseProgram; ParseProgram;
end; 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; procedure TTestResolver.TestPrgAssignment;
var var
El: TPasElement; El: TPasElement;