2
0
Эх сурвалжийг харах

--- Merging r18999 into '.':
A tests/webtbs/tw18767a.pp
A tests/webtbs/tw18767b.pp
U compiler/symtable.pas
--- Merging r19000 into '.':
U tests/webtbs/tw18767a.pp
A tests/webtbs/tw18768.pp
G compiler/symtable.pas
--- Merging r19001 into '.':
A tests/webtbs/tw20119.pp
U compiler/pdecvar.pas

# revisions: 18999,19000,19001
------------------------------------------------------------------------
r18999 | paul | 2011-09-07 03:32:43 +0200 (Wed, 07 Sep 2011) | 1 line
Changed paths:
M /trunk/compiler/symtable.pas
A /trunk/tests/webtbs/tw18767a.pp
A /trunk/tests/webtbs/tw18767b.pp

compiler: fix strict private visibility check for nested types (issue #0018767)
------------------------------------------------------------------------
------------------------------------------------------------------------
r19000 | paul | 2011-09-07 03:51:13 +0200 (Wed, 07 Sep 2011) | 1 line
Changed paths:
M /trunk/compiler/symtable.pas
M /trunk/tests/webtbs/tw18767a.pp
A /trunk/tests/webtbs/tw18768.pp

compiler: fix private and protected members visibility check for nested records (issue #0018768)
------------------------------------------------------------------------
------------------------------------------------------------------------
r19001 | paul | 2011-09-07 04:22:03 +0200 (Wed, 07 Sep 2011) | 1 line
Changed paths:
M /trunk/compiler/pdecvar.pas
A /trunk/tests/webtbs/tw20119.pp

compiler: clear vd_class option if it was added by _STATIC token (issue #0020119)
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@19229 -

marco 14 жил өмнө
parent
commit
8e187dcf27

+ 4 - 0
.gitattributes

@@ -11677,6 +11677,9 @@ tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw18690.pp svneol=native#text/plain
 tests/webtbs/tw18702.pp svneol=native#text/pascal
 tests/webtbs/tw1873.pp svneol=native#text/plain
+tests/webtbs/tw18767a.pp svneol=native#text/pascal
+tests/webtbs/tw18767b.pp svneol=native#text/pascal
+tests/webtbs/tw18768.pp svneol=native#text/pascal
 tests/webtbs/tw1883.pp svneol=native#text/plain
 tests/webtbs/tw18859.pp svneol=native#text/plain
 tests/webtbs/tw1888.pp svneol=native#text/plain
@@ -11716,6 +11719,7 @@ tests/webtbs/tw20005.pp svneol=native#text/pascal
 tests/webtbs/tw2001.pp svneol=native#text/plain
 tests/webtbs/tw2002.pp svneol=native#text/plain
 tests/webtbs/tw2004.pp svneol=native#text/plain
+tests/webtbs/tw20119.pp -text svneol=native#test/pascal
 tests/webtbs/tw2028.pp svneol=native#text/plain
 tests/webtbs/tw2030.pp svneol=native#text/plain
 tests/webtbs/tw2031.pp svneol=native#text/plain

+ 11 - 3
compiler/pdecvar.pas

@@ -1499,7 +1499,8 @@ implementation
          uniondef : trecorddef;
          hintsymoptions : tsymoptions;
          deprecatedmsg : pshortstring;
-         semicoloneaten: boolean;
+         semicoloneaten,
+         removeclassoption: boolean;
 {$if defined(powerpc) or defined(powerpc64)}
          tempdef: tdef;
          is_first_type: boolean;
@@ -1518,7 +1519,8 @@ implementation
            consume(_ID);
          { read vars }
          sc:=TFPObjectList.create(false);
-         recstlist:=TFPObjectList.create(false);;
+         recstlist:=TFPObjectList.create(false);
+         removeclassoption:=false;
          while (token=_ID) and
             not(((vd_object in options) or
                  ((vd_record in options) and (m_advanced_records in current_settings.modeswitches))) and
@@ -1653,7 +1655,8 @@ implementation
                  if not (vd_class in options) and try_to_consume(_STATIC) then
                    begin
                      consume(_SEMICOLON);
-                     include(options, vd_class);
+                     include(options,vd_class);
+                     removeclassoption:=true;
                    end;
                end;
              if vd_class in options then
@@ -1674,6 +1677,11 @@ implementation
                      sl.addsym(sl_load,hstaticvs);
                      recst.insert(tabsolutevarsym.create_ref('$'+static_name,hdef,sl));
                    end;
+                 if removeclassoption then
+                   begin
+                     exclude(options,vd_class);
+                     removeclassoption:=false;
+                   end;
                end;
              if (visibility=vis_published) and
                 not(is_class(hdef)) then

+ 8 - 8
compiler/symtable.pas

@@ -216,7 +216,7 @@ interface
 
 {*** Search ***}
     procedure addsymref(sym:tsym);
-    function  is_owned_by(childdef,ownerdef:tabstractrecorddef):boolean;
+    function  is_owned_by(childdef,ownerdef:tdef):boolean;
     function  is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
     function  is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean;
     function  is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean;
@@ -1796,11 +1796,11 @@ implementation
        end;
 
 
-    function is_owned_by(childdef,ownerdef:tabstractrecorddef):boolean;
+    function is_owned_by(childdef,ownerdef:tdef):boolean;
       begin
         result:=childdef=ownerdef;
-        if not result and (childdef.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-          result:=is_owned_by(tabstractrecorddef(childdef.owner.defowner),ownerdef);
+        if not result and assigned(childdef.owner.defowner) then
+          result:=is_owned_by(tdef(childdef.owner.defowner),ownerdef);
       end;
 
     function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
@@ -1823,8 +1823,8 @@ implementation
                        (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
                        (symownerdef.owner.iscurrentunit)
                       ) or
-                      ( // the case of specialize inside the generic declaration
-                       (symownerdef.owner.symtabletype = objectsymtable) and
+                      ( // the case of specialize inside the generic declaration and nested types
+                       (symownerdef.owner.symtabletype in [objectsymtable,recordsymtable]) and
                        (
                          assigned(current_structdef) and
                          (
@@ -1872,8 +1872,8 @@ implementation
                         (contextobjdef.owner.iscurrentunit) and
                         contextobjdef.is_related(symownerdef)
                        ) or
-                       ( // the case of specialize inside the generic declaration
-                        (symownerdef.owner.symtabletype = objectsymtable) and
+                       ( // the case of specialize inside the generic declaration and nested types
+                        (symownerdef.owner.symtabletype in [objectsymtable,recordsymtable]) and
                         (
                           assigned(current_structdef) and
                           (

+ 19 - 0
tests/webtbs/tw18767a.pp

@@ -0,0 +1,19 @@
+{ %norun}
+program tw18767a;
+
+{$mode delphi}{$H+}
+
+type
+  TFoo = class
+  strict private
+    const
+      n = 3;
+    var
+      x: array[0..1] of record
+        y: array[0..n] of integer;
+      end;
+  end;
+
+begin
+  TFoo.Create;
+end.

+ 19 - 0
tests/webtbs/tw18767b.pp

@@ -0,0 +1,19 @@
+{ %norun}
+program tw18767b;
+
+{$mode delphi}{$H+}
+
+type
+  TFoo = class
+  strict private
+    type
+      TBar = (one, two);
+    var
+      x: array of record
+        y: array[TBar] of integer;
+      end;
+  end;
+
+begin
+  TFoo.Create;
+end.

+ 26 - 0
tests/webtbs/tw18768.pp

@@ -0,0 +1,26 @@
+{ %norun}
+program tw18768;
+
+{$mode delphi}{$H+}
+
+type
+  TFoo1 = record
+  private
+    type
+      TFoo3 = record
+      private
+        b, c: integer;
+      protected
+        a: integer;
+      public
+        function GetFoo2: integer;
+      end;
+  end;
+
+function TFoo1.TFoo3.GetFoo2: integer;
+begin
+  c := a * b;
+end;
+
+begin
+end.

+ 12 - 0
tests/webtbs/tw20119.pp

@@ -0,0 +1,12 @@
+{%norun}
+program tw20119;
+{$mode objfpc}
+type
+  T = class
+  private
+    F1: Integer; static;
+    F2: Integer; static;
+  end;
+begin
+end.
+