paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 17:29:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: allow reintroduce published method

Browse Source 
git-svn-id: trunk@42288 -
This commit is contained in:
Mattias Gaertner 2019-06-26 16:38:17 +00:00
parent c971b4639f
commit 9871196e8c
2 changed files with 52 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2806,7 +2806,10 @@ begin
else if C.InheritsFrom(TPasProcedure) then else if C.InheritsFrom(TPasProcedure) then
begin begin
if TPasProcedure(El).IsOverride then 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 // Note: external proc pollutes the name space
ProcScope:=TPasProcedureScope(El.CustomData); ProcScope:=TPasProcedureScope(El.CustomData);
if ProcScope.DeclarationProc<>nil then if ProcScope.DeclarationProc<>nil then

50
packages/pastojs/tests/tcmodules.pas
View File

@ -787,6 +787,7 @@ type
Procedure TestRTTI_DefaultValueRangeType; Procedure TestRTTI_DefaultValueRangeType;
Procedure TestRTTI_DefaultValueInherit; Procedure TestRTTI_DefaultValueInherit;
Procedure TestRTTI_OverrideMethod; Procedure TestRTTI_OverrideMethod;
Procedure TestRTTI_ReintroduceMethod;
Procedure TestRTTI_OverloadProperty; Procedure TestRTTI_OverloadProperty;
// ToDo: array argument // ToDo: array argument
Procedure TestRTTI_ClassForward; Procedure TestRTTI_ClassForward;
@ -27155,8 +27156,8 @@ begin
Add(' procedure Proc(Sender: tobject); virtual; abstract;'); Add(' procedure Proc(Sender: tobject); virtual; abstract;');
Add(' end;'); Add(' end;');
Add('begin'); Add('begin');
SetExpectedPasResolverError('Duplicate identifier "Proc" at test1.pp(6,19)', SetExpectedPasResolverError('Duplicate published method "Proc" at test1.pp(6,19)',
nDuplicateIdentifier); nDuplicatePublishedMethodXAtY);
ConvertProgram; ConvertProgram;
end; end;
@ -28039,6 +28040,51 @@ begin
''])); '']));
end; 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; procedure TTestModule.TestRTTI_OverloadProperty;
begin begin
Converter.Options:=Converter.Options-[coNoTypeInfo]; Converter.Options:=Converter.Options-[coNoTypeInfo];