procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2016-04-20  Bob Duff  <duff@adacore.com>

	* s-os_lib.ads: Minor comment fix.

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_N_Assignment_Statement): Do no generate
	a discriminant check for a type whose partial view has unknown
	discriminants when the full view has discriminants with defaults.

2016-04-20  Javier Miranda  <miranda@adacore.com>

	* exp_util.adb (Remove_Side_Effects): When generating C code
	remove side effect of type conversion of access to unconstrained
	array type.
	(Side_Effect_Free): Return false for the type
	conversion of access to unconstrained array type when generating
	C code.
	* sem_res.adb (Resolved_Type_Conversion): Remove side effects
	of access to unconstrained array type conversion when generating
	C code.

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Build_Predicate_Function_Declaration): New
	function, to construct the declaration of a predicate function
	at the end of the current declarative part rather than at the
	(possibly later) freeze point of the type. This also allows uses
	of a type with predicates in instantiations elsewhere.
	(Resolve_Aspect_Expression): New procedure to detect visiblity
	errors in aspect expressions, at the end of the declarative part
	that includes the type declaration.
	* sem_ch3.adb (Complete_Private_Subtype): Propagate properly the
	predicate function from private to full view.
	* einfo.adb (Predicate_Function): Refine search for predicate
	function when type has a full view and predicate function may
	be defined on either view.

2016-04-20  Javier Miranda  <miranda@adacore.com>

	* frontend.adb: Passing the root of the tree to
	Unnest_Subprograms().
	* exp_ch6.adb (Expand_N_Subprogram_Body): Remove code that
	took care of adding subprograms to the Unest_Bodies table since
	performing such action too early disables the ability to process
	generic instantiations.
	(Unnest_Subprograms): Adding parameter.
	(Search_Unnesting_Subprograms): New subprogram.
	* exp_ch6.ads (Unnest_Subrograms): Update documentation.

From-SVN: r235268
This commit is contained in:
Arnaud Charlet 2016-04-20 12:56:12 +02:00
parent 268aeaa902
commit 6905a0499b
11 changed files with 354 additions and 84 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
gcc/ada/ChangeLog
View file

@ -1,3 +1,53 @@
2016-04-20 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Minor comment fix.
2016-04-20 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_N_Assignment_Statement): Do no generate
a discriminant check for a type whose partial view has unknown
discriminants when the full view has discriminants with defaults.
2016-04-20 Javier Miranda <miranda@adacore.com>
* exp_util.adb (Remove_Side_Effects): When generating C code
remove side effect of type conversion of access to unconstrained
array type.
(Side_Effect_Free): Return false for the type
conversion of access to unconstrained array type when generating
C code.
* sem_res.adb (Resolved_Type_Conversion): Remove side effects
of access to unconstrained array type conversion when generating
C code.
2016-04-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Build_Predicate_Function_Declaration): New
function, to construct the declaration of a predicate function
at the end of the current declarative part rather than at the
(possibly later) freeze point of the type. This also allows uses
of a type with predicates in instantiations elsewhere.
(Resolve_Aspect_Expression): New procedure to detect visiblity
errors in aspect expressions, at the end of the declarative part
that includes the type declaration.
* sem_ch3.adb (Complete_Private_Subtype): Propagate properly the
predicate function from private to full view.
* einfo.adb (Predicate_Function): Refine search for predicate
function when type has a full view and predicate function may
be defined on either view.
2016-04-20 Javier Miranda <miranda@adacore.com>
* frontend.adb: Passing the root of the tree to
Unnest_Subprograms().
* exp_ch6.adb (Expand_N_Subprogram_Body): Remove code that
took care of adding subprograms to the Unest_Bodies table since
performing such action too early disables the ability to process
generic instantiations.
(Unnest_Subprograms): Adding parameter.
(Search_Unnesting_Subprograms): New subprogram.
* exp_ch6.ads (Unnest_Subrograms): Update documentation.
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb, freeze.adb, sem_util.adb: Minor reformatting.

9
gcc/ada/einfo.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
@ -8213,8 +8213,13 @@ package body Einfo is
-- If type is private and has a completion, predicate may be defined
-- on the full view.
if Is_Private_Type (Id) and then Present (Full_View (Id)) then
if Is_Private_Type (Id)
and then
(not Has_Predicates (Id) or else No (Subprograms_For_Type (Id)))
and then Present (Full_View (Id))
then
T := Full_View (Id);
else
T := Id;
end if;

