diff --git a/compiler/packages/fcl-passrc/src/pasresolver.pp b/compiler/packages/fcl-passrc/src/pasresolver.pp index a580fe3..e76fb3c 100644 --- a/compiler/packages/fcl-passrc/src/pasresolver.pp +++ b/compiler/packages/fcl-passrc/src/pasresolver.pp @@ -2385,6 +2385,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; @@ -6233,15 +6234,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 @@ -29513,6 +29525,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/compiler/packages/pastojs/src/fppas2js.pp b/compiler/packages/pastojs/src/fppas2js.pp index 4d8f169..cddc38b 100644 --- a/compiler/packages/pastojs/src/fppas2js.pp +++ b/compiler/packages/pastojs/src/fppas2js.pp @@ -553,6 +553,7 @@ type pbifnArray_ConcatN, pbifnArray_Copy, pbifnArray_Equal, + pbifnArray_Insert, pbifnArray_Length, pbifnArray_Reference, pbifnArray_SetLength, @@ -738,6 +739,7 @@ const 'arrayConcatN', // rtl.arrayConcatN pbifnArray_ConcatN 'arrayCopy', // rtl.arrayCopy pbifnArray_Copy 'arrayEq', // rtl.arrayEq pbifnArray_Equal + 'arrayInsert', // rtl.arrayCopy pbifnArray_Insert 'length', // rtl.length pbifnArray_Length 'arrayRef', // rtl.arrayRef pbifnArray_Reference 'arraySetLength', // rtl.arraySetLength pbifnArray_SetLength @@ -2150,6 +2152,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; @@ -14328,6 +14331,8 @@ end; function TPasToJSConverter.ConvertBuiltIn_CopyArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; +// convert copy(Arr,Start,Count) +// -> rtl.arrayCopy(type,Arr,Start,Count) var Param: TPasExpr; ParamResolved, ElTypeResolved: TPasResolverResult; @@ -14396,25 +14401,32 @@ end; function TPasToJSConverter.ConvertBuiltIn_InsertArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; -// procedure insert(item,var array,const position) -// -> array.splice(position,0,item); +// procedure insert(item,var AnArray,const position) +// -> AnArray=rtl.arrayInsert(item,AnArray,position); var - ArrEl: TJSElement; Call: TJSCallExpression; + AssignSt: TJSSimpleAssignStatement; begin Result:=nil; - Call:=nil; + AssignSt:=nil; try + // AnArray= + AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); + AssignSt.LHS:=ConvertExpression(El.Params[1],AContext); Call:=CreateCallExpression(El); - ArrEl:=ConvertExpression(El.Params[1],AContext); - Call.Expr:=CreateDotNameExpr(El,ArrEl,'splice'); - Call.AddArg(ConvertExpression(El.Params[2],AContext)); - Call.AddArg(CreateLiteralNumber(El,0)); + AssignSt.Expr:=Call; + // rtl.arrayInsert + Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnArray_Insert)]); + // param: item Call.AddArg(ConvertExpression(El.Params[0],AContext)); - Result:=Call; + // param: AnArray + Call.AddArg(ConvertExpression(El.Params[1],AContext)); + // param: position + Call.AddArg(ConvertExpression(El.Params[2],AContext)); + Result:=AssignSt; finally if Result=nil then - Call.Free; + AssignSt.Free; end; end; @@ -16567,19 +16579,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; @@ -16602,9 +16608,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 @@ -16702,7 +16705,7 @@ begin else Result:=ArraySt; - // store precompiled enum type in proc + // store precompiled array type in proc StorePrecompiledJS(ArraySt); ArraySt:=nil; @@ -16714,52 +16717,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 @@ -20058,6 +20021,7 @@ begin JSTypeInfo:=CreateTypeInfoRef(VarType,AContext,V); OptionsEl:=nil; + // Note: create JSTypeInfo first, it may raise an exception Call:=CreateCallExpression(V); try @@ -20403,6 +20367,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; @@ -20458,35 +20496,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/compiler/packages/pastojs/tests/tcgenerics.pas b/compiler/packages/pastojs/tests/tcgenerics.pas index e7a2f72..0bf0242 100644 --- a/compiler/packages/pastojs/tests/tcgenerics.pas +++ b/compiler/packages/pastojs/tests/tcgenerics.pas @@ -486,7 +486,7 @@ begin ' };', ' this.Alter = function (w) {', ' this.FItems = rtl.arraySetLength(this.FItems, 0, rtl.length(this.FItems) + 1);', - ' this.FItems.splice(2, 0, w);', + ' this.FItems = rtl.arrayInsert(w, this.FItems, 2);', ' this.FItems.splice(2, 3);', ' };', '}, "TList");', diff --git a/compiler/packages/pastojs/tests/tcmodules.pas b/compiler/packages/pastojs/tests/tcmodules.pas index 901cf5a..4256833 100644 --- a/compiler/packages/pastojs/tests/tcmodules.pas +++ b/compiler/packages/pastojs/tests/tcmodules.pas @@ -824,6 +824,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; @@ -10486,13 +10487,13 @@ begin 'this.ArrArrInt = [];', '']), LinesToStr([ // $mod.$main - '$mod.ArrInt.splice(2, 0, 1);', - '$mod.ArrInt.splice(4, 0, $mod.ArrInt[3]);', - '$mod.ArrRec.splice(6, 0, $mod.ArrRec[5]);', - '$mod.ArrSet.splice(7, 0, $mod.ArrSet[7]);', - '$mod.ArrJSValue.splice(9, 0, $mod.ArrJSValue[8]);', - '$mod.ArrJSValue.splice(11, 0, 10);', - '$mod.ArrArrInt.splice(22, 0, [23]);', + '$mod.ArrInt = rtl.arrayInsert(1, $mod.ArrInt, 2);', + '$mod.ArrInt = rtl.arrayInsert($mod.ArrInt[3], $mod.ArrInt, 4);', + '$mod.ArrRec = rtl.arrayInsert($mod.ArrRec[5], $mod.ArrRec, 6);', + '$mod.ArrSet = rtl.arrayInsert($mod.ArrSet[7], $mod.ArrSet, 7);', + '$mod.ArrJSValue = rtl.arrayInsert($mod.ArrJSValue[8], $mod.ArrJSValue, 9);', + '$mod.ArrJSValue = rtl.arrayInsert(10, $mod.ArrJSValue, 11);', + '$mod.ArrArrInt = rtl.arrayInsert([23], $mod.ArrArrInt, 22);', '$mod.ArrInt.splice(12, 13);', '$mod.ArrRec.splice(14, 15);', '$mod.ArrSet.splice(17, 18);', @@ -29632,9 +29633,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;', @@ -29666,6 +29664,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"]);', '});', @@ -29935,6 +29936,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; @@ -30700,9 +30738,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 = [];', @@ -30718,6 +30753,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"]);', '});', diff --git a/compiler/utils/pas2js/dist/rtl.js b/compiler/utils/pas2js/dist/rtl.js index a8fd48e..333efd2 100644 --- a/compiler/utils/pas2js/dist/rtl.js +++ b/compiler/utils/pas2js/dist/rtl.js @@ -1040,6 +1040,14 @@ var rtl = { } }, + arrayInsert: function(item, arr, index){ + if (arr){ + return arr.splice(index,0,item); + } else { + return [item]; + } + }, + setCharAt: function(s,index,c){ return s.substr(0,index)+c+s.substr(index+1); },