OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2012-07-17  Vincent Pucci  <pucci@adacore.com>

	* gnat_ugn.texi: GNAT dimensionality checking
	documentation updated with System.Dim.Mks modifications.

2012-07-17  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb: sloc of array init_proc is sloc of type declaration.

2012-07-17  Tristan Gingold  <gingold@adacore.com>

	* raise-gcc.c (get_call_site_action_for): Remove useless init
	expression for p.
	(get_action_description_for): Do not overwrite action->kind.

2012-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Add local variables Attr
	and Conversion_Added.  Add local constant Typ.
	Retrieve the original attribute after the arithmetic check
	machinery has modified the node. Add a conversion to the target
	type when the prefix of attribute Max_Size_In_Storage_Elements
	is a controlled type.

2012-07-17  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch6.adb (Expand_Inlined_Call): For each actual parameter
	of mode 'out' or 'in out' that denotes an entity, reset
	Last_Assignment on the entity so that any assignments to the
	corresponding formal in the inlining will not trigger spurious
	warnings about overwriting assignments.

From-SVN: r189570
This commit is contained in:
Arnaud Charlet 2012-07-17 12:16:59 +02:00
parent 79ee6ab38b
commit 24cb156d23
5 changed files with 77 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
gcc/ada/exp_attr.adb
View File

