Commit 7134062a by Arnaud Charlet

[multiple changes]

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* sem_ch6.adb, exp_ch3.adb, s-stposu.adb, a-undesu.ads,
	a-undesu.adb: Minor reformatting.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* exp_disp.adb (Check_Premature_Freezing): When building a dispatch
	table, accept an unfrozen untagged component if it is an actual for a
	formal incomplete type.
	* a-convec.ads, a-convec.adb: Instantiate Ada.Iterator_Interfaces to
	provide new iterator forms over vectors.
	Introduce type Iterator in package body to implement operations of
	Reversible_Iterator interface.
	* a-iteint.ads: Make package pure so it is usable with new container
	packages, that are categorized Remote_Types.

From-SVN: r178211
parent 544d960a
2011-08-29 Robert Dewar <dewar@adacore.com> 2011-08-29 Robert Dewar <dewar@adacore.com>
* sem_ch6.adb, exp_ch3.adb, s-stposu.adb, a-undesu.ads,
a-undesu.adb: Minor reformatting.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* exp_disp.adb (Check_Premature_Freezing): When building a dispatch
table, accept an unfrozen untagged component if it is an actual for a
formal incomplete type.
* a-convec.ads, a-convec.adb: Instantiate Ada.Iterator_Interfaces to
provide new iterator forms over vectors.
Introduce type Iterator in package body to implement operations of
Reversible_Iterator interface.
* a-iteint.ads: Make package pure so it is usable with new container
packages, that are categorized Remote_Types.
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-exexpr-gcc.adb, a-synbar.adb, sem_ch13.adb: Minor reformatting. * a-exexpr-gcc.adb, a-synbar.adb, sem_ch13.adb: Minor reformatting.
2011-08-29 Bob Duff <duff@adacore.com> 2011-08-29 Bob Duff <duff@adacore.com>
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -37,6 +37,19 @@ package body Ada.Containers.Vectors is ...@@ -37,6 +37,19 @@ package body Ada.Containers.Vectors is
procedure Free is procedure Free is
new Ada.Unchecked_Deallocation (Elements_Type, Elements_Access); new Ada.Unchecked_Deallocation (Elements_Type, Elements_Access);
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;
--------- ---------
-- "&" -- -- "&" --
--------- ---------
...@@ -786,6 +799,12 @@ package body Ada.Containers.Vectors is ...@@ -786,6 +799,12 @@ package body Ada.Containers.Vectors is
return (Container'Unchecked_Access, Index_Type'First); return (Container'Unchecked_Access, Index_Type'First);
end First; end First;
function First (Object : Iterator) return Cursor is
C : constant Cursor := (Object.Container, Index_Type'First);
begin
return C;
end First;
------------------- -------------------
-- First_Element -- -- First_Element --
------------------- -------------------
...@@ -937,11 +956,7 @@ package body Ada.Containers.Vectors is ...@@ -937,11 +956,7 @@ package body Ada.Containers.Vectors is
function Has_Element (Position : Cursor) return Boolean is function Has_Element (Position : Cursor) return Boolean is
begin begin
if Position.Container = null then return Position /= No_Element;
return False;
end if;
return Position.Index <= Position.Container.Last;
end Has_Element; end Has_Element;
------------ ------------
...@@ -2018,6 +2033,23 @@ package body Ada.Containers.Vectors is ...@@ -2018,6 +2033,23 @@ package body Ada.Containers.Vectors is
B := B - 1; B := B - 1;
end Iterate; end Iterate;
function Iterate (Container : Vector)
return Vector_Iterator_Interfaces.Reversible_Iterator'class
is
It : constant Iterator := (Container'Unchecked_Access, Index_Type'First);
begin
return It;
end Iterate;
function Iterate (Container : Vector; Start : Cursor)
return Vector_Iterator_Interfaces.Forward_Iterator'class
is
It : constant Iterator :=
(Container'Unchecked_Access, Start.Index);
begin
return It;
end Iterate;
---------- ----------
-- Last -- -- Last --
---------- ----------
...@@ -2031,6 +2063,12 @@ package body Ada.Containers.Vectors is ...@@ -2031,6 +2063,12 @@ package body Ada.Containers.Vectors is
return (Container'Unchecked_Access, Container.Last); return (Container'Unchecked_Access, Container.Last);
end Last; end Last;
function Last (Object : Iterator) return Cursor is
C : constant Cursor := (Object.Container, Object.Container.Last);
begin
return C;
end Last;
------------------ ------------------
-- Last_Element -- -- Last_Element --
------------------ ------------------
...@@ -2138,6 +2176,17 @@ package body Ada.Containers.Vectors is ...@@ -2138,6 +2176,17 @@ package body Ada.Containers.Vectors is
return No_Element; return No_Element;
end Next; end Next;
function Next (Object : Iterator; Position : Cursor) return Cursor
is
begin
if Position.Index = Object.Container.Last then
return No_Element;
else
return (Object.Container, Position.Index + 1);
end if;
end Next;
---------- ----------
-- Next -- -- Next --
---------- ----------
...@@ -2206,6 +2255,16 @@ package body Ada.Containers.Vectors is ...@@ -2206,6 +2255,16 @@ package body Ada.Containers.Vectors is
return No_Element; return No_Element;
end Previous; end Previous;
function Previous (Object : Iterator; Position : Cursor) return Cursor
is
begin
if Position.Index > Index_Type'First then
return (Object.Container, Position.Index - 1);
else
return No_Element;
end if;
end Previous;
------------------- -------------------
-- Query_Element -- -- Query_Element --
------------------- -------------------
...@@ -2287,6 +2346,83 @@ package body Ada.Containers.Vectors is ...@@ -2287,6 +2346,83 @@ package body Ada.Containers.Vectors is
raise Program_Error with "attempt to stream vector cursor"; raise Program_Error with "attempt to stream vector cursor";
end Read; end Read;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
---------------
-- Reference --
---------------
function Constant_Reference
(Container : Vector; Position : Cursor) -- SHOULD BE ALIASED
return Constant_Reference_Type is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return
(Element =>
Position.Container.Elements.EA (Position.Index)'Access);
end Constant_Reference;
function Constant_Reference
(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;
return (Element => Container.Elements.EA (Position)'Access);
end Constant_Reference;
function Reference (Container : Vector; Position : Cursor)
return Reference_Type is
begin
pragma Unreferenced (Container);
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Index > Position.Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
return
(Element => Position.Container.Elements.EA (Position.Index)'Access);
end Reference;
function Reference (Container : Vector; Position : Index_Type)
return Reference_Type is
begin
if Position > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
return (Element => Container.Elements.EA (Position)'Access);
end Reference;
--------------------- ---------------------
-- Replace_Element -- -- Replace_Element --
--------------------- ---------------------
...@@ -3117,4 +3253,20 @@ package body Ada.Containers.Vectors is ...@@ -3117,4 +3253,20 @@ package body Ada.Containers.Vectors is
raise Program_Error with "attempt to stream vector cursor"; raise Program_Error with "attempt to stream vector cursor";
end Write; end Write;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Write;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Write;
end Ada.Containers.Vectors; end Ada.Containers.Vectors;
...@@ -32,8 +32,8 @@ ...@@ -32,8 +32,8 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
private with Ada.Finalization; private with Ada.Finalization;
private with Ada.Streams; with Ada.Streams;
with Ada.Iterator_Interfaces;
generic generic
type Index_Type is range <>; type Index_Type is range <>;
type Element_Type is private; type Element_Type is private;
...@@ -43,6 +43,7 @@ generic ...@@ -43,6 +43,7 @@ generic
package Ada.Containers.Vectors is package Ada.Containers.Vectors is
pragma Preelaborate; pragma Preelaborate;
pragma Remote_Types; pragma Remote_Types;
use Ada.Streams;
subtype Extended_Index is Index_Type'Base subtype Extended_Index is Index_Type'Base
range Index_Type'First - 1 .. range Index_Type'First - 1 ..
...@@ -50,15 +51,35 @@ package Ada.Containers.Vectors is ...@@ -50,15 +51,35 @@ package Ada.Containers.Vectors is
No_Index : constant Extended_Index := Extended_Index'First; No_Index : constant Extended_Index := Extended_Index'First;
type Vector is tagged private; type Vector is tagged private
with
Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
pragma Preelaborable_Initialization (Vector); pragma Preelaborable_Initialization (Vector);
type Cursor is private; type Cursor is private;
pragma Preelaborable_Initialization (Cursor); pragma Preelaborable_Initialization (Cursor);
No_Element : constant Cursor;
Empty_Vector : constant Vector; function Has_Element (Position : Cursor) return Boolean;
No_Element : constant Cursor; procedure Read
(Stream : not null access Root_Stream_Type'Class;
Position : out Cursor);
for Cursor'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Position : Cursor);
for Cursor'Write use Write;
package Vector_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
Empty_Vector : constant Vector;
overriding function "=" (Left, Right : Vector) return Boolean; overriding function "=" (Left, Right : Vector) return Boolean;
...@@ -133,8 +154,55 @@ package Ada.Containers.Vectors is ...@@ -133,8 +154,55 @@ package Ada.Containers.Vectors is
Position : Cursor; Position : Cursor;
Process : not null access procedure (Element : in out Element_Type)); Process : not null access procedure (Element : in out Element_Type));
procedure Move (Target : in out Vector; Source : in out Vector); type Constant_Reference_Type
(Element : not null access constant Element_Type) is
private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
type Reference_Type (Element : not null access Element_Type) is private
with
Implicit_Dereference => Element;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
for Reference_Type'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
for Reference_Type'Read use Read;
function Constant_Reference
(Container : Vector; Position : Cursor) -- SHOULD BE ALIASED
return Constant_Reference_Type;
function Constant_Reference
(Container : Vector; Position : Index_Type)
return Constant_Reference_Type;
function Reference (Container : Vector; Position : Cursor)
return Reference_Type;
function Reference (Container : Vector; Position : Index_Type)
return Reference_Type;
procedure Move (Target : in out Vector; Source : in out Vector);
procedure Insert procedure Insert
(Container : in out Vector; (Container : in out Vector;
Before : Extended_Index; Before : Extended_Index;
...@@ -278,8 +346,6 @@ package Ada.Containers.Vectors is ...@@ -278,8 +346,6 @@ package Ada.Containers.Vectors is
(Container : Vector; (Container : Vector;
Item : Element_Type) return Boolean; Item : Element_Type) return Boolean;
function Has_Element (Position : Cursor) return Boolean;
procedure Iterate procedure Iterate
(Container : Vector; (Container : Vector;
Process : not null access procedure (Position : Cursor)); Process : not null access procedure (Position : Cursor));
...@@ -288,6 +354,12 @@ package Ada.Containers.Vectors is ...@@ -288,6 +354,12 @@ package Ada.Containers.Vectors is
(Container : Vector; (Container : Vector;
Process : not null access procedure (Position : Cursor)); Process : not null access procedure (Position : Cursor));
function Iterate (Container : Vector)
return Vector_Iterator_Interfaces.Reversible_Iterator'class;
function Iterate (Container : Vector; Start : Cursor)
return Vector_Iterator_Interfaces.Forward_Iterator'class;
generic generic
with function "<" (Left, Right : Element_Type) return Boolean is <>; with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is package Generic_Sorting is
...@@ -315,7 +387,7 @@ private ...@@ -315,7 +387,7 @@ private
pragma Inline (Next); pragma Inline (Next);
pragma Inline (Previous); pragma Inline (Previous);
type Elements_Array is array (Index_Type range <>) of Element_Type; type Elements_Array is array (Index_Type range <>) of aliased Element_Type;
function "=" (L, R : Elements_Array) return Boolean is abstract; function "=" (L, R : Elements_Array) return Boolean is abstract;
type Elements_Type (Last : Index_Type) is limited record type Elements_Type (Last : Index_Type) is limited record
...@@ -333,11 +405,13 @@ private ...@@ -333,11 +405,13 @@ private
Lock : Natural := 0; Lock : Natural := 0;
end record; end record;
overriding procedure Adjust (Container : in out Vector); type Vector_Access is access constant Vector;
for Vector_Access'Storage_Size use 0;
overriding procedure Finalize (Container : in out Vector);
use Ada.Streams; type Cursor is record
Container : Vector_Access;
Index : Index_Type := Index_Type'First;
end record;
procedure Write procedure Write
(Stream : not null access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
...@@ -351,28 +425,17 @@ private ...@@ -351,28 +425,17 @@ private
for Vector'Read use Read; for Vector'Read use Read;
type Vector_Access is access constant Vector; type Constant_Reference_Type
for Vector_Access'Storage_Size use 0; (Element : not null access constant Element_Type) is null record;
type Cursor is record
Container : Vector_Access;
Index : Index_Type := Index_Type'First;
end record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Position : Cursor);
for Cursor'Write use Write; type Reference_Type
(Element : not null access Element_Type) is null record;
procedure Read overriding procedure Adjust (Container : in out Vector);
(Stream : not null access Root_Stream_Type'Class;
Position : out Cursor);
for Cursor'Read use Read; overriding procedure Finalize (Container : in out Vector);
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0); Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
end Ada.Containers.Vectors; end Ada.Containers.Vectors;
...@@ -6,32 +6,45 @@ ...@@ -6,32 +6,45 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely -- -- GNAT. The copyright notice above, and the license provisions that follow --
-- copy and modify this specification, provided that if you redistribute a -- -- apply solely to the contents of the part following the private keyword. --
-- modified version, any changes that you have made are clearly indicated. -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
generic generic
type Cursor is private; type Cursor;
No_Element : Cursor; with function Has_Element (Position : Cursor) return Boolean;
pragma Unreferenced (No_Element);
package Ada.Iterator_Interfaces is package Ada.Iterator_Interfaces is
type Forward_Iterator is limited interface; pragma Pure;
type Forward_Iterator is limited interface;
function First (Object : Forward_Iterator) return Cursor is abstract; function First (Object : Forward_Iterator) return Cursor is abstract;
function Next function Next
(Object : Forward_Iterator; (Object : Forward_Iterator;
Position : Cursor) return Cursor is abstract; Position : Cursor) return Cursor is abstract;
type Reversible_Iterator is limited interface and Forward_Iterator; type Reversible_Iterator is limited interface and Forward_Iterator;
function Last (Object : Reversible_Iterator) return Cursor is abstract; function Last (Object : Reversible_Iterator) return Cursor is abstract;
function Previous function Previous
(Object : Reversible_Iterator; (Object : Reversible_Iterator;
Position : Cursor) return Cursor is abstract; Position : Cursor) return Cursor is abstract;
end Ada.Iterator_Interfaces; end Ada.Iterator_Interfaces;
...@@ -8,15 +8,27 @@ ...@@ -8,15 +8,27 @@
-- -- -- --
-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- Copyright (C) 2011, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- GNAT. In accordance with the copyright of that document, you can freely -- -- terms of the GNU General Public License as published by the Free Soft- --
-- copy and modify this specification, provided that if you redistribute a -- -- ware Foundation; either version 3, or (at your option) any later ver- --
-- modified version, any changes that you have made are clearly indicated. -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- ??? What is the header version here, see a-uncdea.adb. No GPL?
with System.Storage_Pools.Subpools, with System.Storage_Pools.Subpools,
System.Storage_Pools.Subpools.Finalization; System.Storage_Pools.Subpools.Finalization;
......
...@@ -6,8 +6,6 @@ ...@@ -6,8 +6,6 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely -- -- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a -- -- copy and modify this specification, provided that if you redistribute a --
...@@ -15,8 +13,6 @@ ...@@ -15,8 +13,6 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- ??? What is the header version here, see a-uncdea.ads. No GPL?
with System.Storage_Pools.Subpools; with System.Storage_Pools.Subpools;
procedure Ada.Unchecked_Deallocate_Subpool procedure Ada.Unchecked_Deallocate_Subpool
......
...@@ -5483,7 +5483,7 @@ package body Exp_Ch3 is ...@@ -5483,7 +5483,7 @@ package body Exp_Ch3 is
end if; end if;
-- ??? Now that masters acts as heterogeneous lists, it might be -- ??? Now that masters acts as heterogeneous lists, it might be
-- worthed to revisit the global master approach. -- worthwhile to revisit the global master approach.
elsif Ekind (Comp_Typ) = E_Anonymous_Access_Type elsif Ekind (Comp_Typ) = E_Anonymous_Access_Type
and then Needs_Finalization (Directly_Designated_Type (Comp_Typ)) and then Needs_Finalization (Directly_Designated_Type (Comp_Typ))
......
...@@ -3698,6 +3698,46 @@ package body Exp_Disp is ...@@ -3698,6 +3698,46 @@ package body Exp_Disp is
Typ : Entity_Id) Typ : Entity_Id)
is is
Comp : Entity_Id; Comp : Entity_Id;
function Is_Actual_For_Formal_Incomplete_Type (T : Entity_Id)
return Boolean;
-- In Ada2012, if a nested generic has an incomplete formal type, the
-- actual may be (and usually is) a private type whose completion
-- appears later. It is safe to build the dispatch table in this
-- case, gigi will have full views available.
------------------------------------------
-- Is_Actual_For_Formal_Incomplete_Type --
------------------------------------------
function Is_Actual_For_Formal_Incomplete_Type (T : Entity_Id)
return Boolean
is
Gen_Par : Entity_Id;
F : Node_Id;
begin
if not Is_Generic_Instance (Current_Scope)
or else not Used_As_Generic_Actual (T)
then
return False;
else
Gen_Par := Generic_Parent (Parent (Current_Scope));
end if;
F :=
First
(Generic_Formal_Declarations
(Unit_Declaration_Node (Gen_Par)));
while Present (F) loop
if Ekind (Defining_Identifier (F)) = E_Incomplete_Type then
return True;
end if;
Next (F);
end loop;
return False;
end Is_Actual_For_Formal_Incomplete_Type;
begin begin
if Present (N) if Present (N)
...@@ -3720,6 +3760,8 @@ package body Exp_Disp is ...@@ -3720,6 +3760,8 @@ package body Exp_Disp is
if not Is_Tagged_Type (Typ) if not Is_Tagged_Type (Typ)
and then Present (Comp) and then Present (Comp)
and then not Is_Frozen (Comp) and then not Is_Frozen (Comp)
and then
not Is_Actual_For_Formal_Incomplete_Type (Comp)
then then
Error_Msg_Sloc := Sloc (Subp); Error_Msg_Sloc := Sloc (Subp);
Error_Msg_Node_2 := Subp; Error_Msg_Node_2 := Subp;
......
...@@ -8,10 +8,6 @@ ...@@ -8,10 +8,6 @@
-- -- -- --
-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- Copyright (C) 2011, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- -- -- ware Foundation; either version 3, or (at your option) any later ver- --
...@@ -259,6 +255,7 @@ package body System.Storage_Pools.Subpools is ...@@ -259,6 +255,7 @@ package body System.Storage_Pools.Subpools is
-- object. This operation effectively hides the list header. -- object. This operation effectively hides the list header.
Addr := N_Addr + Header_And_Padding; Addr := N_Addr + Header_And_Padding;
else else
Addr := N_Addr; Addr := N_Addr;
end if; end if;
...@@ -346,6 +343,7 @@ package body System.Storage_Pools.Subpools is ...@@ -346,6 +343,7 @@ package body System.Storage_Pools.Subpools is
-- hidden list header. -- hidden list header.
N_Size := Storage_Size + Header_And_Padding; N_Size := Storage_Size + Header_And_Padding;
else else
N_Addr := Addr; N_Addr := Addr;
N_Size := Storage_Size; N_Size := Storage_Size;
......
...@@ -2348,7 +2348,7 @@ package body Sem_Ch6 is ...@@ -2348,7 +2348,7 @@ package body Sem_Ch6 is
-- the proper back-annotations. -- the proper back-annotations.
if not Is_Frozen (Spec_Id) if not Is_Frozen (Spec_Id)
and then (Expander_Active or else ASIS_Mode) and then (Expander_Active or ASIS_Mode)
then then
-- Force the generation of its freezing node to ensure proper -- Force the generation of its freezing node to ensure proper
-- management of access types in the backend. -- management of access types in the backend.
......
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