فهرست منبع

* 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 -

Jonas Maebe 12 سال پیش
والد
کامیت
1ce93f7430
6فایلهای تغییر یافته به همراه96 افزوده شده و 1 حذف شده
  1. 2 0
      .gitattributes
  2. 18 1
      compiler/jvm/pjvm.pas
  3. 6 0
      tests/test/jvm/testall.bat
  4. 3 0
      tests/test/jvm/testall.sh
  5. 19 0
      tests/test/jvm/tjsetter.java
  6. 48 0
      tests/test/jvm/ujsetter.pp

+ 2 - 0
.gitattributes

@@ -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/tformalpara.pp svneol=native#text/plain
 tests/test/jvm/tint.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/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/tnestdynarr.pp svneol=native#text/plain
 tests/test/jvm/tnestedset.pp svneol=native#text/plain
 tests/test/jvm/tnestedset.pp svneol=native#text/plain
 tests/test/jvm/tnestproc.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/tw24089.pp svneol=native#text/plain
 tests/test/jvm/twith.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/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/jvm/unsupported.pp svneol=native#text/plain
 tests/test/lcpref.inc svneol=native#text/plain
 tests/test/lcpref.inc svneol=native#text/plain
 tests/test/library/testdll.pp svneol=native#text/plain
 tests/test/library/testdll.pp svneol=native#text/plain

+ 18 - 1
compiler/jvm/pjvm.pas

@@ -951,7 +951,24 @@ implementation
                             end;
                             end;
                           { otherwise we can't do anything, and
                           { otherwise we can't do anything, and
                             proc_add_definition will give an error }
                             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;
                 end;
                 end;
               { make the artificial getter/setter virtual so we can override it in
               { make the artificial getter/setter virtual so we can override it in

+ 6 - 0
tests/test/jvm/testall.bat

@@ -262,3 +262,9 @@ ppcjvm -O2 -g -B tw24089
 if %errorlevel% neq 0 exit /b %errorlevel%
 if %errorlevel% neq 0 exit /b %errorlevel%
 java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. -Sa tw24089
 java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. -Sa tw24089
 if %errorlevel% neq 0 exit /b %errorlevel%
 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%

+ 3 - 0
tests/test/jvm/testall.sh

@@ -146,4 +146,7 @@ $PPC -O2 -g -B -CTautogetterprefix=Get tprop4
 java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tprop4
 java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tprop4
 $PPC -O2 -g -B -Sa tw24089
 $PPC -O2 -g -B -Sa tw24089
 java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. 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
 
 

+ 19 - 0
tests/test/jvm/tjsetter.java

@@ -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);
+}
+
+}

+ 48 - 0
tests/test/jvm/ujsetter.pp

@@ -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.
+