* more fixes for protected handling

compiler/ncnv.pas

@@ -733,7 +733,7 @@ implementation
 
 
     function ttypeconvnode.resulttype_dynarray_to_openarray : tnode;
-    
+
       begin
         { a dynamic array is a pointer to an array, so to convert it to }
         { an open array, we have to dereference it (JM)                 }
@@ -1533,6 +1533,27 @@ implementation
             else
              CGMessage(type_e_mismatch);
           end
+         else if is_interface(right.resulttype.def) then
+          begin
+            { left is a class }
+            if is_class(left.resulttype.def) then
+             begin
+               { the operands must be related }
+               if not(assigned(tobjectdef(left.resulttype.def).implementedinterfaces) and
+                      (tobjectdef(left.resulttype.def).implementedinterfaces.searchintf(right.resulttype.def)<>-1)) then
+                 CGMessage(type_e_mismatch);
+             end
+            { left is an interface }
+            else if is_interface(left.resulttype.def) then
+             begin
+               { the operands must be related }
+               if (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(right.resulttype.def)))) and
+                  (not(tobjectdef(right.resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
+                 CGMessage(type_e_mismatch);
+             end
+            else
+             CGMessage(type_e_mismatch);
+          end
          else
           CGMessage(type_e_mismatch);
 
@@ -1546,11 +1567,16 @@ implementation
         paras: tcallparanode;
 
       begin
-         paras := ccallparanode.create(left,ccallparanode.create(right,nil));
-         left := nil;
-         right := nil;
-         result := ccallnode.createintern('fpc_do_is',paras);
-         firstpass(result);
+         if (right.resulttype.def.deftype=classrefdef) then
+          begin
+            paras := ccallparanode.create(left,ccallparanode.create(right,nil));
+            left := nil;
+            right := nil;
+            result := ccallnode.createintern('fpc_do_is',paras);
+            firstpass(result);
+          end
+         else
+          result:=nil;
       end;
 
     { dummy pass_2, it will never be called, but we need one since }
@@ -1600,6 +1626,28 @@ implementation
              CGMessage(type_e_mismatch);
             resulttype:=tclassrefdef(right.resulttype.def).pointertype;
           end
+         else if is_interface(right.resulttype.def) then
+          begin
+            { left is a class }
+            if is_class(left.resulttype.def) then
+             begin
+               { the operands must be related }
+               if not(assigned(tobjectdef(left.resulttype.def).implementedinterfaces) and
+                      (tobjectdef(left.resulttype.def).implementedinterfaces.searchintf(right.resulttype.def)<>-1)) then
+                 CGMessage(type_e_mismatch);
+             end
+            { left is an interface }
+            else if is_interface(left.resulttype.def) then
+             begin
+               { the operands must be related }
+               if (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(right.resulttype.def)))) and
+                  (not(tobjectdef(right.resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
+                 CGMessage(type_e_mismatch);
+             end
+            else
+             CGMessage(type_e_mismatch);
+            resulttype:=right.resulttype;
+          end
          else
           CGMessage(type_e_mismatch);
       end;
@@ -1611,12 +1659,17 @@ implementation
         paras: tcallparanode;
 
       begin
-         paras := ccallparanode.create(left,ccallparanode.create(right,nil));
-         left := nil;
-         right := nil;
-         result := ccallnode.createinternres('fpc_do_as',paras,
-           resulttype);
-         firstpass(result);
+         if (right.resulttype.def.deftype=classrefdef) then
+          begin
+            paras := ccallparanode.create(left,ccallparanode.create(right,nil));
+            left := nil;
+            right := nil;
+            result := ccallnode.createinternres('fpc_do_as',paras,
+              resulttype);
+            firstpass(result);
+          end
+         else
+          result:=nil;
       end;
 
 
@@ -1635,7 +1688,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.47  2001-12-10 14:34:04  jonas
+  Revision 1.48  2002-02-03 09:30:03  peter
+    * more fixes for protected handling
+
+  Revision 1.47  2001/12/10 14:34:04  jonas
     * fixed type conversions from dynamic arrays to open arrays
 
   Revision 1.46  2001/12/06 17:57:34  florian

compiler/pexpr.pas

@@ -424,15 +424,7 @@ implementation
                 Message(sym_e_no_instance_of_abstract_object);
                { search the constructor also in the symbol tables of
                  the parents }
-               sym:=nil;
-               while assigned(classh) do
-                begin
-                  sym:=tsym(classh.symtable.search(pattern));
-                  if assigned(sym) and
-                     tstoredsym(sym).is_visible_for_proc(aktprocdef) then
-                   break;
-                  classh:=classh.childof;
-                end;
+               sym:=searchsym_in_class(classh,pattern);
                consume(_ID);
                do_member_read(false,sym,p2,again);
                { we need to know which procedure is called }
@@ -1317,13 +1309,7 @@ implementation
                                begin
                                  p1:=ctypenode.create(htype);
                                  { search also in inherited methods }
-                                 repeat
-                                   srsym:=tvarsym(tobjectdef(htype.def).symtable.search(pattern));
-                                   if assigned(srsym) and
-                                      tstoredsym(srsym).is_visible_for_proc(aktprocdef) then
-                                    break;
-                                   htype.def:=tobjectdef(htype.def).childof;
-                                 until not assigned(htype.def);
+                                 srsym:=searchsym_in_class(tobjectdef(htype.def),pattern);
                                  consume(_ID);
                                  do_member_read(false,srsym,p1,again);
                                end
@@ -1757,44 +1743,28 @@ implementation
                         classrefdef:
                           begin
                              classh:=tobjectdef(tclassrefdef(p1.resulttype.def).pointertype.def);
-                             hsym:=nil;
-                             while assigned(classh) do
+                             hsym:=searchsym_in_class(classh,pattern);
+                             if hsym=nil then
+                              begin
+                                Message1(sym_e_id_no_member,pattern);
+                                p1.destroy;
+                                p1:=cerrornode.create;
+                                { try to clean up }
+                                consume(_ID);
+                              end
+                             else
                               begin
-                                hsym:=tsym(classh.symtable.search(pattern));
-                                if assigned(hsym) and
-                                   tstoredsym(hsym).is_visible_for_proc(aktprocdef) then
-                                 break;
-                                classh:=classh.childof;
+                                consume(_ID);
+                                do_member_read(getaddr,hsym,p1,again);
                               end;
-                              if hsym=nil then
-                                begin
-                                   Message1(sym_e_id_no_member,pattern);
-                                   p1.destroy;
-                                   p1:=cerrornode.create;
-                                   { try to clean up }
-                                   consume(_ID);
-                                end
-                              else
-                                begin
-                                   consume(_ID);
-                                   do_member_read(getaddr,hsym,p1,again);
-                                end;
                            end;
 
                          objectdef:
                            begin
-                              classh:=tobjectdef(p1.resulttype.def);
-                              hsym:=nil;
                               store_static:=allow_only_static;
                               allow_only_static:=false;
-                              while assigned(classh) do
-                                begin
-                                   hsym:=tsym(classh.symtable.search(pattern));
-                                   if assigned(hsym) and
-                                      tstoredsym(hsym).is_visible_for_proc(aktprocdef) then
-                                     break;
-                                   classh:=classh.childof;
-                                end;
+                              classh:=tobjectdef(p1.resulttype.def);
+                              hsym:=searchsym_in_class(classh,pattern);
                               allow_only_static:=store_static;
                               if hsym=nil then
                                 begin
@@ -1974,23 +1944,17 @@ implementation
                      auto_inherited:=false;
                    end;
                   classh:=procinfo^._class.childof;
-                  while assigned(classh) do
+                  sym:=searchsym_in_class(classh,hs);
+                  if assigned(sym) then
                    begin
-                     sym:=tsym(tobjectdef(classh).symtable.search(hs));
-                     if assigned(sym) and
-                        tstoredsym(sym).is_visible_for_proc(aktprocdef) then
+                     if sym.typ=procsym then
                       begin
-                        if sym.typ=procsym then
-                         begin
-                           htype.setdef(classh);
-                           p1:=ctypenode.create(htype);
-                         end;
-                        do_member_read(false,sym,p1,again);
-                        break;
+                        htype.setdef(classh);
+                        p1:=ctypenode.create(htype);
                       end;
-                     classh:=classh.childof;
-                   end;
-                  if classh=nil then
+                     do_member_read(false,sym,p1,again);
+                   end
+                  else
                    begin
                      Message1(sym_e_id_no_member,hs);
                      again:=false;
@@ -2488,7 +2452,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.56  2002-01-29 21:25:22  peter
+  Revision 1.57  2002-02-03 09:30:04  peter
+    * more fixes for protected handling
+
+  Revision 1.56  2002/01/29 21:25:22  peter
     * more checks for private and protected
 
   Revision 1.55  2002/01/24 18:25:49  peter

compiler/symsym.pas

@@ -547,7 +547,7 @@ implementation
         { 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=globalsymtable) and
+           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
            (owner.defowner.owner.unitid<>0) then
           exit;
 
@@ -556,7 +556,7 @@ implementation
         if (sp_protected in symoptions) and
            (
             (
-             (owner.defowner.owner.symtabletype=globalsymtable) and
+             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
              (owner.defowner.owner.unitid<>0)
             ) and
             not(
@@ -578,7 +578,7 @@ implementation
         { 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=globalsymtable) and
+           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
            (owner.defowner.owner.unitid<>0) then
           exit;
 
@@ -587,7 +587,7 @@ implementation
         if (sp_protected in symoptions) and
            (
             (
-             (owner.defowner.owner.symtabletype=globalsymtable) and
+             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
              (owner.defowner.owner.unitid<>0)
             ) and
             not(
@@ -2513,7 +2513,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.30  2001-12-31 16:59:43  peter
+  Revision 1.31  2002-02-03 09:30:04  peter
+    * more fixes for protected handling
+
+  Revision 1.30  2001/12/31 16:59:43  peter
     * protected/private symbols parsing fixed
 
   Revision 1.29  2001/12/03 21:48:42  peter

compiler/symtable.pas

@@ -212,6 +212,7 @@ interface
 {*** Search ***}
     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  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;
@@ -1754,6 +1755,45 @@ implementation
        end;
 
 
+    function  searchsym_in_class(classh:tobjectdef;const s : stringid):tsym;
+      var
+        speedvalue : cardinal;
+        topclassh  : tobjectdef;
+        sym        : tsym;
+      begin
+         speedvalue:=getspeedvalue(s);
+         { 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 (classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
+            (classh.owner.unitid=0) then
+           topclassh:=classh
+         else
+           topclassh:=nil;
+         sym:=nil;
+         while assigned(classh) do
+          begin
+            sym:=tsym(classh.symtable.speedsearch(s,speedvalue));
+            if assigned(sym) then
+             begin
+               if assigned(topclassh) then
+                begin
+                  if tstoredsym(sym).is_visible_for_object(topclassh) then
+                   break;
+                end
+               else
+                begin
+                  if tstoredsym(sym).is_visible_for_proc(aktprocdef) then
+                   break;
+                end;
+             end;
+            classh:=classh.childof;
+          end;
+         searchsym_in_class:=sym;
+      end;
+
+
     function searchsystype(const s: stringid; var srsym: ttypesym): boolean;
       var
         symowner: tsymtable;
@@ -2028,7 +2068,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  2002-01-29 21:30:25  peter
+  Revision 1.55  2002-02-03 09:30:07  peter
+    * more fixes for protected handling
+
+  Revision 1.54  2002/01/29 21:30:25  peter
     * allow also dup id in delphi mode in interfaces
 
   Revision 1.53  2002/01/29 19:46:00  peter