From 880f7d7c1c0aaa77e72aab8a620b9ee180c8ee1a Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Fri, 16 Aug 2019 19:57:55 +0000 Subject: [PATCH] fcl-passrc: specialize nested class type git-svn-id: trunk@42712 - --- packages/fcl-passrc/src/pasresolver.pp | 133 +++++++++++------- packages/fcl-passrc/src/pparser.pp | 27 +--- .../fcl-passrc/tests/tcresolvegenerics.pas | 10 +- packages/fcl-passrc/tests/tcresolver.pas | 23 --- 4 files changed, 94 insertions(+), 99 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 5e988f0863..5e5933d564 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -1795,6 +1795,7 @@ type procedure SpecializeRangeType(GenEl, SpecEl: TPasRangeType); procedure SpecializeArrayType(GenEl, SpecEl: TPasArrayType; SpecializedItem: TPSSpecializedItem); procedure SpecializeRecordType(GenEl, SpecEl: TPasRecordType; SpecializedItem: TPSSpecializedItem); + procedure SpecializeClassType(GenEl, SpecEl: TPasClassType; SpecializedItem: TPSSpecializedItem); procedure SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue); procedure SpecializeEnumType(GenEl, SpecEl: TPasEnumType); procedure SpecializeSetType(GenEl, SpecEl: TPasSetType); @@ -14866,21 +14867,17 @@ end; procedure TPasResolver.SpecializeGenTypeIntf(GenericType: TPasGenericType; SpecializedItem: TPSSpecializedItem); var - GenericTemplateTypes: TFPList; SpecType: TPasGenericType; NewClassType, GenClassType: TPasClassType; GenScope: TPasGenericScope; - TemplType: TPasGenericTemplateType; C: TClass; NewArrayType, GenArrayType: TPasArrayType; NewRecordType, GenRecordType: TPasRecordType; - HeaderScope: TPasClassHeaderScope; GenProcType, NewProcType: TPasProcedureType; begin if SpecializedItem.Step<>psssNone then exit; SpecializedItem.Step:=psssInterfaceBuilding; - GenericTemplateTypes:=GenericType.GenericTemplateTypes; SpecType:=SpecializedItem.SpecializedType; SpecializePasElementProperties(GenericType,SpecType); @@ -14900,53 +14897,7 @@ begin begin NewClassType:=TPasClassType(SpecType); GenClassType:=TPasClassType(GenericType); - NewClassType.ObjKind:=GenClassType.ObjKind; - NewClassType.PackMode:=GenClassType.PackMode; - if GenClassType.HelperForType<>nil then - RaiseNotYetImplemented(20190730182758,GenClassType,''); - if GenClassType.IsForward then - RaiseNotYetImplemented(20190730182858,GenClassType); - NewClassType.IsExternal:=GenClassType.IsExternal; - NewClassType.IsShortDefinition:=GenClassType.IsShortDefinition; - if GenClassType.GUIDExpr<>nil then - SpecializeElExpr(GenClassType,NewClassType,GenClassType.GUIDExpr,NewClassType.GUIDExpr); - NewClassType.Modifiers.Assign(GenClassType.Modifiers); - NewClassType.ExternalNameSpace:=GenClassType.ExternalNameSpace; - NewClassType.ExternalName:=GenClassType.ExternalName; - NewClassType.InterfaceType:=GenClassType.InterfaceType; - - // ancestor+interfaces - // ancestor can be specialized types. For example: = class(TAncestor) - // -> create a scope with the specialized parameters - HeaderScope:=TPasClassHeaderScope.Create; - SpecializedItem.HeaderScope:=HeaderScope; - TemplType:=TPasGenericTemplateType(GenericTemplateTypes[0]); - HeaderScope.Element:=TemplType; - AddSpecializedTemplateIdentifiers(GenericTemplateTypes, - SpecializedItem.Params,HeaderScope); - PushScope(HeaderScope); - SpecializeElType(GenClassType,NewClassType, - GenClassType.AncestorType,NewClassType.AncestorType); - SpecializeElList(GenClassType,NewClassType, - GenClassType.Interfaces,NewClassType.Interfaces,true - {$IFDEF CheckPasTreeRefCount},'TPasClassType.Interfaces'{$ENDIF}); - if TopScope<>HeaderScope then - RaiseNotYetImplemented(20190813003056,GenClassType); - PopScope; - SpecializedItem.HeaderScope:=nil; - HeaderScope.Free; - - FinishAncestors(NewClassType); - - // Note: class scope is created by FinishAncestors - GenScope:=NoNil(NewClassType.CustomData) as TPasClassScope; - GenScope.SpecializedItem:=SpecializedItem; - AddSpecializedTemplateIdentifiers(GenericTemplateTypes, - SpecializedItem.Params,GenScope); - // specialize sub elements - SpecializeMembers(GenClassType,NewClassType); - SpecializedItem.Step:=psssInterfaceFinished; - FinishClassType(NewClassType); + SpecializeClassType(GenClassType,NewClassType,SpecializedItem); end else if C=TPasArrayType then begin @@ -15195,7 +15146,13 @@ begin AddRecordType(TPasRecordType(SpecEl),nil); SpecializeRecordType(TPasRecordType(GenEl),TPasRecordType(SpecEl),nil); end - // ToDo: TPasClassType + else if C=TPasClassType then + begin + if GetTypeParameterCount(TPasClassType(GenEl))>0 then + RaiseNotYetImplemented(20190816214947,GenEl); + AddClassType(TPasClassType(SpecEl),nil); + SpecializeClassType(TPasClassType(GenEl),TPasClassType(SpecEl),nil); + end else if C=TPasStringType then begin AddType(TPasStringType(SpecEl)); @@ -16039,6 +15996,78 @@ begin SpecializedItem.Step:=psssInterfaceFinished; end; +procedure TPasResolver.SpecializeClassType(GenEl, SpecEl: TPasClassType; + SpecializedItem: TPSSpecializedItem); +var + HeaderScope: TPasClassHeaderScope; + TemplType: TPasGenericTemplateType; + GenericTemplateTypes: TFPList; + GenScope: TPasClassScope; +begin + GenericTemplateTypes:=GenEl.GenericTemplateTypes; + SpecEl.ObjKind:=GenEl.ObjKind; + SpecEl.PackMode:=GenEl.PackMode; + if GenEl.HelperForType<>nil then + RaiseNotYetImplemented(20190730182758,GenEl,''); + if GenEl.IsForward then + RaiseNotYetImplemented(20190730182858,GenEl); + SpecEl.IsExternal:=GenEl.IsExternal; + SpecEl.IsShortDefinition:=GenEl.IsShortDefinition; + if GenEl.GUIDExpr<>nil then + SpecializeElExpr(GenEl,SpecEl,GenEl.GUIDExpr,SpecEl.GUIDExpr); + SpecEl.Modifiers.Assign(GenEl.Modifiers); + SpecEl.ExternalNameSpace:=GenEl.ExternalNameSpace; + SpecEl.ExternalName:=GenEl.ExternalName; + SpecEl.InterfaceType:=GenEl.InterfaceType; + + // ancestor+interfaces + if SpecializedItem<>nil then + begin + // ancestor can be specialized types. For example: = class(TAncestor) + // -> create a scope with the specialized parameters + HeaderScope:=TPasClassHeaderScope.Create; + SpecializedItem.HeaderScope:=HeaderScope; + TemplType:=TPasGenericTemplateType(GenericTemplateTypes[0]); + HeaderScope.Element:=TemplType; + AddSpecializedTemplateIdentifiers(GenericTemplateTypes, + SpecializedItem.Params,HeaderScope); + PushScope(HeaderScope); + end + else + HeaderScope:=nil; + SpecializeElType(GenEl,SpecEl, + GenEl.AncestorType,SpecEl.AncestorType); + SpecializeElList(GenEl,SpecEl, + GenEl.Interfaces,SpecEl.Interfaces,true + {$IFDEF CheckPasTreeRefCount},'TPasClassType.Interfaces'{$ENDIF}); + if HeaderScope<>nil then + begin + if TopScope<>HeaderScope then + RaiseNotYetImplemented(20190813003056,GenEl); + PopScope; + SpecializedItem.HeaderScope:=nil; + HeaderScope.Free; + end; + + FinishAncestors(SpecEl); + + // Note: class scope is created by FinishAncestors + GenScope:=NoNil(SpecEl.CustomData) as TPasClassScope; + if GenScope.SpecializedItem<>nil then + RaiseNotYetImplemented(20190816215413,SpecEl); + if SpecializedItem<>nil then + begin + GenScope.SpecializedItem:=SpecializedItem; + AddSpecializedTemplateIdentifiers(GenericTemplateTypes, + SpecializedItem.Params,GenScope); + end; + // specialize sub elements + SpecializeMembers(GenEl,SpecEl); + if SpecializedItem<>nil then + SpecializedItem.Step:=psssInterfaceFinished; + FinishClassType(SpecEl); +end; + procedure TPasResolver.SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue); begin SpecializeElExpr(GenEl,SpecEl,GenEl.Value,SpecEl.Value); diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index e011191813..eb9cdd4168 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -3750,7 +3750,7 @@ function TPasParser.AddUseUnit(ASection: TPasSection; const NamePos: TPasSourcePos; AUnitName: string; NameExpr: TPasExpr; InFileExpr: TPrimitiveExpr): TPasUsesUnit; - procedure CheckDuplicateInUsesList(UsesClause: TPasUsesClause); + procedure CheckDuplicateInUsesList(AUnitName : string; UsesClause: TPasUsesClause); var i: Integer; begin @@ -3760,16 +3760,6 @@ function TPasParser.AddUseUnit(ASection: TPasSection; ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]); end; - procedure CheckDuplicateInUsesList(UnitRef: TPasElement; UsesClause: TPasUsesClause); - var - i: Integer; - begin - if UsesClause=nil then exit; - for i:=0 to length(UsesClause)-1 do - if UsesClause[i].Module=UnitRef then - ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]); - end; - var UnitRef: TPasElement; UsesUnit: TPasUsesUnit; @@ -3787,23 +3777,16 @@ begin exit; // for compatibility ignore implicit use of system in system ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]); end; + CheckDuplicateInUsesList(AUnitName,ASection.UsesClause); + if ASection.ClassType=TImplementationSection then + CheckDuplicateInUsesList(AUnitName,CurModule.InterfaceSection.UsesClause); UnitRef := Engine.FindModule(AUnitName,NameExpr,InFileExpr); if Assigned(UnitRef) then - begin - UnitRef.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF}; - CheckDuplicateInUsesList(UnitRef,ASection.UsesClause); - if ASection.ClassType=TImplementationSection then - CheckDuplicateInUsesList(UnitRef,CurModule.InterfaceSection.UsesClause); - end + UnitRef.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF} else - begin - CheckDuplicateInUsesList(ASection.UsesClause); - if ASection.ClassType=TImplementationSection then - CheckDuplicateInUsesList(CurModule.InterfaceSection.UsesClause); UnitRef := TPasUnresolvedUnitRef(CreateElement(TPasUnresolvedUnitRef, AUnitName, ASection, NamePos)); - end; UsesUnit:=TPasUsesUnit(CreateElement(TPasUsesUnit,AUnitName,ASection,NamePos)); Result:=ASection.AddUnitToUsesList(AUnitName,NameExpr,InFileExpr,UnitRef,UsesUnit); diff --git a/packages/fcl-passrc/tests/tcresolvegenerics.pas b/packages/fcl-passrc/tests/tcresolvegenerics.pas index a7bdc334e3..80aeb0d25e 100644 --- a/packages/fcl-passrc/tests/tcresolvegenerics.pas +++ b/packages/fcl-passrc/tests/tcresolvegenerics.pas @@ -660,7 +660,6 @@ end; procedure TTestResolveGenerics.TestGen_Class_NestedClass; begin - exit; StartProgram(false); Add([ '{$mode objfpc}', @@ -669,15 +668,22 @@ begin ' generic TBird = class', ' public type TWing = class', ' s: T;', + ' function GetIt: T;', ' end;', ' public', ' w: TWing;', ' end;', ' TBirdWord = specialize TBird;', + 'function TBird.TWing.GetIt: T;', + 'begin', + 'end;', 'var', ' b: TBirdWord;', + ' i: word;', 'begin', - ' b.w.s:=3;']); + ' b.w.s:=3;', + ' i:=b.w.GetIt;', + '']); ParseProgram; end; diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index d948d841f0..43c2e77a46 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -360,7 +360,6 @@ type Procedure TestUnitUseIntf; Procedure TestUnitUseImplFail; Procedure TestUnit_DuplicateUsesFail; - Procedure TestUnit_DuplicateUsesIntfImplFail; Procedure TestUnit_NestedFail; Procedure TestUnitUseDotted; Procedure TestUnit_ProgramDefaultNamespace; @@ -5675,28 +5674,6 @@ begin nParserDuplicateIdentifier); end; -procedure TTestResolver.TestUnit_DuplicateUsesIntfImplFail; -begin - AddModuleWithIntfImplSrc('unit2.pp', - LinesToStr([ - 'type number = longint;']), - LinesToStr([ - ''])); - - StartUnit(true); - Add([ - 'interface', - 'uses unit2;', - 'var j: number;', - 'implementation', - 'uses unit2;', - 'initialization', - ' if number(3) then ;', - '']); - CheckParserException('Duplicate identifier "unit2" at token ";" in file afile.pp at line 6 column 11', - nParserDuplicateIdentifier); -end; - procedure TTestResolver.TestUnit_NestedFail; begin AddModuleWithIntfImplSrc('unit2.pp',