4
gcc/ada/exp_ch5.adb
View file

@ -1946,10 +1946,12 @@ package body Exp_Ch5 is
-- have a full view with discriminants, but those are nameable only
-- in the underlying type, so convert the Rhs to it before potential
-- checking. Convert Lhs as well, otherwise the actual subtype might
-- not be constructible.
-- not be constructible. If the discriminants have defaults the type
-- is unconstrained and there is nothing to check.
elsif Has_Unknown_Discriminants (Base_Type (Etype (Lhs)))
and then Has_Discriminants (Typ)
and then not Has_Defaulted_Discriminants (Typ)
then
Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs));
Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs));

92
gcc/ada/exp_ch6.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
@ -5491,28 +5491,6 @@ package body Exp_Ch6 is
Qualify_Entity_Names (N);
-- If we are unnesting procedures, and this is an outer level procedure
-- with nested subprograms, do the unnesting operation now.
if Opt.Unnest_Subprogram_Mode
-- We are only interested in subprograms (not generic subprograms)
and then Is_Subprogram (Spec_Id)
-- Only deal with outer level subprograms. Nested subprograms are
-- handled as part of dealing with the outer level subprogram in
-- which they are nested.
and then Enclosing_Subprogram (Spec_Id) = Empty
-- We are only interested in subprograms that have nested subprograms
and then Has_Nested_Subprogram (Spec_Id)
then
Unest_Bodies.Append ((Spec_Id, N));
end if;
Ghost_Mode := Save_Ghost_Mode;
end Expand_N_Subprogram_Body;
@ -8497,8 +8475,74 @@ package body Exp_Ch6 is
-- Unnest_Subprograms --
------------------------
procedure Unnest_Subprograms is
procedure Unnest_Subprograms (N : Node_Id) is
procedure Search_Unnesting_Subprograms (N : Node_Id);
-- Search for outer level procedures with nested subprograms and append
-- them to the Unnest table.
----------------------------------
-- Search_Unnesting_Subprograms --
----------------------------------
procedure Search_Unnesting_Subprograms (N : Node_Id) is
function Search_Subprograms (N : Node_Id) return Traverse_Result;
-- Tree visitor that search for outer level procedures with nested
-- subprograms and adds them to the Unnest table.
------------------------
-- Search_Subprograms --
------------------------
function Search_Subprograms (N : Node_Id) return Traverse_Result is
begin
if Nkind_In (N, N_Subprogram_Body,
N_Subprogram_Body_Stub)
then
declare
Spec_Id : constant Entity_Id := Unique_Defining_Entity (N);
begin
-- We are only interested in subprograms (not generic
-- subprograms), that have nested subprograms.
if Is_Subprogram (Spec_Id)
and then Has_Nested_Subprogram (Spec_Id)
and then Is_Library_Level_Entity (Spec_Id)
then
Unest_Bodies.Append ((Spec_Id, N));
end if;
end;
end if;
return OK;
end Search_Subprograms;
---------------
-- Do_Search --
---------------
procedure Do_Search is new Traverse_Proc (Search_Subprograms);
-- Subtree visitor instantiation
-- Start of processing for Search_Unnesting_Subprograms
begin
if Opt.Unnest_Subprogram_Mode then
Do_Search (N);
end if;
end Search_Unnesting_Subprograms;
-- Start of processing for Unnest_Subprograms
begin
if not Opt.Unnest_Subprogram_Mode then
return;
end if;
Search_Unnesting_Subprograms (N);
for J in Unest_Bodies.First .. Unest_Bodies.Last loop
declare
UBJ : Unest_Entry renames Unest_Bodies.Table (J);

10
gcc/ada/exp_ch6.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
@ -212,9 +212,9 @@ package Exp_Ch6 is
-- parameter to identify the accessibility level of the function result
-- "determined by the point of call".
procedure Unnest_Subprograms;
-- Called to unnest subprograms. If we are in unnest subprogram mode, and
-- subprograms have been gathered in the Unest_Bodies table, this is the
-- call that causes them to be processed for unnesting.
procedure Unnest_Subprograms (N : Node_Id);
-- Called to unnest subprograms. If we are in unnest subprogram mode, this
-- is the call that traverses the tree N and locates all the library level
-- subprograms with nested subprograms to process them.
end Exp_Ch6;

38
gcc/ada/exp_util.adb
View file

