diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 54f9110705..331baee4c2 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -6229,16 +6229,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 @@ -6246,11 +6273,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 @@ -7819,6 +7862,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 @@ -12278,12 +12323,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 @@ -21051,8 +21101,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; diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index f60b74be61..0eb5feb3f0 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -2159,7 +2159,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; @@ -19965,23 +19964,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; @@ -19994,10 +19976,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; @@ -20315,37 +20294,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; diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas index 8e7dd8b6ec..317e4fd758 100644 --- a/packages/pastojs/tests/tcgenerics.pas +++ b/packages/pastojs/tests/tcgenerics.pas @@ -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");', ' $mod.$implcode = function () {', ' rtl.recNewT($impl, "TBird", function () {', diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index ca46edd38b..60235b39b2 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -380,6 +380,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; @@ -522,6 +523,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; @@ -5949,6 +5951,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); @@ -9455,7 +9485,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', @@ -9467,6 +9497,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;' ]), @@ -9483,6 +9518,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; @@ -9504,6 +9540,7 @@ begin 'begin', ' arr2[5]:=arr;', ' arr2:=arr2;',// clone multi dim static array + ' arr3:=arr3;',// clone multi dim anonymous static array 'end;', 'begin', '']); @@ -9517,6 +9554,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);', @@ -9524,6 +9566,7 @@ begin ' var i = 0;', ' Arr2[0] = Arr.slice(0);', ' Arr2 = TArrayArrayInt$1$clone(Arr2);', + ' Arr3 = Arr3$a$clone(Arr3);', '};', '']), LinesToStr([ // $mod.$main @@ -11157,26 +11200,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 @@ -13474,6 +13519,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); @@ -29490,6 +29570,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;', @@ -29521,9 +29604,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"]);', '});', @@ -30558,6 +30638,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 = [];', @@ -30572,9 +30655,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"]);',