Commit 4c7e0990 by Arnaud Charlet

[multiple changes]

2013-02-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_N_Expression_With_Actions): Rewritten. This
	routine should be able to properly detect controlled transient
	objects in its actions and generate the appropriate finalization
	actions.
	* exp_ch6.adb (Enclosing_Context): Removed.
	(Expand_Ctrl_Function_Call): Remove local subprogram and
	constant. Use routine Within_Case_Or_If_Expression to determine
	whether the lifetime of the function result must be extended to
	match that of the context.
	* exp_util.ads, exp_util.adb (Within_Case_Or_If_Expression): New
	routine.

2013-02-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Validate_Array_Type_Instance): Extend check
	for subtype matching of component type of formal array type,
	to avoid spurious error when component type is a separate actual
	in the instance, and there may be a discrepancy between private
	and full view of component type.

From-SVN: r195790
parent 088c2c8d
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Expand_N_Expression_With_Actions): Rewritten. This
routine should be able to properly detect controlled transient
objects in its actions and generate the appropriate finalization
actions.
* exp_ch6.adb (Enclosing_Context): Removed.
(Expand_Ctrl_Function_Call): Remove local subprogram and
constant. Use routine Within_Case_Or_If_Expression to determine
whether the lifetime of the function result must be extended to
match that of the context.
* exp_util.ads, exp_util.adb (Within_Case_Or_If_Expression): New
routine.
2013-02-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Validate_Array_Type_Instance): Extend check
for subtype matching of component type of formal array type,
to avoid spurious error when component type is a separate actual
in the instance, and there may be a discrepancy between private
and full view of component type.
2013-02-06 Robert Dewar <dewar@adacore.com>
* s-dim.ads, clean.adb: Minor reformatting.
......
......@@ -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- --
......@@ -4036,45 +4036,6 @@ package body Exp_Ch6 is
-------------------------------
procedure Expand_Ctrl_Function_Call (N : Node_Id) is
function Enclosing_Context return Node_Id;
-- Find the enclosing context where the function call appears
-----------------------
-- Enclosing_Context --
-----------------------
function Enclosing_Context return Node_Id is
Context : Node_Id;
begin
Context := Parent (N);
while Present (Context) loop
-- The following could use a comment (and why is N_Case_Expression
-- not treated in a similar manner ???
if Nkind (Context) = N_If_Expression then
exit;
-- Stop the search when reaching any statement because we have
-- gone too far up the tree.
elsif Nkind (Context) = N_Procedure_Call_Statement
or else Nkind (Context) in N_Statement_Other_Than_Procedure_Call
then
exit;
end if;
Context := Parent (Context);
end loop;
return Context;
end Enclosing_Context;
-- Local variables
Context : constant Node_Id := Enclosing_Context;
begin
-- Optimization, if the returned value (which is on the sec-stack) is
-- returned again, no need to copy/readjust/finalize, we can just pass
......@@ -4096,15 +4057,12 @@ package body Exp_Ch6 is
Remove_Side_Effects (N);
-- The function call is part of an if expression dependent expression.
-- The temporary result must live as long as the if expression itself,
-- otherwise it will be finalized too early. Mark the transient as
-- processed to avoid untimely finalization.
-- Why no special handling for case expressions here ???
-- When the temporary function result appears inside a case or an if
-- expression, its lifetime must be extended to match that of the
-- context. If not, the function result would be finalized prematurely
-- and the evaluation of the expression could yield the wrong result.
if Present (Context)
and then Nkind (Context) = N_If_Expression
if Within_Case_Or_If_Expression (N)
and then Nkind (N) = N_Explicit_Dereference
then
Set_Is_Processed_Transient (Entity (Prefix (N)));
......
......@@ -7944,6 +7944,43 @@ package body Exp_Util is
end if;
end Type_May_Have_Bit_Aligned_Components;
----------------------------------
-- Within_Case_Or_If_Expression --
----------------------------------
function Within_Case_Or_If_Expression (N : Node_Id) return Boolean is
Par : Node_Id;
begin
-- Locate an enclosing case or if expression. Note that these constructs
-- appear as expression_with_actions, hence the test using the original
-- node.
Par := N;
while Present (Par) loop
if Nkind_In (Original_Node (Par), N_Case_Expression,
N_If_Expression)
then
return True;
-- Prevent the search from going too far
elsif Nkind_In (Par, N_Entry_Body,
N_Package_Body,
N_Package_Declaration,
N_Protected_Body,
N_Subprogram_Body,
N_Task_Body)
then
return False;
end if;
Par := Parent (Par);
end loop;
return False;
end Within_Case_Or_If_Expression;
----------------------------
-- Wrap_Cleanup_Procedure --
----------------------------
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
......@@ -818,6 +818,9 @@ package Exp_Util is
-- is conservative, in that a result of False is decisive. A result of True
-- means that such a component may or may not be present.
function Within_Case_Or_If_Expression (N : Node_Id) return Boolean;
-- Determine whether arbitrary node N is within a case or an if expression
procedure Wrap_Cleanup_Procedure (N : Node_Id);
-- Given an N_Subprogram_Body node, this procedure adds an Abort_Defer call
-- at the start of the statement sequence, and an Abort_Undefer call at the
......
......@@ -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- --
......@@ -10699,13 +10699,19 @@ package body Sem_Ch12 is
-- issues when the generic is a child unit and some aspect of the
-- generic type is declared in a parent unit of the generic. We do
-- the test to handle this special case only after a direct check
-- for static matching has failed.
-- for static matching has failed. The case where both the component
-- type and the array type are separate formals, and the component
-- type is a private view may also require special checking.
if Subtypes_Match
(Component_Type (A_Gen_T), Component_Type (Act_T))
or else Subtypes_Match
(Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T),
Component_Type (Act_T))
(Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T),
Component_Type (Act_T))
or else Subtypes_Match
(Base_Type
(Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T)),
Component_Type (Act_T))
then
null;
else
......
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