+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
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;
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;
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
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;
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;
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);
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
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;
-----------------------------
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);
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)");
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
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;
-------------------
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
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 --
---------------------
-- 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
-- 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
-- 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
projects / thirdparty / gcc.git / commitdiff
