Browse Source

pastojs: allow reintroduce published method

mattias 6 years ago
parent
commit
042773cea9

+ 4 - 1
compiler/packages/pastojs/src/fppas2js.pp

@@ -2721,7 +2721,10 @@ begin
   else if C.InheritsFrom(TPasProcedure) then
     begin
     if TPasProcedure(El).IsOverride then
-      exit(true);
+      exit(true); // using name of overridden
+    if El.Visibility=visPublished then
+      exit(false);
+
     // Note: external proc pollutes the name space
     ProcScope:=TPasProcedureScope(El.CustomData);
     if ProcScope.DeclarationProc<>nil then

+ 48 - 2
compiler/packages/pastojs/tests/tcmodules.pas

@@ -782,6 +782,7 @@ type
     Procedure TestRTTI_DefaultValueRangeType;
     Procedure TestRTTI_DefaultValueInherit;
     Procedure TestRTTI_OverrideMethod;
+    Procedure TestRTTI_ReintroduceMethod;
     Procedure TestRTTI_OverloadProperty;
     // ToDo: array argument
     Procedure TestRTTI_ClassForward;
@@ -26745,8 +26746,8 @@ begin
   Add('    procedure Proc(Sender: tobject); virtual; abstract;');
   Add('  end;');
   Add('begin');
-  SetExpectedPasResolverError('Duplicate identifier "Proc" at test1.pp(6,19)',
-    nDuplicateIdentifier);
+  SetExpectedPasResolverError('Duplicate published method "Proc" at test1.pp(6,19)',
+    nDuplicatePublishedMethodXAtY);
   ConvertProgram;
 end;
 
@@ -27629,6 +27630,51 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestRTTI_ReintroduceMethod;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  published',
+  '    procedure DoIt;',
+  '  end;',
+  '  TSky = class',
+  '  published',
+  '    procedure DoIt; reintroduce;',
+  '  end;',
+  'procedure TObject.DoIt; begin end;',
+  'procedure TSky.DoIt;',
+  'begin',
+  '  inherited DoIt;',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestRTTI_ReintroduceMethod',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addMethod("DoIt", 0, null);',
+    '});',
+    'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
+    '  this.DoIt = function () {',
+    '    $mod.TObject.DoIt.call(this);',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addMethod("DoIt", 0, null);',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestRTTI_OverloadProperty;
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];