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

fcl-passrc: resolver: totherarray(array):=

Browse Source 
git-svn-id: trunk@41278 -
This commit is contained in:
Mattias Gaertner 2019-02-10 14:54:42 +00:00
parent b1ee29c836
commit 60976ab94d
2 changed files with 56 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6269,8 +6269,8 @@ begin
if (ClassOrRecScope is TPasClassScope)
and (TPasClassScope(ClassOrRecScope).CanonicalClassOf<>nil) then
begin
// 'Self' in a class method is the hidden classtype argument
// Note: this is true in classes and helpers
// 'Self' in a method is the hidden classtype argument
// Note: this is true in classes, adv records and helpers
SelfArg:=TPasArgument.Create('Self',DeclProc);
ImplProcScope.SelfArg:=SelfArg;
{$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
@ -8962,15 +8962,19 @@ begin
end;
end;
// default: search for type helpers
DotScope:=PushHelperDotScope(LeftResolved.HiTypeEl);
if DotScope<>nil then
if (LeftResolved.BaseType in btAllStandardTypes)
or (LeftResolved.BaseType=btContext) then
begin
if LeftResolved.IdentEl is TPasType then
// e.g. TSet.HelperProc
DotScope.OnlyTypeMembers:=true;
ResolveExpr(El.right,Access);
PopScope;
exit;
DotScope:=PushHelperDotScope(LeftResolved.HiTypeEl);
if DotScope<>nil then
begin
if LeftResolved.IdentEl is TPasType then
// e.g. TSet.HelperProc
DotScope.OnlyTypeMembers:=true;
ResolveExpr(El.right,Access);
PopScope;
exit;
end;
end;
end;
@ -11682,6 +11686,12 @@ begin
else if (ToLoType.ClassType=TPasRecordType)
and (ParamResolved.LoTypeEl.ClassType=TPasRecordType) then
// typecast record
KeepWriteFlags:=true
else if (ToLoType.ClassType=TPasArrayType)
and (ParamResolved.LoTypeEl.ClassType=TPasArrayType)
and IsDynArray(ToLoType)
and IsDynArray(ParamResolved.LoTypeEl) then
// typecast array
KeepWriteFlags:=true;
end
else
@ -17001,6 +17011,13 @@ begin
if TypeEl=nil then
RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
[BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
if (ExprResolved.BaseType in btAllStandardTypes) then
// ok
else if (ExprResolved.BaseType=btContext) then
// ok
else
RaiseMsg(20190210143257,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
[BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
Flags:=[];
CheckUseAsType(TypeEl,20190123113957,Expr);

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

@ -914,6 +914,7 @@ type
Procedure TestTypeHelper_Enum;
Procedure TestTypeHelper_EnumDotValueFail;
Procedure TestTypeHelper_EnumHelperDotProcFail;
Procedure TestTypeHelper_Set;
Procedure TestTypeHelper_Enumerator;
Procedure TestTypeHelper_String;
Procedure TestTypeHelper_Boolean;
@ -17006,6 +17007,8 @@ begin
' f: TFlag;',
'begin',
' f.toString;',
' green.toString;',
' TFlag.green.toString;',
' TFlag.Fly;',
'']);
ParseProgram;
@ -17047,6 +17050,32 @@ begin
CheckResolverException('Cannot access this member from a type helper',nCannotAccessThisMemberFromAX);
end;
procedure TTestResolver.TestTypeHelper_Set;
begin
StartProgram(false);
Add([
'{$modeswitch typehelpers}',
'type',
' TEnum = (Red, Green, Blue);',
' TSetOfEnum = set of TEnum;',
' THelper = type helper for TSetOfEnum',
' procedure Fly;',
' end;',
'procedure THelper.Fly;',
'begin',
' Self:=[];',
' Self:=[green];',
' Include(Self,blue);',
'end;',
'var s: TSetOfEnum;',
'begin',
// todo: ' s.Fly;',
// not supported: [green].Fly
// todo: with s do Fly
'']);
ParseProgram;
end;
procedure TTestResolver.TestTypeHelper_Enumerator;
begin
StartProgram(false);