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

[multiple changes] 

2013-10-14  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Record): Don't give warning about packed
	and foreign convention.

2013-10-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_aux.adb, sem_aux.ads (Package_Specification): New function, to
	replace the less efficient idiom Specification.
	(Unit_Declaration_Node (Pack_Id)), which handles library units and
	child units.
	* sem_ch3.adb, sem_ch10.adb, sem_prag.adb, sem_ch12.adb, sem_ch6.adb,
	exp_disp.adb, sem_cat.adb, exp_dist.adb: Use Package_Specification.

2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_Update_Attribute): Update the call to
	Process_Range_Update.
	(Process_Range_Update): Add new formal parameter Typ and associated
	comment on usage. Add local constant Index_Typ. Add a type conversion
	as part of the indexed component to ensure that the loop variable
	corresponds to the index type.

From-SVN: r203556
This commit is contained in:
Arnaud Charlet 2013-10-14 15:47:38 +02:00
parent 515490e000
commit d12b19faee
13 changed files with 85 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
2013-10-14 Robert Dewar <dewar@adacore.com>
* freeze.adb (Freeze_Record): Don't give warning about packed
and foreign convention.
2013-10-14 Ed Schonberg <schonberg@adacore.com>
* sem_aux.adb, sem_aux.ads (Package_Specification): New function, to
replace the less efficient idiom Specification.
(Unit_Declaration_Node (Pack_Id)), which handles library units and
child units.
* sem_ch3.adb, sem_ch10.adb, sem_prag.adb, sem_ch12.adb, sem_ch6.adb,
exp_disp.adb, sem_cat.adb, exp_dist.adb: Use Package_Specification.
2013-10-14 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb (Expand_Update_Attribute): Update the call to
Process_Range_Update.
(Process_Range_Update): Add new formal parameter Typ and associated
comment on usage. Add local constant Index_Typ. Add a type conversion
as part of the indexed component to ensure that the loop variable
corresponds to the index type.
2013-10-14 Tristan Gingold <gingold@adacore.com>
* a-exexpr-gcc.adb: Adjust comment.

27
gcc/ada/exp_attr.adb
View File

@ -6609,12 +6609,14 @@ package body Exp_Attr is
procedure Process_Range_Update
(Temp : Entity_Id;
Comp : Node_Id;
Expr : Node_Id);
Expr : Node_Id;
Typ : Entity_Id);
-- Generate the statements necessary to update a slice of the prefix.
-- The code is inserted before the attribute N. Temp denotes the entity
-- of the anonymous object created to reflect the changes in values.
-- Comp is range of the slice to be updated. Expr is an expression
-- yielding the new value of Comp.
-- yielding the new value of Comp. Typ is the type of the prefix of
-- attribute Update.
-----------------------------------------
-- Process_Component_Or_Element_Update --
@ -6688,10 +6690,12 @@ package body Exp_Attr is
procedure Process_Range_Update
(Temp : Entity_Id;
Comp : Node_Id;
Expr : Node_Id)
Expr : Node_Id;
Typ : Entity_Id)
is
Loc : constant Source_Ptr := Sloc (Comp);
Index : Entity_Id;
Index_Typ : constant Entity_Id := Etype (First_Index (Typ));
Loc : constant Source_Ptr := Sloc (Comp);
Index : Entity_Id;
begin
-- A range update appears as
@ -6703,7 +6707,7 @@ package body Exp_Attr is
-- value of Expr:
-- for Index in Low .. High loop
-- Temp (Index) := Expr;
-- Temp (<Index_Typ> (Index)) := Expr;
-- end loop;
Index := Make_Temporary (Loc, 'I');
@ -6722,7 +6726,8 @@ package body Exp_Attr is
Name =>
Make_Indexed_Component (Loc,
Prefix => New_Reference_To (Temp, Loc),
Expressions => New_List (New_Reference_To (Index, Loc))),
Expressions => New_List (
Convert_To (Index_Typ, New_Reference_To (Index, Loc)))),
Expression => Relocate_Node (Expr))),
End_Label => Empty));
@ -6730,10 +6735,10 @@ package body Exp_Attr is
-- Local variables
Aggr : constant Node_Id := First (Expressions (N));
Aggr : constant Node_Id := First (Expressions (N));
Loc : constant Source_Ptr := Sloc (N);
Pref : constant Node_Id := Prefix (N);
Typ : constant Entity_Id := Etype (Pref);
Pref : constant Node_Id := Prefix (N);
Typ : constant Entity_Id := Etype (Pref);
Assoc : Node_Id;
Comp : Node_Id;
Expr : Node_Id;
@ -6763,7 +6768,7 @@ package body Exp_Attr is
Expr := Expression (Assoc);
while Present (Comp) loop
if Nkind (Comp) = N_Range then
Process_Range_Update (Temp, Comp, Expr);
Process_Range_Update (Temp, Comp, Expr, Typ);
else
Process_Component_Or_Element_Update (Temp, Comp, Expr, Typ);
end if;

