Sfoglia il codice sorgente

* pass context class to searchsym_in_class to fix the visibility
of protected members called from a named class in a child class
that also has the visibility for those protected members

git-svn-id: trunk@4384 -

peter 19 anni fa
parent
commit
22657a363b
6 ha cambiato i file con 74 aggiunte e 25 eliminazioni
  1. 2 0
      .gitattributes
  2. 6 6
      compiler/pexpr.pas
  3. 1 1
      compiler/pinline.pas
  4. 7 18
      compiler/symtable.pas
  5. 35 0
      tests/webtbf/tw6922.pp
  6. 23 0
      tests/webtbf/uw6922.pp

+ 2 - 0
.gitattributes

@@ -6454,6 +6454,7 @@ tests/webtbf/tw4911.pp svneol=native#text/plain
 tests/webtbf/tw4913.pp -text
 tests/webtbf/tw6686.pp svneol=native#text/plain
 tests/webtbf/tw6796.pp svneol=native#text/plain
+tests/webtbf/tw6922.pp svneol=native#text/plain
 tests/webtbf/tw6970.pp svneol=native#text/plain
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain
@@ -6463,6 +6464,7 @@ tests/webtbf/uw2414.pp svneol=native#text/plain
 tests/webtbf/uw3450.pp svneol=native#text/plain
 tests/webtbf/uw3969.pp svneol=native#text/plain
 tests/webtbf/uw4103.pp svneol=native#text/plain
+tests/webtbf/uw6922.pp svneol=native#text/plain
 tests/webtbs/tu2002.pp svneol=native#text/plain
 tests/webtbs/tw0555.pp svneol=native#text/plain
 tests/webtbs/tw0630.pp svneol=native#text/plain

+ 6 - 6
compiler/pexpr.pas

@@ -1388,7 +1388,7 @@ implementation
                                begin
                                  p1:=ctypenode.create(htype);
                                  { search also in inherited methods }
-                                 searchsym_in_class(tobjectdef(htype.def),pattern,srsym,srsymtable);
+                                 searchsym_in_class(tobjectdef(htype.def),current_procinfo.procdef._class,pattern,srsym,srsymtable);
                                  if assigned(srsym) then
                                    check_hints(srsym,srsym.symoptions);
                                  consume(_ID);
@@ -1919,7 +1919,7 @@ implementation
                            if token=_ID then
                              begin
                                classh:=tobjectdef(tclassrefdef(p1.resulttype.def).pointertype.def);
-                               searchsym_in_class(classh,pattern,srsym,srsymtable);
+                               searchsym_in_class(classh,classh,pattern,srsym,srsymtable);
                                if assigned(srsym) then
                                  begin
                                    check_hints(srsym,srsym.symoptions);
@@ -1945,7 +1945,7 @@ implementation
                                store_static:=allow_only_static;
                                allow_only_static:=false;
                                classh:=tobjectdef(p1.resulttype.def);
-                               searchsym_in_class(classh,pattern,srsym,srsymtable);
+                               searchsym_in_class(classh,classh,pattern,srsym,srsymtable);
                                allow_only_static:=store_static;
                                if assigned(srsym) then
                                  begin
@@ -2107,7 +2107,7 @@ implementation
                       if (po_msgstr in pd.procoptions) then
                         searchsym_in_class_by_msgstr(classh,pd.messageinf.str,srsym,srsymtable)
                      else
-                       searchsym_in_class(classh,hs,srsym,srsymtable);
+                       searchsym_in_class(classh,current_procinfo.procdef._class,hs,srsym,srsymtable);
                    end
                   else
                    begin
@@ -2115,7 +2115,7 @@ implementation
                      hsorg:=orgpattern;
                      consume(_ID);
                      anon_inherited:=false;
-                     searchsym_in_class(classh,hs,srsym,srsymtable);
+                     searchsym_in_class(classh,current_procinfo.procdef._class,hs,srsym,srsymtable);
                    end;
                   if assigned(srsym) then
                    begin
@@ -2148,7 +2148,7 @@ implementation
                         if (po_msgint in pd.procoptions) or
                            (po_msgstr in pd.procoptions) then
                           begin
-                            searchsym_in_class(classh,'DEFAULTHANDLER',srsym,srsymtable);
+                            searchsym_in_class(classh,classh,'DEFAULTHANDLER',srsym,srsymtable);
                             if not assigned(srsym) or
                                (srsym.typ<>procsym) then
                               internalerror(200303171);

+ 1 - 1
compiler/pinline.pas

@@ -421,7 +421,7 @@ implementation
             { search the constructor also in the symbol tables of
               the parents }
             afterassignment:=false;
-            searchsym_in_class(classh,pattern,srsym,srsymtable);
+            searchsym_in_class(classh,nil,pattern,srsym,srsymtable);
             consume(_ID);
             do_member_read(classh,false,srsym,p1,again,[cnf_new_call]);
             { we need to know which procedure is called }

+ 7 - 18
compiler/symtable.pas

@@ -211,7 +211,7 @@ interface
     function  searchsym(const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_type(const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_in_module(pm:pointer;const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
-    function  searchsym_in_class(classh:tobjectdef;const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
+    function  searchsym_in_class(classh,contextclassh:tobjectdef;const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_in_class_by_msgint(classh:tobjectdef;i:longint;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  search_system_type(const s: stringid): ttypesym;
@@ -1738,34 +1738,23 @@ implementation
       end;
 
 
-    function searchsym_in_class(classh:tobjectdef;const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
+    function searchsym_in_class(classh,contextclassh:tobjectdef;const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
       var
         speedvalue : cardinal;
-        topclassh  : tobjectdef;
+        currentclassh : tobjectdef;
       begin
         result:=false;
         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 assigned(classh) and
-           (classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           classh.owner.iscurrentunit then
-          topclassh:=classh
+        if assigned(current_procinfo.procdef) then
+          currentclassh:=current_procinfo.procdef._class
         else
-          begin
-            if assigned(current_procinfo) then
-              topclassh:=current_procinfo.procdef._class
-            else
-              topclassh:=nil;
-          end;
+          currentclassh:=nil;
         while assigned(classh) do
           begin
             srsymtable:=classh.symtable;
             srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
             if assigned(srsym) and
-               tsym(srsym).is_visible_for_object(topclassh,current_procinfo.procdef._class) then
+               tsym(srsym).is_visible_for_object(contextclassh,currentclassh) then
               begin
                 result:=true;
                 exit;

+ 35 - 0
tests/webtbf/tw6922.pp

@@ -0,0 +1,35 @@
+{ %fail }
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+uses uw6922;
+
+type
+
+  { TC }
+
+  TC=class(TA)
+  public
+    procedure Test;
+  end;
+
+{ TC }
+
+procedure TC.Test;
+var
+  B: TB;
+begin
+  T := 'Test1'; // allowed, because it is a descendant
+  B := TB.Create;
+  B.T := 'Test2'; // should not be allowed
+  writeln(B.T);
+  B.Free;
+end;
+
+var
+  c: TC;
+begin
+  c := TC.Create;
+  c.T := 'Test3'; // allowed, because it is in the same 'unit'
+  c.Test;
+  c.Free;
+end.

+ 23 - 0
tests/webtbf/uw6922.pp

@@ -0,0 +1,23 @@
+unit uw6922;
+
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+interface
+
+type
+
+  { TA }
+
+  TA = class
+  private
+    FT: string;
+  protected
+    property T: string read FT write FT;
+  end;
+
+  TB = class(TA)
+  end;
+
+implementation
+
+end.