diff options
author | mattias <mattias@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2021-02-01 22:12:48 +0000 |
---|---|---|
committer | mattias <mattias@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2021-02-01 22:12:48 +0000 |
commit | 74f51ede152a874c416ffa969b82d92ce7df2ffc (patch) | |
tree | 3b5d5d5966e067f2f067ecc8f4dd46cf3eca8568 /packages | |
parent | cc44fd9bde6c964045557ac5afb8627d6b426db2 (diff) | |
download | fpc-74f51ede152a874c416ffa969b82d92ce7df2ffc.tar.gz |
fcl-passrc: resolver: include(intset,int)
git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48497 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages')
-rw-r--r-- | packages/fcl-passrc/src/pasresolver.pp | 65 | ||||
-rw-r--r-- | packages/fcl-passrc/tests/tcresolver.pas | 7 | ||||
-rw-r--r-- | packages/pastojs/tests/tcmodules.pas | 39 |
3 files changed, 83 insertions, 28 deletions
diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 3aa425f3a7..54f9110705 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -18763,54 +18763,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/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 300fe0351d..d7ac1df835 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -3360,7 +3360,8 @@ begin 'begin', ' i:=i2;', ' if i=i2 then ;', - ' i:=ord(i);']); + ' i:=ord(i);', + '']); ParseProgram; CheckResolverUnexpectedHints; end; @@ -4232,7 +4233,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/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 7f68df6b22..ca46edd38b 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -389,6 +389,7 @@ type Procedure TestSet_Property; Procedure TestSet_EnumConst; Procedure TestSet_IntConst; + Procedure TestSet_IntRange; Procedure TestSet_AnonymousEnumType; Procedure TestSet_AnonymousEnumTypeChar; // ToDo Procedure TestSet_ConstEnum; @@ -6420,6 +6421,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); |