* support DefaultHandler and anonymous inheritance fixed

    for message methods

compiler/ncal.pas

@@ -1742,7 +1742,7 @@ type
                         do this ugly hack in Delphi mode as it looks more
                         like a bug. It's also not documented }
                       if (m_delphi in aktmodeswitches) and
-                         (nf_auto_inherited in flags) and
+                         (nf_anon_inherited in flags) and
                          (symtableprocentry.owner.symtabletype=objectsymtable) and
                          (po_overload in symtableprocentry.first_procdef.procoptions) and
                          (symtableprocentry.procdef_count>=2) then
@@ -2395,7 +2395,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.129  2003-03-17 15:54:22  peter
+  Revision 1.130  2003-03-17 16:54:41  peter
+    * support DefaultHandler and anonymous inheritance fixed
+      for message methods
+
+  Revision 1.129  2003/03/17 15:54:22  peter
     * store symoptions also for procdef
     * check symoptions (private,public) when calculating possible
       overload candidates

compiler/node.pas

@@ -222,7 +222,7 @@ interface
          { flags used by tcallnode }
          nf_return_value_used,
          nf_static_call,
-         nf_auto_inherited,
+         nf_anon_inherited,
 
          { flags used by tcallparanode }
          nf_varargs_para,  { belongs this para to varargs }
@@ -976,7 +976,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.49  2003-01-04 15:54:03  daniel
+  Revision 1.50  2003-03-17 16:54:41  peter
+    * support DefaultHandler and anonymous inheritance fixed
+      for message methods
+
+  Revision 1.49  2003/01/04 15:54:03  daniel
     * Fixed mark_write for @ operator
       (can happen when compiling @procvar:=nil (Delphi mode construction))
 

compiler/pexpr.pas

@@ -91,7 +91,7 @@ implementation
 
     const
       got_addrn  : boolean = false;
-      auto_inherited : boolean = false;
+      anon_inherited : boolean = false;
 
 
 
@@ -671,7 +671,7 @@ implementation
          if not(getaddr) then
            begin
              para:=nil;
-             if auto_inherited then
+             if anon_inherited then
               begin
                 hst:=symtablestack;
                 while assigned(hst) and (hst.symtabletype<>parasymtable) do
@@ -1780,24 +1780,33 @@ implementation
                consume(_INHERITED);
                if assigned(procinfo._class) then
                 begin
+                  classh:=procinfo._class.childof;
                   { if inherited; only then we need the method with
                     the same name }
                   if token=_SEMICOLON then
                    begin
                      hs:=aktprocsym.name;
-                     auto_inherited:=true
+                     anon_inherited:=true;
+                     { For message methods we need to search using the message
+                       number or string }
+                     if (po_msgint in aktprocsym.first_procdef.procoptions) then
+                      sym:=searchsym_in_class_by_msgint(classh,aktprocsym.first_procdef.messageinf.i)
+                     else
+                      if (po_msgstr in aktprocsym.first_procdef.procoptions) then
+                       sym:=searchsym_in_class_by_msgstr(classh,aktprocsym.first_procdef.messageinf.str)
+                     else
+                      sym:=searchsym_in_class(classh,hs);
                    end
                   else
                    begin
                      hs:=pattern;
                      consume(_ID);
-                     auto_inherited:=false;
+                     anon_inherited:=false;
+                     sym:=searchsym_in_class(classh,hs);
                    end;
-                  classh:=procinfo._class.childof;
-                  sym:=searchsym_in_class(classh,hs);
-                  check_hints(sym);
                   if assigned(sym) then
                    begin
+                     check_hints(sym);
                      if sym.typ=procsym then
                       begin
                         htype.setdef(classh);
@@ -1806,15 +1815,20 @@ implementation
                      do_member_read(false,sym,p1,again);
                      { Add flag to indicate that inherited is used }
                      if p1.nodetype=calln then
-                       include(p1.flags,nf_auto_inherited);
+                       include(p1.flags,nf_anon_inherited);
                    end
                   else
                    begin
-                     if auto_inherited then
+                     if anon_inherited then
                       begin
-                        { we didn't find a member in the parents so
-                          we do nothing. This is compatible with delphi (PFV) }
-                        p1:=cnothingnode.create;
+                        { we didn't find a member in the parents call the
+                          DefaultHandler }
+                        sym:=searchsym_in_class(classh,'DEFAULTHANDLER');
+                        if not assigned(sym) or
+                           (sym.typ<>procsym) then
+                          internalerror(200303171);
+                        p1:=nil;
+                        do_proc_call(sym,sym.owner,false,again,p1);
                       end
                      else
                       begin
@@ -1824,7 +1838,7 @@ implementation
                      again:=false;
                    end;
                   { turn auto inheriting off }
-                  auto_inherited:=false;
+                  anon_inherited:=false;
                 end
                else
                  begin
@@ -2326,7 +2340,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.102  2003-01-30 21:46:57  peter
+  Revision 1.103  2003-03-17 16:54:41  peter
+    * support DefaultHandler and anonymous inheritance fixed
+      for message methods
+
+  Revision 1.102  2003/01/30 21:46:57  peter
     * self fixes for static methods (merged)
 
   Revision 1.101  2003/01/16 22:12:22  peter

compiler/symdef.pas

@@ -546,6 +546,7 @@ interface
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
           function  is_visible_for_proc(currprocdef:tprocdef):boolean;
+          function  is_visible_for_object(currobjdef:tobjectdef):boolean;
           { debug }
 {$ifdef GDB}
           function  stabstring : pchar;override;
