git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2014-02-20  Robert Dewar  <dewar@adacore.com>

	* a-cborma.adb, a-cbhama.adb, a-cbdlli.adb, a-cbmutr.adb: Use pragma
	Unmodified rather than Warnings (Off). Make comments
	uniform in the four affected units.

2014-02-20  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
	Object_Size): For non-scalar types allow any value that is a
	multiple of 8.
	* gnat_rm.texi: Document Object_Size for composites more clearly.

2014-02-20  Yannick Moy  <moy@adacore.com>

	* sem_util.ads, sem_util.adb (Default_Initialization): Remove function.

2014-02-20  Ed Schonberg  <schonberg@adacore.com>

	* stand.ads: Raise_Type: new predefined entity, used as the type
	of a Raise_Expression prior to resolution.
	* cstand.adb: Build entity for Raise_Type.
	* sem_ch11.adb (Analyze_Raise_Expression): use Raise_Type as the
	initial type of the node.
	* sem_type.adb (Covers): Raise_Type is compatible with all
	other types.
	* sem_res.adb (Resolve): Remove special handling of Any_Type on
	Raise_Expression nodes.
	(Resolve_Raise_Expression): Signal ambiguity if the type of the
	context is still Raise_Type.

From-SVN: r207950
This commit is contained in:
Arnaud Charlet 2014-02-20 15:04:38 +01:00
parent 7f568bfad3
commit 3e586e100a
14 changed files with 113 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
gcc/ada/ChangeLog
View File

@ -1,3 +1,34 @@
2014-02-20 Robert Dewar <dewar@adacore.com>
* a-cborma.adb, a-cbhama.adb, a-cbdlli.adb, a-cbmutr.adb: Use pragma
Unmodified rather than Warnings (Off). Make comments
uniform in the four affected units.
2014-02-20 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
Object_Size): For non-scalar types allow any value that is a
multiple of 8.
* gnat_rm.texi: Document Object_Size for composites more clearly.
2014-02-20 Yannick Moy <moy@adacore.com>
* sem_util.ads, sem_util.adb (Default_Initialization): Remove function.
2014-02-20 Ed Schonberg <schonberg@adacore.com>
* stand.ads: Raise_Type: new predefined entity, used as the type
of a Raise_Expression prior to resolution.
* cstand.adb: Build entity for Raise_Type.
* sem_ch11.adb (Analyze_Raise_Expression): use Raise_Type as the
initial type of the node.
* sem_type.adb (Covers): Raise_Type is compatible with all
other types.
* sem_res.adb (Resolve): Remove special handling of Any_Type on
Raise_Expression nodes.
(Resolve_Raise_Expression): Signal ambiguity if the type of the
context is still Raise_Type.
2014-02-20 Robert Dewar <dewar@adacore.com>
* sem_ch12.adb (Validate_Access_Type_Instance): Add message if

15
gcc/ada/a-cbdlli.adb
View File

@ -1121,15 +1121,16 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Position : out Cursor;
Count : Count_Type := 1)
is
New_Item : Element_Type; -- Default initialized.
pragma Warnings (Off, New_Item);
New_Item : Element_Type;
pragma Unmodified (New_Item);
-- OK to reference, see below
begin
-- There is no explicit element provided, but in an instance the
-- element type may be a scalar with a Default_Value aspect, or a
-- composite type with such a scalar component, so we insert the
-- specified number of possibly initialized elements at the given
-- position.
-- There is no explicit element provided, but in an instance the element
-- type may be a scalar with a Default_Value aspect, or a composite
-- type with such a scalar component, or components with default
-- initialization, so insert the specified number of possibly
-- initialized elements at the given position.
Insert (Container, Before, New_Item, Position, Count);
end Insert;

9
gcc/ada/a-cbhama.adb
View File

@ -557,16 +557,17 @@ package body Ada.Containers.Bounded_Hashed_Maps is
procedure Assign_Key (Node : in out Node_Type) is
New_Item : Element_Type;
pragma Warnings (Off, New_Item);
pragma Unmodified (New_Item);
-- Default-initialized element (ok to reference, see below)
begin
Node.Key := Key;
-- There is no explicit element provided, but in an instance the
-- element type may be a scalar with a Default_Value aspect, or
-- a composite type with such a scalar component, so we insert
-- a possibly initialized element under the given key.
-- element type may be a scalar with a Default_Value aspect, or a
-- composite type with such a scalar component, or components with
-- default initialization, so insert a possibly initialized element
-- under the given key.
Node.Element := New_Item;
end Assign_Key;

