From fd366a46fa987290ccae80e3fde5b5dc4a04bbed Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 6 May 2009 11:03:57 +0200 Subject: [PATCH] [multiple changes] 2009-05-06 Ed Schonberg * sem_ch8.adb (Analyze_Object_Renaming): If the object is a function call returning an unconstrained composite value, create the proper subtype for it, as is done for object dclarations with unconstrained nominal subtypes 2009-05-06 Robert Dewar * sem_ch13.adb (Check_Constant_Address_Clause): Minor error message improvements * freeze.adb: Minor reformatting From-SVN: r147156 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/freeze.adb | 5 ++--- gcc/ada/sem_ch13.adb | 25 +++++++++++-------------- gcc/ada/sem_ch8.adb | 27 +++++++++++++++++++++++++++ 4 files changed, 54 insertions(+), 17 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fa0b625..6970c2c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2009-05-06 Ed Schonberg + + * sem_ch8.adb (Analyze_Object_Renaming): If the object is a function + call returning an unconstrained composite value, create the proper + subtype for it, as is done for object dclarations with unconstrained + nominal subtypes + +2009-05-06 Robert Dewar + + * sem_ch13.adb (Check_Constant_Address_Clause): Minor error message + improvements + + * freeze.adb: Minor reformatting + 2009-05-06 Thomas Quinot * sem_ch3.adb (Access_Type_Declaration): An access type whose diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index fdacb09..7d6491b 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2849,7 +2849,7 @@ package body Freeze is and then Rsiz mod System_Storage_Unit /= 0 then -- For implicit packing mode, just set the - -- component size silently + -- component size silently. if Implicit_Packing then Set_Component_Size (Btyp, Rsiz); @@ -3245,7 +3245,7 @@ package body Freeze is -- later when the full type is frozen). elsif Ekind (E) = E_Record_Type - or else Ekind (E) = E_Record_Subtype + or else Ekind (E) = E_Record_Subtype then Freeze_Record_Type (E); @@ -3263,7 +3263,6 @@ package body Freeze is end if; Comp := First_Entity (E); - while Present (Comp) loop if Is_Type (Comp) then Freeze_And_Append (Comp, Loc, Result); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index aa69a58..89cfbb6 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2986,11 +2986,10 @@ package body Sem_Ch13 is Error_Msg_NE ("invalid address clause for initialized object &!", Nod, U_Ent); - Error_Msg_Name_1 := Chars (Entity (Nod)); - Error_Msg_Name_2 := Chars (U_Ent); - Error_Msg_N - ("\% must be defined before % (RM 13.1(22))!", - Nod); + Error_Msg_Node_2 := U_Ent; + Error_Msg_NE + ("\& must be defined before & (RM 13.1(22))!", + Nod, Entity (Nod)); end if; elsif Nkind (Nod) = N_Selected_Component then @@ -3120,11 +3119,10 @@ package body Sem_Ch13 is Error_Msg_NE ("invalid address clause for initialized object &!", Nod, U_Ent); - Error_Msg_Name_1 := Chars (Ent); - Error_Msg_Name_2 := Chars (U_Ent); - Error_Msg_N - ("\% must be defined before % (RM 13.1(22))!", - Nod); + Error_Msg_Node_2 := U_Ent; + Error_Msg_NE + ("\& must be defined before & (RM 13.1(22))!", + Nod, Ent); end if; elsif Nkind (Original_Node (Nod)) = N_Function_Call then @@ -3136,10 +3134,9 @@ package body Sem_Ch13 is Nod, U_Ent); if Comes_From_Source (Ent) then - Error_Msg_Name_1 := Chars (Ent); - Error_Msg_N - ("\reference to variable% not allowed" - & " (RM 13.1(22))!", Nod); + Error_Msg_NE + ("\reference to variable& not allowed" + & " (RM 13.1(22))!", Nod, Ent); else Error_Msg_N ("non-static expression not allowed" diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 7b41282..9b9f841 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -897,6 +897,33 @@ package body Sem_Ch8 is ("\?suggest using an initialized constant object instead", Nam); end if; + + -- If the function call returns an unconstrained type, we + -- must build a constrained subtype for the new entity, in + -- a way similar to what is done for an object declaration + -- with an unconstrained nominal type. + + if Is_Composite_Type (Etype (Nam)) + and then not Is_Constrained (Etype (Nam)) + and then not Has_Unknown_Discriminants (Etype (Nam)) + and then Expander_Active + then + declare + Loc : constant Source_Ptr := Sloc (N); + Subt : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('T')); + begin + Remove_Side_Effects (Nam); + Insert_Action (N, + Make_Subtype_Declaration (Loc, + Defining_Identifier => Subt, + Subtype_Indication => + Make_Subtype_From_Expr (Nam, Etype (Nam)))); + Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc)); + Set_Etype (Nam, Subt); + end; + end if; end case; end if; -- 2.7.4