diff --git a/compiler/packages/fcl-passrc/src/pasresolver.pp b/compiler/packages/fcl-passrc/src/pasresolver.pp index 55ee1fe..123b822 100644 --- a/compiler/packages/fcl-passrc/src/pasresolver.pp +++ b/compiler/packages/fcl-passrc/src/pasresolver.pp @@ -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; diff --git a/compiler/packages/fcl-passrc/tests/tcresolver.pas b/compiler/packages/fcl-passrc/tests/tcresolver.pas index 7f4757b..7f89305 100644 --- a/compiler/packages/fcl-passrc/tests/tcresolver.pas +++ b/compiler/packages/fcl-passrc/tests/tcresolver.pas @@ -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; diff --git a/compiler/packages/pastojs/tests/tcmodules.pas b/compiler/packages/pastojs/tests/tcmodules.pas index 5093de4..b7500a2 100644 --- a/compiler/packages/pastojs/tests/tcmodules.pas +++ b/compiler/packages/pastojs/tests/tcmodules.pas @@ -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);