* when automatically generating an overriding getter/setter method (because

a property in a child class has a higher visibility than the getter/
    setter), ensure that we call the inherited method and not the method
    itself (causing a stack overflow due to infinite recursion)

git-svn-id: trunk@25223 -
This commit is contained in:
Jonas Maebe 2013-08-06 21:50:56 +00:00
parent a21a20d559
commit 1ce93f7430
6 changed files with 96 additions and 1 deletions

2
.gitattributes vendored
View File

@ -10634,6 +10634,7 @@ tests/test/jvm/testshort.pp svneol=native#text/plain
tests/test/jvm/tformalpara.pp svneol=native#text/plain
tests/test/jvm/tint.pp svneol=native#text/plain
tests/test/jvm/tintstr.pp svneol=native#text/plain
tests/test/jvm/tjsetter.java svneol=native#text/plain
tests/test/jvm/tnestdynarr.pp svneol=native#text/plain
tests/test/jvm/tnestedset.pp svneol=native#text/plain
tests/test/jvm/tnestproc.pp svneol=native#text/plain
@ -10677,6 +10678,7 @@ tests/test/jvm/tw22807.pp svneol=native#text/plain
tests/test/jvm/tw24089.pp svneol=native#text/plain
tests/test/jvm/twith.pp svneol=native#text/plain
tests/test/jvm/uenum.pp svneol=native#text/plain
tests/test/jvm/ujsetter.pp svneol=native#text/plain
tests/test/jvm/unsupported.pp svneol=native#text/plain
tests/test/lcpref.inc svneol=native#text/plain
tests/test/library/testdll.pp svneol=native#text/plain

View File

@ -951,7 +951,24 @@ implementation
end;
{ otherwise we can't do anything, and
proc_add_definition will give an error }
end
end;
{ add method with the correct visibility }
pd:=tprocdef(parentpd.getcopy);
{ get rid of the import name for inherited virtual class methods,
it has to be regenerated rather than amended }
if [po_classmethod,po_virtualmethod]<=pd.procoptions then
begin
stringdispose(pd.import_name);
exclude(pd.procoptions,po_has_importname);
end;
pd.visibility:=p.visibility;
pd.procoptions:=pd.procoptions+procoptions;
{ ignore this artificially added procdef when looking for overloads }
include(pd.procoptions,po_ignore_for_overload_resolution);
finish_copied_procdef(pd,parentpd.procsym.realname,obj.symtable,obj);
exclude(pd.procoptions,po_external);
pd.synthetickind:=tsk_anon_inherited;
exit;
end;
end;
{ make the artificial getter/setter virtual so we can override it in

View File

@ -262,3 +262,9 @@ ppcjvm -O2 -g -B tw24089
if %errorlevel% neq 0 exit /b %errorlevel%
java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. -Sa tw24089
if %errorlevel% neq 0 exit /b %errorlevel%
ppcjvm -O2 -g -B -CTautosetterprefix=Set ujsetter
if %errorlevel% neq 0 exit /b %errorlevel%
javac -encoding utf-8 -cp ..\..\..\rtl\units\jvm-java;. tjsetter.java
if %errorlevel% neq 0 exit /b %errorlevel%
java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. -Sa tjsetter
if %errorlevel% neq 0 exit /b %errorlevel%

View File

@ -146,4 +146,7 @@ $PPC -O2 -g -B -CTautogetterprefix=Get tprop4
java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tprop4
$PPC -O2 -g -B -Sa tw24089
java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tw24089
$PPC -O2 -g -B -Sa -CTautosetterprefix=Set ujsetter
javac -encoding utf-8 -cp ../../../rtl/units/$RTLDIR:. tjsetter.java
java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tjsetter

View File

@ -0,0 +1,19 @@
import org.freepascal.test.jsetter.*;
public class tjsetter {
public static void main(String[] args)
{
tjsetterchild c;
c = new tjsetterchild();
c.SetVal(2);
if (c.get() != 2)
java.lang.Runtime.getRuntime().exit(1);
c = new tjsetterchild2();
c.SetVal(2);
if (c.get() != 1)
java.lang.Runtime.getRuntime().exit(2);
}
}

View File

@ -0,0 +1,48 @@
unit ujsetter;
{$namespace org.freepascal.test.jsetter}
{$mode delphi}
interface
type
tjsetterbase = class
protected
fval: longint;
procedure SetVal(v: longint); virtual;
public
function get: longint;
end;
tjsetterchild = class(tjsetterbase)
public
property Val: longint read fval write SetVal;
end;
tjsetterchild2 = class(tjsetterchild)
protected
procedure SetVal(v: longint); override;
public
property Val: longint read fval write SetVal;
end;
implementation
function tjsetterbase.get: longint;
begin
result:=fval;
end;
procedure tjsetterbase.SetVal(v: longint);
begin
fval:=v;
end;
procedure tjsetterchild2.SetVal(v: longint);
begin
fval:=v-1;
end;
end.