From: Arnaud Charlet Date: Thu, 23 Oct 2014 10:16:47 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3ad33e339551b0a57ffad95cd03b964f9494fc60;p=gcc.git [multiple changes] 2014-10-23 Robert Dewar * sem_type.adb: Minor code reorganization (use Nkind_In, Ekind_In). * sem_ch3.adb: Minor reformatting. 2014-10-23 Ed Schonberg * sem_ch12.adb (Analyze_Associations): If an actual for a formal object is a call to a parameterless expression function, add the function to the list of actuals to freeze. * freeze.adb (Check_Expression_Function): Create freeze nodes of outer types that may be references in the body of the expression. From-SVN: r216583 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 32777f6617e..216f814c98b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2014-10-23 Robert Dewar + + * sem_type.adb: Minor code reorganization (use Nkind_In, Ekind_In). + * sem_ch3.adb: Minor reformatting. + +2014-10-23 Ed Schonberg + + * sem_ch12.adb (Analyze_Associations): If an actual for a formal + object is a call to a parameterless expression function, add + the function to the list of actuals to freeze. + * freeze.adb (Check_Expression_Function): Create freeze nodes of + outer types that may be references in the body of the expression. + 2014-10-23 Hristian Kirtchev * exp_util.ads, checks.ads: Minor comment reformatting. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 5b4bfd9b5d7..156afda2e65 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -112,6 +112,11 @@ package body Freeze is -- to deferred constants without completion. We report this at the freeze -- point of the function, to provide a better error message. + -- In most cases the expression itself is frozen by the time the function + -- itself is frozen, because the formals will be frozen by then. However, + -- Attribute references to outer types are freeze points for those types; + -- this routine generates the required freeze nodes for them. + procedure Check_Strict_Alignment (E : Entity_Id); -- E is a base type. If E is tagged or has a component that is aliased -- or tagged or contains something this is aliased or tagged, set @@ -1272,6 +1277,14 @@ package body Freeze is then Error_Msg_NE ("premature use of& in call or instance", N, Entity (Nod)); + + elsif Nkind (Nod) = N_Attribute_Reference then + Analyze (Prefix (Nod)); + if Is_Entity_Name (Prefix (Nod)) + and then Is_Type (Entity (Prefix (Nod))) + then + Freeze_Before (N, Entity (Prefix (Nod))); + end if; end if; return OK; @@ -5983,7 +5996,7 @@ package body Freeze is -- and the expressions include allocators, the designed type is frozen -- as well. - function In_Exp_Body (N : Node_Id) return Boolean; + function In_Expanded_Body (N : Node_Id) return Boolean; -- Given an N_Handled_Sequence_Of_Statements node N, determines whether -- it is the handled statement sequence of an expander-generated -- subprogram (init proc, stream subprogram, or renaming as body). @@ -6023,11 +6036,11 @@ package body Freeze is return Empty; end Find_Aggregate_Component_Desig_Type; - ----------------- - -- In_Exp_Body -- - ----------------- + ---------------------- + -- In_Expanded_Body -- + ---------------------- - function In_Exp_Body (N : Node_Id) return Boolean is + function In_Expanded_Body (N : Node_Id) return Boolean is P : Node_Id; Id : Entity_Id; @@ -6044,7 +6057,8 @@ package body Freeze is else Id := Defining_Unit_Name (Specification (P)); - -- Following complex conditional could use comments ??? + -- The following are expander-created bodies, or bodies that + -- are not freeze points. if Nkind (Id) = N_Defining_Identifier and then (Is_Init_Proc (Id) @@ -6061,7 +6075,7 @@ package body Freeze is return False; end if; end if; - end In_Exp_Body; + end In_Expanded_Body; -- Start of processing for Freeze_Expression @@ -6314,7 +6328,7 @@ package body Freeze is -- outside this body, not inside it, and we skip past the -- subprogram body that we are inside. - if In_Exp_Body (Parent_P) then + if In_Expanded_Body (Parent_P) then declare Subp : constant Node_Id := Parent (Parent_P); Spec : Entity_Id; @@ -6358,7 +6372,7 @@ package body Freeze is -- of F (2) would place Hidden's freeze node (1) in the -- wrong place. Avoid explicit freezing and let the usual -- scenarios do the job - for example, reaching the end - -- of the private declarations. + -- of the private declarations, or a call to F. if Nkind (Original_Node (Subp)) = N_Expression_Function diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3b84679534a..71a73272b26 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1664,6 +1664,18 @@ package body Sem_Ch12 is Assoc); end if; + -- If the object is a call to an expression function, this + -- is a freezing point for it. + + if Is_Entity_Name (Match) + and then Present (Entity (Match)) + and then Nkind + (Original_Node (Unit_Declaration_Node (Entity (Match)))) + = N_Expression_Function + then + Append_Elmt (Entity (Match), Actuals_To_Freeze); + end if; + when N_Formal_Type_Declaration => Match := Matching_Actual ( diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index aab006c478e..bafeb62bbdb 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6942,6 +6942,7 @@ package body Sem_Ch3 is return; elsif Has_Discriminants (Parent_Type) then + -- Build partial view of derived type from partial view of parent. -- This must be done before building the full derivation because the -- second derivation will modify the discriminants of the first and diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 4f83aaed403..9b9034a74b0 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -765,9 +765,9 @@ package body Sem_Type is Is_Private_Type (Typ1) and then ((Present (Full_View (Typ1)) - and then Covers (Full_View (Typ1), Typ2)) + and then Covers (Full_View (Typ1), Typ2)) or else (Present (Underlying_Full_View (Typ1)) - and then Covers (Underlying_Full_View (Typ1), Typ2)) + and then Covers (Underlying_Full_View (Typ1), Typ2)) or else Base_Type (Typ1) = Typ2 or else Base_Type (Typ2) = Typ1); end Full_View_Covers; @@ -989,11 +989,11 @@ package body Sem_Type is -- attributes require some real type, etc. The built-in types Any_XXX -- represent these classes. - elsif (T1 = Any_Integer and then Is_Integer_Type (T2)) - or else (T1 = Any_Boolean and then Is_Boolean_Type (T2)) - or else (T1 = Any_Real and then Is_Real_Type (T2)) - or else (T1 = Any_Fixed and then Is_Fixed_Point_Type (T2)) - or else (T1 = Any_Discrete and then Is_Discrete_Type (T2)) + elsif (T1 = Any_Integer and then Is_Integer_Type (T2)) + or else (T1 = Any_Boolean and then Is_Boolean_Type (T2)) + or else (T1 = Any_Real and then Is_Real_Type (T2)) + or else (T1 = Any_Fixed and then Is_Fixed_Point_Type (T2)) + or else (T1 = Any_Discrete and then Is_Discrete_Type (T2)) then return True; @@ -1022,16 +1022,16 @@ package body Sem_Type is and then Ekind (BT1) = E_General_Access_Type and then Ekind (BT2) = E_Anonymous_Access_Type and then (Covers (Designated_Type (T1), Designated_Type (T2)) - or else Covers (Designated_Type (T2), Designated_Type (T1))) + or else + Covers (Designated_Type (T2), Designated_Type (T1))) then return True; -- An Access_To_Subprogram is compatible with itself, or with an -- anonymous type created for an attribute reference Access. - elsif (Ekind (BT1) = E_Access_Subprogram_Type - or else - Ekind (BT1) = E_Access_Protected_Subprogram_Type) + elsif Ekind_In (BT1, E_Access_Subprogram_Type, + E_Access_Protected_Subprogram_Type) and then Is_Access_Type (T2) and then (not Comes_From_Source (T1) or else not Comes_From_Source (T2)) @@ -1046,10 +1046,8 @@ package body Sem_Type is -- with itself, or with an anonymous type created for an attribute -- reference Access. - elsif (Ekind (BT1) = E_Anonymous_Access_Subprogram_Type - or else - Ekind (BT1) - = E_Anonymous_Access_Protected_Subprogram_Type) + elsif Ekind_In (BT1, E_Anonymous_Access_Subprogram_Type, + E_Anonymous_Access_Protected_Subprogram_Type) and then Is_Access_Type (T2) and then (not Comes_From_Source (T1) or else not Comes_From_Source (T2)) @@ -1258,7 +1256,7 @@ package body Sem_Type is and then Ekind (T2) = E_Anonymous_Access_Type and then Is_Generic_Type (Directly_Designated_Type (T1)) and then Get_Instance_Of (Directly_Designated_Type (T1)) = - Directly_Designated_Type (T2) + Directly_Designated_Type (T2) then return True; @@ -1387,9 +1385,8 @@ package body Sem_Type is function Is_Actual_Subprogram (S : Entity_Id) return Boolean is begin return In_Open_Scopes (Scope (S)) - and then - Nkind (Unit_Declaration_Node (S)) = - N_Subprogram_Renaming_Declaration + and then Nkind (Unit_Declaration_Node (S)) = + N_Subprogram_Renaming_Declaration -- Why the Comes_From_Source test here??? @@ -1542,8 +1539,8 @@ package body Sem_Type is if Nkind (Act1) in N_Op and then Is_Overloaded (Act1) - and then (Nkind (Right_Opnd (Act1)) = N_Integer_Literal - or else Nkind (Right_Opnd (Act1)) = N_Real_Literal) + and then Nkind_In (Right_Opnd (Act1), N_Integer_Literal, + N_Real_Literal) and then Has_Compatible_Type (Act1, Standard_Boolean) and then Etype (F1) = Standard_Boolean then @@ -1725,8 +1722,7 @@ package body Sem_Type is if Convention (Nam1) = Convention_CIL and then Convention (Nam2) = Convention_CIL and then Ekind (Nam1) = Ekind (Nam2) - and then (Ekind (Nam1) = E_Procedure - or else Ekind (Nam1) = E_Function) + and then Ekind_In (Nam1, E_Procedure, E_Function) then return It2; end if; @@ -1737,9 +1733,7 @@ package body Sem_Type is -- then we must check whether the user-defined entity hides the prede- -- fined one. - if Chars (Nam1) in Any_Operator_Name - and then Standard_Operator - then + if Chars (Nam1) in Any_Operator_Name and then Standard_Operator then if Typ = Universal_Integer or else Typ = Universal_Real or else Typ = Any_Integer @@ -2072,7 +2066,7 @@ package body Sem_Type is and then In_Same_Declaration_List (Designated_Type (Operand_Type), - Unit_Declaration_Node (User_Subp)) + Unit_Declaration_Node (User_Subp)) then if It2.Nam = Predef_Subp then return It1; @@ -2383,9 +2377,9 @@ package body Sem_Type is Get_First_Interp (N, I, It); while Present (It.Typ) loop if (Covers (Typ, It.Typ) - and then - (Scope (It.Nam) /= Standard_Standard - or else not Is_Invisible_Operator (N, Base_Type (Typ)))) + and then + (Scope (It.Nam) /= Standard_Standard + or else not Is_Invisible_Operator (N, Base_Type (Typ)))) -- Ada 2005 (AI-345)