19
gcc/ada/a-cbmutr.adb
View File

@ -1585,14 +1585,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is
Nodes : Tree_Node_Array renames Container.Nodes;
Last : Count_Type;
Elem : Element_Type;
pragma Unmodified (Elem);
-- There is no explicit element provided, but in an instance the
-- element type may be a scalar with a Default_Value aspect, or a
-- composite type with such a scalar component, so we insert the
-- specified number of possibly initialized elements at the given
-- position. So we are declaring Elem just for this possible default
-- initialization, which is why we need the pragma Unmodified.
New_Item : Element_Type;
pragma Unmodified (New_Item);
-- OK to reference, see below
begin
if Parent = No_Element then
@ -1632,7 +1627,13 @@ package body Ada.Containers.Bounded_Multiway_Trees is
Initialize_Root (Container);
end if;
Allocate_Node (Container, Elem, Position.Node);
-- There is no explicit element provided, but in an instance the element
-- type may be a scalar with a Default_Value aspect, or a composite
-- type with such a scalar component, or components with default
-- initialization, so insert the specified number of possibly
-- initialized elements at the given position.
Allocate_Node (Container, New_Item, Position.Node);
Nodes (Position.Node).Parent := Parent.Node;
Last := Position.Node;

10
gcc/ada/a-cborma.adb
View File

@ -827,16 +827,16 @@ package body Ada.Containers.Bounded_Ordered_Maps is
procedure Assign (Node : in out Node_Type) is
New_Item : Element_Type;
pragma Warnings (Off, New_Item);
pragma Unmodified (New_Item);
-- Default-initialized element (ok to reference, see below)
begin
Node.Key := Key;
-- There is no explicit element provided, but in an instance the
-- element type may be a scalar with a Default_Value aspect, or
-- a composite type with such a scalar component, so we insert
-- a possibly initialized element under the given key.
-- There is no explicit element provided, but in an instance the element
-- type may be a scalar with a Default_Value aspect, or a composite type
-- with such a scalar component or with defaulted components, so insert
-- possibly initialized elements at the given position.
Node.Element := New_Item;
end Assign;

7
gcc/ada/cstand.adb
View File

@ -1321,6 +1321,13 @@ package body CStand is
Set_First_Index (Any_String, Index);
end;
Raise_Type := New_Standard_Entity;
Decl := New_Node (N_Full_Type_Declaration, Stloc);
Set_Defining_Identifier (Decl, Raise_Type);
Set_Scope (Raise_Type, Standard_Standard);
Build_Signed_Integer_Type (Raise_Type, Standard_Integer_Size);
Make_Name (Raise_Type, "any type");
Standard_Integer_8 := New_Standard_Entity;
Decl := New_Node (N_Full_Type_Declaration, Stloc);
Set_Defining_Identifier (Decl, Standard_Integer_8);

4
gcc/ada/gnat_rm.texi
View File

@ -8740,6 +8740,10 @@ alignment will be 4, because of the
integer field, and so the default size of record objects for this type
will be 64 (8 bytes).
If the alignment of the above record is specified to be 1, then the
object size will be 40 (5 bytes). This is true by default, and also
an object size of 40 can be explicitly specified in this case.
A consequence of this capability is that different object sizes can be
given to subtypes that would otherwise be considered in Ada to be
statically matching. But it makes no sense to consider such subtypes

6
gcc/ada/sem_ch11.adb
View File

@ -475,9 +475,11 @@ package body Sem_Ch11 is
Kill_Current_Values (Last_Assignment_Only => True);
-- Set type as Any_Type since we have no information at all on the type
-- Raise_Type is compatible with all other types so that the raise
-- expression is legal in any expression context. It will be eventually
-- replaced by the concrete type imposed by the context.
Set_Etype (N, Any_Type);
Set_Etype (N, Raise_Type);
end Analyze_Raise_Expression;
-----------------------------

22
gcc/ada/sem_ch13.adb
View File

