paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 20:31:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: fixed include(FuncResultSet,enum)

Browse Source 
git-svn-id: trunk@39926 -
This commit is contained in:
Mattias Gaertner 2018-10-13 20:40:23 +00:00
parent c9c8ff1eef
commit 903854ad82
3 changed files with 29 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -12157,7 +12157,8 @@ begin
EnumType:=nil; EnumType:=nil;
if ([rrfReadable,rrfWritable]*ParamResolved.Flags=[rrfReadable,rrfWritable]) if ([rrfReadable,rrfWritable]*ParamResolved.Flags=[rrfReadable,rrfWritable])
and ((ParamResolved.IdentEl is TPasVariable) and ((ParamResolved.IdentEl is TPasVariable)
or (ParamResolved.IdentEl is TPasArgument)) then or (ParamResolved.IdentEl is TPasArgument)
or (ParamResolved.IdentEl is TPasResultElement)) then
begin begin
if (ParamResolved.BaseType=btSet) if (ParamResolved.BaseType=btSet)
and (ParamResolved.LoTypeEl is TPasEnumType) then and (ParamResolved.LoTypeEl is TPasEnumType) then

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

@ -254,7 +254,7 @@ type
Procedure TestCharAssignStringFail; Procedure TestCharAssignStringFail;
Procedure TestChar_ForIn; Procedure TestChar_ForIn;
// enums // enums and sets
Procedure TestEnums; Procedure TestEnums;
Procedure TestEnumRangeFail; Procedure TestEnumRangeFail;
Procedure TestSets; Procedure TestSets;
@ -3568,9 +3568,12 @@ begin
Add('function {#A1}FuncA: TFlags;'); Add('function {#A1}FuncA: TFlags;');
Add('begin'); Add('begin');
Add(' Result:=[red];'); Add(' Result:=[red];');
Add(' Include(Result,green);');
Add(' Exclude(Result,blue);');
Add('end;'); Add('end;');
Add('function {#A2}FuncA(f: TFlags): TFlags;'); Add('function {#A2}FuncA(f: TFlags): TFlags;');
Add('begin'); Add('begin');
Add(' Include(f,green);');
Add(' Result:=f;'); Add(' Result:=f;');
Add('end;'); Add('end;');
Add('var'); Add('var');

39
packages/pastojs/tests/tcmodules.pas
View File

@ -4503,22 +4503,25 @@ end;
procedure TTestModule.TestSet_AsParams; procedure TTestModule.TestSet_AsParams;
begin begin
StartProgram(false); StartProgram(false);
Add('type TEnum = (Red,Blue);'); Add([
Add('type TEnums = set of TEnum;'); 'type TEnum = (Red,Blue);',
Add('procedure DoIt(vG: TEnums; const vH: TEnums; var vI: TEnums);'); 'type TEnums = set of TEnum;',
Add('var vJ: TEnums;'); 'function DoIt(vG: TEnums; const vH: TEnums; var vI: TEnums): TEnums;',
Add('begin'); 'var vJ: TEnums;',
Add(' vg:=vg;'); 'begin',
Add(' vj:=vh;'); ' Include(vg,red);',
Add(' vi:=vi;'); ' Include(result,blue);',
Add(' doit(vg,vg,vg);'); ' vg:=vg;',
Add(' doit(vh,vh,vj);'); ' vj:=vh;',
Add(' doit(vi,vi,vi);'); ' vi:=vi;',
Add(' doit(vj,vj,vj);'); ' doit(vg,vg,vg);',
Add('end;'); ' doit(vh,vh,vj);',
Add('var i: TEnums;'); ' doit(vi,vi,vi);',
Add('begin'); ' doit(vj,vj,vj);',
Add(' doit(i,i,i);'); 'end;',
'var i: TEnums;',
'begin',
' doit(i,i,i);']);
ConvertProgram; ConvertProgram;
CheckSource('TestSet_AsParams', CheckSource('TestSet_AsParams',
LinesToStr([ // statements LinesToStr([ // statements
@ -4529,7 +4532,10 @@ begin
' Blue: 1', ' Blue: 1',
'};', '};',
'this.DoIt = function (vG,vH,vI) {', 'this.DoIt = function (vG,vH,vI) {',
' var Result = {};',
' var vJ = {};', ' var vJ = {};',
' vG = rtl.includeSet(vG, $mod.TEnum.Red);',
' Result = rtl.includeSet(Result, $mod.TEnum.Blue);',
' vG = rtl.refSet(vG);', ' vG = rtl.refSet(vG);',
' vJ = rtl.refSet(vH);', ' vJ = rtl.refSet(vH);',
' vI.set(rtl.refSet(vI.get()));', ' vI.set(rtl.refSet(vI.get()));',
@ -4558,6 +4564,7 @@ begin
' vJ = v;', ' vJ = v;',
' }', ' }',
' });', ' });',
' return Result;',
'};', '};',
'this.i = {};' 'this.i = {};'
]), ]),