Commit 56af8688 by Pierre-Marie de Rodat

[multiple changes]

2017-12-15  Bob Duff  <duff@adacore.com>

	* exp_ch6.adb (Expand_N_Extended_Return_Statement): If the
	Init_Assignment is rewritten, we need to set Assignment_OK on the new
	node.  Otherwise, we will get spurious errors when initializing via
	assignment statement.

2017-12-15  Arnaud Charlet  <charlet@adacore.com>

	* exp_unst.adb (Visit_Node): Refine handling of 'Access to ignore non
	relevant nodes.
	(Has_Non_Null_Statements): Moved to sem_util for later reuse.

2017-12-15  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_attr.adb (Is_Inline_Floating_Point_Attribute): Fix comment.
	* libgnat/s-fatgen.adb (Model): Use Machine attribute.
	(Truncation): Likewise.

2017-12-15  Bob Duff  <duff@adacore.com>

	* exp_ch7.adb (Expand_Cleanup_Actions): Make sure the block and handled
	statement sequence generated for certain extended return statements
	have a Sloc that is not No_Location. Otherwise, the back end doesn't
	set any location and ends up reading uninitialized variables.

From-SVN: r255680
parent e83a74b0
2017-12-15 Bob Duff <duff@adacore.com>
* exp_ch6.adb (Expand_N_Extended_Return_Statement): If the
Init_Assignment is rewritten, we need to set Assignment_OK on the new
node. Otherwise, we will get spurious errors when initializing via
assignment statement.
2017-12-15 Arnaud Charlet <charlet@adacore.com>
* exp_unst.adb (Visit_Node): Refine handling of 'Access to ignore non
relevant nodes.
(Has_Non_Null_Statements): Moved to sem_util for later reuse.
2017-12-15 Eric Botcazou <ebotcazou@adacore.com>
* exp_attr.adb (Is_Inline_Floating_Point_Attribute): Fix comment.
* libgnat/s-fatgen.adb (Model): Use Machine attribute.
(Truncation): Likewise.
2017-12-15 Bob Duff <duff@adacore.com>
* exp_ch7.adb (Expand_Cleanup_Actions): Make sure the block and handled
statement sequence generated for certain extended return statements
have a Sloc that is not No_Location. Otherwise, the back end doesn't
set any location and ends up reading uninitialized variables.
2017-12-15 Bob Duff <duff@adacore.com>
* types.ads, exp_ch6.adb, libgnat/s-regexp.ads, opt.ads: Partly revert
r255414, committed by mistake.
......
......@@ -8274,7 +8274,7 @@ package body Exp_Attr is
-- Start of processing for Is_Inline_Floating_Point_Attribute
begin
-- Machine and Model can be expanded by the GCC and AAMP back ends only
-- Machine and Model can be expanded by the GCC back end only
if Id = Attribute_Machine or else Id = Attribute_Model then
return Is_GCC_Target;
......
......@@ -5370,6 +5370,10 @@ package body Exp_Ch6 is
Rewrite (Name (Init_Assignment),
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Alloc_Obj_Id, Loc)));
pragma Assert
(Assignment_OK
(Original_Node (Name (Init_Assignment))));
Set_Assignment_OK (Name (Init_Assignment));
Set_Etype (Name (Init_Assignment), Etype (Ret_Obj_Id));
......@@ -7310,7 +7314,7 @@ package body Exp_Ch6 is
begin
-- ???For now, enable build-in-place for a very narrow set of
-- controlled types. Change "if True" to "if False" to
-- experiment more controlled types. Eventually, we would
-- experiment with more controlled types. Eventually, we might
-- like to enable build-in-place for all tagged types, all
-- types that need finalization, and all caller-unknown-size
-- types.
......
......@@ -4310,20 +4310,6 @@ package body Exp_Ch7 is
return;
end if;
-- If we are generating expanded code for debugging purposes, use the
-- Sloc of the point of insertion for the cleanup code. The Sloc will be
-- updated subsequently to reference the proper line in .dg files. If we
-- are not debugging generated code, use No_Location instead, so that
-- no debug information is generated for the cleanup code. This makes
-- the behavior of the NEXT command in GDB monotonic, and makes the
-- placement of breakpoints more accurate.
if Debug_Generated_Code then
Loc := Sloc (Scop);
else
Loc := No_Location;
end if;
-- If an extended return statement contains something like
-- X := F (...);
-- where F is a build-in-place function call returning a controlled
......@@ -4350,13 +4336,13 @@ package body Exp_Ch7 is
if Nkind (N) = N_Extended_Return_Statement then
declare
Block : constant Node_Id :=
Make_Block_Statement (Loc,
Make_Block_Statement (Sloc (N),
Declarations => Empty_List,
Handled_Statement_Sequence =>
Handled_Statement_Sequence (N));
begin
Set_Handled_Statement_Sequence
(N, Make_Handled_Sequence_Of_Statements (Loc,
(N, Make_Handled_Sequence_Of_Statements (Sloc (N),
Statements => New_List (Block)));
Analyze (Block);
end;
......@@ -4380,6 +4366,20 @@ package body Exp_Ch7 is
Old_Poll : Boolean;
begin
-- If we are generating expanded code for debugging purposes, use the
-- Sloc of the point of insertion for the cleanup code. The Sloc will
-- be updated subsequently to reference the proper line in .dg files.
-- If we are not debugging generated code, use No_Location instead,
-- so that no debug information is generated for the cleanup code.
-- This makes the behavior of the NEXT command in GDB monotonic, and
-- makes the placement of breakpoints more accurate.
if Debug_Generated_Code then
Loc := Sloc (Scop);
else
Loc := No_Location;
end if;
-- Set polling off. The finalization and cleanup code is executed
-- with aborts deferred.
......
......@@ -586,18 +586,20 @@ package body Exp_Unst is
| Attribute_Unchecked_Access
| Attribute_Unrestricted_Access
=>
Ent := Entity (Prefix (N));
if Nkind (Prefix (N)) in N_Has_Entity then
Ent := Entity (Prefix (N));
-- We are only interested in calls to subprograms
-- nested within Subp.
-- We are only interested in calls to subprograms
-- nested within Subp.
if Scope_Within (Ent, Subp) then
if Is_Imported (Ent) then
null;
if Scope_Within (Ent, Subp) then
if Is_Imported (Ent) then
null;
elsif Is_Subprogram (Ent) then
Append_Unique_Call
((N, Current_Subprogram, Ent));
elsif Is_Subprogram (Ent) then
Append_Unique_Call
((N, Current_Subprogram, Ent));
end if;
end if;
end if;
......
......@@ -394,7 +394,7 @@ package body System.Fat_Gen is
function Model (X : T) return T is
begin
return Machine (X);
return T'Machine (X);
end Model;
----------
......@@ -739,10 +739,11 @@ package body System.Fat_Gen is
Result := abs X;
if Result >= Radix_To_M_Minus_1 then
return Machine (X);
return T'Machine (X);
else
Result := Machine (Radix_To_M_Minus_1 + Result) - Radix_To_M_Minus_1;
Result :=
T'Machine (Radix_To_M_Minus_1 + Result) - Radix_To_M_Minus_1;
if Result > abs X then
Result := Result - 1.0;
......
......@@ -10619,6 +10619,30 @@ package body Sem_Util is
and then Nkind (Node (First_Elmt (Constits))) /= N_Null;
end Has_Non_Null_Refinement;
-----------------------------
-- Has_Non_Null_Statements --
-----------------------------
function Has_Non_Null_Statements (L : List_Id) return Boolean is
Node : Node_Id;
begin
if Is_Non_Empty_List (L) then
Node := First (L);
loop
if Nkind (Node) /= N_Null_Statement then
return True;
end if;
Next (Node);
exit when Node = Empty;
end loop;
end if;
return False;
end Has_Non_Null_Statements;
----------------------------------
-- Has_Non_Trivial_Precondition --
----------------------------------
......
......@@ -1290,6 +1290,9 @@ package Sem_Util is
-- in pragma Refined_State. This function does not take into account the
-- visible refinement region of abstract state Id.
function Has_Non_Null_Statements (L : List_Id) return Boolean;
-- Return True if L has non-null statements
function Has_Overriding_Initialize (T : Entity_Id) return Boolean;
-- Predicate to determine whether a controlled type has a user-defined
-- Initialize primitive (and, in Ada 2012, whether that primitive is
......
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