@ -7800,7 +7800,30 @@ package body Exp_Util is
elsif Nkind (Exp) = N_Type_Conversion then
Remove_Side_Effects (Expression (Exp), Name_Req, Variable_Ref);
goto Leave;
-- Generating C code the type conversion of an access to constrained
-- array type into an access to unconstrained array type involves
-- initializing a fat pointer and the expression must be free of
-- side effects to safely compute its bounds.
if Generate_C_Code
and then Is_Access_Type (Etype (Exp))
and then Is_Array_Type (Designated_Type (Etype (Exp)))
and then not Is_Constrained (Designated_Type (Etype (Exp)))
then
Def_Id := Build_Temporary (Loc, 'R', Exp);
Set_Etype (Def_Id, Exp_Type);
Res := New_Occurrence_Of (Def_Id, Loc);
Insert_Action (Exp,
Make_Object_Declaration (Loc,
Defining_Identifier => Def_Id,
Object_Definition => New_Occurrence_Of (Exp_Type, Loc),
Constant_Present => True,
Expression => Relocate_Node (Exp)));
else
goto Leave;
end if;
-- If this is an unchecked conversion that Gigi can't handle, make
-- a copy or a use a renaming to capture the value.
@ -9076,6 +9099,19 @@ package body Exp_Util is
and then Is_Class_Wide_Type (Typ)
then
return True;
-- Generating C the type conversion of an access to constrained array
-- type into an access to unconstrained array type involves initializing
-- a fat pointer and the expression cannot be assumed to be free of side
-- effects since it must referenced several times to compute its bounds.
elsif Generate_C_Code
and then Nkind (N) = N_Type_Conversion
and then Is_Access_Type (Typ)
and then Is_Array_Type (Designated_Type (Typ))
and then not Is_Constrained (Designated_Type (Typ))
then
return False;
end if;
-- For other than entity names and compile time known values,

4
gcc/ada/frontend.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
@ -440,7 +440,7 @@ begin
-- At this stage we can unnest subprogram bodies if required
Exp_Ch6.Unnest_Subprograms;
Exp_Ch6.Unnest_Subprograms (Cunit (Main_Unit));
-- List library units if requested

2
gcc/ada/s-os_lib.ads
View file

@ -454,7 +454,7 @@ package System.OS_Lib is
-- that is writable. Returns True if so, False otherwise. Note that this
-- function simply interrogates the file attributes (e.g. using the C
-- function stat), so it does not indicate a situation in which a file may
-- not actually be writeable due to some other process having exclusive
-- not actually be writable due to some other process having exclusive
-- access.
function Locate_Exec_On_Path (Exec_Name : String) return String_Access;

