From 1ad834f5f9b8724903073ce164f0d68d6d627eca Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sat, 20 Aug 2011 08:16:56 +0000
Subject: [PATCH]   * in case a property uses a getter/setter with lower
 visibility than the     property, generate a wrapper with the same visibility
 as the property     that calls through to the original getter/setter (JVM
 target only:     ensures that the JVM verifier doesn't complain about calling
 methods     that are not visible to the current class when using such
 properties     from other units/classes)

git-svn-id: branches/jvmbackend@18632 -
---
 compiler/pdecvar.pas  | 32 ++++++++++++++++++++++++++++++--
 compiler/pjvm.pas     | 37 +++++++++++++++++++++++++++++++++++--
 compiler/symcreat.pas | 36 ++++++++++++++++++++++++++++++++++++
 compiler/symdef.pas   |  5 +++++
 4 files changed, 106 insertions(+), 4 deletions(-)

diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
index ae3417ed7a..e2e507c7ea 100644
--- a/compiler/pdecvar.pas
+++ b/compiler/pdecvar.pas
@@ -543,7 +543,21 @@ implementation
                           if not assigned(p.propaccesslist[palt_read].procdef) or
                             { because of cpo_ignorehidden we need to compare if it is a static class method and we have a class property }
                             ((sp_static in p.symoptions) <> tprocdef(p.propaccesslist[palt_read].procdef).no_self_node) then
-                            Message(parser_e_ill_property_access_sym);
+                            Message(parser_e_ill_property_access_sym)
+                          else
+                            begin
+{$ifdef jvm}
+                              { if the visibility of the getter is lower than
+                                the visibility of the property, wrap it so that
+                                we can call it from all contexts in which the
+                                property is visible }
+                              if (tprocdef(p.propaccesslist[palt_read].procdef).visibility<p.visibility) then
+                                begin
+                                  p.propaccesslist[palt_read].procdef:=jvm_wrap_method_with_vis(tprocdef(p.propaccesslist[palt_read].procdef),p.visibility);
+                                  p.propaccesslist[palt_read].firstsym^.sym:=tprocdef(p.propaccesslist[palt_read].procdef).procsym;
+                                end;
+{$endif jvm}
+                            end;
                         end;
                       fieldvarsym :
                         begin
@@ -591,7 +605,21 @@ implementation
                           else
                             p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults]);
                           if not assigned(p.propaccesslist[palt_write].procdef) then
-                            Message(parser_e_ill_property_access_sym);
+                            Message(parser_e_ill_property_access_sym)
+                          else
+                            begin
+{$ifdef jvm}
+                              { if the visibility of the getter is lower than
+                                the visibility of the property, wrap it so that
+                                we can call it from all contexts in which the
+                                property is visible }
+                              if (tprocdef(p.propaccesslist[palt_write].procdef).visibility<p.visibility) then
+                                begin
+                                  p.propaccesslist[palt_write].procdef:=jvm_wrap_method_with_vis(tprocdef(p.propaccesslist[palt_write].procdef),p.visibility);
+                                  p.propaccesslist[palt_write].firstsym^.sym:=tprocdef(p.propaccesslist[palt_write].procdef).procsym;
+                                end;
+{$endif jvm}
+                            end;
                         end;
                       fieldvarsym :
                         begin
diff --git a/compiler/pjvm.pas b/compiler/pjvm.pas
index ec197682a2..e7233e7140 100644
--- a/compiler/pjvm.pas
+++ b/compiler/pjvm.pas
@@ -28,7 +28,7 @@ interface
 
     uses
       globtype,
