paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-05 19:27:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed published field with anonymous array

Browse Source
This commit is contained in:
mattias 2021-03-28 21:42:03 +00:00
parent 0fd205a621
commit 539ce2a5c8
5 changed files with 250 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -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

236
compiler/packages/pastojs/src/fppas2js.pp
View File

@ -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

2
compiler/packages/pastojs/tests/tcgenerics.pas
View File

@ -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<System.Word>");',

64
compiler/packages/pastojs/tests/tcmodules.pas
View File

@ -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"]);',
'});',

8
compiler/utils/pas2js/dist/rtl.js vendored
View File

@ -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);
},