paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-04 18:50:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: delay RTTI init of dynamic and static array specializations

Browse Source 
git-svn-id: trunk@46749 -
(cherry picked from commit 05edd719d5)
This commit is contained in:
Mattias Gaertner 2020-09-02 14:03:26 +00:00 committed by Florian Klämpfl
parent e361a90aa8
commit 3512397408
3 changed files with 131 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
packages/fcl-passrc/src/pparser.pp
View File

@ -14,26 +14,10 @@
**********************************************************************}
{$mode objfpc}
{$h+}
{$ifdef fpc}
{$define UsePChar}
{$define UseAnsiStrings}
{$define HasStreams}
{$IF FPC_FULLVERSION<30101}
{$define EmulateArrayInsert}
{$endif}
{$define HasFS}
{$endif}
{$IFDEF NODEJS}
{$define HasFS}
{$ENDIF}
unit PParser;
{$i fcl-passrc.inc}
interface
uses

76
packages/pastojs/src/fppas2js.pp
View File

@ -15531,6 +15531,9 @@ var
end;
var
aResolver: TPas2JSResolver;
Scope: TPasArrayScope;
SpecializeNeedsDelay: Boolean;
AssignSt: TJSSimpleAssignStatement;
CallName, ArrName: String;
Obj: TJSObjectLiteral;
@ -15538,7 +15541,7 @@ var
ArrLit: TJSArrayLiteral;
Arr: TPasArrayType;
Index: Integer;
ElType: TPasType;
ElTypeHi, ElTypeLo: TPasType;
RangeEl: TPasExpr;
Call: TJSCallExpression;
RgLen, RangeEnd: TMaxPrecInt;
@ -15552,7 +15555,6 @@ var
BracketEx: TJSBracketMemberExpression;
ArraySt, CloneEl: TJSElement;
ReturnSt: TJSReturnStatement;
aResolver: TPas2JSResolver;
begin
Result:=nil;
aResolver:=AContext.Resolver;
@ -15564,6 +15566,10 @@ begin
writeln('TPasToJSConverter.ConvertArrayType ',GetObjName(El));
{$ENDIF}
Scope:=El.CustomData as TPasArrayScope;
SpecializeNeedsDelay:=(Scope<>nil)
and (aResolver.SpecializeNeedsDelay(Scope.SpecializedFromItem)<>nil);
ProcScope:=nil;
Src:=nil;
if AContext.JSElement is TJSSourceElements then
@ -15615,20 +15621,20 @@ begin
BracketEx.MExpr:=CreatePrimitiveDotExpr(CloneArrName,El);
BracketEx.Name:=CreatePrimitiveDotExpr(CloneRunName,El);
// clone a[i]
ElType:=aResolver.ResolveAliasType(El.ElType);
ElTypeLo:=aResolver.ResolveAliasType(El.ElType);
CloneEl:=nil;
if ElType is TPasArrayType then
if ElTypeLo is TPasArrayType then
begin
if length(TPasArrayType(ElType).Ranges)=0 then
RaiseNotSupported(El,AContext,20180218223414,GetObjName(ElType));
CloneEl:=CreateCloneStaticArray(El,TPasArrayType(ElType),BracketEx,AContext);
if length(TPasArrayType(ElTypeLo).Ranges)=0 then
RaiseNotSupported(El,AContext,20180218223414,GetObjName(ElTypeLo));
CloneEl:=CreateCloneStaticArray(El,TPasArrayType(ElTypeLo),BracketEx,AContext);
end
else if ElType is TPasRecordType then
CloneEl:=CreateRecordCallClone(El,TPasRecordType(ElType),BracketEx,AContext)
else if ElType is TPasSetType then
else if ElTypeLo is TPasRecordType then
CloneEl:=CreateRecordCallClone(El,TPasRecordType(ElTypeLo),BracketEx,AContext)
else if ElTypeLo is TPasSetType then
CloneEl:=CreateReferencedSet(El,BracketEx)
else
RaiseNotSupported(El,AContext,20180218223618,GetObjName(ElType));
RaiseNotSupported(El,AContext,20180218223618,GetObjName(ElTypeLo));
Call.AddArg(CloneEl);
BracketEx:=nil;
// return r;
@ -15679,7 +15685,8 @@ begin
CallName:=GetBIName(pbifnRTTINewDynArray);
Call:=CreateRTTINewType(El,CallName,false,AContext,Obj);
try
ElType:=aResolver.ResolveAliasType(El.ElType);
ElTypeHi:=aResolver.ResolveAliasType(El.ElType,false);
ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
if length(El.Ranges)>0 then
begin
// static array
@ -15697,20 +15704,24 @@ begin
inc(Index);
if Index=length(Arr.Ranges) then
begin
if ElType.ClassType<>TPasArrayType then
if ElTypeLo.ClassType<>TPasArrayType then
break;
Arr:=TPasArrayType(ElType);
Arr:=TPasArrayType(ElTypeLo);
if length(Arr.Ranges)=0 then
RaiseNotSupported(Arr,AContext,20170411222315,'static array of anonymous array');
ElType:=aResolver.ResolveAliasType(Arr.ElType);
ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
Index:=0;
end;
until false;
end;
// eltype: ref
Prop:=Obj.Elements.AddElement;
Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_ElType));
Prop.Expr:=CreateTypeInfoRef(ElType,AContext,El);
if not SpecializeNeedsDelay then
begin
Prop:=Obj.Elements.AddElement;
Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_ElType));
Prop.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El);
end;
if Src<>nil then
begin
@ -16729,6 +16740,10 @@ var
Path: String;
Call: TJSCallExpression;
DotExpr: TJSDotMemberExpression;
AssignSt: TJSSimpleAssignStatement;
Arr: TPasArrayType;
ElTypeHi, ElTypeLo: TPasType;
aResolver: TPas2JSResolver;
begin
if not IsElementUsed(El) then exit;
C:=El.ClassType;
@ -16753,6 +16768,31 @@ begin
Call.Expr:=DotExpr;
AddToSourceElements(Src,Call);
end
else if (C=TPasArrayType) then
begin
// pas.unitname.$rtti.TArr.eltype=$mod.$rtti.TBird;
aResolver:=AContext.Resolver;
Arr:=TPasArrayType(El);
ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
if length(Arr.Ranges)>0 then
begin
// static array
while ElTypeLo.ClassType=TPasArrayType do
begin
Arr:=TPasArrayType(ElTypeLo);
if length(Arr.Ranges)=0 then
RaiseNotSupported(Arr,AContext,20200902155418,'static array of anonymous array');
ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
end;
end;
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
AssignSt.LHS:=CreateDotNameExpr(El,CreateTypeInfoRef(El,AContext,El),
TJSString(GetBIName(pbivnRTTIArray_ElType)));
AssignSt.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El);
AddToSourceElements(Src,AssignSt);
end
else
RaiseNotSupported(El,AContext,20200831115251);
end;