5
gcc/ada/exp_disp.adb
View File

@ -7645,7 +7645,7 @@ package body Exp_Disp is
end if;
return List_Containing (Parent (Typ)) =
Visible_Declarations (Specification (Unit_Declaration_Node (Scop)));
Visible_Declarations (Package_Specification (Scop));
end Original_View_In_Visible_Part;
------------------
@ -8446,8 +8446,7 @@ package body Exp_Disp is
and then In_Private_Part (Current_Scope)
and then
List_Containing (Parent (Prim)) =
Private_Declarations
(Specification (Unit_Declaration_Node (Current_Scope)))
Private_Declarations (Package_Specification (Current_Scope))
and then Original_View_In_Visible_Part (Typ)
then
-- We exclude Input and Output stream operations because

3
gcc/ada/exp_dist.adb
View File

@ -2874,8 +2874,7 @@ package body Exp_Dist is
if RCI_Locator = Empty then
RCI_Locator_Decl :=
RCI_Package_Locator
(Loc, Specification (Unit_Declaration_Node (RCI_Package)));
RCI_Package_Locator (Loc, Package_Specification (RCI_Package));
Prepend_To (Current_Sem_Unit_Declarations, RCI_Locator_Decl);
Analyze (RCI_Locator_Decl);
RCI_Locator := Defining_Unit_Name (RCI_Locator_Decl);

5
gcc/ada/freeze.adb
View File

@ -2741,6 +2741,11 @@ package body Freeze is
if Has_Foreign_Convention (Etype (Comp))
and then Has_Pragma_Pack (Rec)
-- Don't warn for aliased components, since override
-- cannot happen in that case.
and then not Is_Aliased (Comp)
then
declare
CN : constant Name_Id :=

21
gcc/ada/sem_aux.adb
View File

@ -1151,6 +1151,27 @@ package body Sem_Aux is
and then Has_Discriminants (Typ));
end Object_Type_Has_Constrained_Partial_View;
---------------------------
-- Package_Specification --
---------------------------
function Package_Specification (Pack_Id : Entity_Id) return Node_Id is
N : Node_Id;
begin
N := Parent (Pack_Id);
while Nkind (N) /= N_Package_Specification loop
N := Parent (N);
if No (N) then
raise Program_Error;
end if;
end loop;
return N;
end Package_Specification;
---------------
-- Tree_Read --
---------------

4
gcc/ada/sem_aux.ads
View File

@ -348,4 +348,8 @@ package Sem_Aux is
-- it returns the subprogram, task or protected body node for it. The unit
-- may be a child unit with any number of ancestors.
function Package_Specification (Pack_Id : Entity_Id) return Node_Id;
-- Given an entity for a package or generic package, return corresponding
-- package specification. Simplifies handling of child units, and better
-- than the old idiom: Specification (Unit_Declaration_Node (Pack_Id).
end Sem_Aux;

5
gcc/ada/sem_cat.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -561,8 +561,7 @@ package body Sem_Cat is
and then Is_Package_Or_Generic_Package (Unit_Entity)
and then Unit_Kind /= N_Package_Body
and then List_Containing (N) =
Visible_Declarations
(Specification (Unit_Declaration_Node (Unit_Entity)))
Visible_Declarations (Package_Specification (Unit_Entity))
and then not In_Package_Body (Unit_Entity)
and then not In_Instance;

2
gcc/ada/sem_ch10.adb
View File

@ -4028,7 +4028,7 @@ package body Sem_Ch10 is
Is_Private_Descendant (P_Name)
or else Private_Present (Parent (Lib_Unit)));
P_Spec := Specification (Unit_Declaration_Node (P_Name));
P_Spec := Package_Specification (P_Name);
Push_Scope (P_Name);
-- Save current visibility of unit

