mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 23:19:24 +02:00
pas2js: rename overloads in specialized members
git-svn-id: trunk@45563 -
This commit is contained in:
Mattias Gaertner
parent
a03ed979fd
commit
f94221d788
@ -1131,6 +1131,7 @@ type
|
||||
TPas2JSSectionScope = class(TPasSectionScope)
|
||||
public
|
||||
ElevatedLocals: TPas2jsElevatedLocals;
|
||||
Renamed: boolean;
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
procedure WriteElevatedLocals(Prefix: string); virtual;
|
||||
@ -1151,22 +1152,31 @@ type
|
||||
public
|
||||
NewInstanceFunction: TPasClassFunction;
|
||||
GUID: string;
|
||||
ElevatedLocals: TPas2jsElevatedLocals;
|
||||
MemberOverloadsRenamed: boolean;
|
||||
// Dispatch and message modifiers:
|
||||
DispatchField: String;
|
||||
DispatchStrField: String;
|
||||
MsgIntToProc, MsgStrToProc: TMessageIdToProc_List; // not stored by filer
|
||||
ElevatedLocals: TPas2jsElevatedLocals;
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TPas2JSRecordScope }
|
||||
|
||||
TPas2JSRecordScope = class(TPasRecordScope)
|
||||
public
|
||||
MemberOverloadsRenamed: boolean;
|
||||
end;
|
||||
|
||||
{ TPas2JSProcedureScope }
|
||||
|
||||
TPas2JSProcedureScope = class(TPasProcedureScope)
|
||||
public
|
||||
OverloadName: string;
|
||||
ResultVarName: string; // valid in implementation ProcScope, empty means use ResolverResultVar
|
||||
BodyOverloadsRenamed: boolean;
|
||||
BodyJS: string; // Option coStoreProcJS: stored in ImplScope
|
||||
GlobalJS: TStringList; // Option coStoreProcJS: stored in ImplScope
|
||||
EmptyJS: boolean; // Option coStoreProcJS: stored in ImplScope, true if Body.Body=nil
|
||||
@ -1371,9 +1381,12 @@ type
|
||||
procedure RenameOverloadsInSection(aSection: TPasSection);
|
||||
procedure RenameOverloads(DeclEl: TPasElement; Declarations: TFPList);
|
||||
procedure RenameSubOverloads(Declarations: TFPList);
|
||||
procedure RenameMembers(El: TPasMembersType);
|
||||
procedure PushOverloadScopeSkip;
|
||||
procedure PushOverloadScope(Scope: TPasIdentifierScope);
|
||||
function PushOverloadClassOrRecScopes(Scope: TPasClassOrRecordScope; WithParents: boolean): integer;
|
||||
procedure PopOverloadScope;
|
||||
procedure RestoreOverloadScopeLvl(OldScopeCount: integer);
|
||||
procedure ClearOverloadScopes;
|
||||
protected
|
||||
procedure AddType(El: TPasType); override;
|
||||
@ -1417,6 +1430,10 @@ type
|
||||
procedure AddElevatedLocal(El: TPasElement); virtual;
|
||||
procedure ClearElementData; virtual;
|
||||
function GenerateGUID(El: TPasClassType): string; virtual;
|
||||
protected
|
||||
// generic/specialize
|
||||
procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem);
|
||||
override;
|
||||
protected
|
||||
const
|
||||
cJSValueConversion = 2*cTypeConversion;
|
||||
@ -3027,7 +3044,7 @@ var
|
||||
ElevatedLocals: TPas2jsElevatedLocals;
|
||||
begin
|
||||
Result:=0;
|
||||
//if SameText(El.Name,'ci') then writeln('TPas2JSResolver.GetOverloadIndex ',GetObjPath(El),' ',HasOverloadIndex(El,true));
|
||||
//if SameText(El.Name,'ci') then writeln('TPas2JSResolver.GetOverloadIndex ',GetObjPath(El),' HasOverloadIndex=',HasOverloadIndex(El,true));
|
||||
if not HasOverloadIndex(El,true) then exit;
|
||||
|
||||
ThisChanged:=false;
|
||||
@ -3048,7 +3065,7 @@ begin
|
||||
|
||||
// check elevated locals
|
||||
ElevatedLocals:=GetElevatedLocals(Scope);
|
||||
// if SameText(El.Name,'ci') then writeln('TPas2JSResolver.GetOverloadIndex ',GetObjPath(El),' ',Scope.Element.ClassName,' ',ElevatedLocals<>nil);
|
||||
//if SameText(El.Name,'ci') then writeln('TPas2JSResolver.GetOverloadIndex ',GetObjPath(El),' Scope.Element=',GetObjName(Scope.Element),' ',ElevatedLocals<>nil);
|
||||
if ElevatedLocals<>nil then
|
||||
begin
|
||||
Identifier:=ElevatedLocals.Find(El.Name);
|
||||
@ -3074,7 +3091,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
if ThisChanged then exit;
|
||||
// finally add count or index of the external scope
|
||||
// element in global scope
|
||||
// -> add count or index of the external scope
|
||||
Identifier:=FindExternalName(El.Name);
|
||||
inc(Result,GetOverloadIndex(Identifier,El));
|
||||
end;
|
||||
@ -3199,9 +3217,16 @@ end;
|
||||
procedure TPas2JSResolver.RenameOverloadsInSection(aSection: TPasSection);
|
||||
var
|
||||
IntfSection: TInterfaceSection;
|
||||
OldScopeCount: Integer;
|
||||
Scope: TPas2JSSectionScope;
|
||||
begin
|
||||
if aSection=nil then exit;
|
||||
Scope:=aSection.CustomData as TPas2JSSectionScope;
|
||||
if Scope.Renamed then
|
||||
RaiseNotYetImplemented(20200601231236,aSection);
|
||||
|
||||
IntfSection:=nil;
|
||||
OldScopeCount:=FOverloadScopes.Count;
|
||||
if aSection.ClassType=TImplementationSection then
|
||||
begin
|
||||
IntfSection:=RootElement.InterfaceSection;
|
||||
@ -3210,9 +3235,8 @@ begin
|
||||
PushOverloadScope(aSection.CustomData as TPasIdentifierScope);
|
||||
RenameOverloads(aSection,aSection.Declarations);
|
||||
RenameSubOverloads(aSection.Declarations);
|
||||
PopOverloadScope;
|
||||
if IntfSection<>nil then
|
||||
PopOverloadScope;
|
||||
RestoreOverloadScopeLvl(OldScopeCount);
|
||||
Scope.Renamed:=true;
|
||||
{$IFDEF VerbosePas2JS}
|
||||
//writeln('TPas2JSResolver.RenameOverloadsInSection END ',GetObjName(aSection));
|
||||
{$ENDIF}
|
||||
@ -3286,51 +3310,14 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.RenameSubOverloads(Declarations: TFPList);
|
||||
|
||||
procedure RestoreScopeLvl(OldScopeCount: integer);
|
||||
begin
|
||||
while FOverloadScopes.Count>OldScopeCount do
|
||||
PopOverloadScope;
|
||||
end;
|
||||
|
||||
procedure LocalPushClassOrRecScopes(Scope: TPasClassOrRecordScope);
|
||||
var
|
||||
CurScope: TPasClassOrRecordScope;
|
||||
aParent: TPasElement;
|
||||
begin
|
||||
CurScope:=Scope;
|
||||
repeat
|
||||
PushOverloadScope(CurScope);
|
||||
if Scope is TPas2JSClassScope then
|
||||
CurScope:=TPas2JSClassScope(CurScope).AncestorScope
|
||||
else
|
||||
break;
|
||||
until CurScope=nil;
|
||||
aParent:=Scope.Element.Parent;
|
||||
if not (aParent is TPasMembersType) then
|
||||
exit;
|
||||
// nested class -> push parent class scope...
|
||||
CurScope:=aParent.CustomData as TPasClassOrRecordScope;
|
||||
LocalPushClassOrRecScopes(CurScope);
|
||||
end;
|
||||
|
||||
var
|
||||
i, OldScopeCount: Integer;
|
||||
El: TPasElement;
|
||||
Proc, ImplProc: TPasProcedure;
|
||||
ProcScope, ImplProcScope: TPas2JSProcedureScope;
|
||||
ClassScope, aScope: TPasClassScope;
|
||||
ClassEl: TPasClassType;
|
||||
C: TClass;
|
||||
ProcBody: TProcedureBody;
|
||||
IntfSection: TInterfaceSection;
|
||||
ImplSection: TImplementationSection;
|
||||
begin
|
||||
IntfSection:=RootElement.InterfaceSection;
|
||||
if IntfSection<>nil then
|
||||
ImplSection:=RootElement.ImplementationSection
|
||||
else
|
||||
ImplSection:=nil;
|
||||
for i:=0 to Declarations.Count-1 do
|
||||
begin
|
||||
El:=TPasElement(Declarations[i]);
|
||||
@ -3340,18 +3327,6 @@ begin
|
||||
Proc:=TPasProcedure(El);
|
||||
ProcScope:=Proc.CustomData as TPas2JSProcedureScope;
|
||||
|
||||
// handle each Proc only once, by handling only the DeclProc,
|
||||
// except for DeclProc in the unit interface
|
||||
if ProcScope.DeclarationProc<>nil then
|
||||
begin
|
||||
// ImplProc with separate declaration
|
||||
if (Proc.Parent=ImplSection)
|
||||
and ProcScope.DeclarationProc.HasParent(IntfSection) then
|
||||
// ImplProc in unit implementation, DeclProc in unit interface
|
||||
// Note: The Unit Impl elements are renamed in a separate run, aka now
|
||||
else
|
||||
continue; // handled via DeclProc
|
||||
end;
|
||||
ImplProc:=ProcScope.ImplProc;
|
||||
if ImplProc<>nil then
|
||||
ImplProcScope:=TPas2JSProcedureScope(ImplProc.CustomData)
|
||||
@ -3364,62 +3339,71 @@ begin
|
||||
//writeln('TPas2JSResolver.RenameSubOverloads ImplProc=',ImplProc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ClassScope=',GetObjName(ImplProcScope.ClassOrRecordScope));
|
||||
{$ENDIF}
|
||||
ProcBody:=ImplProc.Body;
|
||||
if ProcBody<>nil then
|
||||
if (ProcBody<>nil) and (not ImplProcScope.BodyOverloadsRenamed) then
|
||||
begin
|
||||
ImplProcScope.BodyOverloadsRenamed:=true;
|
||||
OldScopeCount:=FOverloadScopes.Count;
|
||||
if (ImplProcScope.ClassRecScope<>nil)
|
||||
and not (Proc.Parent is TPasMembersType) then
|
||||
begin
|
||||
// push class scopes
|
||||
LocalPushClassOrRecScopes(ImplProcScope.ClassRecScope);
|
||||
PushOverloadClassOrRecScopes(ImplProcScope.ClassRecScope,true);
|
||||
end;
|
||||
|
||||
PushOverloadScope(ImplProcScope);
|
||||
// first rename all overloads on this level
|
||||
RenameOverloads(ProcBody,ProcBody.Declarations);
|
||||
// then process nested procedures
|
||||
RenameSubOverloads(ProcBody.Declarations);
|
||||
PopOverloadScope;
|
||||
RestoreScopeLvl(OldScopeCount);
|
||||
RestoreOverloadScopeLvl(OldScopeCount);
|
||||
end;
|
||||
end
|
||||
else if (C=TPasClassType) or (C=TPasRecordType) then
|
||||
begin
|
||||
OldScopeCount:=FOverloadScopes.Count;
|
||||
if C=TPasClassType then
|
||||
begin
|
||||
ClassEl:=TPasClassType(El);
|
||||
if ClassEl.IsForward then continue;
|
||||
ClassScope:=El.CustomData as TPas2JSClassScope;
|
||||
// add class and ancestor scopes
|
||||
PushOverloadScopeSkip;
|
||||
aScope:=ClassScope;
|
||||
repeat
|
||||
PushOverloadScope(aScope);
|
||||
aScope:=aScope.AncestorScope;
|
||||
until aScope=nil;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// add record scope
|
||||
PushOverloadScopeSkip;
|
||||
PushOverloadScope(TPasRecordType(El).CustomData as TPasRecordScope);
|
||||
end;
|
||||
|
||||
// first rename all overloads on this level
|
||||
RenameOverloads(El,TPasMembersType(El).Members);
|
||||
// then process nested procedures
|
||||
RenameSubOverloads(TPasMembersType(El).Members);
|
||||
|
||||
// restore scope
|
||||
RestoreScopeLvl(OldScopeCount);
|
||||
end;
|
||||
RenameMembers(TPasMembersType(El));
|
||||
end;
|
||||
{$IFDEF VerbosePas2JS}
|
||||
//writeln('TPas2JSResolver.RenameSubOverloads END');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.RenameMembers(El: TPasMembersType);
|
||||
var
|
||||
OldScopeCount: Integer;
|
||||
ClassEl: TPasClassType;
|
||||
ClassOrRecScope: TPasClassOrRecordScope;
|
||||
RecScope: TPas2JSRecordScope;
|
||||
ClassScope: TPas2JSClassScope;
|
||||
begin
|
||||
OldScopeCount:=FOverloadScopes.Count;
|
||||
if El.ClassType=TPasClassType then
|
||||
begin
|
||||
ClassEl:=TPasClassType(El);
|
||||
if ClassEl.IsForward then exit;
|
||||
// add class and ancestor scopes
|
||||
ClassScope:=El.CustomData as TPas2JSClassScope;
|
||||
if ClassScope.MemberOverloadsRenamed then exit;
|
||||
ClassScope.MemberOverloadsRenamed:=true;
|
||||
ClassOrRecScope:=ClassScope;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// add record scope
|
||||
RecScope:=El.CustomData as TPas2JSRecordScope;
|
||||
if RecScope.MemberOverloadsRenamed then exit;
|
||||
RecScope.MemberOverloadsRenamed:=true;
|
||||
ClassOrRecScope:=RecScope;
|
||||
end;
|
||||
PushOverloadClassOrRecScopes(ClassOrRecScope,false);
|
||||
|
||||
// first rename all overloads on this level
|
||||
RenameOverloads(El,El.Members);
|
||||
// then process nested procedures
|
||||
RenameSubOverloads(El.Members);
|
||||
|
||||
// restore scope
|
||||
RestoreOverloadScopeLvl(OldScopeCount);
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.PushOverloadScopeSkip;
|
||||
begin
|
||||
FOverloadScopes.Add(TPas2JSOverloadChgThisScope.Create);
|
||||
@ -3427,9 +3411,40 @@ end;
|
||||
|
||||
procedure TPas2JSResolver.PushOverloadScope(Scope: TPasIdentifierScope);
|
||||
begin
|
||||
if (FOverloadScopes.Count>0) and (TObject(FOverloadScopes[FOverloadScopes.Count-1])=Scope) then
|
||||
RaiseNotYetImplemented(20200602000045,Scope.Element);
|
||||
FOverloadScopes.Add(Scope);
|
||||
end;
|
||||
|
||||
function TPas2JSResolver.PushOverloadClassOrRecScopes(
|
||||
Scope: TPasClassOrRecordScope; WithParents: boolean): integer;
|
||||
var
|
||||
CurScope: TPasClassOrRecordScope;
|
||||
aParent: TPasElement;
|
||||
begin
|
||||
Result:=FOverloadScopes.Count;
|
||||
repeat
|
||||
PushOverloadScopeSkip;
|
||||
// push class and ancestors
|
||||
CurScope:=Scope;
|
||||
repeat
|
||||
PushOverloadScope(CurScope);
|
||||
if CurScope is TPas2JSClassScope then
|
||||
CurScope:=TPas2JSClassScope(CurScope).AncestorScope
|
||||
else
|
||||
break;
|
||||
until CurScope=nil;
|
||||
|
||||
if not WithParents then
|
||||
exit;
|
||||
aParent:=Scope.Element.Parent;
|
||||
if not (aParent is TPasMembersType) then
|
||||
exit;
|
||||
// nested class -> push parent class scope...
|
||||
Scope:=aParent.CustomData as TPasClassOrRecordScope;
|
||||
until false;
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.PopOverloadScope;
|
||||
var
|
||||
i: Integer;
|
||||
@ -3442,6 +3457,12 @@ begin
|
||||
FOverloadScopes.Delete(i);
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.RestoreOverloadScopeLvl(OldScopeCount: integer);
|
||||
begin
|
||||
while FOverloadScopes.Count>OldScopeCount do
|
||||
PopOverloadScope;
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.ClearOverloadScopes;
|
||||
begin
|
||||
if FOverloadScopes=nil then exit;
|
||||
@ -4765,6 +4786,24 @@ begin
|
||||
Result:=Result+'}';
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.SpecializeGenericImpl(
|
||||
SpecializedItem: TPRSpecializedItem);
|
||||
begin
|
||||
inherited SpecializeGenericImpl(SpecializedItem);
|
||||
if SpecializedItem.SpecializedEl is TPasMembersType then
|
||||
begin
|
||||
if FOverloadScopes=nil then
|
||||
begin
|
||||
FOverloadScopes:=TFPList.Create;
|
||||
try
|
||||
RenameMembers(TPasMembersType(SpecializedItem.SpecializedEl));
|
||||
finally
|
||||
ClearOverloadScopes;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPas2JSResolver.AddJSBaseType(const aName: string; Typ: TPas2jsBaseType
|
||||
): TResElDataPas2JSBaseType;
|
||||
var
|
||||
@ -5554,6 +5593,7 @@ begin
|
||||
ScopeClass_InitialFinalization:=TPas2JSInitialFinalizationScope;
|
||||
ScopeClass_Module:=TPas2JSModuleScope;
|
||||
ScopeClass_Procedure:=TPas2JSProcedureScope;
|
||||
ScopeClass_Record:=TPas2JSRecordScope;
|
||||
ScopeClass_Section:=TPas2JSSectionScope;
|
||||
ScopeClass_WithExpr:=TPas2JSWithExprScope;
|
||||
for bt in [pbtJSValue] do
|
||||
|
||||
@ -844,7 +844,7 @@ type
|
||||
procedure WriteEnumType(Obj: TJSONObject; El: TPasEnumType; aContext: TPCUWriterContext); virtual;
|
||||
procedure WriteSetType(Obj: TJSONObject; El: TPasSetType; aContext: TPCUWriterContext); virtual;
|
||||
procedure WriteRecordVariant(Obj: TJSONObject; El: TPasVariant; aContext: TPCUWriterContext); virtual;
|
||||
procedure WriteRecordTypeScope(Obj: TJSONObject; Scope: TPasRecordScope; aContext: TPCUWriterContext); virtual;
|
||||
procedure WriteRecordTypeScope(Obj: TJSONObject; Scope: TPas2jsRecordScope; aContext: TPCUWriterContext); virtual;
|
||||
procedure WriteRecordType(Obj: TJSONObject; El: TPasRecordType; aContext: TPCUWriterContext); virtual;
|
||||
procedure WriteClassScopeFlags(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TPasClassScopeFlags); virtual;
|
||||
procedure WriteClassIntfMapProcs(Obj: TJSONObject; Map: TPasClassIntfMap); virtual;
|
||||
@ -1137,7 +1137,7 @@ type
|
||||
procedure ReadSetType(Obj: TJSONObject; El: TPasSetType; aContext: TPCUReaderContext); virtual;
|
||||
function ReadPackedMode(Obj: TJSONObject; const PropName: string; ErrorEl: TPasElement): TPackMode; virtual;
|
||||
procedure ReadRecordVariant(Obj: TJSONObject; El: TPasVariant; aContext: TPCUReaderContext); virtual;
|
||||
procedure ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope; aContext: TPCUReaderContext); virtual;
|
||||
procedure ReadRecordScope(Obj: TJSONObject; Scope: TPas2jsRecordScope; aContext: TPCUReaderContext); virtual;
|
||||
procedure ReadRecordType(Obj: TJSONObject; El: TPasRecordType; aContext: TPCUReaderContext); virtual;
|
||||
function ReadClassInterfaceType(Obj: TJSONObject; const PropName: string; ErrorEl: TPasElement; DefaultValue: TPasClassInterfaceType): TPasClassInterfaceType;
|
||||
function ReadClassScopeFlags(Obj: TJSONObject; El: TPasElement;
|
||||
@ -4038,7 +4038,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPCUWriter.WriteRecordTypeScope(Obj: TJSONObject;
|
||||
Scope: TPasRecordScope; aContext: TPCUWriterContext);
|
||||
Scope: TPas2jsRecordScope; aContext: TPCUWriterContext);
|
||||
begin
|
||||
AddReferenceToObj(Obj,'DefaultProperty',Scope.DefaultProperty);
|
||||
WriteIdentifierScope(Obj,Scope,aContext);
|
||||
@ -4059,7 +4059,7 @@ begin
|
||||
WriteElementProperty(Obj,El,'VariantEl',El.VariantEl,aContext);
|
||||
WriteElementList(Obj,El,'Variants',El.Variants,aContext);
|
||||
|
||||
WriteRecordTypeScope(Obj,El.CustomData as TPasRecordScope,aContext);
|
||||
WriteRecordTypeScope(Obj,El.CustomData as TPas2jsRecordScope,aContext);
|
||||
end;
|
||||
|
||||
procedure TPCUWriter.WriteClassScopeFlags(Obj: TJSONObject;
|
||||
@ -5076,7 +5076,7 @@ end;
|
||||
procedure TPCUReader.Set_RecordScope_DefaultProperty(RefEl: TPasElement;
|
||||
Data: TObject);
|
||||
var
|
||||
Scope: TPasRecordScope absolute Data;
|
||||
Scope: TPas2jsRecordScope absolute Data;
|
||||
begin
|
||||
if RefEl is TPasProperty then
|
||||
Scope.DefaultProperty:=TPasProperty(RefEl) // no AddRef
|
||||
@ -8168,7 +8168,7 @@ begin
|
||||
ReadElType(Obj,'Members',El,@Set_Variant_Members,aContext);
|
||||
end;
|
||||
|
||||
procedure TPCUReader.ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope;
|
||||
procedure TPCUReader.ReadRecordScope(Obj: TJSONObject; Scope: TPas2jsRecordScope;
|
||||
aContext: TPCUReaderContext);
|
||||
begin
|
||||
ReadElementReference(Obj,Scope,'DefaultProperty',@Set_RecordScope_DefaultProperty);
|
||||
@ -8180,13 +8180,13 @@ procedure TPCUReader.ReadRecordType(Obj: TJSONObject; El: TPasRecordType;
|
||||
var
|
||||
Data: TJSONData;
|
||||
Id: Integer;
|
||||
Scope: TPasRecordScope;
|
||||
Scope: TPas2jsRecordScope;
|
||||
SubObj: TJSONObject;
|
||||
begin
|
||||
if FileVersion<3 then
|
||||
RaiseMsg(20190109214718,El,'record format changed');
|
||||
|
||||
Scope:=TPasRecordScope(Resolver.CreateScope(El,TPasRecordScope));
|
||||
Scope:=TPas2jsRecordScope(Resolver.CreateScope(El,TPas2jsRecordScope));
|
||||
El.CustomData:=Scope;
|
||||
|
||||
ReadPasElement(Obj,El,aContext);
|
||||
|
||||
@ -75,7 +75,7 @@ type
|
||||
procedure CheckRestoredSectionScope(const Path: string; Orig, Rest: TPas2JSSectionScope; Flags: TPCCheckFlags); virtual;
|
||||
procedure CheckRestoredInitialFinalizationScope(const Path: string; Orig, Rest: TPas2JSInitialFinalizationScope; Flags: TPCCheckFlags); virtual;
|
||||
procedure CheckRestoredEnumTypeScope(const Path: string; Orig, Rest: TPasEnumTypeScope; Flags: TPCCheckFlags); virtual;
|
||||
procedure CheckRestoredRecordScope(const Path: string; Orig, Rest: TPasRecordScope; Flags: TPCCheckFlags); virtual;
|
||||
procedure CheckRestoredRecordScope(const Path: string; Orig, Rest: TPas2jsRecordScope; Flags: TPCCheckFlags); virtual;
|
||||
procedure CheckRestoredClassScope(const Path: string; Orig, Rest: TPas2JSClassScope; Flags: TPCCheckFlags); virtual;
|
||||
procedure CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope; Flags: TPCCheckFlags); virtual;
|
||||
procedure CheckRestoredScopeRefs(const Path: string; Orig, Rest: TPasScopeReferences; Flags: TPCCheckFlags); virtual;
|
||||
@ -805,7 +805,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TCustomTestPrecompile.CheckRestoredRecordScope(const Path: string;
|
||||
Orig, Rest: TPasRecordScope; Flags: TPCCheckFlags);
|
||||
Orig, Rest: TPas2jsRecordScope; Flags: TPCCheckFlags);
|
||||
begin
|
||||
CheckRestoredReference(Path+'.DefaultProperty',Orig.DefaultProperty,Rest.DefaultProperty);
|
||||
CheckRestoredIdentifierScope(Path,Orig,Rest,Flags);
|
||||
@ -1107,8 +1107,8 @@ begin
|
||||
CheckRestoredInitialFinalizationScope(Path+'[TPas2JSInitialFinalizationScope]',TPas2JSInitialFinalizationScope(Orig),TPas2JSInitialFinalizationScope(Rest),Flags)
|
||||
else if C=TPasEnumTypeScope then
|
||||
CheckRestoredEnumTypeScope(Path+'[TPasEnumTypeScope]',TPasEnumTypeScope(Orig),TPasEnumTypeScope(Rest),Flags)
|
||||
else if C=TPasRecordScope then
|
||||
CheckRestoredRecordScope(Path+'[TPasRecordScope]',TPasRecordScope(Orig),TPasRecordScope(Rest),Flags)
|
||||
else if C=TPas2jsRecordScope then
|
||||
CheckRestoredRecordScope(Path+'[TPas2jsRecordScope]',TPas2jsRecordScope(Orig),TPas2jsRecordScope(Rest),Flags)
|
||||
else if C=TPas2JSClassScope then
|
||||
CheckRestoredClassScope(Path+'[TPas2JSClassScope]',TPas2JSClassScope(Orig),TPas2JSClassScope(Rest),Flags)
|
||||
else if C=TPas2JSProcedureScope then
|
||||
|
||||
@ -33,10 +33,10 @@ type
|
||||
//Procedure TestGen_Class_ClassProc_Delphi;
|
||||
//Procedure TestGen_Class_ReferGenClass_DelphiFail;
|
||||
Procedure TestGen_Class_ClassConstructor;
|
||||
// ToDo: rename local const T
|
||||
Procedure TestGen_Class_TypeCastSpecializesWarn;
|
||||
Procedure TestGen_Class_TypeCastSpecializesJSValueNoWarn;
|
||||
procedure TestGen_Class_VarArgsOfType;
|
||||
procedure TestGen_Class_OverloadsInUnit;
|
||||
|
||||
// generic external class
|
||||
procedure TestGen_ExtClass_Array;
|
||||
@ -772,6 +772,84 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_Class_OverloadsInUnit;
|
||||
begin
|
||||
StartProgram(true,[supTObject]);
|
||||
AddModuleWithIntfImplSrc('UnitA.pas',
|
||||
LinesToStr([
|
||||
'type',
|
||||
' generic TBird<T> = class',
|
||||
' const c = 13;',
|
||||
' constructor Create(w: T);',
|
||||
' constructor Create(b: boolean);',
|
||||
' end;',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'constructor TBird.Create(w: T);',
|
||||
'const c = 14;',
|
||||
'begin',
|
||||
'end;',
|
||||
'constructor TBird.Create(b: boolean);',
|
||||
'const c = 15;',
|
||||
'begin',
|
||||
'end;',
|
||||
'']));
|
||||
Add([
|
||||
'uses UnitA;',
|
||||
'type',
|
||||
' TWordBird = specialize TBird<word>;',
|
||||
' TDoubleBird = specialize TBird<double>;',
|
||||
'var',
|
||||
' wb: TWordBird;',
|
||||
' db: TDoubleBird;',
|
||||
'begin',
|
||||
' wb:=TWordBird.Create(3);',
|
||||
' wb:=TWordBird.Create(true);',
|
||||
' db:=TDoubleBird.Create(1.3);',
|
||||
' db:=TDoubleBird.Create(true);',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckUnit('UnitA.pas',
|
||||
LinesToStr([ // statements
|
||||
'rtl.module("UnitA", ["system"], function () {',
|
||||
' var $mod = this;',
|
||||
' rtl.createClass($mod, "TBird$G1", pas.system.TObject, function () {',
|
||||
' this.c = 13;',
|
||||
' var c$1 = 14;',
|
||||
' this.Create$1 = function (w) {',
|
||||
' return this;',
|
||||
' };',
|
||||
' var c$2 = 15;',
|
||||
' this.Create$2 = function (b) {',
|
||||
' return this;',
|
||||
' };',
|
||||
' });',
|
||||
' rtl.createClass($mod, "TBird$G2", pas.system.TObject, function () {',
|
||||
' this.c = 13;',
|
||||
' var c$1 = 14;',
|
||||
' this.Create$1 = function (w) {',
|
||||
' return this;',
|
||||
' };',
|
||||
' var c$2 = 15;',
|
||||
' this.Create$2 = function (b) {',
|
||||
' return this;',
|
||||
' };',
|
||||
' });',
|
||||
'});',
|
||||
'']));
|
||||
CheckSource('TestGen_Class_OverloadsInUnit',
|
||||
LinesToStr([ // statements
|
||||
'this.wb = null;',
|
||||
'this.db = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.wb = pas.UnitA.TBird$G1.$create("Create$1", [3]);',
|
||||
'$mod.wb = pas.UnitA.TBird$G1.$create("Create$2", [true]);',
|
||||
'$mod.db = pas.UnitA.TBird$G2.$create("Create$1", [1.3]);',
|
||||
'$mod.db = pas.UnitA.TBird$G2.$create("Create$2", [true]);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_ExtClass_Array;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user