fcl-passrc: resolver: include(intset,int)

This commit is contained in:
mattias 2021-02-01 22:13:41 +00:00
parent e1d0d3b185
commit 3787087cae
3 changed files with 83 additions and 28 deletions

View File

@ -18677,54 +18677,67 @@ function TPasResolver.BI_InExclude_OnGetCallCompatibility(
// check params of built in proc 'include'
var
Params: TParamsExpr;
Param: TPasExpr;
ParamResolved: TPasResolverResult;
Param0, Param1: TPasExpr;
Param0Resolved, Param1Resolved: TPasResolverResult;
EnumType: TPasEnumType;
C: TClass;
LoTypeEl: TPasType;
RgType: TPasRangeType;
begin
if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
exit(cIncompatible);
Params:=TParamsExpr(Expr);
// first param: set variable
// first Param0: set variable
// todo set of int, set of char, set of bool
Param:=Params.Params[0];
ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
Param0:=Params.Params[0];
ComputeElement(Param0,Param0Resolved,[rcNoImplicitProc]);
Param1:=Params.Params[1];
ComputeElement(Param1,Param1Resolved,[]);
EnumType:=nil;
if ([rrfReadable,rrfWritable]*ParamResolved.Flags=[rrfReadable,rrfWritable])
and (ParamResolved.IdentEl<>nil) then
RgType:=nil;
if ([rrfReadable,rrfWritable]*Param0Resolved.Flags=[rrfReadable,rrfWritable])
and (Param0Resolved.IdentEl<>nil) then
begin
C:=ParamResolved.IdentEl.ClassType;
C:=Param0Resolved.IdentEl.ClassType;
if (C.InheritsFrom(TPasVariable)
or (C=TPasArgument)
or (C=TPasResultElement)) then
begin
if (ParamResolved.BaseType=btSet)
and (ParamResolved.LoTypeEl is TPasEnumType) then
EnumType:=TPasEnumType(ParamResolved.LoTypeEl);
if Param0Resolved.BaseType=btSet then
begin
LoTypeEl:=Param0Resolved.LoTypeEl;
if LoTypeEl.ClassType=TPasEnumType then
begin
EnumType:=TPasEnumType(LoTypeEl);
if (not (rrfReadable in Param0Resolved.Flags))
or (Param0Resolved.LoTypeEl<>EnumType) then
begin
if RaiseOnError then
RaiseIncompatibleType(20210201225926,nIncompatibleTypeArgNo,
['2'],Param0Resolved.LoTypeEl,EnumType,Param0);
exit(cIncompatible);
end;
end
else if LoTypeEl.ClassType=TPasRangeType then
begin
RgType:=TPasRangeType(LoTypeEl);
ComputeElement(RgType.RangeExpr.left,Param0Resolved,[]);
Result:=CheckAssignResCompatibility(Param0Resolved,Param1Resolved,Param1,RaiseOnError);
end;
end;
end;
end;
if EnumType=nil then
if (EnumType=nil) and (RgType=nil) then
begin
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDbg(ParamResolved));
writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDbg(Param0Resolved));
{$ENDIF}
exit(CheckRaiseTypeArgNo(20170216152301,1,Param,ParamResolved,
exit(CheckRaiseTypeArgNo(20170216152301,1,Param0,Param0Resolved,
'variable of set of enumtype',RaiseOnError));
end;
// second param: enum
Param:=Params.Params[1];
ComputeElement(Param,ParamResolved,[]);
if (not (rrfReadable in ParamResolved.Flags))
or (ParamResolved.LoTypeEl<>EnumType) then
begin
if RaiseOnError then
RaiseIncompatibleType(20170216152302,nIncompatibleTypeArgNo,
['2'],ParamResolved.LoTypeEl,EnumType,Param);
exit(cIncompatible);
end;
Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
end;

View File

@ -3351,7 +3351,8 @@ begin
'begin',
' i:=i2;',
' if i=i2 then ;',
' i:=ord(i);']);
' i:=ord(i);',
'']);
ParseProgram;
CheckResolverUnexpectedHints;
end;
@ -4223,7 +4224,9 @@ begin
' s:= {#s3_set}[3..4];',
' s:= {#s4_set}[Three];',
' if 3 in a then ;',
' s:=c;']);
' s:=c;',
' Include(s,3);',
'']);
ParseProgram;
CheckParamsExpr_pkSet_Markers;
CheckResolverUnexpectedHints;

View File

@ -384,6 +384,7 @@ type
Procedure TestSet_Property;
Procedure TestSet_EnumConst;
Procedure TestSet_IntConst;
Procedure TestSet_IntRange;
Procedure TestSet_AnonymousEnumType;
Procedure TestSet_AnonymousEnumTypeChar; // ToDo
Procedure TestSet_ConstEnum;
@ -6373,6 +6374,44 @@ begin
'']));
end;
procedure TTestModule.TestSet_IntRange;
begin
StartProgram(false);
Add([
'type',
' TRange = 1..3;',
' TEnums = set of TRange;',
'const',
' Orange = 2;',
'var',
' Enum: byte;',
' Enums: TEnums;',
'begin',
' Enums:=[];',
' Enums:=[1];',
' Enums:=[2..3];',
' Include(enums,orange);',
' Exclude(enums,orange);',
' if orange in enums then;',
' if orange in [orange,1] then;']);
ConvertProgram;
CheckSource('TestSet_IntRange',
LinesToStr([ // statements
'this.Orange = 2;',
'this.Enum = 0;',
'this.Enums = {};',
'']),
LinesToStr([
'$mod.Enums = {};',
'$mod.Enums = rtl.createSet(1);',
'$mod.Enums = rtl.createSet(null, 2, 3);',
'$mod.Enums = rtl.includeSet($mod.Enums, 2);',
'$mod.Enums = rtl.excludeSet($mod.Enums, 2);',
'if (2 in $mod.Enums) ;',
'if (2 in rtl.createSet(2, 1)) ;',
'']));
end;
procedure TTestModule.TestSet_AnonymousEnumType;
begin
StartProgram(false);