201
gcc/ada/sem_ch13.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
@ -101,17 +101,24 @@ package body Sem_Ch13 is
-- list is stored in Static_Discrete_Predicate (Typ), and the Expr is
-- rewritten as a canonicalized membership operation.
function Build_Predicate_Function_Declaration
(Typ : Entity_Id) return Node_Id;
-- Build the declaration for a predicate function. The declaration is built
-- at the end of the declarative part containing the type definition, which
-- may be before the freeze point of the type. The predicate expression is
-- pre-analyzed at this point, to catch visibility errors.
procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id);
-- If Typ has predicates (indicated by Has_Predicates being set for Typ),
-- then either there are pragma Predicate entries on the rep chain for the
-- type (note that Predicate aspects are converted to pragma Predicate), or
-- there are inherited aspects from a parent type, or ancestor subtypes.
-- This procedure builds the spec and body for the Predicate function that
-- tests these predicates. N is the freeze node for the type. The spec of
-- the function is inserted before the freeze node, and the body of the
-- function is inserted after the freeze node. If the predicate expression
-- has at least one Raise_Expression, then this procedure also builds the
-- M version of the predicate function for use in membership tests.
-- This procedure builds body for the Predicate function that tests these
-- predicates. N is the freeze node for the type. The spec of the function
-- is inserted before the freeze node, and the body of the function is
-- inserted after the freeze node. If the predicate expression has a least
-- one Raise_Expression, then this procedure also builds the M version of
-- the predicate function for use in membership tests.
procedure Check_Pool_Size_Clash (Ent : Entity_Id; SP, SS : Node_Id);
-- Called if both Storage_Pool and Storage_Size attribute definition
@ -8419,18 +8426,23 @@ package body Sem_Ch13 is
-- function. It differs in that raise expressions are marked for
-- special expansion (see Process_REs).
Object_Name : constant Name_Id := New_Internal_Name ('I');
Object_Name : Name_Id;
-- Name for argument of Predicate procedure. Note that we use the same
-- name for both predicate functions. That way the reference within the
-- predicate expression is the same in both functions.
Object_Entity : constant Entity_Id :=
Make_Defining_Identifier (Loc, Chars => Object_Name);
Object_Entity : Entity_Id;
-- Entity for argument of Predicate procedure
Object_Entity_M : constant Entity_Id :=
Make_Defining_Identifier (Loc, Chars => Object_Name);
-- Entity for argument of Predicate_M procedure
Object_Entity_M : Entity_Id;
-- Entity for argument of separate Predicate procedure when exceptions
-- are present in expression.
FDecl : Node_Id;
-- The function declaration.
SId : Entity_Id;
-- Its entity.
Raise_Expression_Present : Boolean := False;
-- Set True if Expr has at least one Raise_Expression
@ -8669,8 +8681,9 @@ package body Sem_Ch13 is
begin
-- Return if already built or if type does not have predicates
SId := Predicate_Function (Typ);
if not Has_Predicates (Typ)
or else Present (Predicate_Function (Typ))
or else (Present (SId) and then Has_Completion (SId))
then
return;
end if;
@ -8684,6 +8697,24 @@ package body Sem_Ch13 is
Expr := Empty;
if Present (SId) then
FDecl := Unit_Declaration_Node (SId);
else
FDecl := Build_Predicate_Function_Declaration (Typ);
SId := Defining_Entity (FDecl);
end if;
-- Recover name of formal parameter of function that replaces references
-- to the type in predicate expressions.
Object_Entity :=
Defining_Identifier
(First (Parameter_Specifications (Specification (FDecl))));
Object_Name := Chars (Object_Entity);
Object_Entity_M := Make_Defining_Identifier (Loc, Chars => Object_Name);
-- Add predicates for ancestor if present. These must come before the
-- ones for the current type, as required by AI12-0071-1.
@ -8694,7 +8725,6 @@ package body Sem_Ch13 is
Add_Call (Atyp);
end if;
end;
-- Add Predicates for the current type
Add_Predicates;
@ -8757,27 +8787,15 @@ package body Sem_Ch13 is
-- Build the main predicate function
declare
SId : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Predicate"));
-- The entity for the function spec
SIdB : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Predicate"));
-- The entity for the function body
Spec : Node_Id;
FDecl : Node_Id;
FBody : Node_Id;
begin
-- Build function declaration
Set_Ekind (SId, E_Function);
Set_Is_Internal (SId);
Set_Is_Predicate_Function (SId);
Set_Predicate_Function (Typ, SId);
-- The predicate function is shared between views of a type
@ -8792,20 +8810,6 @@ package body Sem_Ch13 is
Set_Is_Ghost_Entity (SId);
end if;
Spec :=
Make_Function_Specification (Loc,
Defining_Unit_Name => SId,
Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc,
Defining_Identifier => Object_Entity,
Parameter_Type => New_Occurrence_Of (Typ, Loc))),
Result_Definition =>
New_Occurrence_Of (Standard_Boolean, Loc));
FDecl :=
Make_Subprogram_Declaration (Loc,
Specification => Spec);
-- Build function body
Spec :=
@ -8830,9 +8834,14 @@ package body Sem_Ch13 is
Make_Simple_Return_Statement (Loc,
Expression => Expr))));
-- Insert declaration before freeze node and body after
-- If declaration has not been analyzed yet, Insert declaration
-- before freeze node.
-- Insert body after freeze node.
if not Analyzed (FDecl) then
Insert_Before_And_Analyze (N, FDecl);
end if;
Insert_Before_And_Analyze (N, FDecl);
Insert_After_And_Analyze (N, FBody);
-- Static predicate functions are always side-effect free, and
@ -8863,8 +8872,8 @@ package body Sem_Ch13 is
-- The entity for the function body
Spec : Node_Id;
FDecl : Node_Id;
FBody : Node_Id;
FDecl : Node_Id;
BTemp : Entity_Id;
begin
@ -9046,6 +9055,59 @@ package body Sem_Ch13 is
Ghost_Mode := Save_Ghost_Mode;
end Build_Predicate_Functions;
------------------------------------------
-- Build_Predicate_Function_Declaration --
------------------------------------------
function Build_Predicate_Function_Declaration
(Typ : Entity_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (Typ);
Object_Entity : constant Entity_Id :=
Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('I'));
-- The formal parameter of the function
SId : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Predicate"));
-- The entity for the function spec
FDecl : Node_Id;
Spec : Node_Id;
begin
Spec :=
Make_Function_Specification (Loc,
Defining_Unit_Name => SId,
Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc,
Defining_Identifier => Object_Entity,
Parameter_Type => New_Occurrence_Of (Typ, Loc))),
Result_Definition =>
New_Occurrence_Of (Standard_Boolean, Loc));
FDecl := Make_Subprogram_Declaration (Loc, Specification => Spec);
Set_Ekind (SId, E_Function);
Set_Etype (SId, Standard_Boolean);
Set_Is_Internal (SId);
Set_Is_Predicate_Function (SId);
Set_Predicate_Function (Typ, SId);
if Comes_From_Source (Typ) then
Insert_After (Parent (Typ), FDecl);
else
Insert_After (Parent (Base_Type (Typ)), FDecl);
end if;
Analyze (FDecl);
return FDecl;
end Build_Predicate_Function_Declaration;
-----------------------------------------
-- Check_Aspect_At_End_Of_Declarations --
-----------------------------------------
@ -12532,6 +12594,37 @@ package body Sem_Ch13 is
A_Id : Aspect_Id;
Expr : Node_Id;
function Resolve_Name (N : Node_Id) return Traverse_Result;
-- Verify that all identifiers in the expression, with the exception
-- of references to the current entity, denote visible entities. This
-- is done only to detect visibility errors, as the expression will be
-- properly analyzed/expanded during analysis of the predicate function
-- body.
------------------
-- Resolve_Name --
------------------
function Resolve_Name (N : Node_Id) return Traverse_Result is
begin
if Nkind (N) = N_Selected_Component then
if Nkind (Prefix (N)) = N_Identifier
and then Chars (Prefix (N)) /= Chars (E)
then
Find_Selected_Component (Parent (N));
end if;
return Skip;
elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then
Find_Direct_Name (N);
Set_Entity (N, Empty);
end if;
return OK;
end Resolve_Name;
procedure Resolve_Aspect_Expression is new Traverse_Proc (Resolve_Name);
begin
ASN := First_Rep_Item (E);
while Present (ASN) loop
@ -12546,11 +12639,25 @@ package body Sem_Ch13 is
when Aspect_Predicate |
Aspect_Predicate_Failure |
Aspect_Invariant |
Aspect_Static_Predicate |
Aspect_Dynamic_Predicate =>
Aspect_Invariant =>
null;
when Aspect_Static_Predicate |
Aspect_Dynamic_Predicate =>
-- build predicate function specification and preanalyze
-- expression after type replacement.
if No (Predicate_Function (E)) then
declare
FDecl : constant Node_Id :=
Build_Predicate_Function_Declaration (E);
pragma Unreferenced (FDecl);
begin
Resolve_Aspect_Expression (Expr);
end;
end if;
when Pre_Post_Aspects =>
null;

