[multiple changes]

2011-09-01  Romain Berrendonner  <berrendo@adacore.com>

	* gnatls.adb: Display simple message instead of content of
	gnatlic.adl.

2011-09-01  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch3.adb: (Build_Derived_Record_Type) Remove the kludgy update of
	access discriminant and anonymous access component scopes.
	(Inherit_Component): Reuse the itype of an access discriminant
	or anonymous access component by copying it in order to set the proper
	scope. This is done only when the parent and the derived type
	are in different scopes.
	(Set_Anonymous_Etype): New routine.

2011-09-01  Robert Dewar  <dewar@adacore.com>

	* a-convec.adb: Minor reformatting throughout.

From-SVN: r178417

gcc/ada/ChangeLog

+2011-09-01  Romain Berrendonner  <berrendo@adacore.com>
+
+	* gnatls.adb: Display simple message instead of content of
+	gnatlic.adl.
+
+2011-09-01  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch3.adb: (Build_Derived_Record_Type) Remove the kludgy update of
+	access discriminant and anonymous access component scopes.
+	(Inherit_Component): Reuse the itype of an access discriminant
+	or anonymous access component by copying it in order to set the proper
+	scope. This is done only when the parent and the derived type
+	are in different scopes.
+	(Set_Anonymous_Etype): New routine.
+
+2011-09-01  Robert Dewar  <dewar@adacore.com>
+
+	* a-convec.adb: Minor reformatting throughout.
+
 2011-09-01  Jose Ruiz  <ruiz@adacore.com>
 
 	* adaint.c, adaint.h (__gnat_cpu_alloc, __gnat_cpu_alloc_size,

gcc/ada/a-convec.adb

@@ -37,18 +37,20 @@ package body Ada.Containers.Vectors is
    procedure Free is
      new Ada.Unchecked_Deallocation (Elements_Type, Elements_Access);
 
-   type Iterator is new
-     Vector_Iterator_Interfaces.Reversible_Iterator with record
+   type Iterator is new Vector_Iterator_Interfaces.Reversible_Iterator with
+   record
       Container : Vector_Access;
       Index     : Index_Type;
    end record;
 
    overriding function First (Object : Iterator) return Cursor;
    overriding function Last  (Object : Iterator) return Cursor;
-   overriding function Next  (Object : Iterator; Position : Cursor)
-     return Cursor;
-   overriding function Previous (Object : Iterator; Position : Cursor)
-     return Cursor;
+   overriding function Next
+     (Object : Iterator;
+      Position : Cursor) return Cursor;
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
 
    ---------
    -- "&" --
@@ -125,6 +127,7 @@ package body Ada.Containers.Vectors is
       --  Count_Type'Base as the type for intermediate values.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We perform a two-part test. First we determine whether the
          --  computed Last value lies in the base range of the type, and then
          --  determine whether it lies in the range of the index (sub)type.
@@ -153,6 +156,7 @@ package body Ada.Containers.Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  Here we can compute Last directly, in the normal way. We know that
          --  No_Index is less than 0, so there is no danger of overflow when
          --  adding the (positive) value of length.
@@ -209,8 +213,7 @@ package body Ada.Containers.Vectors is
       --  basis for knowing how much larger, so we just allocate the minimum
       --  amount of storage.
 
-      --  Here we handle the easy case first, when the vector parameter (Left)
-      --  is empty.
+      --  Handle easy case first, when the vector parameter (Left) is empty
 
       if Left.Is_Empty then
          declare
@@ -245,9 +248,7 @@ package body Ada.Containers.Vectors is
            Left.Elements.EA (Index_Type'First .. Left.Last);
 
          Elements : constant Elements_Access :=
-           new Elements_Type'
-                 (Last => Last,
-                  EA   => LE & Right);
+                      new Elements_Type'(Last => Last, EA => LE & Right);
 
       begin
          return (Controlled with Elements, Last, 0, 0);
@@ -261,8 +262,7 @@ package body Ada.Containers.Vectors is
       --  basis for knowing how much larger, so we just allocate the minimum
       --  amount of storage.
 
-      --  Here we handle the easy case first, when the vector parameter (Right)
-      --  is empty.
+      --  Handle easy case first, when the vector parameter (Right) is empty
 
       if Right.Is_Empty then
          declare
@@ -440,9 +440,9 @@ package body Ada.Containers.Vectors is
    begin
       if Container.Elements = null then
          return 0;
-      end if;
-
+      else
          return Container.Elements.EA'Length;
+      end if;
    end Capacity;
 
    -----------
@@ -454,9 +454,9 @@ package body Ada.Containers.Vectors is
       if Container.Busy > 0 then
          raise Program_Error with
            "attempt to tamper with cursors (vector is busy)";
-      end if;
-
+      else
          Container.Last := No_Index;
+      end if;
    end Clear;
 
    --------------
@@ -711,13 +711,11 @@ package body Ada.Containers.Vectors is
    begin
       if Position.Container = null then
          raise Constraint_Error with "Position cursor has no element";
-      end if;
-
-      if Position.Index > Position.Container.Last then
+      elsif Position.Index > Position.Container.Last then
          raise Constraint_Error with "Position cursor is out of range";
-      end if;
-
+      else
          return Position.Container.Elements.EA (Position.Index);
+      end if;
    end Element;
 
    --------------
@@ -794,18 +792,18 @@ package body Ada.Containers.Vectors is
    begin
       if Is_Empty (Container) then
          return No_Element;
-      end if;
-
+      else
          return (Container'Unchecked_Access, Index_Type'First);
+      end if;
    end First;
 
    function First (Object : Iterator) return Cursor is
    begin
       if Is_Empty (Object.Container.all) then
          return No_Element;
-      end if;
-
+      else
          return Cursor'(Object.Container, Index_Type'First);
+      end if;
    end First;
 
    -------------------
@@ -816,9 +814,9 @@ package body Ada.Containers.Vectors is
    begin
       if Container.Last = No_Index then
          raise Constraint_Error with "Container is empty";
-      end if;
-
+      else
          return Container.Elements.EA (Index_Type'First);
+      end if;
    end First_Element;
 
    -----------------
@@ -850,8 +848,8 @@ package body Ada.Containers.Vectors is
          declare
             EA : Elements_Array renames Container.Elements.EA;
          begin
-            for I in Index_Type'First .. Container.Last - 1 loop
-               if EA (I + 1) < EA (I) then
+            for J in Index_Type'First .. Container.Last - 1 loop
+               if EA (J + 1) < EA (J) then
                   return False;
                end if;
             end loop;
@@ -1044,10 +1042,12 @@ package body Ada.Containers.Vectors is
       --  acceptable, then we compute the new last index from that.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We have to handle the case when there might be more values in the
          --  range of Index_Type than in the range of Count_Type.
 
          if Index_Type'First <= 0 then
+
             --  We know that No_Index (the same as Index_Type'First - 1) is
             --  less than 0, so it is safe to compute the following sum without
             --  fear of overflow.
@@ -1055,6 +1055,7 @@ package body Ada.Containers.Vectors is
             Index := No_Index + Index_Type'Base (Count_Type'Last);
 
             if Index <= Index_Type'Last then
+
                --  We have determined that range of Index_Type has at least as
                --  many values as in Count_Type, so Count_Type'Last is the
                --  maximum number of items that are allowed.
@@ -1079,6 +1080,7 @@ package body Ada.Containers.Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  We know that No_Index (the same as Index_Type'First - 1) is less
          --  than 0, so it is safe to compute the following sum without fear of
          --  overflow.
@@ -1086,6 +1088,7 @@ package body Ada.Containers.Vectors is
          J := Count_Type'Base (No_Index) + Count_Type'Last;
 
          if J <= Count_Type'Base (Index_Type'Last) then
+
             --  We have determined that range of Index_Type has at least as
             --  many values as in Count_Type, so Count_Type'Last is the maximum
             --  number of items that are allowed.
@@ -1172,6 +1175,7 @@ package body Ada.Containers.Vectors is
       --  whether there is enough unused storage for the new items.
 
       if New_Length <= Container.Elements.EA'Length then
+
          --  In this case, we're inserting elements into a vector that has
          --  already allocated an internal array, and the existing array has
          --  enough unused storage for the new items.
@@ -1181,6 +1185,7 @@ package body Ada.Containers.Vectors is
 
          begin
             if Before > Container.Last then
+
                --  The new items are being appended to the vector, so no
                --  sliding of existing elements is required.
 
@@ -1228,6 +1233,7 @@ package body Ada.Containers.Vectors is
       end loop;
 
       if New_Capacity > Max_Length then
+
          --  We have reached the limit of capacity, so no further expansion
          --  will occur. (This is not a problem, as there is never a need to
          --  have more capacity than the maximum container length.)
@@ -1282,6 +1288,7 @@ package body Ada.Containers.Vectors is
             DA (Before .. Index - 1) := (others => New_Item);
             DA (Index .. New_Last) := SA (Before .. Container.Last);
          end if;
+
       exception
          when others =>
             Free (Dst);
@@ -1324,6 +1331,7 @@ package body Ada.Containers.Vectors is
       Insert_Space (Container, Before, Count => N);
 
       if N = 0 then
+
          --  There's nothing else to do here (vetting of parameters was
          --  performed already in Insert_Space), so we simply return.
 
@@ -1341,6 +1349,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Container'Address /= New_Item'Address then
+
          --  This is the simple case.  New_Item denotes an object different
          --  from Container, so there's nothing special we need to do to copy
          --  the source items to their destination, because all of the source
@@ -1386,6 +1395,7 @@ package body Ada.Containers.Vectors is
          Container.Elements.EA (Before .. K) := Src;
 
          if Src'Length = N then
+
             --  The new items were effectively appended to the container, so we
             --  have already copied all of the items that need to be copied.
             --  We return early here, even though the source slice below is
@@ -1536,9 +1546,9 @@ package body Ada.Containers.Vectors is
          if Container.Last = Index_Type'Last then
             raise Constraint_Error with
               "vector is already at its maximum length";
-         end if;
-
+         else
             Index := Container.Last + 1;
+         end if;
 
       else
          Index := Before.Index;
@@ -1700,10 +1710,12 @@ package body Ada.Containers.Vectors is
       --  acceptable, then we compute the new last index from that.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We have to handle the case when there might be more values in the
          --  range of Index_Type than in the range of Count_Type.
 
          if Index_Type'First <= 0 then
+
             --  We know that No_Index (the same as Index_Type'First - 1) is
             --  less than 0, so it is safe to compute the following sum without
             --  fear of overflow.
@@ -1711,6 +1723,7 @@ package body Ada.Containers.Vectors is
             Index := No_Index + Index_Type'Base (Count_Type'Last);
 
             if Index <= Index_Type'Last then
+
                --  We have determined that range of Index_Type has at least as
                --  many values as in Count_Type, so Count_Type'Last is the
                --  maximum number of items that are allowed.
@@ -1735,6 +1748,7 @@ package body Ada.Containers.Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  We know that No_Index (the same as Index_Type'First - 1) is less
          --  than 0, so it is safe to compute the following sum without fear of
          --  overflow.
@@ -1742,6 +1756,7 @@ package body Ada.Containers.Vectors is
          J := Count_Type'Base (No_Index) + Count_Type'Last;
 
          if J <= Count_Type'Base (Index_Type'Last) then
+
             --  We have determined that range of Index_Type has at least as
             --  many values as in Count_Type, so Count_Type'Last is the maximum
             --  number of items that are allowed.
@@ -1827,6 +1842,7 @@ package body Ada.Containers.Vectors is
       --  whether there is enough unused storage for the new items.
 
       if New_Last <= Container.Elements.Last then
+
          --  In this case, we're inserting space into a vector that has already
          --  allocated an internal array, and the existing array has enough
          --  unused storage for the new items.
@@ -1836,6 +1852,7 @@ package body Ada.Containers.Vectors is
 
          begin
             if Before <= Container.Last then
+
                --  The space is being inserted before some existing elements,
                --  so we must slide the existing elements up to their new
                --  home. We use the wider of Index_Type'Base and
@@ -1876,6 +1893,7 @@ package body Ada.Containers.Vectors is
       end loop;
 
       if New_Capacity > Max_Length then
+
          --  We have reached the limit of capacity, so no further expansion
          --  will occur. (This is not a problem, as there is never a need to
          --  have more capacity than the maximum container length.)
@@ -1914,6 +1932,7 @@ package body Ada.Containers.Vectors is
            SA (Index_Type'First .. Before - 1);
 
          if Before <= Container.Last then
+
             --  The space is being inserted before some existing elements, so
             --  we must slide the existing elements up to their new home.
 
@@ -1926,6 +1945,7 @@ package body Ada.Containers.Vectors is
 
             DA (Index .. New_Last) := SA (Before .. Container.Last);
          end if;
+
       exception
          when others =>
             Free (Dst);
@@ -1938,6 +1958,7 @@ package body Ada.Containers.Vectors is
 
       declare
          X : Elements_Access := Container.Elements;
+
       begin
          --  We first isolate the old internal array, removing it from the
          --  container and replacing it with the new internal array, before we
@@ -1987,9 +2008,9 @@ package body Ada.Containers.Vectors is
          if Container.Last = Index_Type'Last then
             raise Constraint_Error with
               "vector is already at its maximum length";
-         end if;
-
+         else
             Index := Container.Last + 1;
+         end if;
 
       else
          Index := Before.Index;
@@ -2036,7 +2057,8 @@ package body Ada.Containers.Vectors is
       B := B - 1;
    end Iterate;
 
-   function Iterate (Container : Vector)
+   function Iterate
+     (Container : Vector)
       return Vector_Iterator_Interfaces.Reversible_Iterator'Class
    is
       It : constant Iterator := (Container'Unchecked_Access, Index_Type'First);
@@ -2044,7 +2066,9 @@ package body Ada.Containers.Vectors is
       return It;
    end Iterate;
 
-   function Iterate (Container : Vector; Start : Cursor)
+   function Iterate
+     (Container : Vector;
+      Start     : Cursor)
       return Vector_Iterator_Interfaces.Reversible_Iterator'class
    is
       It : constant Iterator := (Container'Unchecked_Access, Start.Index);
@@ -2060,18 +2084,18 @@ package body Ada.Containers.Vectors is
    begin
       if Is_Empty (Container) then
          return No_Element;
-      end if;
-
+      else
          return (Container'Unchecked_Access, Container.Last);
+      end if;
    end Last;
 
    function Last (Object : Iterator) return Cursor is
    begin
       if Is_Empty (Object.Container.all) then
          return No_Element;
-      end if;
-
+      else
          return Cursor'(Object.Container, Object.Container.Last);
+      end if;
    end Last;
 
    ------------------
@@ -2082,9 +2106,9 @@ package body Ada.Containers.Vectors is
    begin
       if Container.Last = No_Index then
          raise Constraint_Error with "Container is empty";
-      end if;
-
+      else
          return Container.Elements.EA (Container.Last);
+      end if;
    end Last_Element;
 
    ----------------
@@ -2172,13 +2196,11 @@ package body Ada.Containers.Vectors is
    begin
       if Position.Container = null then
          return No_Element;
-      end if;
-
-      if Position.Index < Position.Container.Last then
+      elsif Position.Index < Position.Container.Last then
          return (Position.Container, Position.Index + 1);
-      end if;
-
+      else
          return No_Element;
+      end if;
    end Next;
 
    function Next (Object : Iterator; Position : Cursor) return Cursor is
@@ -2369,8 +2391,10 @@ package body Ada.Containers.Vectors is
    ---------------
 
    function Constant_Reference
-     (Container : Vector; Position : Cursor)    --  SHOULD BE ALIASED
-   return Constant_Reference_Type is
+     (Container : Vector;
+      Position  : Cursor)    --  SHOULD BE ALIASED
+      return Constant_Reference_Type
+   is
    begin
       pragma Unreferenced (Container);
 
@@ -2388,14 +2412,16 @@ package body Ada.Containers.Vectors is
    end Constant_Reference;
 
    function Constant_Reference
-     (Container : Vector; Position : Index_Type)
-   return Constant_Reference_Type is
+     (Container : Vector;
+      Position  : Index_Type)
+      return Constant_Reference_Type
+   is
    begin
       if (Position) > Container.Last then
          raise Constraint_Error with "Index is out of range";
-      end if;
-
+      else
          return (Element => Container.Elements.EA (Position)'Access);
+      end if;
    end Constant_Reference;
 
    function Reference (Container : Vector; Position : Cursor)
@@ -2420,9 +2446,9 @@ package body Ada.Containers.Vectors is
    begin
       if Position > Container.Last then
          raise Constraint_Error with "Index is out of range";
-      end if;
-
+      else
          return (Element => Container.Elements.EA (Position)'Access);
+      end if;
    end Reference;
 
    ---------------------
@@ -2496,10 +2522,12 @@ package body Ada.Containers.Vectors is
       --  container length.
 
       if Capacity = 0 then
+
          --  This is a request to trim back storage, to the minimum amount
          --  possible given the current state of the container.
 
          if N = 0 then
+
             --  The container is empty, so in this unique case we can
             --  deallocate the entire internal array. Note that an empty
             --  container can never be busy, so there's no need to check the
@@ -2507,6 +2535,7 @@ package body Ada.Containers.Vectors is
 
             declare
                X : Elements_Access := Container.Elements;
+
             begin
                --  First we remove the internal array from the container, to
                --  handle the case when the deallocation raises an exception.
@@ -2520,6 +2549,7 @@ package body Ada.Containers.Vectors is
             end;
 
          elsif N < Container.Elements.EA'Length then
+
             --  The container is not empty, and the current length is less than
             --  the current capacity, so there's storage available to trim. In
             --  this case, we allocate a new internal array having a length
@@ -2576,6 +2606,7 @@ package body Ada.Containers.Vectors is
       --  any possibility of overflow.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We perform a two-part test. First we determine whether the
          --  computed Last value lies in the base range of the type, and then
          --  determine whether it lies in the range of the index (sub)type.
@@ -2604,6 +2635,7 @@ package body Ada.Containers.Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  Here we can compute Last directly, in the normal way. We know that
          --  No_Index is less than 0, so there is no danger of overflow when
          --  adding the (positive) value of Capacity.
@@ -2642,6 +2674,7 @@ package body Ada.Containers.Vectors is
       --  this is a request for expansion or contraction of storage.
 
       if Container.Elements = null then
+
          --  The container is empty (it doesn't even have an internal array),
          --  so this represents a request to allocate (expand) storage having
          --  the given capacity.
@@ -2651,11 +2684,13 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Capacity <= N then
+
          --  This is a request to trim back storage, but only to the limit of
          --  what's already in the container. (Reserve_Capacity never deletes
          --  active elements, it only reclaims excess storage.)
 
          if N < Container.Elements.EA'Length then
+
             --  The container is not empty (because the requested capacity is
             --  positive, and less than or equal to the container length), and
             --  the current length is less than the current capacity, so
@@ -2708,6 +2743,7 @@ package body Ada.Containers.Vectors is
       --  current capacity is.
 
       if Capacity = Container.Elements.EA'Length then
+
          --  The requested capacity matches the existing capacity, so there's
          --  nothing to do here. We treat this case as a no-op, and simply
          --  return without checking the busy bit.
@@ -2761,6 +2797,7 @@ package body Ada.Containers.Vectors is
 
          declare
             X : Elements_Access := Container.Elements;
+
          begin
             --  First we isolate the old internal array, and replace it in the
             --  container with the new internal array.
@@ -2982,9 +3019,9 @@ package body Ada.Containers.Vectors is
    begin
       if Index not in Index_Type'First .. Container.Last then
          return No_Element;
-      end if;
-
+      else
          return Cursor'(Container'Unchecked_Access, Index);
+      end if;
    end To_Cursor;
 
    --------------
@@ -3026,6 +3063,7 @@ package body Ada.Containers.Vectors is
       --  create a Last index value greater than Index_Type'Last.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We perform a two-part test. First we determine whether the
          --  computed Last value lies in the base range of the type, and then
          --  determine whether it lies in the range of the index (sub)type.
@@ -3054,6 +3092,7 @@ package body Ada.Containers.Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  Here we can compute Last directly, in the normal way. We know that
          --  No_Index is less than 0, so there is no danger of overflow when
          --  adding the (positive) value of Length.
@@ -3114,6 +3153,7 @@ package body Ada.Containers.Vectors is
       --  create a Last index value greater than Index_Type'Last.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We perform a two-part test. First we determine whether the
          --  computed Last value lies in the base range of the type, and then
          --  determine whether it lies in the range of the index (sub)type.

gcc/ada/gnatls.adb

@@ -822,41 +822,18 @@ procedure Gnatls is
    --------------------------------
 
    procedure Output_License_Information is
-      Params_File_Name : constant String := "gnatlic.adl";
-      --  Name of license file
-
-      Lo   : constant Source_Ptr := 1;
-      Hi   : Source_Ptr;
-      Text : Source_Buffer_Ptr;
-
    begin
-      Name_Len := 0;
-      Add_Str_To_Name_Buffer (Params_File_Name);
-      Read_Source_File (Name_Find, Lo, Hi, Text);
-
-      if Text /= null then
-
-         --  Omit last character (end-of-file marker) in output
-
-         Write_Str (String (Text (Lo .. Hi - 1)));
-         Write_Eol;
-
-         --  The following condition is determined at compile time: disable
-         --  "condition is always true/false" warning.
-
-         pragma Warnings (Off);
-      elsif Build_Type /= GPL and then Build_Type /= FSF then
-         pragma Warnings (On);
-
-         Write_Str ("License file missing, please contact AdaCore.");
+      case Build_Type is
+         when Gnatpro =>
+            Write_Str ("Please refer to the section ""Software License"" on"
+                     & " GNAT Tracker at http://www.adacore.com/"
+                     & " for license terms.");
             Write_Eol;
-
-      else
+         when others =>
             Write_Str ("Please refer to file COPYING in your distribution"
                      & " for license terms.");
             Write_Eol;
-
-      end if;
+      end case;
 
       Exit_Program (E_Success);
    end Output_License_Information;

gcc/ada/sem_ch3.adb

@@ -7980,28 +7980,6 @@ package body Sem_Ch3 is
          Set_Last_Entity
            (Class_Wide_Type (Derived_Type), Last_Entity (Derived_Type));
       end if;
-
-      --  Update the scope of anonymous access types of discriminants and other
-      --  components, to prevent scope anomalies in gigi, when the derivation
-      --  appears in a scope nested within that of the parent.
-
-      declare
-         D : Entity_Id;
-
-      begin
-         D := First_Entity (Derived_Type);
-         while Present (D) loop
-            if Ekind_In (D, E_Discriminant, E_Component) then
-               if Is_Itype (Etype (D))
-                  and then Ekind (Etype (D)) = E_Anonymous_Access_Type
-               then
-                  Set_Scope (Etype (D), Current_Scope);
-               end if;
-            end if;
-
-            Next_Entity (D);
-         end loop;
-      end;
    end Build_Derived_Record_Type;
 
    ------------------------
@@ -15702,10 +15680,42 @@ package body Sem_Ch3 is
          Plain_Discrim  : Boolean := False;
          Stored_Discrim : Boolean := False)
       is
+         procedure Set_Anonymous_Type (Id : Entity_Id);
+         --  Id denotes the entity of an access discriminant or anonymous
+         --  access component. Set the type of Id to either the same type of
+         --  Old_C or create a new one depending on whether the parent and
+         --  the child types are in the same scope.
+
+         ------------------------
+         -- Set_Anonymous_Type --
+         ------------------------
+
+         procedure Set_Anonymous_Type (Id : Entity_Id) is
+            Typ : constant Entity_Id := Etype (Old_C);
+
+         begin
+            if Scope (Parent_Base) = Scope (Derived_Base) then
+               Set_Etype (Id, Typ);
+
+            --  The parent and the derived type are in two different scopes.
+            --  Reuse the type of the original discriminant / component by
+            --  copying it in order to preserve all attributes and update the
+            --  scope.
+
+            else
+               Set_Etype (Id, New_Copy (Typ));
+               Set_Scope (Etype (Id), Current_Scope);
+            end if;
+         end Set_Anonymous_Type;
+
+         --  Local variables and constants
+
          New_C : constant Entity_Id := New_Copy (Old_C);
 
-         Discrim      : Entity_Id;
          Corr_Discrim : Entity_Id;
+         Discrim      : Entity_Id;
+
+      --  Start of processing for Inherit_Component
 
       begin
          pragma Assert (not Is_Tagged or else not Stored_Discrim);
@@ -15727,6 +15737,14 @@ package body Sem_Ch3 is
             Set_Original_Record_Component (New_C, New_C);
          end if;
 
+         --  Set the proper type of an access discriminant
+
+         if Ekind (New_C) = E_Discriminant
+           and then Ekind (Etype (New_C)) = E_Anonymous_Access_Type
+         then
+            Set_Anonymous_Type (New_C);
+         end if;
+
          --  If we have inherited a component then see if its Etype contains
          --  references to Parent_Base discriminants. In this case, replace
          --  these references with the constraints given in Discs. We do not
@@ -15736,7 +15754,13 @@ package body Sem_Ch3 is
          --  transformation in some error situations.
 
          if Ekind (New_C) = E_Component then
-            if (Is_Private_Type (Derived_Base)
+
+            --  Set the proper type of an anonymous access component
+
+            if Ekind (Etype (New_C)) = E_Anonymous_Access_Type then
+               Set_Anonymous_Type (New_C);
+
+            elsif (Is_Private_Type (Derived_Base)
                      and then not Is_Generic_Type (Derived_Base))
               or else (Is_Empty_Elmt_List (Discs)
                          and then not Expander_Active)
@@ -15760,8 +15784,7 @@ package body Sem_Ch3 is
                --        type T_2 is new Pack_1.T_1 with ...;
                --     end Pack_2;
 
-               Set_Etype
-                 (New_C,
+               Set_Etype (New_C,
                  Constrain_Component_Type
                    (Old_C, Derived_Base, N, Parent_Base, Discs));
             end if;