Skip to content

R
riscv-gcc-1
Commit c84700e7 by Ed Schonberg Committed by Geert Bosch
Options

einfo.adb (Write_Field19_Name): Body_Entity is also defined for a generic package. 

	* einfo.adb (Write_Field19_Name): Body_Entity is also defined for
	a generic package.

	* einfo.ads: Body_Entity is also defined for generic package.
	Documentation change only

	* exp_aggr.adb (Build_Array_Aggr_Code): When expanding an
	others_choice for a discriminated component initialization,
	convert discriminant references into the corresponding discriminals.

	* exp_ch3.adb (Get_Simple_Init_Val): Add qualification to aggregate
	only if original type is private and expression has to be wrapped
	in a conversion.

	* checks.adb:
	(Apply_Constraint_Check): Do not perform length check
	if expression is an aggregate with only an others_choice.
	(Length_N_Cond): two references to the same in_parameter
	(typically the discriminal in an init_proc) denote the same value.
	Two useful optimization uncovered by bugfixes above.

From-SVN: r46165
parent d8d80dcd
Showing with 85 additions and 25 deletions
gcc/ada/ChangeLog
2001-10-10 Ed Schonberg <schonber@gnat.com>
* einfo.adb (Write_Field19_Name): Body_Entity is also defined for
a generic package.
* einfo.ads: Body_Entity is also defined for generic package.
Documentation change only
* exp_aggr.adb (Build_Array_Aggr_Code): When expanding an
others_choice for a discriminated component initialization,
convert discriminant references into the corresponding discriminals.
* exp_ch3.adb (Get_Simple_Init_Val): Add qualification to aggregate
only if original type is private and expression has to be wrapped
in a conversion.
* checks.adb:
(Apply_Constraint_Check): Do not perform length check
if expression is an aggregate with only an others_choice.
(Length_N_Cond): two references to the same in_parameter
(typically the discriminal in an init_proc) denote the same value.
Two useful optimization uncovered by bugfixes above.
2001-10-10 Robert Dewar <dewar@gnat.com> 2001-10-10 Robert Dewar <dewar@gnat.com>
* xeinfo.adb: Change int to char in translation of enumeration types. * xeinfo.adb: Change int to char in translation of enumeration types.
......
gcc/ada/checks.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.205 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- -- -- --
...@@ -692,6 +692,18 @@ package body Checks is ...@@ -692,6 +692,18 @@ package body Checks is
elsif Is_Array_Type (Typ) then elsif Is_Array_Type (Typ) then
-- A useful optimization: an aggregate with only an Others clause
-- always has the right bounds.
if Nkind (N) = N_Aggregate
and then No (Expressions (N))
and then Nkind
(First (Choices (First (Component_Associations (N)))))
= N_Others_Choice
then
return;
end if;
if Is_Constrained (Typ) then if Is_Constrained (Typ) then
Apply_Length_Check (N, Typ); Apply_Length_Check (N, Typ);
...@@ -2805,8 +2817,9 @@ package body Checks is ...@@ -2805,8 +2817,9 @@ package body Checks is
function Same_Bounds (L : Node_Id; R : Node_Id) return Boolean; function Same_Bounds (L : Node_Id; R : Node_Id) return Boolean;
-- True for equal literals and for nodes that denote the same constant -- True for equal literals and for nodes that denote the same constant
-- entity, even if its value is not a static constant. This removes -- entity, even if its value is not a static constant. This includes the
-- some obviously superfluous checks. -- case of a discriminal reference within an init_proc. Removes some
-- obviously superfluous checks.
function Length_E_Cond function Length_E_Cond
(Exptyp : Entity_Id; (Exptyp : Entity_Id;
...@@ -3038,7 +3051,14 @@ package body Checks is ...@@ -3038,7 +3051,14 @@ package body Checks is
and then Ekind (Entity (R)) = E_Constant and then Ekind (Entity (R)) = E_Constant
and then Nkind (L) = N_Type_Conversion and then Nkind (L) = N_Type_Conversion
and then Is_Entity_Name (Expression (L)) and then Is_Entity_Name (Expression (L))
and then Entity (R) = Entity (Expression (L))); and then Entity (R) = Entity (Expression (L)))
or else
(Is_Entity_Name (L)
and then Is_Entity_Name (R)
and then Entity (L) = Entity (R)
and then Ekind (Entity (L)) = E_In_Parameter
and then Inside_Init_Proc);
end Same_Bounds; end Same_Bounds;
-- Start of processing for Selected_Length_Checks -- Start of processing for Selected_Length_Checks
......
gcc/ada/einfo.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.630 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- -- -- --
...@@ -6569,7 +6569,8 @@ package body Einfo is ...@@ -6569,7 +6569,8 @@ package body Einfo is
when E_Discriminant => when E_Discriminant =>
Write_Str ("Corresponding_Discriminant"); Write_Str ("Corresponding_Discriminant");
when E_Package => when E_Package |
E_Generic_Package =>
Write_Str ("Body_Entity"); Write_Str ("Body_Entity");
when E_Package_Body | when E_Package_Body |
......
gcc/ada/einfo.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- $Revision: 1.640 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- -- -- --
...@@ -397,8 +397,8 @@ package Einfo is ...@@ -397,8 +397,8 @@ package Einfo is
-- Present in block entities. Points to the Block_Statement itself. -- Present in block entities. Points to the Block_Statement itself.
-- Body_Entity (Node19) -- Body_Entity (Node19)
-- Present in package entities, points to the corresponding package -- Present in package and generic package entities, points to the
-- body entity if one is present. -- corresponding package body entity if one is present.
-- C_Pass_By_Copy (Flag125) [implementation base type only] -- C_Pass_By_Copy (Flag125) [implementation base type only]
-- Present in record types. Set if a pragma Convention for the record -- Present in record types. Set if a pragma Convention for the record
......
gcc/ada/exp_aggr.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.170 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- -- -- --
...@@ -1136,6 +1136,24 @@ package body Exp_Aggr is ...@@ -1136,6 +1136,24 @@ package body Exp_Aggr is
High := Add (-1, To => Table (J + 1).Choice_Lo); High := Add (-1, To => Table (J + 1).Choice_Lo);
end if; end if;
-- If this is an expansion within an init_proc, make
-- sure that discriminant references are replaced by
-- the corresponding discriminal.
if Inside_Init_Proc then
if Is_Entity_Name (Low)
and then Ekind (Entity (Low)) = E_Discriminant
then
Set_Entity (Low, Discriminal (Entity (Low)));
end if;
if Is_Entity_Name (High)
and then Ekind (Entity (High)) = E_Discriminant
then
Set_Entity (High, Discriminal (Entity (High)));
end if;
end if;
if First if First
or else not Empty_Range (Low, High) or else not Empty_Range (Low, High)
then then
......
gcc/ada/exp_ch3.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.481 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- -- -- --
...@@ -4210,20 +4210,14 @@ package body Exp_Ch3 is ...@@ -4210,20 +4210,14 @@ package body Exp_Ch3 is
then then
pragma Assert (Init_Or_Norm_Scalars); pragma Assert (Init_Or_Norm_Scalars);
-- Build aggregate with an explicit qualification, because it
-- may otherwise be ambiguous in context.
return return
Make_Qualified_Expression (Loc, Make_Aggregate (Loc,
Subtype_Mark => New_Occurrence_Of (T, Loc), Component_Associations => New_List (
Expression => Make_Component_Association (Loc,
Make_Aggregate (Loc, Choices => New_List (
Component_Associations => New_List ( Make_Others_Choice (Loc)),
Make_Component_Association (Loc, Expression =>
Choices => New_List ( Get_Simple_Init_Val (Component_Type (T), Loc))));
Make_Others_Choice (Loc)),
Expression =>
Get_Simple_Init_Val (Component_Type (T), Loc)))));
-- Access type is initialized to null -- Access type is initialized to null
...@@ -4267,8 +4261,12 @@ package body Exp_Ch3 is ...@@ -4267,8 +4261,12 @@ package body Exp_Ch3 is
-- A special case, if the underlying value is null, then qualify -- A special case, if the underlying value is null, then qualify
-- it with the underlying type, so that the null is properly typed -- it with the underlying type, so that the null is properly typed
-- Similarly, if it is an aggregate it must be qualified, because
-- an unchecked conversion does not provide a context for it.
if Nkind (Val) = N_Null then if Nkind (Val) = N_Null
or else Nkind (Val) = N_Aggregate
then
Val := Val :=
Make_Qualified_Expression (Loc, Make_Qualified_Expression (Loc,
Subtype_Mark => Subtype_Mark =>
......
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