72
packages/pastojs/tests/tcgenerics.pas
View File

@ -76,7 +76,7 @@ type
procedure TestGenMethod_ObjFPC;
// generic array
// procedure TestGen_ArrayOfUnitImplRec; ToDo dynamic + static + RTTI
procedure TestGen_ArrayOfUnitImplRec;
// generic procedure type
procedure TestGen_ProcType_ParamUnitImpl;
@ -1974,6 +1974,76 @@ begin
'']));
end;
procedure TTestGenerics.TestGen_ArrayOfUnitImplRec;
begin
WithTypeInfo:=true;
StartProgram(true,[supTObject]);
AddModuleWithIntfImplSrc('UnitA.pas',
LinesToStr([
'type',
' generic TDyn<T> = array of T;',
' generic TStatic<T> = array[1..2] of T;',
'']),
LinesToStr([
'type',
' TBird = record',
' b: word;',
' end;',
'var',
' d: specialize TDyn<TBird>;',
' s: specialize TStatic<TBird>;',
'begin',
' d[0].b:=s[1].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.$DynArray("TDyn$G1", {});',
' this.TStatic$G1$clone = function (a) {',
' var r = [];',
' for (var i = 0; i < 2; i++) r.push($impl.TBird.$clone(a[i]));',
' return r;',
' };',
' $mod.$rtti.$StaticArray("TStatic$G1", {',
' dims: [2]',
' });',
' $mod.$init = function () {',
' $impl.d[0].b = $impl.s[0].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.d = [];',
' $impl.s = rtl.arraySetLength(null, $impl.TBird, 2);',
'});']));
CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
LinesToStr([ // statements
'pas.UnitA.$rtti["TDyn$G1"].eltype = pas.UnitA.$rtti["TBird"];',
'pas.UnitA.$rtti["TStatic$G1"].eltype = pas.UnitA.$rtti["TBird"];',
'']),
LinesToStr([ // $mod.$main
'']));
end;
procedure TTestGenerics.TestGen_ProcType_ParamUnitImpl;
begin
WithTypeInfo:=true;