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

pastojs: anonymous vartype

Browse Source
This commit is contained in:
mattias 2021-02-23 01:37:44 +00:00
parent a3346a1c63
commit 4953371b04
4 changed files with 179 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6226,16 +6226,43 @@ begin
end;
procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
procedure InsertInFront(NewParent: TPasElement; List: TFPList
{$IFDEF CheckPasTreeRefCount};const aId: string{$ENDIF});
var
i: Integer;
p: TPasElement;
begin
p:=El.Parent;
if NewParent=p.Parent then
begin
// e.g. a:array of longint; -> insert a$a in front of a
i:=List.Count-1;
while (i>=0) and (List[i]<>Pointer(p)) do
dec(i);
if i<0 then
List.Add(El)
else
List.Insert(i,El);
end
else
begin
List.Add(El);
end;
El.AddRef{$IFDEF CheckPasTreeRefCount}aID{$ENDIF};
El.Parent:=NewParent;
end;
var
Decl: TPasDeclarations;
EnumScope: TPasEnumTypeScope;
p: TPasElement;
MembersType: TPasMembersType;
begin
EmitTypeHints(Parent,El);
if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
if Parent.Name='' then
RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
if not (Parent.Parent is TPasDeclarations) then
RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
if El.Parent<>Parent then
RaiseNotYetImplemented(20190215085011,Parent);
// give anonymous sub type a name
@ -6243,11 +6270,27 @@ begin
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
{$ENDIF}
Decl:=TPasDeclarations(Parent.Parent);
Decl.Declarations.Add(El);
El.AddRef{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Declarations'){$ENDIF};
El.Parent:=Decl;
Decl.Types.Add(El);
p:=Parent.Parent;
repeat
if p is TPasDeclarations then
begin
Decl:=TPasDeclarations(p);
InsertInFront(Decl,Decl.Declarations{$IFDEF CheckPasTreeRefCount},'TPasDeclarations.Declarations'{$ENDIF});
Decl.Types.Add(El);
break;
end
else if p is TPasMembersType then
begin
MembersType:=TPasMembersType(p);
InsertInFront(MembersType,MembersType.Members{$IFDEF CheckPasTreeRefCount},'TPasMembersType.Members'{$ENDIF});
break;
end
else
p:=p.Parent;
if p=nil then
RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
until false;
if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
begin
// anonymous enumtype
@ -7814,6 +7857,8 @@ begin
CheckUseAsType(El.VarType,20190123095916,El);
if El.Expr<>nil then
CheckAssignCompatibility(El,El.Expr,true);
if El.VarType.Parent=El then
FinishSubElementType(El,El.VarType);
end
else if El.Expr<>nil then
begin
@ -12194,12 +12239,17 @@ begin
{$ENDIF}
if not (TopScope is TPasIdentifierScope) then
RaiseInvalidScopeForElement(20160929205732,El);
AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
if El.Name<>'' then
AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple)
else
begin
// anonymous enumtype
end;
EnumScope:=TPasEnumTypeScope(PushScope(El,TPasEnumTypeScope));
// add canonical set
if El.Parent is TPasSetType then
begin
// anonymous enumtype, e.g. "set of ()"
// set of anonymous enumtype, e.g. "set of ()"
CanonicalSet:=TPasSetType(El.Parent);
CanonicalSet.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
end
@ -20963,8 +21013,8 @@ begin
writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
{AllowWriteln-}
{$ENDIF}
if not IsValidIdent(CurName) then
RaiseNotYetImplemented(20170328000033,ErrorEl,CurName);
// Note: CurName can be a non Pascal name, when specializing an autogenerated anonymous type
//if not IsValidIdent(CurName) then ;
if CurScopeEl<>nil then
begin
NeedPop:=true;

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