-      symtype,symbase,symdef,symsym;
+      symconst,symtype,symbase,symdef,symsym;
 
     { the JVM specs require that you add a default parameterless
       constructor in case the programmer hasn't specified any }
@@ -43,6 +43,8 @@ interface
 
     procedure jvm_add_typed_const_initializer(csym: tconstsym);
 
+    function jvm_wrap_method_with_vis(pd: tprocdef; vis: tvisibility): tprocdef;
+
 
 implementation
 
@@ -52,7 +54,7 @@ implementation
     fmodule,
     parabase,aasmdata,
     pdecsub,
-    symtable,symconst,symcreat,defcmp,jvmdef,
+    symtable,symcreat,defcmp,jvmdef,
     defutil,paramgr;
 
 
@@ -370,4 +372,35 @@ implementation
         end;
       end;
 
+
+    function jvm_wrap_method_with_vis(pd: tprocdef; vis: tvisibility): tprocdef;
+      var
+        obj: tabstractrecorddef;
+        visname: string;
+      begin
+        obj:=current_structdef;
+        { if someone gets the idea to add a property to an external class
+          definition, don't try to wrap it since we cannot add methods to
+          external classes }
+        if oo_is_external in obj.objectoptions then
+          begin
+            result:=pd;
+            exit
+          end;
+        result:=tprocdef(pd.getcopy);
+        result.visibility:=vis;
+        visname:=visibilityName[vis];
+        replace(visname,' ','_');
+        { create a name that is unique amongst all units (start with '$unitname$$') and
+          unique in this unit (result.defid) }
+        finish_copied_procdef(result,'$'+current_module.realmodulename^+'$$'+tostr(result.defid)+pd.procsym.realname+'$'+visname,obj.symtable,obj);
+        { in case the referred method is from an external class }
+        exclude(result.procoptions,po_external);
+        { not virtual/override/abstract/... }
+        result.procoptions:=result.procoptions*[po_classmethod,po_staticmethod,po_java,po_varargs,po_public];
+        result.synthetickind:=tsk_callthrough;
+        { so we know the name of the routine to call through to }
+        result.skpara:=pd;
+      end;
+
 end.
diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas
index 0ebe9a3d4f..34ad0d63d8 100644
--- a/compiler/symcreat.pas
+++ b/compiler/symcreat.pas
@@ -388,6 +388,40 @@ implementation
     end;
 
 
+  procedure implement_callthrough(pd: tprocdef);
+    var
+      str: ansistring;
+      callpd: tprocdef;
+      currpara: tparavarsym;
+      i: longint;
+      firstpara,
+      isclassmethod: boolean;
+    begin
+      isclassmethod:=
+        (po_classmethod in pd.procoptions) and
+        not(pd.proctypeoption in [potype_constructor,potype_destructor]);
+      callpd:=tprocdef(pd.skpara);
+      str:='begin ';
+      if pd.returndef<>voidtype then
+        str:=str+'result:=';
+      str:=str+callpd.procsym.realname+'(';
+      firstpara:=true;
+      for i:=0 to pd.paras.count-1 do
+        begin
+          currpara:=tparavarsym(pd.paras[i]);
+          if not(vo_is_hidden_para in currpara.varoptions) then
+            begin
+              if not firstpara then
+                str:=str+',';
+              firstpara:=false;
+              str:=str+currpara.realname;
+            end;
+        end;
+      str:=str+') end;';
+      str_parse_method_impl(str,pd,isclassmethod);
+    end;
+
+
   procedure implement_jvm_enum_values(pd: tprocdef);
     begin
       str_parse_method_impl('begin result:=__fpc_FVALUES end;',pd,true);
@@ -524,6 +558,8 @@ implementation
             { special handling for this one is done in tnodeutils.wrap_proc_body }
             tsk_tcinit:
               implement_empty(pd);
+            tsk_callthrough:
+              implement_callthrough(pd);
             tsk_jvm_enum_values:
               implement_jvm_enum_values(pd);
             tsk_jvm_enum_valueof:
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 60b1ed9b4e..57e87aff42 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -497,6 +497,7 @@ interface
          tsk_record_deepcopy,       // deepcopy for records field by field
          tsk_empty,                 // an empty routine
          tsk_tcinit,                // initialisation of typed constants
+         tsk_callthrough,           // call through to another routine with the same parameters/return type (its def is stored in the skpara field)
          tsk_jvm_enum_values,       // Java "values" class method of JLEnum descendants
          tsk_jvm_enum_valueof,      // Java "valueOf" class method of JLEnum descendants
          tsk_jvm_enum_classconstr,  // Java class constructor for JLEnum descendants
@@ -598,7 +599,11 @@ interface
           fpu_used     : byte;
 {$endif i386}
           visibility   : tvisibility;
+          { set to a value different from tsk_none in case this procdef is for
+            a routine that has to be internally generated by the compiler }
           synthetickind : tsynthetickind;
+          { optional parameter for the synthetic routine generation logic }
+          skpara: pointer;
           { true, if the procedure is only declared
             (forward procedure) }
           forwarddef,