From d2a6bd6bb570c3ece919323e9a01fe3c2beec08d Mon Sep 17 00:00:00 2001
From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Wed, 6 Feb 2013 11:13:51 +0100
Subject: [PATCH] [multiple changes]
2013-02-06 Ed Schonberg <schonberg@adacore.com>
* checks.adb (Apply_Discriminant_Check): Look for discriminant
constraint in full view of private type when needed.
* sem_ch12.adb (Validate_Array_Type_Instance): Specialize
previous patch to components types that are private and without
discriminants.
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Find_Enclosing_Context): Recognize
a simple return statement as one of the cases that require special
processing with respect to temporary controlled function results.
(Process_Transient_Object): Do attempt to finalize a temporary
controlled function result when the associated context is
a simple return statement. Instead, leave this task to the
general finalization mechanism.
2013-02-06 Thomas Quinot <quinot@adacore.com>
* einfo.ads: Minor reformatting.
(Status_Flag_Or_Transient_Decl): Add ??? comment.
From-SVN: r195791
---
gcc/ada/ChangeLog | 23 ++++++++++++++++++
gcc/ada/checks.adb | 18 ++++++++++----
gcc/ada/einfo.ads | 13 +++++-----
gcc/ada/exp_ch4.adb | 57 ++++++++++++++++++++++++++++----------------
gcc/ada/sem_ch12.adb | 12 ++++++----
5 files changed, 88 insertions(+), 35 deletions(-)
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6cc022acfe36..e7b259a0afc4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2013-02-06 Ed Schonberg <schonberg@adacore.com>
+
+ * checks.adb (Apply_Discriminant_Check): Look for discriminant
+ constraint in full view of private type when needed.
+ * sem_ch12.adb (Validate_Array_Type_Instance): Specialize
+ previous patch to components types that are private and without
+ discriminants.
+
+2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch4.adb (Find_Enclosing_Context): Recognize
+ a simple return statement as one of the cases that require special
+ processing with respect to temporary controlled function results.
+ (Process_Transient_Object): Do attempt to finalize a temporary
+ controlled function result when the associated context is
+ a simple return statement. Instead, leave this task to the
+ general finalization mechanism.
+
+2013-02-06 Thomas Quinot <quinot@adacore.com>
+
+ * einfo.ads: Minor reformatting.
+ (Status_Flag_Or_Transient_Decl): Add ??? comment.
+
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Expand_N_Expression_With_Actions): Rewritten. This
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index a0ca4c61a43c..37c6dd1e8caf 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -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- --
@@ -1536,8 +1536,8 @@ package body Checks is
-- the constraints are constants. In this case, we can do the check
-- successfully at compile time.
- -- We skip this check for the case where the node is a rewritten`
- -- allocator, because it already carries the context subtype, and
+ -- We skip this check for the case where the node is a rewritten`as
+ -- an allocator, because it already carries the context subtype, and
-- extracting the discriminants from the aggregate is messy.
if Is_Constrained (S_Typ)
@@ -1591,7 +1591,17 @@ package body Checks is
end if;
end if;
- DconT := First_Elmt (Discriminant_Constraint (T_Typ));
+ -- Constraint may appear in full view of type
+
+ if Ekind (T_Typ) = E_Private_Subtype
+ and then Present (Full_View (T_Typ))
+ then
+ DconT :=
+ First_Elmt (Discriminant_Constraint (Full_View (T_Typ)));
+
+ else
+ DconT := First_Elmt (Discriminant_Constraint (T_Typ));
+ end if;
while Present (Discr) loop
ItemS := Node (DconS);
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 1266a3deb80c..0f33b7f375c4 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -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- --
@@ -3725,11 +3725,12 @@ package Einfo is
-- Status_Flag_Or_Transient_Decl (Node15)
-- Defined in variables and constants. Applies to objects that require
--- special treatment by the finalization machinery. Such examples are
--- extended return results, if and case expression results and objects
--- inside N_Expression_With_Actions nodes. The attribute contains the
--- entity of a flag which specifies particular behavior over a region
--- of code or the declaration of a "hook" object.
+-- special treatment by the finalization machinery, such as extended
+-- return results, IF and CASE expression results, and objects inside
+-- N_Expression_With_Actions nodes. The attribute contains the entity
+-- of a flag which specifies particular behavior over a region of code
+-- or the declaration of a "hook" object.
+-- In which case is it a flag, or a hook object???
-- Storage_Size_Variable (Node15) [implementation base type only]
-- Defined in access types and task type entities. This flag is set
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 56b1d6305992..f8d37a5530f0 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5038,7 +5038,7 @@ package body Exp_Ch4 is
-- Start of processing for Find_Enclosing_Context
begin
- -- The expression_with_action is in a case or if expression and
+ -- The expression_with_actions is in a case/if expression and
-- the lifetime of any temporary controlled object is therefore
-- extended. Find a suitable insertion node by locating the top
-- most case or if expressions.
@@ -5088,12 +5088,12 @@ package body Exp_Ch4 is
return Par;
- -- Shor circuit operators in complex expressions are converted
+ -- Short circuit operators in complex expressions are converted
-- into expression_with_actions.
else
-- Take care of the case where the expression_with_actions
- -- is burried deep inside an if statement. The temporary
+ -- is buried deep inside an IF statement. The temporary
-- function result must be finalized before the then, elsif
-- or else statements are evaluated.
@@ -5123,7 +5123,7 @@ package body Exp_Ch4 is
Top := Par;
- -- The expression_with_action might be located in a pragm
+ -- The expression_with_actions might be located in a pragma
-- in which case locate the pragma itself:
-- pragma Precondition (... and then Ctrl_Func_Call ...);
@@ -5133,10 +5133,16 @@ package body Exp_Ch4 is
-- Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
+ -- Another case to consider is an expression_with_actions as
+ -- part of a return statement:
+
+ -- return ... and then Ctrl_Func_Call ...;
+
while Present (Par) loop
if Nkind_In (Par, N_Assignment_Statement,
N_Object_Declaration,
- N_Pragma)
+ N_Pragma,
+ N_Simple_Return_Statement)
then
return Par;
@@ -5238,23 +5244,32 @@ package body Exp_Ch4 is
-- Temp := null;
-- end if;
- Insert_Action_After (Context,
- Make_If_Statement (Loc,
- Condition =>
- Make_Op_Ne (Loc,
- Left_Opnd => New_Reference_To (Temp_Id, Loc),
- Right_Opnd => Make_Null (Loc)),
-
- Then_Statements => New_List (
- Make_Final_Call
- (Obj_Ref =>
- Make_Explicit_Dereference (Loc,
- Prefix => New_Reference_To (Temp_Id, Loc)),
- Typ => Desig_Typ),
+ -- When the expression_with_actions is part of a return statement,
+ -- there is no need to insert a finalization call, as the general
+ -- finalization mechanism (see Build_Finalizer) would take care of
+ -- the temporary function result on subprogram exit. Note that it
+ -- would also be impossible to insert the finalization code after
+ -- the return statement as this would make it unreachable.
+
+ if Nkind (Context) /= N_Simple_Return_Statement then
+ Insert_Action_After (Context,
+ Make_If_Statement (Loc,
+ Condition =>
+ Make_Op_Ne (Loc,
+ Left_Opnd => New_Reference_To (Temp_Id, Loc),
+ Right_Opnd => Make_Null (Loc)),
+
+ Then_Statements => New_List (
+ Make_Final_Call
+ (Obj_Ref =>
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Reference_To (Temp_Id, Loc)),
+ Typ => Desig_Typ),
- Make_Assignment_Statement (Loc,
- Name => New_Reference_To (Temp_Id, Loc),
- Expression => Make_Null (Loc)))));
+ Make_Assignment_Statement (Loc,
+ Name => New_Reference_To (Temp_Id, Loc),
+ Expression => Make_Null (Loc)))));
+ end if;
end Process_Transient_Object;
-- Start of processing for Process_Action
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 267d50c6dca0..fad6ae0b0041 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -10708,10 +10708,14 @@ package body Sem_Ch12 is
or else Subtypes_Match
(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))
+ or else
+ (Is_Private_Type (Component_Type (A_Gen_T))
+ and then not Has_Discriminants (Component_Type (A_Gen_T))
+ and then
+ Subtypes_Match
+ (Base_Type
+ (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T)),
+ Component_Type (Act_T)))
then
null;
else
--
GitLab