@ -4413,17 +4413,17 @@ package body Sem_Ch13 is
else
Check_Size (Expr, U_Ent, Size, Biased);
if Size /= 8
and then
Size /= 16
and then
Size /= 32
and then
UI_Mod (Size, 64) /= 0
then
Error_Msg_N
("Object_Size must be 8, 16, 32, or multiple of 64",
Expr);
if Is_Scalar_Type (U_Ent) then
if Size /= 8 and then Size /= 16 and then Size /= 32
and then UI_Mod (Size, 64) /= 0
then
Error_Msg_N
("Object_Size must be 8, 16, 32, or multiple of 64",
Expr);
end if;
elsif Size mod 8 /= 0 then
Error_Msg_N ("Object_Size must be a multiple of 8", Expr);
end if;
Set_Esize (U_Ent, Size);

30
gcc/ada/sem_res.adb
View File

@ -2060,17 +2060,8 @@ package body Sem_Res is
Analyze_Dimension (N);
return;
-- A Raise_Expression takes its type from context. The Etype was set
-- to Any_Type, reflecting the fact that the expression itself does
-- not specify any possible interpretation. So we set the type to the
-- resolution type here and now. We need to do this before Resolve sees
-- the Any_Type value.
elsif Nkind (N) = N_Raise_Expression then
Set_Etype (N, Typ);
-- Any other case of Any_Type as the Etype value means that we had
-- a previous error.
-- Any case of Any_Type as the Etype value means that we had a
-- previous error.
elsif Etype (N) = Any_Type then
Debug_A_Exit ("resolving ", N, " (done, Etype = Any_Type)");
@ -7405,6 +7396,16 @@ package body Sem_Res is
Check_Fully_Declared_Prefix (Typ, P);
P_Typ := Empty;
-- A useful optimization: check whether the dereference denotes an
-- element of a container, and if so rewrite it as a call to the
-- corresponding Element function.
-- Disabled for now, on advice of ARG. A more restricted form of the
-- predicate might be acceptable ???
-- if Is_Container_Element (N) then
-- return;
-- end if;
if Is_Overloaded (P) then
-- Use the context type to select the prefix that has the correct
@ -8816,7 +8817,12 @@ package body Sem_Res is
procedure Resolve_Raise_Expression (N : Node_Id; Typ : Entity_Id) is
begin
Set_Etype (N, Typ);
if Typ = Raise_Type then
Error_Msg_N ("cannot find unique type for raise expression", N);
Set_Etype (N, Any_Type);
else
Set_Etype (N, Typ);
end if;
end Resolve_Raise_Expression;
-------------------

5
gcc/ada/sem_type.adb
View File

@ -1128,6 +1128,11 @@ package body Sem_Type is
elsif BT2 = Any_Type then
return True;
-- A Raise_Expressions is legal in any expression context.
elsif BT2 = Raise_Type then
return True;
-- A packed array type covers its corresponding non-packed type. This is
-- not legitimate Ada, but allows the omission of a number of otherwise
-- useless unchecked conversions, and since this can only arise in

132
gcc/ada/sem_util.adb
View File

