mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 13:09:32 +02:00
pastojs: delay RTTI init of record/class/proctype specializations
git-svn-id: trunk@46748 -
This commit is contained in:
Mattias Gaertner
parent
bbdf1b5d27
commit
4db51d69e4
@ -49,12 +49,12 @@ type
|
||||
procedure TestGen_RecordLocalNameDuplicateFail;
|
||||
procedure TestGen_Record;
|
||||
procedure TestGen_RecordDelphi;
|
||||
procedure TestGen_RecordNestedSpecialized;
|
||||
procedure TestGen_RecordNestedSpecialize_ClassRecord;
|
||||
procedure TestGen_RecordNestedSpecialize_Self;
|
||||
procedure TestGen_Record_SpecializeSelfInsideFail;
|
||||
procedure TestGen_Record_ReferGenericSelfFail;
|
||||
procedure TestGen_RecordAnoArray;
|
||||
// ToDo: unitname.specialize TBird<word>.specialize TAnt<word>
|
||||
procedure TestGen_RecordNestedSpecialize;
|
||||
|
||||
// generic class
|
||||
procedure TestGen_Class;
|
||||
@ -78,6 +78,7 @@ type
|
||||
procedure TestGen_Class_MethodImplConstraintFail;
|
||||
procedure TestGen_Class_MethodImplTypeParamNameMismatch;
|
||||
procedure TestGen_Class_SpecializeSelfInside;
|
||||
procedure TestGen_Class_AncestorTFail;
|
||||
procedure TestGen_Class_GenAncestor;
|
||||
procedure TestGen_Class_AncestorSelfFail;
|
||||
procedure TestGen_ClassOfSpecializeFail;
|
||||
@ -729,7 +730,7 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_RecordNestedSpecialized;
|
||||
procedure TTestResolveGenerics.TestGen_RecordNestedSpecialize_ClassRecord;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
@ -744,6 +745,21 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_RecordNestedSpecialize_Self;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode objfpc}',
|
||||
'type',
|
||||
' generic TBird<T> = record v: T; end;',
|
||||
'var',
|
||||
' a: specialize TBird<specialize TBird<word>>;',
|
||||
'begin',
|
||||
' a.v.v:=3;',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_Record_SpecializeSelfInsideFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -790,21 +806,6 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_RecordNestedSpecialize;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode objfpc}',
|
||||
'type',
|
||||
' generic TBird<T> = record v: T; end;',
|
||||
'var',
|
||||
' a: specialize TBird<specialize TBird<word>>;',
|
||||
'begin',
|
||||
' a.v.v:=3;',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_Class;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -1261,6 +1262,22 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_Class_AncestorTFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode objfpc}',
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TBird = class end;',
|
||||
' generic TFish<T: TBird> = class(T)',
|
||||
' v: T;',
|
||||
' end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('class type expected, but T found',nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_Class_GenAncestor;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
@ -571,6 +571,7 @@ type
|
||||
pbifnClassAncestorFunc,
|
||||
pbifnClassInstanceFree,
|
||||
pbifnClassInstanceNew,
|
||||
pbifnClassInitSpecialize,
|
||||
pbifnCreateClass,
|
||||
pbifnCreateClassExt,
|
||||
pbifnCreateHelper,
|
||||
@ -695,6 +696,7 @@ type
|
||||
pbivnRTTIMethodKind, // tTypeInfoMethodVar has methodkind
|
||||
pbivnRTTIPointer_RefType, // reftype
|
||||
pbivnRTTIProcFlags, // flags
|
||||
pbivnRTTIProc_InitSpec, // init
|
||||
pbivnRTTIProcVar_ProcSig, // procsig
|
||||
pbivnRTTIPropDefault, // Default
|
||||
pbivnRTTIPropIndex, // index
|
||||
@ -751,6 +753,7 @@ const
|
||||
'$ancestorfunc', // pbifnClassAncestorFunc
|
||||
'$destroy', // pbifnClassInstanceFree
|
||||
'$create', // pbifnClassInstanceNew
|
||||
'$initSpec', // pbifnClassInitSpecialize
|
||||
'createClass', // pbifnCreateClass rtl.createClass
|
||||
'createClassExt', // pbifnCreateClassExt rtl.createClassExt
|
||||
'createHelper', // pbifnCreateHelper rtl.createHelper
|
||||
@ -874,6 +877,7 @@ const
|
||||
'methodkind', // pbivnRTTIMethodKind
|
||||
'reftype', // pbivnRTTIPointer_RefType
|
||||
'flags', // pbivnRTTIProcFlags
|
||||
'init', // pbivnRTTIProc_InitSpec
|
||||
'procsig', // pbivnRTTIProcVar_ProcSig
|
||||
'Default', // pbivnRTTIPropDefault
|
||||
'index', // pbivnRTTIPropIndex
|
||||
@ -1493,7 +1497,7 @@ type
|
||||
// generic/specialize
|
||||
procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem);
|
||||
override;
|
||||
function SpecializeNeedsDelay(SpecializedItem: TPRSpecializedItem): TPasElement;
|
||||
function SpecializeNeedsDelay(SpecializedItem: TPRSpecializedItem): TPasElement; virtual;
|
||||
protected
|
||||
const
|
||||
cJSValueConversion = 2*cTypeConversion;
|
||||
@ -1960,6 +1964,8 @@ type
|
||||
Function CreateImplementationSection(El: TPasModule; AContext: TConvertContext): TJSFunctionDeclarationStatement; virtual;
|
||||
Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
|
||||
Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
|
||||
Procedure AddDelayedInits(El: TPasProgram; Src: TJSSourceElements; AContext: TConvertContext); virtual;
|
||||
Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual;
|
||||
// set
|
||||
Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual;
|
||||
// record
|
||||
@ -1977,6 +1983,8 @@ type
|
||||
Fields: TFPList): TJSElement; virtual;
|
||||
Procedure CreateRecordRTTI(El: TPasRecordType; Src: TJSSourceElements;
|
||||
FuncContext: TFunctionContext); virtual;
|
||||
Function CreateDelayedInitFunction(PosEl: TPasElement; Src: TJSSourceElements;
|
||||
FuncContext: TFunctionContext; out DelaySrc: TJSSourceElements): TFunctionContext; virtual;
|
||||
// array
|
||||
Function CreateArrayConcat(ElTypeResolved: TPasResolverResult; PosEl: TPasElement;
|
||||
AContext: TConvertContext): TJSCallExpression; overload; virtual;
|
||||
@ -4949,15 +4957,23 @@ end;
|
||||
|
||||
procedure TPas2JSResolver.SpecializeGenericImpl(
|
||||
SpecializedItem: TPRSpecializedItem);
|
||||
var
|
||||
El: TPasElement;
|
||||
begin
|
||||
inherited SpecializeGenericImpl(SpecializedItem);
|
||||
if SpecializedItem.SpecializedEl is TPasMembersType then
|
||||
|
||||
El:=SpecializedItem.SpecializedEl;
|
||||
if (El is TPasGenericType)
|
||||
and (SpecializeNeedsDelay(SpecializedItem)<>nil) then
|
||||
TPas2JSResolverHub(Hub).AddJSDelaySpecialize(TPasGenericType(El));
|
||||
|
||||
if El is TPasMembersType then
|
||||
begin
|
||||
if FOverloadScopes=nil then
|
||||
begin
|
||||
FOverloadScopes:=TFPList.Create;
|
||||
try
|
||||
RenameMembers(TPasMembersType(SpecializedItem.SpecializedEl));
|
||||
RenameMembers(TPasMembersType(El));
|
||||
finally
|
||||
ClearOverloadScopes;
|
||||
end;
|
||||
@ -4980,9 +4996,7 @@ var
|
||||
ParamResolver, GenResolver: TPasResolver;
|
||||
begin
|
||||
Result:=nil;
|
||||
{$IFNDEF EnableDelaySpecialize}
|
||||
exit;
|
||||
{$ENDIF}
|
||||
if SpecializedItem=nil then exit;
|
||||
Gen:=SpecializedItem.GenericEl;
|
||||
GenSection:=GetParentSection(Gen);
|
||||
if not (GenSection is TInterfaceSection) then
|
||||
@ -4998,6 +5012,9 @@ begin
|
||||
Param:=ResolveAliasType(Params[i],false);
|
||||
if Param.ClassType=TPasUnresolvedSymbolRef then
|
||||
continue; // built-in type -> no delay needed
|
||||
if (Param.CustomData is TPasGenericScope)
|
||||
and (TPasGenericScope(Param.CustomData).GenericStep<psgsInterfaceParsed) then
|
||||
exit(Param); // specialization is within param itself -> needs delay
|
||||
ParamSection:=GetParentSection(Param);
|
||||
if ParamSection=GenSection then
|
||||
continue; // same section -> no delay needed
|
||||
@ -7531,6 +7548,8 @@ Var
|
||||
ImplVarSt: TJSVariableStatement;
|
||||
HasImplUsesClause, ok, NeedRTLCheckVersion: Boolean;
|
||||
UsesClause: TPasUsesClause;
|
||||
Prg: TPasProgram;
|
||||
Lib: TPasLibrary;
|
||||
begin
|
||||
Result:=Nil;
|
||||
OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
|
||||
@ -7594,15 +7613,18 @@ begin
|
||||
|
||||
if (El is TPasProgram) then
|
||||
begin // program
|
||||
if Assigned(TPasProgram(El).ProgramSection) then
|
||||
AddToSourceElements(Src,ConvertDeclarations(TPasProgram(El).ProgramSection,IntfContext));
|
||||
CreateInitSection(El,Src,IntfContext);
|
||||
Prg:=TPasProgram(El);
|
||||
if Assigned(Prg.ProgramSection) then
|
||||
AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext));
|
||||
AddDelayedInits(Prg,Src,IntfContext);
|
||||
CreateInitSection(Prg,Src,IntfContext);
|
||||
end
|
||||
else if El is TPasLibrary then
|
||||
begin // library
|
||||
if Assigned(TPasLibrary(El).LibrarySection) then
|
||||
AddToSourceElements(Src,ConvertDeclarations(TPasLibrary(El).LibrarySection,IntfContext));
|
||||
CreateInitSection(El,Src,IntfContext);
|
||||
Lib:=TPasLibrary(El);
|
||||
if Assigned(Lib.LibrarySection) then
|
||||
AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
|
||||
CreateInitSection(Lib,Src,IntfContext);
|
||||
end
|
||||
else
|
||||
begin // unit
|
||||
@ -14607,6 +14629,9 @@ var
|
||||
end;
|
||||
|
||||
var
|
||||
aResolver: TPas2JSResolver;
|
||||
DelaySrc: TJSSourceElements;
|
||||
DelayFuncContext: TFunctionContext;
|
||||
Call: TJSCallExpression;
|
||||
FunDecl: TJSFunctionDeclarationStatement;
|
||||
Src: TJSSourceElements;
|
||||
@ -14620,9 +14645,9 @@ var
|
||||
AncestorPath, OwnerName, DestructorName, FnName, IntfKind: String;
|
||||
C: TClass;
|
||||
AssignSt: TJSSimpleAssignStatement;
|
||||
NeedInitFunction, HasConstructor, IsJSFunction, NeedClassExt: Boolean;
|
||||
NeedInitFunction, HasConstructor, IsJSFunction, NeedClassExt,
|
||||
SpecializeNeedsDelay: Boolean;
|
||||
Proc: TPasProcedure;
|
||||
aResolver: TPas2JSResolver;
|
||||
begin
|
||||
Result:=nil;
|
||||
aResolver:=AContext.Resolver;
|
||||
@ -14652,16 +14677,20 @@ begin
|
||||
end;
|
||||
FreeAndNil(Scope.MsgIntToProc);
|
||||
FreeAndNil(Scope.MsgStrToProc);
|
||||
SpecializeNeedsDelay:=aResolver.SpecializeNeedsDelay(Scope.SpecializedFromItem)<>nil;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Scope:=nil;
|
||||
IsTObject:=(El.AncestorType=nil) and (El.ObjKind=okClass) and SameText(El.Name,'TObject');
|
||||
Ancestor:=El.AncestorType;
|
||||
SpecializeNeedsDelay:=false;
|
||||
end;
|
||||
|
||||
// create call 'rtl.createClass(' or 'rtl.createInterface('
|
||||
FuncContext:=nil;
|
||||
DelaySrc:=nil;
|
||||
DelayFuncContext:=nil;
|
||||
Call:=CreateCallExpression(El);
|
||||
try
|
||||
AncestorIsExternal:=(Ancestor is TPasClassType) and TPasClassType(Ancestor).IsExternal;
|
||||
@ -14797,7 +14826,16 @@ begin
|
||||
else
|
||||
RaiseNotSupported(P,FuncContext,20161221233338);
|
||||
if NewEl<>nil then
|
||||
AddToSourceElements(Src,NewEl);
|
||||
begin
|
||||
if SpecializeNeedsDelay and not (P is TPasProcedure) then
|
||||
begin
|
||||
if DelayFuncContext=nil then
|
||||
DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
|
||||
AddToSourceElements(DelaySrc,NewEl);
|
||||
end
|
||||
else
|
||||
AddToSourceElements(Src,NewEl);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -14861,7 +14899,14 @@ begin
|
||||
AddClassMessageIds(El,Src,FuncContext,pbivnMessageInt);
|
||||
AddClassMessageIds(El,Src,FuncContext,pbivnMessageStr);
|
||||
// add RTTI init function
|
||||
AddClassRTTI(El,Src,FuncContext);
|
||||
if SpecializeNeedsDelay then
|
||||
begin
|
||||
if DelayFuncContext=nil then
|
||||
DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
|
||||
AddClassRTTI(El,DelaySrc,DelayFuncContext);
|
||||
end
|
||||
else
|
||||
AddClassRTTI(El,Src,FuncContext);
|
||||
end;
|
||||
|
||||
end;// end of init function
|
||||
@ -15335,10 +15380,16 @@ function TPasToJSConverter.ConvertProcedureType(El: TPasProcedureType;
|
||||
// module.$rtti.$ProcVar("name",{
|
||||
// procsig: rtl.newTIProcSignature([[arg1name,arg1type,arg1flags],[arg2name...],...],resulttype,flags)
|
||||
// })
|
||||
// "of object":
|
||||
// module.$rtti.$MethodVar("name",{
|
||||
// procsig: rtl.newTIProcSignature([[arg1name,arg1type,arg1flags],[arg2name...],...],resulttype,flags),
|
||||
// methodkind: 1
|
||||
// })
|
||||
// delayed specialization:
|
||||
// module.$rtti.$MethodVar("name",{
|
||||
// init: function()}{ this.procsig = rtl.newTIProcSignature([[arg1name,arg1type,arg1flags],[arg2name...],...],resulttype,flags)},
|
||||
// methodkind: 1
|
||||
// })
|
||||
var
|
||||
Call, InnerCall: TJSCallExpression;
|
||||
FunName: String;
|
||||
@ -15349,6 +15400,10 @@ var
|
||||
Obj: TJSObjectLiteral;
|
||||
Prop: TJSObjectLiteralElement;
|
||||
aResolver: TPas2JSResolver;
|
||||
Scope: TPasProcTypeScope;
|
||||
SpecializeNeedsDelay: Boolean;
|
||||
FuncSt: TJSFunctionDeclarationStatement;
|
||||
AssignSt: TJSSimpleAssignStatement;
|
||||
begin
|
||||
Result:=nil;
|
||||
aResolver:=AContext.Resolver;
|
||||
@ -15359,11 +15414,16 @@ begin
|
||||
if not (El.CallingConvention in [ccDefault,ccSafeCall]) then
|
||||
DoError(20170222231532,nPasElementNotSupported,sPasElementNotSupported,
|
||||
['calling convention '+cCallingConventions[El.CallingConvention]],El);
|
||||
if not HasTypeInfo(El,AContext) then exit;
|
||||
if not HasTypeInfo(El,AContext) then
|
||||
exit; // no RTTI needed
|
||||
|
||||
if El.Parent is TProcedureBody then
|
||||
RaiseNotSupported(El,AContext,20181231112029);
|
||||
|
||||
Scope:=El.CustomData as TPasProcTypeScope;
|
||||
SpecializeNeedsDelay:=(Scope<>nil)
|
||||
and (aResolver.SpecializeNeedsDelay(Scope.SpecializedFromItem)<>nil);
|
||||
|
||||
// module.$rtti.$ProcVar("name",function(){})
|
||||
if El.IsReferenceTo then
|
||||
FunName:=GetBIName(pbifnRTTINewRefToProcVar)
|
||||
@ -15375,9 +15435,25 @@ begin
|
||||
try
|
||||
// add "procsig: rtl.newTIProcSignature()"
|
||||
Prop:=Obj.Elements.AddElement;
|
||||
Prop.Name:=TJSString(GetBIName(pbivnRTTIProcVar_ProcSig));
|
||||
InnerCall:=CreateCallExpression(El);
|
||||
Prop.Expr:=InnerCall;
|
||||
|
||||
if SpecializeNeedsDelay then
|
||||
begin
|
||||
Prop.Name:=TJSString(GetBIName(pbivnRTTIProc_InitSpec));
|
||||
// init: function(){ this.procsig = rtl.newTIProcSignature(...) }
|
||||
FuncSt:=CreateFunctionSt(El);
|
||||
Prop.Expr:=FuncSt;
|
||||
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
|
||||
AssignSt.LHS:=CreatePrimitiveDotExpr('this.'+GetBIName(pbivnRTTIProcVar_ProcSig),El);
|
||||
AssignSt.Expr:=InnerCall;
|
||||
FuncSt.AFunction.Body.A:=AssignSt;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Prop.Name:=TJSString(GetBIName(pbivnRTTIProcVar_ProcSig));
|
||||
Prop.Expr:=InnerCall;
|
||||
end;
|
||||
|
||||
InnerCall.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnRTTINewProcSig)]);
|
||||
// add array of arguments
|
||||
InnerCall.AddArg(CreateRTTIArgList(El,El.Args,AContext));
|
||||
@ -16628,6 +16704,59 @@ begin
|
||||
inc(SectionCtx.HeaderIndex);
|
||||
end;
|
||||
|
||||
procedure TPasToJSConverter.AddDelayedInits(El: TPasProgram;
|
||||
Src: TJSSourceElements; AContext: TConvertContext);
|
||||
var
|
||||
aResolver: TPas2JSResolver;
|
||||
Hub: TPas2JSResolverHub;
|
||||
i: Integer;
|
||||
begin
|
||||
aResolver:=AContext.Resolver;
|
||||
if aResolver=nil then exit;
|
||||
if El=nil then ;
|
||||
Hub:=aResolver.Hub as TPas2JSResolverHub;
|
||||
{$IFDEF VerbosePas2JS}
|
||||
writeln('TPasToJSConverter.AddDelayedInits Hub.JSDelaySpecializeCount=',Hub.JSDelaySpecializeCount);
|
||||
{$ENDIF}
|
||||
for i:=0 to Hub.JSDelaySpecializeCount-1 do
|
||||
AddDelaySpecializeInit(Hub.JSDelaySpecializes[i],Src,AContext);
|
||||
end;
|
||||
|
||||
procedure TPasToJSConverter.AddDelaySpecializeInit(El: TPasGenericType;
|
||||
Src: TJSSourceElements; AContext: TConvertContext);
|
||||
var
|
||||
C: TClass;
|
||||
Path: String;
|
||||
Call: TJSCallExpression;
|
||||
DotExpr: TJSDotMemberExpression;
|
||||
begin
|
||||
if not IsElementUsed(El) then exit;
|
||||
C:=El.ClassType;
|
||||
if (C=TPasRecordType)
|
||||
or (C=TPasClassType) then
|
||||
begin
|
||||
// pas.unitname.recordtype.$initSpec();
|
||||
Path:=CreateReferencePath(El,AContext,rpkPathAndName)+'.'+GetBIName(pbifnClassInitSpecialize);
|
||||
Call:=CreateCallExpression(El);
|
||||
Call.Expr:=CreatePrimitiveDotExpr(Path,El);
|
||||
AddToSourceElements(Src,Call);
|
||||
end
|
||||
else if (C=TPasProcedureType) or (C=TPasFunctionType) then
|
||||
begin
|
||||
if not HasTypeInfo(El,AContext) then
|
||||
exit; // no RTTI needed
|
||||
// pas.unitname.$rtti.TProcF.init();
|
||||
DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
|
||||
DotExpr.MExpr:=CreateTypeInfoRef(El,AContext,El);
|
||||
DotExpr.Name:=TJSString(GetBIName(pbivnRTTIProc_InitSpec));
|
||||
Call:=CreateCallExpression(El);
|
||||
Call.Expr:=DotExpr;
|
||||
AddToSourceElements(Src,Call);
|
||||
end
|
||||
else
|
||||
RaiseNotSupported(El,AContext,20200831115251);
|
||||
end;
|
||||
|
||||
function TPasToJSConverter.CreateReferencedSet(El: TPasElement; SetExpr: TJSElement
|
||||
): TJSElement;
|
||||
var
|
||||
@ -17041,6 +17170,25 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasToJSConverter.CreateDelayedInitFunction(PosEl: TPasElement;
|
||||
Src: TJSSourceElements; FuncContext: TFunctionContext; out
|
||||
DelaySrc: TJSSourceElements): TFunctionContext;
|
||||
var
|
||||
AssignSt: TJSSimpleAssignStatement;
|
||||
FunDecl: TJSFunctionDeclarationStatement;
|
||||
begin
|
||||
// this.$initSpec = function(){ DelaySrc }
|
||||
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,PosEl));
|
||||
AddToSourceElements(Src,AssignSt);
|
||||
AssignSt.LHS:=CreatePrimitiveDotExpr('this.'+GetBIName(pbifnClassInitSpecialize),PosEl);
|
||||
FunDecl:=CreateFunctionSt(PosEl,true,true);
|
||||
AssignSt.Expr:=FunDecl;
|
||||
DelaySrc:=TJSSourceElements(FunDecl.AFunction.Body.A);
|
||||
Result:=TFunctionContext.Create(PosEl,DelaySrc,FuncContext);
|
||||
Result.IsGlobal:=true;
|
||||
Result.ThisPas:=PosEl;
|
||||
end;
|
||||
|
||||
function TPasToJSConverter.CreateArrayConcat(
|
||||
ElTypeResolved: TPasResolverResult; PosEl: TPasElement;
|
||||
AContext: TConvertContext): TJSCallExpression;
|
||||
@ -23595,8 +23743,8 @@ begin
|
||||
// element is in foreign unit -> use pas.unitname
|
||||
CurModule:=Parent.GetModule;
|
||||
Result:=TransformModuleName(CurModule,true,AContext);
|
||||
if (CurModule<>AContext.GetRootContext.PasElement.GetModule)
|
||||
and (Parent is TImplementationSection) then
|
||||
if (Parent.ClassType=TImplementationSection)
|
||||
and (CurModule<>AContext.GetRootContext.PasElement.GetModule) then
|
||||
begin
|
||||
// element is in foreign implementation section (not program/library section)
|
||||
// -> use pas.unitname.$impl
|
||||
@ -24717,6 +24865,10 @@ end;
|
||||
function TPasToJSConverter.ConvertRecordType(El: TPasRecordType;
|
||||
AContext: TConvertContext): TJSElement;
|
||||
var
|
||||
aResolver: TPas2JSResolver;
|
||||
RecScope: TPas2JSRecordScope;
|
||||
DelaySrc: TJSSourceElements;
|
||||
DelayFuncContext: TFunctionContext;
|
||||
Call: TJSCallExpression;
|
||||
JSParentName: String;
|
||||
FunDecl: TJSFunctionDeclarationStatement;
|
||||
@ -24726,14 +24878,11 @@ var
|
||||
P: TPasElement;
|
||||
C: TClass;
|
||||
NewEl: TJSElement;
|
||||
aResolver: TPas2JSResolver;
|
||||
PasVar: TPasVariable;
|
||||
PasVarType: TPasType;
|
||||
NewFields, Vars, Methods: TFPList;
|
||||
ok, IsFull: Boolean;
|
||||
ok, IsComplex, SpecializeNeedsDelay: Boolean;
|
||||
VarSt: TJSVariableStatement;
|
||||
bifn: TPas2JSBuiltInName;
|
||||
RecScope: TPas2JSRecordScope;
|
||||
begin
|
||||
Result:=nil;
|
||||
if El.Name='' then
|
||||
@ -24747,21 +24896,16 @@ begin
|
||||
NewFields:=nil;
|
||||
Vars:=nil;
|
||||
Methods:=nil;
|
||||
DelaySrc:=nil;
|
||||
DelayFuncContext:=nil;
|
||||
ok:=false;
|
||||
try
|
||||
RecScope:=TPas2JSRecordScope(El.CustomData);
|
||||
SpecializeNeedsDelay:=aResolver.SpecializeNeedsDelay(RecScope.SpecializedFromItem)<>nil;
|
||||
|
||||
// rtl.recNewT()
|
||||
Call:=CreateCallExpression(El);
|
||||
bifn:=pbifnRecordCreateType;
|
||||
|
||||
RecScope:=TPas2JSRecordScope(El.CustomData);
|
||||
if RecScope.SpecializedFromItem<>nil then
|
||||
begin
|
||||
// ToDo
|
||||
if aResolver.SpecializeNeedsDelay(RecScope.SpecializedFromItem)<>nil then
|
||||
;//bifn:=pbifnRecordCreateSpecializeType;
|
||||
end;
|
||||
|
||||
Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(bifn)]);
|
||||
Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnRecordCreateType)]);
|
||||
|
||||
// types are stored in interface/implementation
|
||||
if El.Parent is TProcedureBody then
|
||||
@ -24811,7 +24955,7 @@ begin
|
||||
NewFields:=TFPList.Create;
|
||||
Vars:=TFPList.Create;
|
||||
Methods:=TFPList.Create;
|
||||
IsFull:=false;
|
||||
IsComplex:=false;
|
||||
for i:=0 to El.Members.Count-1 do
|
||||
begin
|
||||
P:=TPasElement(El.Members[i]);
|
||||
@ -24822,8 +24966,8 @@ begin
|
||||
if C=TPasVariable then
|
||||
begin
|
||||
PasVar:=TPasVariable(P);
|
||||
if ClassVarModifiersType*TPasVariable(P).VarModifiers*[vmClass, vmStatic]<>[] then
|
||||
IsFull:=true
|
||||
if ClassVarModifiersType*PasVar.VarModifiers*[vmClass, vmStatic]<>[] then
|
||||
IsComplex:=true
|
||||
else if aResolver<>nil then
|
||||
begin
|
||||
Vars.Add(PasVar);
|
||||
@ -24845,14 +24989,18 @@ begin
|
||||
// sub set
|
||||
NewFields.Add(PasVar);
|
||||
continue;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// simple vars are initialized in the record type, no need to initialize them for each instance
|
||||
end;
|
||||
end;
|
||||
NewEl:=CreateVarDecl(TPasVariable(P),FuncContext); // can be nil
|
||||
NewEl:=CreateVarDecl(PasVar,FuncContext); // can be nil
|
||||
end
|
||||
else if C=TPasConst then
|
||||
begin
|
||||
NewEl:=ConvertConst(TPasConst(P),aContext);
|
||||
IsFull:=true;
|
||||
IsComplex:=true;
|
||||
end
|
||||
else if C=TPasProperty then
|
||||
NewEl:=ConvertProperty(TPasProperty(P),AContext)
|
||||
@ -24860,7 +25008,7 @@ begin
|
||||
begin
|
||||
NewEl:=CreateTypeDecl(TPasType(P),aContext);
|
||||
if (C=TPasRecordType) or (C=TPasClassType) then
|
||||
IsFull:=true;
|
||||
IsComplex:=true;
|
||||
end
|
||||
else if C.InheritsFrom(TPasProcedure) then
|
||||
begin
|
||||
@ -24873,18 +25021,26 @@ begin
|
||||
if (C=TPasConstructor)
|
||||
or ((aResolver<>nil) and aResolver.IsClassMethod(P)
|
||||
and not aResolver.MethodIsStatic(TPasProcedure(P))) then
|
||||
IsFull:=true; // needs $record
|
||||
IsComplex:=true; // needs $record
|
||||
end;
|
||||
end
|
||||
else if C=TPasAttributes then
|
||||
// ToDo
|
||||
else
|
||||
RaiseNotSupported(P,FuncContext,20190105105436);
|
||||
if NewEl<>nil then
|
||||
AddToSourceElements(Src,NewEl);
|
||||
begin
|
||||
if SpecializeNeedsDelay and not (P is TPasProcedure) then
|
||||
begin
|
||||
if DelayFuncContext=nil then
|
||||
DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
|
||||
AddToSourceElements(DelaySrc,NewEl);
|
||||
end
|
||||
else
|
||||
AddToSourceElements(Src,NewEl);
|
||||
end;
|
||||
end;
|
||||
if IsFull then
|
||||
Call.AddArg(CreateLiteralBoolean(El,true));
|
||||
if IsComplex then
|
||||
Call.AddArg(CreateLiteralBoolean(El,true)); // needs $record
|
||||
|
||||
// add $new function if needed
|
||||
if NewFields.Count>0 then
|
||||
@ -24903,13 +25059,23 @@ begin
|
||||
|
||||
// add RTTI init function
|
||||
if (aResolver<>nil) and HasTypeInfo(El,FuncContext) then
|
||||
CreateRecordRTTI(El,Src,FuncContext);
|
||||
begin
|
||||
if SpecializeNeedsDelay then
|
||||
begin
|
||||
if DelayFuncContext=nil then
|
||||
DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
|
||||
CreateRecordRTTI(El,DelaySrc,DelayFuncContext);
|
||||
end
|
||||
else
|
||||
CreateRecordRTTI(El,Src,FuncContext);
|
||||
end;
|
||||
|
||||
ok:=true;
|
||||
finally
|
||||
NewFields.Free;
|
||||
Vars.Free;
|
||||
Methods.Free;
|
||||
DelayFuncContext.Free;
|
||||
FuncContext.Free;
|
||||
if not ok then
|
||||
FreeAndNil(Result);
|
||||
|
||||
@ -17,9 +17,11 @@ type
|
||||
// generic record
|
||||
Procedure TestGen_RecordEmpty;
|
||||
Procedure TestGen_Record_ClassProc;
|
||||
Procedure TestGen_Record_AsClassVar_Program;
|
||||
Procedure TestGen_Record_AsClassVar_UnitImpl; // ToDo
|
||||
// ToDo: delay using recNewS
|
||||
Procedure TestGen_Record_ClassVarRecord_Program;
|
||||
Procedure TestGen_Record_ClassVarRecord_UnitImpl;
|
||||
Procedure TestGen_Record_RTTI_UnitImpl;
|
||||
// ToDo: delay RTTI with anonymous array a:array of T, array[1..2] of T
|
||||
// ToDo: type alias type as parameter, TBird = type word;
|
||||
|
||||
// generic class
|
||||
Procedure TestGen_ClassEmpty;
|
||||
@ -38,6 +40,7 @@ type
|
||||
procedure TestGen_Class_VarArgsOfType;
|
||||
procedure TestGen_Class_OverloadsInUnit;
|
||||
procedure TestGen_ClassForward_CircleRTTI;
|
||||
Procedure TestGen_Class_ClassVarRecord_UnitImpl;
|
||||
|
||||
// generic external class
|
||||
procedure TestGen_ExtClass_Array;
|
||||
@ -67,11 +70,16 @@ type
|
||||
procedure TestGenProc_TypeInfo;
|
||||
procedure TestGenProc_Infer_Widen;
|
||||
procedure TestGenProc_Infer_PassAsArg;
|
||||
// ToDo: delay create: type TRec=record end; ... r:=GenProc<TRec>();
|
||||
// ToDo: FuncName:= instead of Result:=
|
||||
|
||||
// generic methods
|
||||
procedure TestGenMethod_ObjFPC;
|
||||
|
||||
// generic array
|
||||
// procedure TestGen_ArrayOfUnitImplRec; ToDo dynamic + static + RTTI
|
||||
|
||||
// generic procedure type
|
||||
procedure TestGen_ProcType_ParamUnitImpl;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -157,7 +165,7 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_Record_AsClassVar_Program;
|
||||
procedure TTestGenerics.TestGen_Record_ClassVarRecord_Program;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
@ -174,7 +182,7 @@ begin
|
||||
' f.x.b:=f.x.b+10;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestGen_Record_AsClassVar_Program',
|
||||
CheckSource('TestGen_Record_ClassVarRecord_Program',
|
||||
LinesToStr([ // statements
|
||||
'rtl.recNewT($mod, "TBird", function () {',
|
||||
' this.b = 0;',
|
||||
@ -202,17 +210,19 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_Record_AsClassVar_UnitImpl;
|
||||
procedure TTestGenerics.TestGen_Record_ClassVarRecord_UnitImpl;
|
||||
begin
|
||||
StartUnit(true);
|
||||
Add([
|
||||
'interface',
|
||||
StartProgram(true,[supTObject]);
|
||||
AddModuleWithIntfImplSrc('UnitA.pas',
|
||||
LinesToStr([
|
||||
'{$modeswitch AdvancedRecords}',
|
||||
'type',
|
||||
' generic TAnt<T> = record',
|
||||
' class var x: T;',
|
||||
' class var a: array[1..2] of T;',
|
||||
' end;',
|
||||
'implementation',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'type',
|
||||
' TBird = record',
|
||||
' b: word;',
|
||||
@ -220,13 +230,87 @@ begin
|
||||
'var f: specialize TAnt<TBird>;',
|
||||
'begin',
|
||||
' f.x.b:=f.x.b+10;',
|
||||
'']));
|
||||
Add([
|
||||
'uses UnitA;',
|
||||
'begin',
|
||||
'end.']);
|
||||
ConvertProgram;
|
||||
CheckUnit('UnitA.pas',
|
||||
LinesToStr([ // statements
|
||||
'rtl.module("UnitA", ["system"], function () {',
|
||||
' var $mod = this;',
|
||||
' var $impl = $mod.$impl;',
|
||||
' rtl.recNewT($mod, "TAnt$G1", function () {',
|
||||
' this.$initSpec = function () {',
|
||||
' this.x = $impl.TBird.$new();',
|
||||
' this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
|
||||
' };',
|
||||
' this.$eq = function (b) {',
|
||||
' return true;',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' return this;',
|
||||
' };',
|
||||
' }, true);',
|
||||
' $mod.$init = function () {',
|
||||
' $impl.f.x.b = $impl.f.x.b + 10;',
|
||||
' };',
|
||||
'}, null, function () {',
|
||||
' var $mod = this;',
|
||||
' var $impl = $mod.$impl;',
|
||||
' rtl.recNewT($impl, "TBird", function () {',
|
||||
' this.b = 0;',
|
||||
' this.$eq = function (b) {',
|
||||
' return this.b === b.b;',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' this.b = s.b;',
|
||||
' return this;',
|
||||
' };',
|
||||
' });',
|
||||
' $impl.f = $mod.TAnt$G1.$new();',
|
||||
'});']));
|
||||
CheckSource('TestGen_Record_ClassVarRecord_UnitImpl',
|
||||
LinesToStr([ // statements
|
||||
'pas.UnitA.TAnt$G1.$initSpec();',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_Record_RTTI_UnitImpl;
|
||||
begin
|
||||
WithTypeInfo:=true;
|
||||
StartUnit(true);
|
||||
Add([
|
||||
'interface',
|
||||
'{$modeswitch AdvancedRecords}',
|
||||
'type',
|
||||
' generic TAnt<T> = record',
|
||||
' class var x: T;',
|
||||
//' class var a,b: array of T;',
|
||||
' end;',
|
||||
'implementation',
|
||||
'type',
|
||||
' TBird = record',
|
||||
' b: word;',
|
||||
' end;',
|
||||
'var f: specialize TAnt<TBird>;',
|
||||
' p: pointer;',
|
||||
'begin',
|
||||
' p:=typeinfo(f);',
|
||||
'']);
|
||||
ConvertUnit;
|
||||
CheckSource('TestGen_Record_AsClassVar_UnitImpl',
|
||||
CheckSource('TestGen_Record_RTTI_UnitImpl',
|
||||
LinesToStr([ // statements
|
||||
'var $impl = $mod.$impl;',
|
||||
'rtl.recNewT($mod, "TAnt$G1", function () {',
|
||||
' this.x = $impl.TBird.$new();',
|
||||
' this.$initSpec = function () {',
|
||||
' this.x = $impl.TBird.$new();',
|
||||
' var $r = $mod.$rtti.$Record("TAnt$G1", {});',
|
||||
' $r.addField("x", $mod.$rtti["TBird"]);',
|
||||
' };',
|
||||
' this.$eq = function (b) {',
|
||||
' return true;',
|
||||
' };',
|
||||
@ -236,7 +320,7 @@ begin
|
||||
'}, true);',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$init
|
||||
' $impl.f.x.b = $impl.f.x.b + 10;',
|
||||
'$impl.p = $mod.$rtti["TAnt$G1"];',
|
||||
'']),
|
||||
LinesToStr([ // statements
|
||||
'rtl.recNewT($impl, "TBird", function () {',
|
||||
@ -248,9 +332,11 @@ begin
|
||||
' this.b = s.b;',
|
||||
' return this;',
|
||||
' };',
|
||||
' var $r = $mod.$rtti.$Record("TBird", {});',
|
||||
' $r.addField("b", rtl.word);',
|
||||
'});',
|
||||
//'$mod.TAnt$G1();',
|
||||
'$impl.f = $mod.TAnt$G1.$new();',
|
||||
'$impl.p = null;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
@ -489,7 +575,7 @@ end;
|
||||
|
||||
procedure TTestGenerics.TestGen_Class_TypeInfo;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -952,7 +1038,7 @@ end;
|
||||
|
||||
procedure TTestGenerics.TestGen_ClassForward_CircleRTTI;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode objfpc}',
|
||||
@ -1025,6 +1111,69 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_Class_ClassVarRecord_UnitImpl;
|
||||
begin
|
||||
StartProgram(true,[supTObject]);
|
||||
AddModuleWithIntfImplSrc('UnitA.pas',
|
||||
LinesToStr([
|
||||
'type',
|
||||
' generic TAnt<T> = class',
|
||||
' public',
|
||||
' class var x: T;',
|
||||
' class var a: array[1..2] of T;',
|
||||
' end;',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'type',
|
||||
' TBird = record',
|
||||
' b: word;',
|
||||
' end;',
|
||||
'var f: specialize TAnt<TBird>;',
|
||||
'begin',
|
||||
' f.x.b:=f.x.b+10;',
|
||||
'']));
|
||||
Add([
|
||||
'uses UnitA;',
|
||||
'begin',
|
||||
'end.']);
|
||||
ConvertProgram;
|
||||
CheckUnit('UnitA.pas',
|
||||
LinesToStr([ // statements
|
||||
'rtl.module("UnitA", ["system"], function () {',
|
||||
' var $mod = this;',
|
||||
' var $impl = $mod.$impl;',
|
||||
' rtl.createClass($mod, "TAnt$G1", pas.system.TObject, function () {',
|
||||
' this.$initSpec = function () {',
|
||||
' this.x = $impl.TBird.$new();',
|
||||
' this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
|
||||
' };',
|
||||
' });',
|
||||
' $mod.$init = function () {',
|
||||
' $impl.f.x.b = $impl.f.x.b + 10;',
|
||||
' };',
|
||||
'}, null, function () {',
|
||||
' var $mod = this;',
|
||||
' var $impl = $mod.$impl;',
|
||||
' rtl.recNewT($impl, "TBird", function () {',
|
||||
' this.b = 0;',
|
||||
' this.$eq = function (b) {',
|
||||
' return this.b === b.b;',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' this.b = s.b;',
|
||||
' return this;',
|
||||
' };',
|
||||
' });',
|
||||
' $impl.f = null;',
|
||||
'});']));
|
||||
CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
|
||||
LinesToStr([ // statements
|
||||
'pas.UnitA.TAnt$G1.$initSpec();',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_ExtClass_Array;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -1144,7 +1293,7 @@ end;
|
||||
|
||||
procedure TTestGenerics.TestGen_ExtClass_RTTI;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode objfpc}',
|
||||
@ -1663,7 +1812,7 @@ end;
|
||||
|
||||
procedure TTestGenerics.TestGenProc_TypeInfo;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add([
|
||||
'{$modeswitch implicitfunctionspecialization}',
|
||||
@ -1825,6 +1974,70 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_ProcType_ParamUnitImpl;
|
||||
begin
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTObject]);
|
||||
AddModuleWithIntfImplSrc('UnitA.pas',
|
||||
LinesToStr([
|
||||
'type',
|
||||
' generic TAnt<T> = function(const a: T): T;',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'type',
|
||||
' TBird = record',
|
||||
' b: word;',
|
||||
' end;',
|
||||
'var',
|
||||
' f: specialize TAnt<TBird>;',
|
||||
' b: TBird;',
|
||||
'begin',
|
||||
' b:=f(b);',
|
||||
'']));
|
||||
Add([
|
||||
'uses UnitA;',
|
||||
'begin',
|
||||
'end.']);
|
||||
ConvertProgram;
|
||||
CheckUnit('UnitA.pas',
|
||||
LinesToStr([ // statements
|
||||
'rtl.module("UnitA", ["system"], function () {',
|
||||
' var $mod = this;',
|
||||
' var $impl = $mod.$impl;',
|
||||
' $mod.$rtti.$ProcVar("TAnt$G1", {',
|
||||
' init: function () {',
|
||||
' this.procsig = rtl.newTIProcSig([["a", $mod.$rtti["TBird"], 2]], $mod.$rtti["TBird"]);',
|
||||
' }',
|
||||
' });',
|
||||
' $mod.$init = function () {',
|
||||
' $impl.b.$assign($impl.f($impl.b));',
|
||||
' };',
|
||||
'}, null, function () {',
|
||||
' var $mod = this;',
|
||||
' var $impl = $mod.$impl;',
|
||||
' rtl.recNewT($impl, "TBird", function () {',
|
||||
' this.b = 0;',
|
||||
' this.$eq = function (b) {',
|
||||
' return this.b === b.b;',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' this.b = s.b;',
|
||||
' return this;',
|
||||
' };',
|
||||
' var $r = $mod.$rtti.$Record("TBird", {});',
|
||||
' $r.addField("b", rtl.word);',
|
||||
' });',
|
||||
' $impl.f = null;',
|
||||
' $impl.b = $impl.TBird.$new();',
|
||||
'});']));
|
||||
CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
|
||||
LinesToStr([ // statements
|
||||
'pas.UnitA.$rtti["TAnt$G1"].init();',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'']));
|
||||
end;
|
||||
|
||||
Initialization
|
||||
RegisterTests([TTestGenerics]);
|
||||
end.
|
||||
|
||||
@ -32,7 +32,7 @@ uses
|
||||
const
|
||||
// default parser+scanner options
|
||||
po_tcmodules = po_Pas2js+[po_KeepScannerError];
|
||||
co_tcmodules = [coNoTypeInfo];
|
||||
co_tcmodules = [];
|
||||
type
|
||||
TSrcMarkerKind = (
|
||||
mkLabel,
|
||||
@ -132,6 +132,7 @@ type
|
||||
FSkipTests: boolean;
|
||||
FSource: TStringList;
|
||||
FFirstPasStatement: TPasImplBlock;
|
||||
FWithTypeInfo: boolean;
|
||||
{$IFDEF EnablePasTreeGlobalRefCount}
|
||||
FElementRefCountAtSetup: int64;
|
||||
{$ENDIF}
|
||||
@ -143,6 +144,7 @@ type
|
||||
procedure OnParserLog(Sender: TObject; const Msg: String);
|
||||
procedure OnPasResolverLog(Sender: TObject; const Msg: String);
|
||||
procedure OnScannerLog(Sender: TObject; const Msg: String);
|
||||
procedure SetWithTypeInfo(const AValue: boolean);
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
function CreateConverter: TPasToJSConverter; virtual;
|
||||
@ -224,6 +226,7 @@ type
|
||||
property Parser: TTestPasParser read FParser;
|
||||
property MsgCount: integer read GetMsgCount;
|
||||
property Msgs[Index: integer]: TTestHintMessage read GetMsgs;
|
||||
property WithTypeInfo: boolean read FWithTypeInfo write SetWithTypeInfo;
|
||||
end;
|
||||
|
||||
{ TTestModule }
|
||||
@ -1248,6 +1251,16 @@ begin
|
||||
FHintMsgs.Add(Item);
|
||||
end;
|
||||
|
||||
procedure TCustomTestModule.SetWithTypeInfo(const AValue: boolean);
|
||||
begin
|
||||
if FWithTypeInfo=AValue then Exit;
|
||||
FWithTypeInfo:=AValue;
|
||||
if AValue then
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo]
|
||||
else
|
||||
Converter.Options:=Converter.Options+[coNoTypeInfo];
|
||||
end;
|
||||
|
||||
function TCustomTestModule.LoadUnit(const aUnitName: String): TPasModule;
|
||||
var
|
||||
i: Integer;
|
||||
@ -1311,6 +1324,7 @@ begin
|
||||
|
||||
inherited SetUp;
|
||||
FSkipTests:=false;
|
||||
FWithTypeInfo:=false;
|
||||
FSource:=TStringList.Create;
|
||||
|
||||
FHub:=TPas2JSResolverHub.Create(Self);
|
||||
@ -1339,9 +1353,16 @@ begin
|
||||
end;
|
||||
|
||||
function TCustomTestModule.CreateConverter: TPasToJSConverter;
|
||||
var
|
||||
Options: TPasToJsConverterOptions;
|
||||
begin
|
||||
Result:=TPasToJSConverter.Create;
|
||||
Result.Options:=co_tcmodules;
|
||||
Options:=co_tcmodules;
|
||||
if WithTypeInfo then
|
||||
Exclude(Options,coNoTypeInfo)
|
||||
else
|
||||
Include(Options,coNoTypeInfo);
|
||||
Result.Options:=Options;
|
||||
Result.Globals:=TPasToJSConverterGlobals.Create(Result);
|
||||
end;
|
||||
|
||||
@ -1375,6 +1396,7 @@ begin
|
||||
FHintMsgs.Clear;
|
||||
FHintMsgsGood.Clear;
|
||||
FSkipTests:=false;
|
||||
FWithTypeInfo:=false;
|
||||
FJSRegModuleCall:=nil;
|
||||
FJSModuleCallArgs:=nil;
|
||||
FJSImplentationUses:=nil;
|
||||
@ -2070,6 +2092,7 @@ var
|
||||
begin
|
||||
aResolver:=GetResolver(Filename);
|
||||
AssertNotNull('missing resolver of unit '+Filename,aResolver);
|
||||
AssertNotNull('missing resolver.module of unit '+Filename,aResolver.Module);
|
||||
{$IFDEF VerbosePas2JS}
|
||||
writeln('CheckUnit '+Filename+' converting ...');
|
||||
{$ENDIF}
|
||||
@ -16150,7 +16173,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestNestedClass_Alias;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -16186,7 +16209,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestNestedClass_Record;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -16252,7 +16275,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestNestedClass_Class;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -28502,7 +28525,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_IntRange;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add([
|
||||
'{$modeswitch externalclass}',
|
||||
@ -28540,7 +28563,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Double;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add([
|
||||
'{$modeswitch externalclass}',
|
||||
@ -28566,7 +28589,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_ProcType;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TProcA = procedure;');
|
||||
@ -28609,7 +28632,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_ProcType_ArgFromOtherUnit;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
|
||||
AddModuleWithIntfImplSrc('unit2.pas',
|
||||
LinesToStr([
|
||||
@ -28651,7 +28674,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_EnumAndSetType;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TFlag = (light,dark);');
|
||||
@ -28692,7 +28715,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_EnumRange;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -28709,7 +28732,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_AnonymousEnumType;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TFlags = set of (red, green);');
|
||||
@ -28744,7 +28767,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_StaticArray;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TFlag = (light,dark);');
|
||||
@ -28796,7 +28819,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_DynArray;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TArrStr = array of string;');
|
||||
@ -28828,7 +28851,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_ArrayNestedAnonymous;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TArr = array of array of longint;');
|
||||
@ -28851,7 +28874,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_PublishedMethodOverloadFail;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
@ -28867,7 +28890,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_PublishedMethodExternalFail;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
@ -28882,7 +28905,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_PublishedClassPropertyFail;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
@ -28898,7 +28921,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_PublishedClassFieldFail;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
@ -28913,7 +28936,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_PublishedFieldExternalFail;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
@ -28929,7 +28952,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Class_Field;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
@ -29009,7 +29032,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Class_Method;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
@ -29045,7 +29068,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Class_MethodArgFlags;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
@ -29075,7 +29098,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Class_Property;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
@ -29154,7 +29177,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Class_PropertyParams;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
@ -29189,7 +29212,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Class_OtherUnit_TypeAlias;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
AddModuleWithIntfImplSrc('unit1.pas',
|
||||
'type TColor = -5..5;',
|
||||
'');
|
||||
@ -29236,7 +29259,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Class_OmitRTTI;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch omitrtti}',
|
||||
@ -29265,7 +29288,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_IndexModifier;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -29344,7 +29367,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_StoredModifier;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'const',
|
||||
@ -29404,7 +29427,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_DefaultValue;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -29531,7 +29554,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_DefaultValueSet;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -29624,7 +29647,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_DefaultValueRangeType;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -29674,7 +29697,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_DefaultValueInherit;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -29721,7 +29744,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_OverrideMethod;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
@ -29756,7 +29779,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_ReintroduceMethod;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -29801,7 +29824,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_OverloadProperty;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
@ -29838,7 +29861,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_ClassForward;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class end;');
|
||||
@ -29906,7 +29929,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_ClassOf;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TClass = class of tobject;');
|
||||
@ -29968,7 +29991,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Record;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' integer = longint;');
|
||||
@ -30011,7 +30034,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_RecordAnonymousArray;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TFloatRec = record');
|
||||
@ -30061,7 +30084,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_LocalTypes;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'procedure DoIt;',
|
||||
@ -30099,7 +30122,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_TypeInfo_BaseTypes;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -30173,7 +30196,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_TypeInfo_Type_BaseTypes;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -30246,7 +30269,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_TypeInfo_LocalFail;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add('procedure DoIt;');
|
||||
Add('type');
|
||||
@ -30265,7 +30288,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses1;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add([
|
||||
'{$modeswitch externalclass}',
|
||||
@ -30333,7 +30356,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses2;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
@ -30399,7 +30422,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses3;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
@ -30464,7 +30487,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_TypeInfo_FunctionClassType;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add([
|
||||
'{$modeswitch externalclass}',
|
||||
@ -30535,7 +30558,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_TypeInfo_MixedUnits_PointerAndClass;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
AddModuleWithIntfImplSrc('typinfo.pas',
|
||||
LinesToStr([
|
||||
'{$modeswitch externalclass}',
|
||||
@ -30615,7 +30638,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Interface_Corba;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add([
|
||||
'{$interfaces corba}',
|
||||
@ -30678,7 +30701,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_Interface_COM;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add([
|
||||
'{$interfaces com}',
|
||||
@ -30753,7 +30776,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_ClassHelper;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add([
|
||||
'{$interfaces com}',
|
||||
@ -30801,7 +30824,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestRTTI_ExternalClass;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true,[supTypeInfo]);
|
||||
Add([
|
||||
'{$modeswitch externalclass}',
|
||||
@ -30958,7 +30981,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestAttributes_Members;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch PrefixedAttributes}',
|
||||
@ -31054,7 +31077,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestAttributes_Types;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch PrefixedAttributes}',
|
||||
@ -31124,7 +31147,7 @@ end;
|
||||
|
||||
procedure TTestModule.TestAttributes_HelperConstructor_Fail;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch PrefixedAttributes}',
|
||||
|
||||
1
utils/pas2js/dist/rtl.js
vendored
1
utils/pas2js/dist/rtl.js
vendored
@ -460,6 +460,7 @@ var rtl = {
|
||||
h(t,'$name');
|
||||
h(t,'$parent');
|
||||
h(t,'$module');
|
||||
h(t,'$initSpec');
|
||||
}
|
||||
initfn.call(t);
|
||||
if (!t.$new){
|
||||
|
||||
Loading…
Reference in New Issue
Block a user