Skip to content

R
riscv-gcc-1
Commit d7386a7a by Arnaud Charlet
Options

[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
parent 9d1e0e72
Showing with 180 additions and 121 deletions
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;
else
return Container.Elements.EA'Length;
end if;
return Container.Elements.EA'Length;
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)";
else
Container.Last := No_Index;
end if;
Container.Last := No_Index;
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";
else
return Position.Container.Elements.EA (Position.Index);
end if;
return Position.Container.Elements.EA (Position.Index);
end Element;
--------------
......@@ -794,18 +792,18 @@ package body Ada.Containers.Vectors is
begin
if Is_Empty (Container) then
return No_Element;
else
return (Container'Unchecked_Access, Index_Type'First);
end if;
return (Container'Unchecked_Access, Index_Type'First);
end First;
function First (Object : Iterator) return Cursor is
begin
if Is_Empty (Object.Container.all) then
return No_Element;
else
return Cursor'(Object.Container, Index_Type'First);
end if;
return Cursor'(Object.Container, Index_Type'First);
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";
else
return Container.Elements.EA (Index_Type'First);
end if;
return Container.Elements.EA (Index_Type'First);
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,10 +1546,10 @@ package body Ada.Containers.Vectors is
if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
else
Index := Container.Last + 1;
end if;
Index := Container.Last + 1;
else
Index := Before.Index;
end if;
......@@ -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,10 +2008,10 @@ package body Ada.Containers.Vectors is
if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
else
Index := Container.Last + 1;
end if;
Index := Container.Last + 1;
else
Index := Before.Index;
end if;
......@@ -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;
else
return (Container'Unchecked_Access, Container.Last);
end if;
return (Container'Unchecked_Access, Container.Last);
end Last;
function Last (Object : Iterator) return Cursor is
begin
if Is_Empty (Object.Container.all) then
return No_Element;
else
return Cursor'(Object.Container, Object.Container.Last);
end if;
return Cursor'(Object.Container, Object.Container.Last);
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";
else
return Container.Elements.EA (Container.Last);
end if;
return Container.Elements.EA (Container.Last);
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);
else
return No_Element;
end if;
return No_Element;
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";
else
return (Element => Container.Elements.EA (Position)'Access);
end if;
return (Element => Container.Elements.EA (Position)'Access);
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";
else
return (Element => Container.Elements.EA (Position)'Access);
end if;
return (Element => Container.Elements.EA (Position)'Access);
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;
else
return Cursor'(Container'Unchecked_Access, Index);
end if;
return Cursor'(Container'Unchecked_Access, Index);
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.");
Write_Eol;
else
Write_Str ("Please refer to file COPYING in your distribution"
& " for license terms.");
Write_Eol;
end if;
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;
when others =>
Write_Str ("Please refer to file COPYING in your distribution"
& " for license terms.");
Write_Eol;
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,10 +15754,16 @@ package body Sem_Ch3 is
-- transformation in some error situations.
if Ekind (New_C) = E_Component then
if (Is_Private_Type (Derived_Base)
and then not Is_Generic_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)
and then not Expander_Active)
then
Set_Etype (New_C, Etype (Old_C));
......@@ -15760,10 +15784,9 @@ package body Sem_Ch3 is
-- type T_2 is new Pack_1.T_1 with ...;
-- end Pack_2;
Set_Etype
(New_C,
Constrain_Component_Type
(Old_C, Derived_Base, N, Parent_Base, Discs));
Set_Etype (New_C,
Constrain_Component_Type
(Old_C, Derived_Base, N, Parent_Base, Discs));
end if;
end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment