Commit 4ff4293f by Arnaud Charlet

[multiple changes]

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.

From-SVN: r194799
parent ef7c5fa9
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> 2013-01-02 Robert Dewar <dewar@adacore.com>
* gnat1drv.adb, targparm.adb, targparm.ads: Minor name change: add * gnat1drv.adb, targparm.adb, targparm.ads: Minor name change: add
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -39,12 +39,12 @@ with System.Traceback_Entries; ...@@ -39,12 +39,12 @@ with System.Traceback_Entries;
package Ada.Exceptions.Traceback is package Ada.Exceptions.Traceback is
package TBE renames System.Traceback_Entries; package STBE renames System.Traceback_Entries;
subtype Code_Loc is System.Address; subtype Code_Loc is System.Address;
-- Code location in executing program -- 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 -- A traceback array is an array of traceback entries
function Tracebacks (E : Exception_Occurrence) return Tracebacks_Array; function Tracebacks (E : Exception_Occurrence) return Tracebacks_Array;
...@@ -52,4 +52,9 @@ package Ada.Exceptions.Traceback is ...@@ -52,4 +52,9 @@ package Ada.Exceptions.Traceback is
-- occurrence, and returns it formatted in the manner required for -- occurrence, and returns it formatted in the manner required for
-- processing in GNAT.Traceback. See g-traceb.ads for further details. -- 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; end Ada.Exceptions.Traceback;
...@@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions; ...@@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions;
package Ada.Numerics.Long_Complex_Elementary_Functions is package Ada.Numerics.Long_Complex_Elementary_Functions is
new Ada.Numerics.Generic_Complex_Elementary_Functions new Ada.Numerics.Generic_Complex_Elementary_Functions
(Ada.Numerics.Long_Complex_Types); (Ada.Numerics.Long_Complex_Types);
pragma Pure (Ada.Numerics.Long_Complex_Elementary_Functions);
...@@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions; ...@@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions;
package Ada.Numerics.Long_Long_Complex_Elementary_Functions is package Ada.Numerics.Long_Long_Complex_Elementary_Functions is
new Ada.Numerics.Generic_Complex_Elementary_Functions new Ada.Numerics.Generic_Complex_Elementary_Functions
(Ada.Numerics.Long_Long_Complex_Types); (Ada.Numerics.Long_Long_Complex_Types);
pragma Pure (Ada.Numerics.Long_Long_Complex_Elementary_Functions);
...@@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions; ...@@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions;
package Ada.Numerics.Short_Complex_Elementary_Functions is package Ada.Numerics.Short_Complex_Elementary_Functions is
new Ada.Numerics.Generic_Complex_Elementary_Functions new Ada.Numerics.Generic_Complex_Elementary_Functions
(Ada.Numerics.Short_Complex_Types); (Ada.Numerics.Short_Complex_Types);
pragma Pure (Ada.Numerics.Short_Complex_Elementary_Functions);
...@@ -1040,11 +1040,18 @@ package body Freeze is ...@@ -1040,11 +1040,18 @@ package body Freeze is
if Present (Comp) then if Present (Comp) then
Err_Node := Comp; Err_Node := Comp;
Comp_Type := Etype (Comp); Comp_Type := Etype (Comp);
Comp_Def := Component_Definition (Parent (Comp));
Comp_Byte_Aligned := if Is_Tag (Comp) then
Present (Component_Clause (Comp)) Comp_Def := Empty;
and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0; 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 -- Array case
...@@ -1080,7 +1087,7 @@ package body Freeze is ...@@ -1080,7 +1087,7 @@ package body Freeze is
& "storage order as enclosing composite", Err_Node); & "storage order as enclosing composite", Err_Node);
end if; end if;
elsif Aliased_Present (Comp_Def) then elsif Present (Comp_Def) and then Aliased_Present (Comp_Def) then
Error_Msg_N Error_Msg_N
("aliased component not permitted for type with " ("aliased component not permitted for type with "
& "explicit Scalar_Storage_Order", Err_Node); & "explicit Scalar_Storage_Order", Err_Node);
......
...@@ -2170,12 +2170,12 @@ package body Par_SCO is ...@@ -2170,12 +2170,12 @@ package body Par_SCO is
is is
Spec : constant Node_Id := Specification (N); Spec : constant Node_Id := Specification (N);
Dom : Dominant_Info; Dom : Dominant_Info;
begin begin
Dom := Traverse_Declarations_Or_Statements Dom :=
(Visible_Declarations (Spec), D); Traverse_Declarations_Or_Statements (Visible_Declarations (Spec), D);
-- The first private declaration is dominated by the last visible -- First private declaration is dominated by last visible declaration
-- declaration.
Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom); Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom);
end Traverse_Package_Declaration; end Traverse_Package_Declaration;
......
...@@ -1877,31 +1877,6 @@ package body Sem_Aggr is ...@@ -1877,31 +1877,6 @@ package body Sem_Aggr is
return Failure; return Failure;
end if; 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 -- Protect against cascaded errors
if Etype (Index_Typ) = Any_Type then if Etype (Index_Typ) = Any_Type then
......
...@@ -2218,7 +2218,7 @@ package body Sem_Ch7 is ...@@ -2218,7 +2218,7 @@ package body Sem_Ch7 is
Write_Eol; Write_Eol;
end if; 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: -- established by use clauses in the current scope. Two cases:
-- a) If the entity is an operator, it may be a primitive operator of -- a) If the entity is an operator, it may be a primitive operator of
...@@ -2252,8 +2252,8 @@ package body Sem_Ch7 is ...@@ -2252,8 +2252,8 @@ package body Sem_Ch7 is
-- of its parent unit. -- of its parent unit.
if Is_Child_Unit (Id) then if Is_Child_Unit (Id) then
Set_Is_Potentially_Use_Visible (Id, Set_Is_Potentially_Use_Visible
Is_Visible_Child_Unit (Id)); (Id, Is_Visible_Child_Unit (Id));
else else
Set_Is_Potentially_Use_Visible (Id); Set_Is_Potentially_Use_Visible (Id);
end if; end if;
...@@ -2272,9 +2272,7 @@ package body Sem_Ch7 is ...@@ -2272,9 +2272,7 @@ package body Sem_Ch7 is
-- full view is also removed from visibility: it may be exposed when -- full view is also removed from visibility: it may be exposed when
-- swapping views in an instantiation. -- swapping views in an instantiation.
if Is_Type (Id) if Is_Type (Id) and then Present (Full_View (Id)) then
and then Present (Full_View (Id))
then
Set_Is_Immediately_Visible (Full_View (Id), False); Set_Is_Immediately_Visible (Full_View (Id), False);
end if; end if;
...@@ -2328,7 +2326,7 @@ package body Sem_Ch7 is ...@@ -2328,7 +2326,7 @@ package body Sem_Ch7 is
-- OK if object declaration with the No_Initialization flag set -- OK if object declaration with the No_Initialization flag set
and then not (Nkind (Parent (Id)) = N_Object_Declaration and then not (Nkind (Parent (Id)) = N_Object_Declaration
and then No_Initialization (Parent (Id))) and then No_Initialization (Parent (Id)))
then then
-- If no private declaration is present, we assume the user did -- If no private declaration is present, we assume the user did
-- not intend a deferred constant declaration and the problem -- not intend a deferred constant declaration and the problem
...@@ -2354,13 +2352,13 @@ package body Sem_Ch7 is ...@@ -2354,13 +2352,13 @@ package body Sem_Ch7 is
else else
Error_Msg_N Error_Msg_N
("missing full declaration for deferred constant (RM 7.4)", ("missing full declaration for deferred constant (RM 7.4)",
Id); Id);
if Is_Limited_Type (Etype (Id)) then if Is_Limited_Type (Etype (Id)) then
Error_Msg_N Error_Msg_N
("\if variable intended, remove CONSTANT from declaration", ("\if variable intended, remove CONSTANT from declaration",
Parent (Id)); Parent (Id));
end if; end if;
end if; end if;
end if; end if;
...@@ -2396,9 +2394,7 @@ package body Sem_Ch7 is ...@@ -2396,9 +2394,7 @@ package body Sem_Ch7 is
Set_Is_Immediately_Visible (Id, False); Set_Is_Immediately_Visible (Id, False);
if Is_Private_Base_Type (Id) if Is_Private_Base_Type (Id) and then Present (Full_View (Id)) then
and then Present (Full_View (Id))
then
Full := Full_View (Id); Full := Full_View (Id);
-- If the partial view is not declared in the visible part of the -- If the partial view is not declared in the visible part of the
...@@ -2407,8 +2403,8 @@ package body Sem_Ch7 is ...@@ -2407,8 +2403,8 @@ package body Sem_Ch7 is
-- no exchange takes place. -- no exchange takes place.
if No (Parent (Id)) if No (Parent (Id))
or else List_Containing (Parent (Id)) or else List_Containing (Parent (Id)) /=
/= Visible_Declarations (Specification (Decl)) Visible_Declarations (Specification (Decl))
then then
goto Next_Id; goto Next_Id;
end if; end if;
...@@ -2433,9 +2429,9 @@ package body Sem_Ch7 is ...@@ -2433,9 +2429,9 @@ package body Sem_Ch7 is
Priv_Elmt := First_Elmt (Private_Dependents (Id)); Priv_Elmt := First_Elmt (Private_Dependents (Id));
-- Swap out the subtypes and derived types of Id that were -- Swap out the subtypes and derived types of Id that
-- compiled in this scope, or installed previously by -- were compiled in this scope, or installed previously
-- Install_Private_Declarations. -- by Install_Private_Declarations.
-- Before we do the swap, we verify the presence of the Full_View -- 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 -- field which may be empty due to a swap by a previous call to
...@@ -2445,7 +2441,6 @@ package body Sem_Ch7 is ...@@ -2445,7 +2441,6 @@ package body Sem_Ch7 is
Priv_Sub := Node (Priv_Elmt); Priv_Sub := Node (Priv_Elmt);
if Present (Full_View (Priv_Sub)) then if Present (Full_View (Priv_Sub)) then
if Scope (Priv_Sub) = P if Scope (Priv_Sub) = P
or else not In_Open_Scopes (Scope (Priv_Sub)) or else not In_Open_Scopes (Scope (Priv_Sub))
then then
...@@ -2615,11 +2610,11 @@ package body Sem_Ch7 is ...@@ -2615,11 +2610,11 @@ package body Sem_Ch7 is
-- expander will provide an implicit completion at some point. -- expander will provide an implicit completion at some point.
elsif (Is_Overloadable (E) elsif (Is_Overloadable (E)
and then Ekind (E) /= E_Enumeration_Literal and then Ekind (E) /= E_Enumeration_Literal
and then Ekind (E) /= E_Operator and then Ekind (E) /= E_Operator
and then not Is_Abstract_Subprogram (E) and then not Is_Abstract_Subprogram (E)
and then not Has_Completion (E) and then not Has_Completion (E)
and then Comes_From_Source (Parent (E))) and then Comes_From_Source (Parent (E)))
or else or else
(Ekind (E) = E_Package (Ekind (E) = E_Package
...@@ -2633,12 +2628,12 @@ package body Sem_Ch7 is ...@@ -2633,12 +2628,12 @@ package body Sem_Ch7 is
and then not Is_Generic_Type (E)) and then not Is_Generic_Type (E))
or else or else
((Ekind (E) = E_Task_Type or else (Ekind_In (E, E_Task_Type, E_Protected_Type)
Ekind (E) = E_Protected_Type)
and then not Has_Completion (E)) and then not Has_Completion (E))
or else 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 not Has_Completion (E)
and then Unit_Requires_Body (E)) and then Unit_Requires_Body (E))
......
...@@ -4744,7 +4744,7 @@ package body Sem_Ch8 is ...@@ -4744,7 +4744,7 @@ package body Sem_Ch8 is
goto Found; goto Found;
-- If there is more than one potentially use-visible entity and at -- 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. -- 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 -- Special case: if one of the entities is declared in an actual
-- package, it was visible in the generic, and takes precedence over -- package, it was visible in the generic, and takes precedence over
......
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