From a3576453846bf5ebdad6fbcf9bc1b44853285396 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sun, 28 Mar 2021 21:41:22 +0000 Subject: [PATCH] pastojs: fixed published field with anonymous array git-svn-id: trunk@49076 - --- packages/fcl-passrc/src/pasresolver.pp | 47 +++++- packages/pastojs/src/fppas2js.pp | 205 +++++++++++++++---------- packages/pastojs/tests/tcmodules.pas | 50 +++++- 3 files changed, 213 insertions(+), 89 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index ce62008175..0d8819301d 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -2387,6 +2387,7 @@ type EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue; virtual; // compute low() or high() function EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags): TResEvalValue; virtual; // compute low() and high() function HasTypeInfo(El: TPasType): boolean; virtual; + function IsAnonymousElType(El: TPasType): boolean; virtual; function GetActualBaseType(bt: TResolverBaseType): TResolverBaseType; virtual; function GetCombinedBoolean(Bool1, Bool2: TResolverBaseType; ErrorEl: TPasElement): TResolverBaseType; virtual; function GetCombinedInt(const Int1, Int2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual; @@ -6236,15 +6237,26 @@ procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType); {$IFDEF CheckPasTreeRefCount};const aId: string{$ENDIF}); var i: Integer; - p: TPasElement; + p, Prev: TPasElement; begin p:=El.Parent; if NewParent=p.Parent then begin - // e.g. a:array of longint; -> insert a$a in front of a + // e.g. m,n:array of longint; -> insert n$a in front of m i:=List.Count-1; while (i>=0) and (List[i]<>Pointer(p)) do dec(i); + if P is TPasVariable then + begin + while (i>0) do + begin + Prev:=TPasElement(List[i-1]); + if (Prev.ClassType=P.ClassType) and (TPasVariable(Prev).VarType=TPasVariable(P).VarType) then + dec(i) // e.g. m,n: array of longint + else + break; + end; + end; if i<0 then List.Add(El) else @@ -29672,6 +29684,37 @@ begin Result:=true; end; +function TPasResolver.IsAnonymousElType(El: TPasType): boolean; +// e.g. b$a$a +var + aName: String; + i, l: SizeInt; + j: Integer; +begin + Result:=false; + if AnonymousElTypePostfix='' then exit; + aName:=El.Name; + l:=length(AnonymousElTypePostfix); + i:=length(aName); + repeat + dec(i,l); + if i>0 then + begin + j:=i; + while (j<=l) and (aName[i+j]=AnonymousElTypePostfix[j]) do inc(j); + if j>l then + begin + Result:=true; + continue; + end; + end; + if not Result then exit; // no postfix + // at least one anonymous eltype postfix + Result:=IsValidIdent(LeftStr(aName,i+l)); + exit; + until false; +end; + function TPasResolver.GetActualBaseType(bt: TResolverBaseType ): TResolverBaseType; begin diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index d998cd88e9..4ad7623078 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -2162,6 +2162,7 @@ type Function CreateRTTIMemberProperty(Members: TFPList; Index: integer; AContext: TConvertContext): TJSElement; virtual; Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext); virtual; // needed by precompiled files from 2.0.0 + Function CreateRTTIAnonymousArray(El: TPasArrayType; AContext: TConvertContext): TJSCallExpression; virtual; Function CreateRTTIMembers(El: TPasMembersType; Src: TJSSourceElements; FuncContext: TFunctionContext; MembersSrc: TJSSourceElements; MembersFuncContext: TFunctionContext; RTTIExpr: TJSElement; @@ -16631,19 +16632,13 @@ var var aResolver: TPas2JSResolver; - Scope: TPas2JSArrayScope; - SpecializeDelay: Boolean; AssignSt: TJSSimpleAssignStatement; - CallName, ArrName: String; - Obj: TJSObjectLiteral; - Prop: TJSObjectLiteralElement; - ArrLit: TJSArrayLiteral; - Arr: TPasArrayType; + ArrName: String; Index: Integer; - ElTypeHi, ElTypeLo: TPasType; + ElTypeLo: TPasType; RangeEl: TPasExpr; Call: TJSCallExpression; - RgLen, RangeEnd: TMaxPrecInt; + RangeEnd: TMaxPrecInt; List: TJSStatementList; Func: TJSFunctionDeclarationStatement; BodySrc: TJSSourceElements; @@ -16666,9 +16661,6 @@ begin writeln('TPasToJSConverter.ConvertArrayType ',GetObjName(El)); {$ENDIF} - Scope:=El.CustomData as TPas2JSArrayScope; - SpecializeDelay:=(Scope<>nil) and (SpecializeNeedsDelay(El,AContext)); - ProcScope:=nil; Src:=nil; if AContext.JSElement is TJSSourceElements then @@ -16766,7 +16758,7 @@ begin else Result:=ArraySt; - // store precompiled enum type in proc + // store precompiled array type in proc StorePrecompiledJS(ArraySt); ArraySt:=nil; @@ -16778,52 +16770,12 @@ begin end; end; - if HasTypeInfo(El,AContext) then + if (not (AContext.PasElement is TPasMembersType)) // rtti of members is added separate + and HasTypeInfo(El,AContext) then begin - // module.$rtti.$DynArray("name",{...}) - if length(El.Ranges)>0 then - CallName:=GetBIName(pbifnRTTINewStaticArray) - else - CallName:=GetBIName(pbifnRTTINewDynArray); - Call:=CreateRTTINewType(El,CallName,false,AContext,Obj); + Call:=nil; try - ElTypeHi:=aResolver.ResolveAliasType(El.ElType,false); - ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi); - if length(El.Ranges)>0 then - begin - // static array - // dims: [dimsize1,dimsize2,...] - Prop:=Obj.Elements.AddElement; - Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_Dims)); - ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El)); - Prop.Expr:=ArrLit; - Arr:=El; - Index:=0; - repeat - RangeEl:=Arr.Ranges[Index]; - RgLen:=aResolver.GetRangeLength(RangeEl); - ArrLit.AddElement(CreateLiteralNumber(RangeEl,RgLen)); - inc(Index); - if Index=length(Arr.Ranges) then - begin - if ElTypeLo.ClassType<>TPasArrayType then - break; - Arr:=TPasArrayType(ElTypeLo); - if length(Arr.Ranges)=0 then - RaiseNotSupported(Arr,AContext,20170411222315,'static array of anonymous array'); - ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false); - ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi); - Index:=0; - end; - until false; - end; - // eltype: ref - if not SpecializeDelay then - begin - Prop:=Obj.Elements.AddElement; - Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_ElType)); - Prop.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El); - end; + Call:=CreateRTTIAnonymousArray(El,AContext); if Src<>nil then begin @@ -20132,6 +20084,7 @@ begin JSTypeInfo:=CreateTypeInfoRef(VarType,AContext,V); OptionsEl:=nil; + // Note: create JSTypeInfo first, it may raise an exception Call:=CreateCallExpression(V); try @@ -20477,6 +20430,80 @@ begin end; end; +function TPasToJSConverter.CreateRTTIAnonymousArray(El: TPasArrayType; + AContext: TConvertContext): TJSCallExpression; +var + Scope: TPas2JSArrayScope; + SpecializeDelay: Boolean; + CallName: String; + Call: TJSCallExpression; + Obj: TJSObjectLiteral; + aResolver: TPas2JSResolver; + ElTypeHi, ElTypeLo: TPasType; + Prop: TJSObjectLiteralElement; + ArrLit: TJSArrayLiteral; + Arr: TPasArrayType; + Index: Integer; + RangeEl: TPasExpr; + RgLen: TMaxPrecInt; +begin + Result:=nil; + aResolver:=AContext.Resolver; + + Scope:=El.CustomData as TPas2JSArrayScope; + SpecializeDelay:=(Scope<>nil) and (SpecializeNeedsDelay(El,AContext)); + + // module.$rtti.$DynArray("name",{...}) + if length(El.Ranges)>0 then + CallName:=GetBIName(pbifnRTTINewStaticArray) + else + CallName:=GetBIName(pbifnRTTINewDynArray); + Call:=CreateRTTINewType(El,CallName,false,AContext,Obj); + try + ElTypeHi:=aResolver.ResolveAliasType(El.ElType,false); + ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi); + if length(El.Ranges)>0 then + begin + // static array + // dims: [dimsize1,dimsize2,...] + Prop:=Obj.Elements.AddElement; + Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_Dims)); + ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El)); + Prop.Expr:=ArrLit; + Arr:=El; + Index:=0; + repeat + RangeEl:=Arr.Ranges[Index]; + RgLen:=aResolver.GetRangeLength(RangeEl); + ArrLit.AddElement(CreateLiteralNumber(RangeEl,RgLen)); + inc(Index); + if Index=length(Arr.Ranges) then + begin + if ElTypeLo.ClassType<>TPasArrayType then + break; + Arr:=TPasArrayType(ElTypeLo); + if length(Arr.Ranges)=0 then + RaiseNotSupported(Arr,AContext,20170411222315,'static array of anonymous array'); + ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false); + ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi); + Index:=0; + end; + until false; + end; + // eltype: ref + if not SpecializeDelay then + begin + Prop:=Obj.Elements.AddElement; + Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_ElType)); + Prop.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El); + end; + Result:=Call; + finally + if Result=nil then + Call.Free; + end; +end; + function TPasToJSConverter.CreateRTTIMembers(El: TPasMembersType; Src: TJSSourceElements; FuncContext: TFunctionContext; MembersSrc: TJSSourceElements; MembersFuncContext: TFunctionContext; @@ -20532,35 +20559,51 @@ begin Members:=El.Members; For i:=0 to Members.Count-1 do begin + NewEl:=nil; P:=TPasElement(Members[i]); C:=P.ClassType; - // check visibility - case mt of - mtClass: - if P.Visibility<>visPublished then continue; - mtInterface: ; // all members of an interface are published - mtRecord: - // a published record publishes all non private members - if P.Visibility in [visPrivate,visStrictPrivate] then - continue; - end; - if not IsElementUsed(P) then continue; - - NewEl:=nil; - if C=TPasVariable then - NewEl:=CreateRTTIMemberField(Members,i,MembersFuncContext) - else if C.InheritsFrom(TPasProcedure) then + writeln('AAA1 TPasToJSConverter.CreateRTTIMembers ',GetObjPath(P)); + if C.InheritsFrom(TPasType) and HasTypeInfo(TPasType(P),MembersFuncContext) then begin - if aResolver.GetProcTemplateTypes(TPasProcedure(P))<>nil then - continue; // parametrized functions cannot be published - NewEl:=CreateRTTIMemberMethod(Members,i,MembersFuncContext); + writeln('AAA2 TPasToJSConverter.CreateRTTIMembers ',GetObjPath(P)); + // published subtype + if aResolver.IsAnonymousElType(TPasType(P)) then + begin + // published anonymous eltype + writeln('AAA3 TPasToJSConverter.CreateRTTIMembers ',GetObjPath(P)); + if C.InheritsFrom(TPasArrayType) then + NewEl:=CreateRTTIAnonymousArray(TPasArrayType(P),MembersFuncContext); + end; end - else if C=TPasProperty then - NewEl:=CreateRTTIMemberProperty(Members,i,MembersFuncContext) - else if C.InheritsFrom(TPasType) - or (C=TPasAttributes) then else - DoError(20190105142236,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P); + begin + // check visibility + case mt of + mtClass: + if P.Visibility<>visPublished then continue; + mtInterface: ; // all members of an interface are published + mtRecord: + // a published record publishes all non private members + if P.Visibility in [visPrivate,visStrictPrivate] then + continue; + end; + if not IsElementUsed(P) then continue; + + if C=TPasVariable then + NewEl:=CreateRTTIMemberField(Members,i,MembersFuncContext) + else if C.InheritsFrom(TPasProcedure) then + begin + if aResolver.GetProcTemplateTypes(TPasProcedure(P))<>nil then + continue; // parametrized functions cannot be published + NewEl:=CreateRTTIMemberMethod(Members,i,MembersFuncContext); + end + else if C=TPasProperty then + NewEl:=CreateRTTIMemberProperty(Members,i,MembersFuncContext) + else if C.InheritsFrom(TPasType) + or (C=TPasAttributes) then + else + DoError(20190105142236,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P); + end; if NewEl=nil then continue; // e.g. abstract or external proc // add RTTI element diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 0c84f1e73d..2194b08311 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -829,6 +829,7 @@ type Procedure TestRTTI_Class_PropertyParams; Procedure TestRTTI_Class_OtherUnit_TypeAlias; Procedure TestRTTI_Class_OmitRTTI; + Procedure TestRTTI_Class_Field_AnonymousArrayOfSelfClass; Procedure TestRTTI_IndexModifier; Procedure TestRTTI_StoredModifier; Procedure TestRTTI_DefaultValue; @@ -29679,9 +29680,6 @@ begin CheckSource('TestRTTI_Class_Field', LinesToStr([ // statements 'rtl.createClass(this, "TObject", null, function () {', - ' $mod.$rtti.$DynArray("TObject.ArrB$a", {', - ' eltype: rtl.byte', - ' });', ' this.$init = function () {', ' this.FPropA = "";', ' this.VarLI = 0;', @@ -29713,6 +29711,9 @@ begin ' $r.addField("VarShI", rtl.shortint);', ' $r.addField("VarBy", rtl.byte);', ' $r.addField("VarExt", rtl.longint);', + ' $mod.$rtti.$DynArray("TObject.ArrB$a", {', + ' eltype: rtl.byte', + ' });', ' $r.addField("ArrA", $mod.$rtti["TObject.ArrB$a"]);', ' $r.addField("ArrB", $mod.$rtti["TObject.ArrB$a"]);', '});', @@ -29982,6 +29983,43 @@ begin ''])); end; +procedure TTestModule.TestRTTI_Class_Field_AnonymousArrayOfSelfClass; +begin + WithTypeInfo:=true; + StartUnit(true,[supTObject]); + Add([ + 'interface', + 'type', + ' {$M+1}', + ' TBird = class', + ' published', + ' Swarm: array of TBird;', + ' end;', + 'implementation', + '']); + ConvertUnit; + CheckSource('TestRTTI_Class_Field_AnonymousArrayOfSelfClass', + LinesToStr([ // statements + 'rtl.createClass(this, "TBird", pas.system.TObject, function () {', + ' this.$init = function () {', + ' pas.system.TObject.$init.call(this);', + ' this.Swarm = [];', + ' };', + ' this.$final = function () {', + ' this.Swarm = undefined;', + ' pas.system.TObject.$final.call(this);', + ' };', + ' var $r = this.$rtti;', + ' $mod.$rtti.$DynArray("TBird.Swarm$a", {', + ' eltype: $r', + ' });', + ' $r.addField("Swarm", $mod.$rtti["TBird.Swarm$a"]);', + '});', + '']), + LinesToStr([ // $mod.$main + ''])); +end; + procedure TTestModule.TestRTTI_IndexModifier; begin WithTypeInfo:=true; @@ -30747,9 +30785,6 @@ begin CheckSource('TestRTTI_Record', LinesToStr([ // statements 'rtl.recNewT(this, "TFloatRec", function () {', - ' $mod.$rtti.$DynArray("TFloatRec.d$a", {', - ' eltype: rtl.char', - ' });', ' this.$new = function () {', ' var r = Object.create(this);', ' r.c = [];', @@ -30765,6 +30800,9 @@ begin ' return this;', ' };', ' var $r = $mod.$rtti.$Record("TFloatRec", {});', + ' $mod.$rtti.$DynArray("TFloatRec.d$a", {', + ' eltype: rtl.char', + ' });', ' $r.addField("c", $mod.$rtti["TFloatRec.d$a"]);', ' $r.addField("d", $mod.$rtti["TFloatRec.d$a"]);', '});',