diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 08e45a4f96..f852d24226 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -9925,6 +9925,13 @@ begin DotBin:=TBinaryExpr(Value); Value:=DotBin.right; end; + if (not (Value.CustomData is TResolvedReference)) + and (aResolver<>nil) + and (Value is TInlineSpecializeExpr) then + begin + // Value<>() + Value:=TInlineSpecializeExpr(Value).NameExpr; + end; if Value.CustomData is TResolvedReference then begin diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas index 2b4fc96db1..760d7fc91e 100644 --- a/packages/pastojs/tests/tcgenerics.pas +++ b/packages/pastojs/tests/tcgenerics.pas @@ -22,8 +22,8 @@ type Procedure TestGen_Class_EmptyMethod; Procedure TestGen_Class_TList; Procedure TestGen_ClassAncestor; - Procedure TestGen_TypeInfo; - // ToDo: TBird, TBird, TBird + Procedure TestGen_Class_TypeInfo; + Procedure TestGen_Class_TypeOverload; // ToDo TBird, TBird, TBird // ToDo: rename local const T // generic external class @@ -33,6 +33,7 @@ type Procedure TestGen_InlineSpec_Constructor; Procedure TestGen_CallUnitImplProc; Procedure TestGen_IntAssignTemplVar; + Procedure TestGen_TypeCastDotField; // ToDo: TBird(o).field:=3; // generic helper @@ -254,7 +255,7 @@ begin ''])); end; -procedure TTestGenerics.TestGen_TypeInfo; +procedure TTestGenerics.TestGen_Class_TypeInfo; begin Converter.Options:=Converter.Options-[coNoTypeInfo]; StartProgram(false); @@ -299,6 +300,39 @@ begin ''])); end; +procedure TTestGenerics.TestGen_Class_TypeOverload; +begin + exit;// ToDo + + StartProgram(false); + Add([ + '{$mode delphi}', + 'type', + ' TObject = class end;', + ' TBird = word;', + ' TBird = class', + ' m: T;', + ' end;', + ' TEagle = TBird;', + 'var', + ' b: TBird;', + ' e: TEagle;', + 'begin', + '']); + ConvertProgram; + CheckSource('TestGen_Class_TypeOverload', + LinesToStr([ // statements + 'rtl.createClass($mod, "TObject", null, function () {', + ' this.$init = function () {', + ' };', + ' this.$final = function () {', + ' };', + '});', + '']), + LinesToStr([ // $mod.$main + ''])); +end; + procedure TTestGenerics.TestGen_ExtClass_Array; begin StartProgram(false); @@ -493,6 +527,56 @@ begin ''])); end; +procedure TTestGenerics.TestGen_TypeCastDotField; +begin + StartProgram(false); + Add([ + 'type', + ' TObject = class end;', + ' generic TBird = class', + ' Field: T;', + ' procedure Fly;', + ' end;', + 'var', + ' o: TObject;', + ' b: specialize TBird;', + 'procedure TBird.Fly;', + 'begin', + ' specialize TBird(o).Field:=3;', + ' if 4=specialize TBird(o).Field then ;', + 'end;', + 'begin', + ' specialize TBird(o).Field:=5;', + ' if 6=specialize TBird(o).Field then ;', + '']); + ConvertProgram; + CheckSource('TestGen_TypeCastDotField', + LinesToStr([ // statements + 'rtl.createClass($mod, "TObject", null, function () {', + ' this.$init = function () {', + ' };', + ' this.$final = function () {', + ' };', + '});', + 'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {', + ' this.$init = function () {', + ' $mod.TObject.$init.call(this);', + ' this.Field = 0;', + ' };', + ' this.Fly = function () {', + ' $mod.o.Field = 3;', + ' if (4 === $mod.o.Field) ;', + ' };', + '});', + 'this.o = null;', + 'this.b = null;', + '']), + LinesToStr([ // $mod.$main + '$mod.o.Field = 5;', + 'if (6 === $mod.o.Field) ;', + ''])); +end; + Initialization RegisterTests([TTestGenerics]); end.