11
gcc/ada/sem_ch3.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
@ -11820,8 +11820,17 @@ package body Sem_Ch3 is
-- in particular when the full type is a scalar type for which an
-- anonymous base type is constructed.
-- The predicate functions are generated either at the freeze point
-- of the type or at the end of the visible part, and we must avoid
-- generating them twice.
if Has_Predicates (Priv) then
Set_Has_Predicates (Full);
if Present (Predicate_Function (Priv))
and then No (Predicate_Function (Full))
then
Set_Predicate_Function (Full, Predicate_Function (Priv));
end if;
end if;
if Has_Delayed_Aspects (Priv) then

17
gcc/ada/sem_res.adb
View file

@ -10847,6 +10847,23 @@ package body Sem_Res is
then
Set_Do_Range_Check (Operand);
end if;
-- Generating C code a type conversion of an access to constrained
-- array type to access to unconstrained array type involves building
-- a fat pointer which in general cannot be generated on the fly. We
-- remove side effects in order to store the result of the conversion
-- into a temporary.
if Generate_C_Code
and then Nkind (N) = N_Type_Conversion
and then Nkind (Parent (N)) /= N_Object_Declaration
and then Is_Access_Type (Etype (N))
and then Is_Array_Type (Designated_Type (Etype (N)))
and then not Is_Constrained (Designated_Type (Etype (N)))
and then Is_Constrained (Designated_Type (Etype (Expression (N))))
then
Remove_Side_Effects (N);
end if;
end Resolve_Type_Conversion;
----------------------