[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
This commit is contained in:
Arnaud Charlet
parent
ef7c5fa919
commit
4ff4293f15
@ -1,3 +1,32 @@
|
||||
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
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- 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 --
|
||||
@ -39,12 +39,12 @@ with System.Traceback_Entries;
|
||||
|
||||
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;
|
||||
@ -52,4 +52,9 @@ package Ada.Exceptions.Traceback is
|
||||
-- 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;
|
||||
|
||||
@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions;
|
||||
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);
|
||||
|
||||
@ -19,3 +19,4 @@ with Ada.Numerics.Generic_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);
|
||||
|
||||
@ -19,3 +19,4 @@ with Ada.Numerics.Generic_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);
|
||||
|
||||
@ -1040,11 +1040,18 @@ package body Freeze is
|
||||
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
|
||||
|
||||
@ -1080,7 +1087,7 @@ package body Freeze is
|
||||
& "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);
|
||||
|
||||
@ -2170,12 +2170,12 @@ package body Par_SCO is
|
||||
is
|
||||
Spec : constant Node_Id := Specification (N);
|
||||
Dom : Dominant_Info;
|
||||
begin
|
||||
Dom := Traverse_Declarations_Or_Statements
|
||||
(Visible_Declarations (Spec), D);
|
||||
|
||||
-- The first private declaration is dominated by the last visible
|
||||
-- declaration.
|
||||
begin
|
||||
Dom :=
|
||||
Traverse_Declarations_Or_Statements (Visible_Declarations (Spec), D);
|
||||
|
||||
-- First private declaration is dominated by last visible declaration
|
||||
|
||||
Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom);
|
||||
end Traverse_Package_Declaration;
|
||||
|
||||
@ -1877,31 +1877,6 @@ package body Sem_Aggr is
|
||||
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
|
||||
|
||||
@ -2218,7 +2218,7 @@ package body Sem_Ch7 is
|
||||
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
|
||||
@ -2252,8 +2252,8 @@ package body Sem_Ch7 is
|
||||
-- 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;
|
||||
@ -2272,9 +2272,7 @@ package body Sem_Ch7 is
|
||||
-- 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;
|
||||
|
||||
@ -2328,7 +2326,7 @@ package body Sem_Ch7 is
|
||||
-- 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
|
||||
@ -2354,13 +2352,13 @@ package body Sem_Ch7 is
|
||||
|
||||
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;
|
||||
@ -2396,9 +2394,7 @@ package body Sem_Ch7 is
|
||||
|
||||
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
|
||||
@ -2407,8 +2403,8 @@ package body Sem_Ch7 is
|
||||
-- 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;
|
||||
@ -2433,9 +2429,9 @@ package body Sem_Ch7 is
|
||||
|
||||
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
|
||||
@ -2445,7 +2441,6 @@ package body Sem_Ch7 is
|
||||
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
|
||||
@ -2615,11 +2610,11 @@ package body Sem_Ch7 is
|
||||
-- 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
|
||||
@ -2633,12 +2628,12 @@ package body Sem_Ch7 is
|
||||
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))
|
||||
|
||||
|
||||
@ -4744,7 +4744,7 @@ package body Sem_Ch8 is
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user