Skip to content

R
riscv-gcc-1
Commit d2a6bd6b by Arnaud Charlet
Options

[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
parent 4c7e0990
Showing with 88 additions and 35 deletions
gcc/ada/ChangeLog
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
......
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);
......
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
......
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
......
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
......
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