@@ -3672,6 +3673,36 @@ implementation
       end;
 
 
+    function tprocdef.is_visible_for_object(currobjdef:tobjectdef):boolean;
+      begin
+        is_visible_for_object:=false;
+
+        { private symbols are allowed when we are in the same
+          module as they are defined }
+        if (sp_private in symoptions) and
+           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
+           (owner.defowner.owner.unitid<>0) then
+          exit;
+
+        { protected symbols are vissible in the module that defines them and
+          also visible to related objects }
+        if (sp_protected in symoptions) and
+           (
+            (
+             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
+             (owner.defowner.owner.unitid<>0)
+            ) and
+            not(
+                assigned(currobjdef) and
+                currobjdef.is_related(tobjectdef(owner.defowner))
+               )
+           ) then
+          exit;
+
+        is_visible_for_object:=true;
+      end;
+
+
     function tprocdef.getsymtable(t:tgetsymtable):tsymtable;
       begin
         case t of
@@ -5693,7 +5724,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.130  2003-03-17 15:54:22  peter
+  Revision 1.131  2003-03-17 16:54:41  peter
+    * support DefaultHandler and anonymous inheritance fixed
+      for message methods
+
+  Revision 1.130  2003/03/17 15:54:22  peter
     * store symoptions also for procdef
     * check symoptions (private,public) when calculating possible
       overload candidates

compiler/symtable.pas

@@ -221,6 +221,8 @@ interface
     function  searchsym(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean;
     function  searchsymonlyin(p : tsymtable;const s : stringid):tsym;
     function  searchsym_in_class(classh:tobjectdef;const s : stringid):tsym;
+    function  searchsym_in_class_by_msgint(classh:tobjectdef;i:longint):tsym;
+    function  searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string):tsym;
     function  searchsystype(const s: stringid; var srsym: ttypesym): boolean;
     function  searchsysvar(const s: stringid; var srsym: tvarsym; var symowner: tsymtable): boolean;
     function  search_class_member(pd : tobjectdef;const s : string):tsym;
@@ -2076,6 +2078,104 @@ implementation
       end;
 
 
+    function  searchsym_in_class_by_msgint(classh:tobjectdef;i:longint):tsym;
+      var
+        topclassh  : tobjectdef;
+        def        : tdef;
+        sym        : tsym;
+      begin
+         { when the class passed is defined in this unit we
+           need to use the scope of that class. This is a trick
+           that can be used to access protected members in other
+           units. At least kylix supports it this way (PFV) }
+         if assigned(classh) and
+            (classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
+            (classh.owner.unitid=0) then
+           topclassh:=classh
+         else
+           topclassh:=nil;
+         sym:=nil;
+         def:=nil;
+         while assigned(classh) do
+          begin
+            def:=tdef(classh.symtable.defindex.first);
+            while assigned(def) do
+             begin
+               if (def.deftype=procdef) and
+                  (po_msgint in tprocdef(def).procoptions) and
+                  (tprocdef(def).messageinf.i=i) then
+                begin
+                  sym:=tprocdef(def).procsym;
+                  if assigned(topclassh) then
+                   begin
+                     if tprocdef(def).is_visible_for_object(topclassh) then
+                      break;
+                   end
+                  else
+                   begin
+                     if tprocdef(def).is_visible_for_proc(aktprocdef) then
+                      break;
+                   end;
+                end;
+               def:=tdef(def.indexnext);
+             end;
+            if assigned(sym) then
+             break;
+            classh:=classh.childof;
+          end;
+         searchsym_in_class_by_msgint:=sym;
+      end;
+
+
+    function  searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string):tsym;
+      var
+        topclassh  : tobjectdef;
+        def        : tdef;
+        sym        : tsym;
+      begin
+         { when the class passed is defined in this unit we
+           need to use the scope of that class. This is a trick
+           that can be used to access protected members in other
+           units. At least kylix supports it this way (PFV) }
+         if assigned(classh) and
+            (classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
+            (classh.owner.unitid=0) then
+           topclassh:=classh
+         else
+           topclassh:=nil;
+         sym:=nil;
+         def:=nil;
+         while assigned(classh) do
+          begin
+            def:=tdef(classh.symtable.defindex.first);
+            while assigned(def) do
+             begin
+               if (def.deftype=procdef) and
+                  (po_msgstr in tprocdef(def).procoptions) and
+                  (tprocdef(def).messageinf.str=s) then
+                begin
+                  sym:=tprocdef(def).procsym;
+                  if assigned(topclassh) then
+                   begin
+                     if tprocdef(def).is_visible_for_object(topclassh) then
+                      break;
+                   end
+                  else
+                   begin
+                     if tprocdef(def).is_visible_for_proc(aktprocdef) then
+                      break;
+                   end;
+                end;
+               def:=tdef(def.indexnext);
+             end;
+            if assigned(sym) then
+             break;
+            classh:=classh.childof;
+          end;
+         searchsym_in_class_by_msgstr:=sym;
+      end;
+
+
     function searchsystype(const s: stringid; var srsym: ttypesym): boolean;
       var
         symowner: tsymtable;
@@ -2350,7 +2450,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.89  2002-12-29 14:57:50  peter
+  Revision 1.90  2003-03-17 16:54:41  peter
+    * support DefaultHandler and anonymous inheritance fixed
+      for message methods
+
+  Revision 1.89  2002/12/29 14:57:50  peter
     * unit loading changed to first register units and load them
       afterwards. This is needed to support uses xxx in yyy correctly
     * unit dependency check fixed