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

fcl-passrc: resolver: fixed CheckClassIsClass if DestType is forward class

Browse Source 
git-svn-id: trunk@37434 -
This commit is contained in:
Mattias Gaertner 2017-10-09 11:08:31 +00:00
parent 061c0b4da3
commit bc6b6fe7c9
2 changed files with 32 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -920,7 +920,7 @@ type
FLastMsgType: TMessageType;
FLastSourcePos: TPasSourcePos;
FOptions: TPasResolverOptions;
FPendingForwards: TFPList; // list of TPasElement needed to check for forward procs
FPendingForwardProcs: TFPList; // list of TPasElement needed to check for forward procs
FRootElement: TPasModule;
FScopeClass_Class: TPasClassScopeClass;
FScopeClass_Proc: TPasProcedureScopeClass;
@ -1055,7 +1055,7 @@ type
procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure; CheckNames: boolean);
procedure CheckPendingForwards(El: TPasElement);
procedure CheckPendingForwardProcs(El: TPasElement);
procedure ComputeBinaryExpr(Bin: TBinaryExpr;
out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
StartEl: TPasElement);
@ -3121,9 +3121,9 @@ begin
// check all methods have bodies
// and all forward classes and pointers are resolved
for i:=0 to FPendingForwards.Count-1 do
CheckPendingForwards(TPasElement(FPendingForwards[i]));
FPendingForwards.Clear;
for i:=0 to FPendingForwardProcs.Count-1 do
CheckPendingForwardProcs(TPasElement(FPendingForwardProcs[i]));
FPendingForwardProcs.Clear;
// close all sections
while (TopScope<>nil) and (TopScope.ClassType=TPasSectionScope) do
@ -6046,7 +6046,7 @@ begin
end;
end;
procedure TPasResolver.CheckPendingForwards(El: TPasElement);
procedure TPasResolver.CheckPendingForwardProcs(El: TPasElement);
var
i: Integer;
DeclEl: TPasElement;
@ -6108,7 +6108,7 @@ procedure TPasResolver.AddSection(El: TPasSection);
// TInterfaceSection, TImplementationSection, TProgramSection, TLibrarySection
// Note: implementation scope is within the interface scope
begin
FPendingForwards.Add(El); // check forward declarations at the end
FPendingForwardProcs.Add(El); // check forward declarations at the end
PushScope(El,TPasSectionScope);
end;
@ -6132,7 +6132,7 @@ begin
RaiseInvalidScopeForElement(20160922163508,El);
if El.Name<>'' then begin
AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
FPendingForwards.Add(El); // check forward declarations at the end
FPendingForwardProcs.Add(El); // check forward declarations at the end
end;
if El.Parent.ClassType<>TPasVariant then
@ -6177,7 +6177,7 @@ begin
else
AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
FPendingForwards.Add(El); // check forward declarations at the end
FPendingForwardProcs.Add(El); // check forward declarations at the end
end;
procedure TPasResolver.AddVariable(El: TPasVariable);
@ -9350,7 +9350,7 @@ constructor TPasResolver.Create;
begin
inherited Create;
FDefaultScope:=TPasDefaultScope.Create;
FPendingForwards:=TFPList.Create;
FPendingForwardProcs:=TFPList.Create;
FBaseTypeChar:=btAnsiChar;
FBaseTypeString:=btAnsiString;
FBaseTypeExtended:=btDouble;
@ -10059,7 +10059,7 @@ begin
{$IFDEF VerbosePasResolverMem}
writeln('TPasResolver.Destroy FPendingForwards...');
{$ENDIF}
FreeAndNil(FPendingForwards);
FreeAndNil(FPendingForwardProcs);
FreeAndNil(fExprEvaluator);
inherited Destroy;
{$IFDEF VerbosePasResolverMem}
@ -11391,7 +11391,6 @@ begin
begin
LBT:=GetActualBaseType(LHS.BaseType);
RBT:=GetActualBaseType(RHS.BaseType);
writeln('AAA1 TPasResolver.CheckAssignResCompatibility ',lbt,' ',rbt);
if LHS.TypeEl=nil then
begin
if LBT=btUntyped then
@ -14290,9 +14289,7 @@ begin
writeln('TPasResolver.CheckClassIsClass SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
{$ENDIF}
if DestType=nil then exit(cIncompatible);
// skip Dest alias
while (DestType.ClassType=TPasAliasType) do
DestType:=TPasAliasType(DestType).DestType;
DestType:=ResolveAliasType(DestType);
Result:=cExact;
while SrcType<>nil do

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

@ -486,6 +486,7 @@ type
Procedure TestClassOf_AlwaysForward;
Procedure TestClassOf_ClassOfBeforeClass_FuncResult;
Procedure TestClassOf_Const;
Procedure TestClassOf_Const2;
// property
Procedure TestProperty1;
@ -7953,6 +7954,25 @@ begin
ParseProgram;
end;
procedure TTestResolver.TestClassOf_Const2;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' end;',
' TFieldType = (fta,ftb);',
' TField = Class;',
' TFieldClass = class of TField;',
' TField = Class(TObject);',
' TFieldA = Class(TField);',
' TFieldB = Class(TField);',
'Const',
' DefaultFieldClasses : Array [TFieldType] of TFieldClass = (TFieldA,TFieldB);',
'begin']);
ParseProgram;
end;
procedure TTestResolver.TestProperty1;
begin
StartProgram(false);