@ -2149,7 +2149,6 @@ type
AContext: TConvertContext): TJSElement; virtual;
Function CreateRTTIMemberProperty(Members: TFPList; Index: integer;
AContext: TConvertContext): TJSElement; virtual;
Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext); virtual;
Function CreateRTTIMembers(El: TPasMembersType; Src: TJSSourceElements;
FuncContext: TFunctionContext; MembersSrc: TJSSourceElements;
MembersFuncContext: TFunctionContext; RTTIExpr: TJSElement;
@ -19902,23 +19901,6 @@ var
ObjLit.Expr:=JS;
end;
function VarTypeInfoAlreadyCreated(VarType: TPasType): boolean;
var
i: Integer;
PrevMember: TPasElement;
begin
i:=Index-1;
while (i>=0) do
begin
PrevMember:=TPasElement(Members[i]);
if (PrevMember is TPasVariable) and (TPasVariable(PrevMember).VarType=VarType)
and IsElementUsed(PrevMember) then
exit(true);
dec(i);
end;
Result:=false;
end;
var
JSTypeInfo: TJSElement;
aName: String;
@ -19931,10 +19913,7 @@ begin
V:=TPasVariable(Members[Index]);
VarType:=V.VarType;
if (VarType<>nil) and (VarType.Name='') then
begin
if not VarTypeInfoAlreadyCreated(VarType) then
CreateRTTIAnonymous(VarType,AContext);
end;
RaiseNotSupported(VarType,AContext,20210223022919);
JSTypeInfo:=CreateTypeInfoRef(VarType,AContext,V);
OptionsEl:=nil;
@ -20252,37 +20231,6 @@ begin
end;
end;
procedure TPasToJSConverter.CreateRTTIAnonymous(El: TPasType;
AContext: TConvertContext);
// if El has any anonymous types, create the RTTI
var
C: TClass;
JS: TJSElement;
GlobalCtx: TFunctionContext;
Src: TJSSourceElements;
begin
if El.Name<>'' then
RaiseNotSupported(El,AContext,20170905162324,'inconsistency');
GlobalCtx:=AContext.GetGlobalFunc;
if GlobalCtx=nil then
RaiseNotSupported(El,AContext,20181229130835);
if not (GlobalCtx.JSElement is TJSSourceElements) then
begin
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.CreateRTTIAnonymous GlobalCtx=',GetObjName(GlobalCtx),' JSElement=',GetObjName(GlobalCtx.JSElement));
{$ENDIF}
RaiseNotSupported(El,AContext,20181229130926);
end;
Src:=TJSSourceElements(GlobalCtx.JSElement);
C:=El.ClassType;
if C=TPasArrayType then
begin
JS:=ConvertArrayType(TPasArrayType(El),AContext);
AddToSourceElements(Src,JS);
end;
end;
function TPasToJSConverter.CreateRTTIMembers(El: TPasMembersType;
Src: TJSSourceElements; FuncContext: TFunctionContext;
MembersSrc: TJSSourceElements; MembersFuncContext: TFunctionContext;

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

@ -256,6 +256,11 @@ begin
' this.x = $impl.TBird.$new();',
' this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
' };',
' this.a$a$clone = function (a) {',
' var r = [];',
' for (var i = 0; i < 2; i++) r.push($impl.TBird.$clone(a[i]));',
' return r;',
' };',
' this.$eq = function (b) {',
' return true;',
' };',
@ -1169,6 +1174,11 @@ begin
' this.x = $impl.TBird.$new();',
' this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
' };',
' this.a$a$clone = function (a) {',
' var r = [];',
' for (var i = 0; i < 2; i++) r.push($impl.TBird.$clone(a[i]));',
' return r;',
' };',
' }, "TAnt<UnitA.TBird>");',
' $mod.$implcode = function () {',
' rtl.recNewT($impl, "TBird", function () {',

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

@ -375,6 +375,7 @@ type
Procedure TestEnum_ForIn;
Procedure TestEnum_ScopedNumber;
Procedure TestEnum_InFunction;
Procedure TestEnum_Name_Anonymous_Unit;
Procedure TestSet_Enum;
Procedure TestSet_Operators;
Procedure TestSet_Operator_In;
@ -517,6 +518,7 @@ type
Procedure TestClasS_CallInheritedConstructor;
Procedure TestClass_ClassVar_Assign;
Procedure TestClass_CallClassMethod;
Procedure TestClass_CallClassMethodStatic; // ToDo
Procedure TestClass_Property;
Procedure TestClass_Property_ClassMethod;
Procedure TestClass_Property_Indexed;
@ -5902,6 +5904,34 @@ begin
'']));
end;
procedure TTestModule.TestEnum_Name_Anonymous_Unit;
begin
StartUnit(true);
Add([
'interface',
'var color: (red, green);',
'implementation',
'initialization',
' color:=green;',
'']);
ConvertUnit;
CheckSource('TestEnum_Name_Anonymous_Unit',
LinesToStr([
'this.color$a = {',
' "0": "red",',
' red: 0,',
' "1": "green",',
' green: 1',
'};',
'this.color = 0;',
'']),
LinesToStr([ // this.$init
'$mod.color = $mod.color$a.green;',
'']),
LinesToStr([ // implementation
'']) );
end;
procedure TTestModule.TestSet_Enum;
begin
StartProgram(false);
@ -9408,7 +9438,7 @@ begin
' arr2[6,3]:=i;',
' i:=arr2[5,2];',
' arr2:=arr2;',// clone multi dim static array
//' arr3:=arr3;',// clone anonymous multi dim static array
' arr3:=arr3;',// clone anonymous multi dim static array
'']);
ConvertProgram;
CheckSource('TestArray_StaticMultiDim',
@ -9420,6 +9450,11 @@ begin
'};',
'this.Arr = rtl.arraySetLength(null, 0, 3);',
'this.Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
'this.Arr3$a$clone = function (a) {',
' var r = [];',
' for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
' return r;',
'};',
'this.Arr3 = [[11, 12, 13], [21, 22, 23]];',
'this.i = 0;'
]),
@ -9436,6 +9471,7 @@ begin
'$mod.Arr2[1][2] = $mod.i;',
'$mod.i = $mod.Arr2[0][1];',
'$mod.Arr2 = $mod.TArrayArrayInt$clone($mod.Arr2);',
'$mod.Arr3 = $mod.Arr3$a$clone($mod.Arr3);',
'']));
end;
@ -9457,6 +9493,7 @@ begin
'begin',
' arr2[5]:=arr;',
' arr2:=arr2;',// clone multi dim static array
' arr3:=arr3;',// clone multi dim anonymous static array
'end;',
'begin',
'']);
@ -9470,6 +9507,11 @@ begin
' for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
' return r;',
'};',
'var Arr3$a$clone = function (a) {',
' var r = [];',
' for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
' return r;',
'};',
'this.DoIt = function () {',
' var Arr = rtl.arraySetLength(null, 0, 3);',
' var Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
@ -9477,6 +9519,7 @@ begin
' var i = 0;',
' Arr2[0] = Arr.slice(0);',
' Arr2 = TArrayArrayInt$1$clone(Arr2);',
' Arr3 = Arr3$a$clone(Arr3);',
'};',
'']),
LinesToStr([ // $mod.$main
@ -11110,26 +11153,28 @@ end;
procedure TTestModule.TestRecord_Assign;
begin
StartProgram(false);
Add('type');
Add(' TEnum = (red,green);');
Add(' TEnums = set of TEnum;');
Add(' TSmallRec = record');
Add(' N: longint;');
Add(' end;');
Add(' TBigRec = record');
Add(' Int: longint;');
Add(' D: double;');
Add(' Arr: array of longint;');
Add(' Arr2: array[1..2] of longint;');
Add(' Small: TSmallRec;');
Add(' Enums: TEnums;');
Add(' end;');
Add('var');
Add(' r, s: TBigRec;');
Add('begin');
Add(' r:=s;');
Add(' r:=default(TBigRec);');
Add(' r:=default(s);');
Add([
'type',
' TEnum = (red,green);',
' TEnums = set of TEnum;',
' TSmallRec = record',
' N: longint;',
' end;',
' TBigRec = record',
' Int: longint;',
' D: double;',
' Arr: array of longint;',
' Arr2: array[1..2] of longint;',
' Small: TSmallRec;',
' Enums: TEnums;',
' end;',
'var',
' r, s: TBigRec;',
'begin',
' r:=s;',
' r:=default(TBigRec);',
' r:=default(s);',
'']);
ConvertProgram;
CheckSource('TestRecord_Assign',
LinesToStr([ // statements
@ -13427,6 +13472,41 @@ begin
'']));
end;
procedure TTestModule.TestClass_CallClassMethodStatic;
begin
exit;
StartProgram(false);
Add([
'type',
' TObject = class',
' public',
' class var w: word;',
' class function GetIt: tobject; static;',
' end;',
'class function tobject.getit: tobject;',
'begin',
' Result.GetIt;',
' w:=3;',
' w:=w+3;',
'end;',
'var Obj: tobject;',
'begin',
' obj.GetIt;',
' obj.w:=obj.w+4;',
' with obj do begin',
' w:=w-5;',
' end;',
'']);
ConvertProgram;
CheckSource('TestClass_CallClassMethodStatic',
LinesToStr([ // statements
'this.Obj = null;'
]),
LinesToStr([ // $mod.$main
'']));
end;
procedure TTestModule.TestClass_Property;
begin
StartProgram(false);
@ -29443,6 +29523,9 @@ 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;',
@ -29474,9 +29557,6 @@ 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"]);',
'});',
@ -30511,6 +30591,9 @@ 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 = [];',
@ -30525,9 +30608,6 @@ begin
' this.d = rtl.arrayRef(s.d);',
' return this;',
' };',
' $mod.$rtti.$DynArray("TFloatRec.d$a", {',
' eltype: rtl.char',
' });',
' var $r = $mod.$rtti.$Record("TFloatRec", {});',
' $r.addField("c", $mod.$rtti["TFloatRec.d$a"]);',
' $r.addField("d", $mod.$rtti["TFloatRec.d$a"]);',