+2013-01-02 Geert Bosch <bosch@adacore.com>
+
+ * a-nllcef.ads, a-nlcefu.ads, a-nscefu.ads: Make Pure.
+
+2013-01-02 Robert Dewar <dewar@adacore.com>
+
+ * par_sco.adb: Minor reformatting.
+
+2013-01-02 Javier Miranda <miranda@adacore.com>
+
+ * sem_aggr.adb (Resolve_Array_Aggregate): Remove dead code.
+
+2013-01-02 Olivier Hainque <hainque@adacore.com>
+
+ * a-exctra.ads (Get_PC): New function.
+
+2013-01-02 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch8.adb: Minor reformatting.
+
+2013-01-02 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch7.adb: Minor reformatting.
+
+2013-01-02 Thomas Quinot <quinot@adacore.com>
+
+ * freeze.adb (Check_Component_Storage_Order): Do not crash on
+ _Tag component.
+
2013-01-02 Robert Dewar <dewar@adacore.com>
* gnat1drv.adb, targparm.adb, targparm.ads: Minor name change: add
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2012, 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 --
package Ada.Exceptions.Traceback is
- package TBE renames System.Traceback_Entries;
+ package STBE renames System.Traceback_Entries;
subtype Code_Loc is System.Address;
-- Code location in executing program
- type Tracebacks_Array is array (Positive range <>) of TBE.Traceback_Entry;
+ type Tracebacks_Array is array (Positive range <>) of STBE.Traceback_Entry;
-- A traceback array is an array of traceback entries
function Tracebacks (E : Exception_Occurrence) return Tracebacks_Array;
-- occurrence, and returns it formatted in the manner required for
-- processing in GNAT.Traceback. See g-traceb.ads for further details.
+ function Get_PC (TBE : STBE.Traceback_Entry) return Code_Loc
+ renames STBE.PC_For;
+ -- Returns the code address held by a given traceback entry, typically the
+ -- address of a call instruction.
+
end Ada.Exceptions.Traceback;
package Ada.Numerics.Long_Complex_Elementary_Functions is
new Ada.Numerics.Generic_Complex_Elementary_Functions
(Ada.Numerics.Long_Complex_Types);
+pragma Pure (Ada.Numerics.Long_Complex_Elementary_Functions);
package Ada.Numerics.Long_Long_Complex_Elementary_Functions is
new Ada.Numerics.Generic_Complex_Elementary_Functions
(Ada.Numerics.Long_Long_Complex_Types);
+pragma Pure (Ada.Numerics.Long_Long_Complex_Elementary_Functions);
package Ada.Numerics.Short_Complex_Elementary_Functions is
new Ada.Numerics.Generic_Complex_Elementary_Functions
(Ada.Numerics.Short_Complex_Types);
+pragma Pure (Ada.Numerics.Short_Complex_Elementary_Functions);
if Present (Comp) then
Err_Node := Comp;
Comp_Type := Etype (Comp);
- Comp_Def := Component_Definition (Parent (Comp));
- Comp_Byte_Aligned :=
- Present (Component_Clause (Comp))
- and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
+ if Is_Tag (Comp) then
+ Comp_Def := Empty;
+ Comp_Byte_Aligned := True;
+
+ else
+ Comp_Def := Component_Definition (Parent (Comp));
+ Comp_Byte_Aligned :=
+ Present (Component_Clause (Comp))
+ and then
+ Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
+ end if;
-- Array case
& "storage order as enclosing composite", Err_Node);
end if;
- elsif Aliased_Present (Comp_Def) then
+ elsif Present (Comp_Def) and then Aliased_Present (Comp_Def) then
Error_Msg_N
("aliased component not permitted for type with "
& "explicit Scalar_Storage_Order", Err_Node);
is
Spec : constant Node_Id := Specification (N);
Dom : Dominant_Info;
+
begin
- Dom := Traverse_Declarations_Or_Statements
- (Visible_Declarations (Spec), D);
+ Dom :=
+ Traverse_Declarations_Or_Statements (Visible_Declarations (Spec), D);
- -- The first private declaration is dominated by the last visible
- -- declaration.
+ -- First private declaration is dominated by last visible declaration
Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom);
end Traverse_Package_Declaration;
return Failure;
end if;
- if Others_Present
- and then Nkind (Parent (N)) /= N_Component_Association
- and then No (Expressions (N))
- and then
- Nkind (First (Choices (First (Component_Associations (N)))))
- = N_Others_Choice
- and then Is_Elementary_Type (Component_Typ)
- and then False
- then
- declare
- Assoc : constant Node_Id := First (Component_Associations (N));
- begin
- Rewrite (Assoc,
- Make_Component_Association (Loc,
- Choices =>
- New_List (
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Index_Typ, Loc),
- Attribute_Name => Name_Range)),
- Expression => Relocate_Node (Expression (Assoc))));
- return Resolve_Array_Aggregate
- (N, Index, Index_Constr, Component_Typ, Others_Allowed);
- end;
- end if;
-
-- Protect against cascaded errors
if Etype (Index_Typ) = Any_Type then
Write_Eol;
end if;
- -- On exit from the package scope, we must preserve the visibility
+ -- On exit from the package scope, we must preserve the visibility
-- established by use clauses in the current scope. Two cases:
-- a) If the entity is an operator, it may be a primitive operator of
-- of its parent unit.
if Is_Child_Unit (Id) then
- Set_Is_Potentially_Use_Visible (Id,
- Is_Visible_Child_Unit (Id));
+ Set_Is_Potentially_Use_Visible
+ (Id, Is_Visible_Child_Unit (Id));
else
Set_Is_Potentially_Use_Visible (Id);
end if;
-- full view is also removed from visibility: it may be exposed when
-- swapping views in an instantiation.
- if Is_Type (Id)
- and then Present (Full_View (Id))
- then
+ if Is_Type (Id) and then Present (Full_View (Id)) then
Set_Is_Immediately_Visible (Full_View (Id), False);
end if;
-- OK if object declaration with the No_Initialization flag set
and then not (Nkind (Parent (Id)) = N_Object_Declaration
- and then No_Initialization (Parent (Id)))
+ and then No_Initialization (Parent (Id)))
then
-- If no private declaration is present, we assume the user did
-- not intend a deferred constant declaration and the problem
else
Error_Msg_N
- ("missing full declaration for deferred constant (RM 7.4)",
- Id);
+ ("missing full declaration for deferred constant (RM 7.4)",
+ Id);
if Is_Limited_Type (Etype (Id)) then
Error_Msg_N
("\if variable intended, remove CONSTANT from declaration",
- Parent (Id));
+ Parent (Id));
end if;
end if;
end if;
Set_Is_Immediately_Visible (Id, False);
- if Is_Private_Base_Type (Id)
- and then Present (Full_View (Id))
- then
+ if Is_Private_Base_Type (Id) and then Present (Full_View (Id)) then
Full := Full_View (Id);
-- If the partial view is not declared in the visible part of the
-- no exchange takes place.
if No (Parent (Id))
- or else List_Containing (Parent (Id))
- /= Visible_Declarations (Specification (Decl))
+ or else List_Containing (Parent (Id)) /=
+ Visible_Declarations (Specification (Decl))
then
goto Next_Id;
end if;
Priv_Elmt := First_Elmt (Private_Dependents (Id));
- -- Swap out the subtypes and derived types of Id that were
- -- compiled in this scope, or installed previously by
- -- Install_Private_Declarations.
+ -- Swap out the subtypes and derived types of Id that
+ -- were compiled in this scope, or installed previously
+ -- by Install_Private_Declarations.
-- Before we do the swap, we verify the presence of the Full_View
-- field which may be empty due to a swap by a previous call to
Priv_Sub := Node (Priv_Elmt);
if Present (Full_View (Priv_Sub)) then
-
if Scope (Priv_Sub) = P
or else not In_Open_Scopes (Scope (Priv_Sub))
then
-- expander will provide an implicit completion at some point.
elsif (Is_Overloadable (E)
- and then Ekind (E) /= E_Enumeration_Literal
- and then Ekind (E) /= E_Operator
- and then not Is_Abstract_Subprogram (E)
- and then not Has_Completion (E)
- and then Comes_From_Source (Parent (E)))
+ and then Ekind (E) /= E_Enumeration_Literal
+ and then Ekind (E) /= E_Operator
+ and then not Is_Abstract_Subprogram (E)
+ and then not Has_Completion (E)
+ and then Comes_From_Source (Parent (E)))
or else
(Ekind (E) = E_Package
and then not Is_Generic_Type (E))
or else
- ((Ekind (E) = E_Task_Type or else
- Ekind (E) = E_Protected_Type)
+ (Ekind_In (E, E_Task_Type, E_Protected_Type)
and then not Has_Completion (E))
or else
- (Ekind (E) = E_Generic_Package and then E /= P
+ (Ekind (E) = E_Generic_Package
+ and then E /= P
and then not Has_Completion (E)
and then Unit_Requires_Body (E))
goto Found;
-- If there is more than one potentially use-visible entity and at
- -- least one of them non-overloadable, we have an error (RM 8.4(11).
+ -- least one of them non-overloadable, we have an error (RM 8.4(11)).
-- Note that E points to the first such entity on the homonym list.
-- Special case: if one of the entities is declared in an actual
-- package, it was visible in the generic, and takes precedence over
git://gcc.gnu.org / gcc.git / commitdiff