20
gcc/ada/sem_ch12.adb
View File

@ -5664,8 +5664,7 @@ package body Sem_Ch12 is
(Related_Instance (Instance))));
else
Gen_Id :=
Generic_Parent
(Specification (Unit_Declaration_Node (Instance)));
Generic_Parent (Package_Specification (Instance));
end if;
Parent_Scope := Scope (Gen_Id);
@ -8365,7 +8364,7 @@ package body Sem_Ch12 is
-- of its generic parent.
if Is_Generic_Instance (Par) then
Gen := Generic_Parent (Specification (Unit_Declaration_Node (Par)));
Gen := Generic_Parent (Package_Specification (Par));
Gen_E := First_Entity (Gen);
end if;
@ -8449,8 +8448,7 @@ package body Sem_Ch12 is
------------------
procedure Install_Spec (Par : Entity_Id) is
Spec : constant Node_Id :=
Specification (Unit_Declaration_Node (Par));
Spec : constant Node_Id := Package_Specification (Par);
begin
-- If this parent of the child instance is a top-level unit,
@ -8519,8 +8517,7 @@ package body Sem_Ch12 is
First_Par := Inst_Par;
Gen_Par :=
Generic_Parent (Specification (Unit_Declaration_Node (Inst_Par)));
Gen_Par := Generic_Parent (Package_Specification (Inst_Par));
First_Gen := Gen_Par;
@ -8538,9 +8535,7 @@ package body Sem_Ch12 is
Inst_Par := Renamed_Entity (Inst_Par);
end if;
Gen_Par :=
Generic_Parent
(Specification (Unit_Declaration_Node (Inst_Par)));
Gen_Par := Generic_Parent (Package_Specification (Inst_Par));
if Present (Gen_Par) then
Prepend_Elmt (Inst_Par, Ancestors);
@ -9009,7 +9004,7 @@ package body Sem_Ch12 is
end if;
if Nkind (Parent (Actual_Pack)) = N_Defining_Program_Unit_Name then
Parent_Spec := Specification (Unit_Declaration_Node (Actual_Pack));
Parent_Spec := Package_Specification (Actual_Pack);
else
Parent_Spec := Parent (Actual_Pack);
end if;
@ -12571,8 +12566,7 @@ package body Sem_Ch12 is
elsif S = Current_Scope and then Is_Generic_Instance (S) then
declare
Par : constant Entity_Id :=
Generic_Parent
(Specification (Unit_Declaration_Node (S)));
Generic_Parent (Package_Specification (S));
begin
if Present (Par)
and then P = Scope (Par)

3
gcc/ada/sem_ch3.adb
View File

@ -10919,8 +10919,7 @@ package body Sem_Ch3 is
elsif Ekind (Current_Scope) = E_Package
and then
List_Containing (Parent (Prev)) /=
Visible_Declarations
(Specification (Unit_Declaration_Node (Current_Scope)))
Visible_Declarations (Package_Specification (Current_Scope))
then
Error_Msg_N
("deferred constant must be declared in visible part",

3
gcc/ada/sem_ch6.adb
View File

@ -10318,8 +10318,7 @@ package body Sem_Ch6 is
and then In_Private_Part (Current_Scope)
then
Priv_Decls :=
Private_Declarations
(Specification (Unit_Declaration_Node (Current_Scope)));
Private_Declarations (Package_Specification (Current_Scope));
return In_Package_Body (Current_Scope)
or else

2
gcc/ada/sem_prag.adb
View File

@ -21725,7 +21725,7 @@ package body Sem_Prag is
-- Local variables
Pack_Spec : constant Node_Id := Parent (Spec_Id);
Pack_Spec : constant Node_Id := Package_Specification (Spec_Id);
-- Start of processing for Collect_Hidden_States