@ -3201,9 +3201,26 @@ package body Exp_Attr is
-- Max_Size_In_Storage_Elements --
----------------------------------
when Attribute_Max_Size_In_Storage_Elements =>
when Attribute_Max_Size_In_Storage_Elements => declare
Typ : constant Entity_Id := Etype (N);
Attr : Node_Id;
Conversion_Added : Boolean := False;
-- A flag which tracks whether the original attribute has been
-- wrapped inside a type conversion.
begin
Apply_Universal_Integer_Attribute_Checks (N);
-- The universal integer check may sometimes add a type conversion,
-- retrieve the original attribute reference from the expression.
Attr := N;
if Nkind (Attr) = N_Type_Conversion then
Attr := Expression (Attr);
Conversion_Added := True;
end if;
-- Heap-allocated controlled objects contain two extra pointers which
-- are not part of the actual type. Transform the attribute reference
-- into a runtime expression to add the size of the hidden header.
@ -3212,20 +3229,20 @@ package body Exp_Attr is
-- two pointers are already present in the type.
if VM_Target = No_VM
and then Nkind (N) = N_Attribute_Reference
and then Nkind (Attr) = N_Attribute_Reference
and then Needs_Finalization (Ptyp)
and then not Header_Size_Added (N)
and then not Header_Size_Added (Attr)
then
Set_Header_Size_Added (N);
Set_Header_Size_Added (Attr);
-- Generate:
-- P'Max_Size_In_Storage_Elements +
-- Universal_Integer
-- (Header_Size_With_Padding (Ptyp'Alignment))
Rewrite (N,
Rewrite (Attr,
Make_Op_Add (Loc,
Left_Opnd => Relocate_Node (N),
Left_Opnd => Relocate_Node (Attr),
Right_Opnd =>
Convert_To (Universal_Integer,
Make_Function_Call (Loc,
@ -3239,9 +3256,19 @@ package body Exp_Attr is
New_Reference_To (Ptyp, Loc),
Attribute_Name => Name_Alignment))))));
Analyze (N);
-- Add a conversion to the target type
if not Conversion_Added then
Rewrite (Attr,
Make_Type_Conversion (Loc,
Subtype_Mark => New_Reference_To (Typ, Loc),
Expression => Relocate_Node (Attr)));
end if;
Analyze (Attr);
return;
end if;
end;
--------------------
-- Mechanism_Code --

15
gcc/ada/exp_ch3.adb
View File

@ -518,11 +518,11 @@ package body Exp_Ch3 is
---------------------------
procedure Build_Array_Init_Proc (A_Type : Entity_Id; Nod : Node_Id) is
Loc : constant Source_Ptr := Sloc (Nod);
Comp_Type : constant Entity_Id := Component_Type (A_Type);
Body_Stmts : List_Id;
Has_Default_Init : Boolean;
Index_List : List_Id;
Loc : Source_Ptr;
Proc_Id : Entity_Id;
function Init_Component return List_Id;
@ -631,6 +631,19 @@ package body Exp_Ch3 is
-- Start of processing for Build_Array_Init_Proc
begin
-- The init proc is created when analyzing the freeze node for the type,
-- but it properly belongs with the array type declaration. However, if
-- the freeze node is for a subtype of a type declared in another unit
-- it seems preferable to use the freeze node as the source location of
-- of the init.proc. In any case this is preferable for gcov usage, and
-- the Sloc is not otherwise used by the compiler.
if In_Open_Scopes (Scope (A_Type)) then
Loc := Sloc (A_Type);
else
Loc := Sloc (Nod);
end if;
-- Nothing to generate in the following cases:
-- 1. Initialization is suppressed for the type

10
gcc/ada/exp_ch6.adb
View File

@ -4846,6 +4846,16 @@ package body Exp_Ch6 is
return;
end if;
-- Reset Last_Assignment for any parameters of mode out or in out, to
-- prevent spurious warnings about overwriting for assignments to the
-- formal in the inlined code.
if Is_Entity_Name (A)
and then Ekind (F) /= E_In_Parameter
then
Set_Last_Assignment (Entity (A), Empty);
end if;
-- If the argument may be a controlling argument in a call within
-- the inlined body, we must preserve its classwide nature to insure
-- that dynamic dispatching take place subsequently. If the formal

26
gcc/ada/gnat_ugn.texi
View File

@ -18684,13 +18684,13 @@ package, in file s-dimmks.ads.
type Mks_Type is new Long_Long_Float
with
Dimension_System => (
(Meter, 'm'),
(Kilogram, "kg"),
(Second, 's'),
(Ampere, 'A'),
(Kelvin, 'K'),
(Mole, "mol"),
(Candela, "cd"));
(Unit_Name => Meter, Unit_Symbol => 'm', Dim_Symbol => 'L'),
(Unit_Name => Kilogram, Unit_Symbol => "kg", Dim_Symbol => 'M'),
(Unit_Name => Second, Unit_Symbol => 's', Dim_Symbol => 'T'),
(Unit_Name => Ampere, Unit_Symbol => 'A', Dim_Symbol => 'I'),
(Unit_Name => Kelvin, Unit_Symbol => 'K', Dim_Symbol => "Theta"),
(Unit_Name => Mole, Unit_Symbol => "mol", Dim_Symbol => 'N'),
(Unit_Name => Candela, Unit_Symbol => "cd", Dim_Symbol => 'J'));
@end smallexample
@noindent
@ -18699,8 +18699,8 @@ conventional units. For example:
@smallexample @c ada
subtype Length is Mks_Type
with
Dimension => ('m',
Meter => 1,
Dimension => (Symbol => 'm',
Meter => 1,
others => 0);
@end smallexample
@noindent
@ -18712,10 +18712,10 @@ The package also defines conventional names for values of each unit, for
example:
@smallexample @c ada
m : constant Length := 1.0;
kg : constant Mass := 1.0;
s : constant Time := 1.0;
A : constant Electric_Current := 1.0;
m : constant Length := 1.0;
kg : constant Mass := 1.0;
s : constant Time := 1.0;
A : constant Electric_Current := 1.0;
@end smallexample
@noindent

9
gcc/ada/raise-gcc.c
View File

@ -710,7 +710,7 @@ get_call_site_action_for (_Unwind_Ptr call_site,
else
{
_uleb128_t cs_lp, cs_action;
const unsigned char *p = region->call_site_table;
const unsigned char *p;
/* Let the caller know there may be an action to take, but let it
determine the kind. */
@ -947,13 +947,16 @@ get_action_description_for (_Unwind_Ptr ip,
passed (to follow the ABI). */
if (!(uw_phase & _UA_FORCE_UNWIND))
{
enum action_kind act;
/* See if the filter we have is for an exception which
matches the one we are propagating. */
_Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
action->kind = is_handled_by (choice, gnat_exception);
if (action->kind != nothing)
act = is_handled_by (choice, gnat_exception);
if (act != nothing)
{
action->kind = act;
action->ttype_filter = ar_filter;
return;
}