@ -4036,138 +4036,6 @@ package body Sem_Util is
end if;
end Deepest_Type_Access_Level;
----------------------------
-- Default_Initialization --
----------------------------
function Default_Initialization
(Typ : Entity_Id) return Default_Initialization_Kind
is
Comp : Entity_Id;
Init : Default_Initialization_Kind;
FDI : Boolean := False;
NDI : Boolean := False;
-- Two flags used to designate whether a record type has at least one
-- fully default initialized component and/or one not fully default
-- initialized component.
begin
-- Access types are always fully default initialized
if Is_Access_Type (Typ) then
return Full_Default_Initialization;
-- An array type subject to aspect/pragma Default_Component_Value is
-- fully default initialized. Otherwise its initialization status is
-- that of its component type.
elsif Is_Array_Type (Typ) then
if Present (Default_Aspect_Component_Value (Base_Type (Typ))) then
return Full_Default_Initialization;
else
return Default_Initialization (Component_Type (Typ));
end if;
-- The initialization status of a private type depends on its full view
elsif Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
return Default_Initialization (Full_View (Typ));
-- Record and protected types offer several initialization options
-- depending on their components (if any).
elsif Is_Record_Type (Typ) or else Is_Protected_Type (Typ) then
Comp := First_Component (Typ);
-- Inspect all components
if Present (Comp) then
while Present (Comp) loop
-- Do not process internally generated components except for
-- _parent which represents the ancestor portion of a derived
-- type.
if Comes_From_Source (Comp)
or else Chars (Comp) = Name_uParent
then
Init := Default_Initialization (Base_Type (Etype (Comp)));
-- A component with mixed initialization renders the whole
-- record/protected type mixed.
if Init = Mixed_Initialization then
return Mixed_Initialization;
-- The component is fully default initialized when its type
-- is fully default initialized or when the component has an
-- initialization expression. Note that this has precedence
-- given that the component type may lack initialization.
elsif Init = Full_Default_Initialization
or else Present (Expression (Parent (Comp)))
then
FDI := True;
-- Components with no possible initialization are ignored
elsif Init = No_Possible_Initialization then
null;
-- The component has no full default initialization
else
NDI := True;
end if;
end if;
Next_Component (Comp);
end loop;
-- Detect a mixed case of initialization
if FDI and NDI then
return Mixed_Initialization;
elsif FDI then
return Full_Default_Initialization;
elsif NDI then
return No_Default_Initialization;
-- The type either has no components or they are all internally
-- generated.
else
return No_Possible_Initialization;
end if;
-- The record type is null, there is nothing to initialize
else
return No_Possible_Initialization;
end if;
-- A scalar type subject to aspect/pragma Default_Value is fully default
-- initialized.
elsif Is_Scalar_Type (Typ)
and then Present (Default_Aspect_Value (Base_Type (Typ)))
then
return Full_Default_Initialization;
-- Task types are always fully default initialized
elsif Is_Task_Type (Typ) then
return Full_Default_Initialization;
end if;
-- The type has no full default initialization
return No_Default_Initialization;
end Default_Initialization;
---------------------
-- Defining_Entity --
---------------------

33
gcc/ada/sem_util.ads
View File

@ -419,39 +419,6 @@ package Sem_Util is
-- Current_Scope is returned. The returned value is Empty if this is called
-- from a library package which is not within any subprogram.
-- The following type lists all possible forms of default initialization
-- that may apply to a type.
type Default_Initialization_Kind is
(No_Possible_Initialization,
-- This value signifies that a type cannot possibly be initialized
-- because it has no content, for example - a null record.
Full_Default_Initialization,
-- This value covers the following combinations of types and content:
-- * Access type
-- * Array-of-scalars with specified Default_Component_Value
-- * Array type with fully default initialized component type
-- * Record or protected type with components that either have a
-- default expression or their related types are fully default
-- initialized.
-- * Scalar type with specified Default_Value
-- * Task type
-- * Type extension of a type with full default initialization where
-- the extension components are also fully default initialized.
Mixed_Initialization,
-- This value applies to a type where some of its internals are fully
-- default initialized and some are not.
No_Default_Initialization);
-- This value reflects a type where none of its content is fully
-- default initialized.
function Default_Initialization
(Typ : Entity_Id) return Default_Initialization_Kind;
-- Determine default initialization kind that applies to a particular type
function Deepest_Type_Access_Level (Typ : Entity_Id) return Uint;
-- Same as Type_Access_Level, except that if the type is the type of an Ada
-- 2012 stand-alone object of an anonymous access type, then return the

13
gcc/ada/stand.ads
View File

@ -371,14 +371,6 @@ package Stand is
-- candidate interpretations has been examined. If after examining all of
-- them the type is still Any_Type, the node has no possible interpretation
-- and an error can be emitted (and Any_Type will be propagated upwards).
--
-- There is one situation in which Any_Type is used to legitimately
-- represent a case where the type is not known pre-resolution, and that
-- is for the N_Raise_Expression node. In this case, the Etype being set to
-- Any_Type is normal and does not represent an error. In particular, it is
-- compatible with the type of any constituent of the enclosing expression,
-- if any. The type is eventually replaced with the type of the context,
-- which plays no role in the resolution of the Raise_Expression.
Any_Access : Entity_Id;
-- Used to resolve the overloaded literal NULL
@ -427,6 +419,11 @@ package Stand is
-- component type is compatible with any character type, not just
-- Standard_Character.
Raise_Type : Entity_Id;
-- The type Raise_Type denotes the type of a Raise_Expression. It is
-- compatible with all other types, and must eventually resolve to a
-- concrete type that is imposed by the context.
Universal_Integer : Entity_Id;
-- Entity for universal integer type. The bounds of this type correspond
-- to the largest supported integer type (i.e. Long_Long_Integer). It is