From b04d926e216ec1c7bd66080fd891dafc1baed9c5 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 23 Oct 2014 12:19:58 +0200 Subject: [PATCH] [multiple changes] 2014-10-23 Yannick Moy * sem_prag.adb (Analyze_Pragma/Pragma_Inline & Pragma_Inline_Always): Disable analysis in GNATprove mode. 2014-10-23 Arnaud Charlet * mlib-prj.adb: Remove obsolete references to libdecgnat (VMS only). 2014-10-23 Arnaud Charlet * gnat1drv.adb (Adjust_Global_Switches): Ignore style check pragmas in codepeer mode. 2014-10-23 Gary Dismukes * gnat_rm.texi: Minor syntax fix for pragma Annotate (missing ','). 2014-10-23 Hristian Kirtchev * sem_ch12.adb (Inline_Instance_Body): Alphabetize local variables and constants. Add constants Save_SM and Save_SMP to capture SPARK_Mode-related attributes. Compile the inlined body with the SPARK_Mode of the enclosing context. 2014-10-23 Hristian Kirtchev * sinfo.adb (Elaboration_Boolean): Removed. (Set_Elaboration_Boolean): Removed. * sinfo.ads Remove attribute Elaboration_Boolean along with its occurrence in nodes. (Elaboration_Boolean): Removed along with pragma Inline. (Set_Elaboration_Boolean): Removed along with pragma Inline. 2014-10-23 Ed Schonberg * sem_ch3.adb (Constant_Redeclaration): Make error message more explicit on a deferred constant whose object_definition is an anonymous array. 2014-10-23 Vincent Celier * gnatls.adb: Never call Targparm.Get_Target_Parameters. 2014-10-23 Ed Schonberg * sem_ch6.adb (Analyze_Expression_Function): In a generic context do not create a body, and only pre-analyze the expression, which may include incomplete views. From-SVN: r216584 --- gcc/ada/ChangeLog | 50 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/gnat1drv.adb | 6 ++++-- gcc/ada/gnat_rm.texi | 2 +- gcc/ada/gnatls.adb | 8 ------- gcc/ada/mlib-prj.adb | 11 +++------- gcc/ada/sem_ch12.adb | 34 ++++++++++++++++++++---------- gcc/ada/sem_ch3.adb | 14 +++++++++++++ gcc/ada/sem_ch6.adb | 31 +++++++++++++++++++++++++-- gcc/ada/sem_prag.adb | 35 +++++++++++++++++++------------ gcc/ada/sinfo.adb | 18 ---------------- gcc/ada/sinfo.ads | 21 ++----------------- 11 files changed, 148 insertions(+), 82 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 216f814c98b..43024e259aa 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,53 @@ +2014-10-23 Yannick Moy + + * sem_prag.adb (Analyze_Pragma/Pragma_Inline & Pragma_Inline_Always): + Disable analysis in GNATprove mode. + +2014-10-23 Arnaud Charlet + + * mlib-prj.adb: Remove obsolete references to libdecgnat (VMS only). + +2014-10-23 Arnaud Charlet + + * gnat1drv.adb (Adjust_Global_Switches): Ignore style check + pragmas in codepeer mode. + +2014-10-23 Gary Dismukes + + * gnat_rm.texi: Minor syntax fix for pragma Annotate (missing ','). + +2014-10-23 Hristian Kirtchev + + * sem_ch12.adb (Inline_Instance_Body): Alphabetize + local variables and constants. Add constants Save_SM and Save_SMP + to capture SPARK_Mode-related attributes. Compile the inlined + body with the SPARK_Mode of the enclosing context. + +2014-10-23 Hristian Kirtchev + + * sinfo.adb (Elaboration_Boolean): Removed. + (Set_Elaboration_Boolean): Removed. + * sinfo.ads Remove attribute Elaboration_Boolean along with its + occurrence in nodes. + (Elaboration_Boolean): Removed along with pragma Inline. + (Set_Elaboration_Boolean): Removed along with pragma Inline. + +2014-10-23 Ed Schonberg + + * sem_ch3.adb (Constant_Redeclaration): Make error message more + explicit on a deferred constant whose object_definition is an + anonymous array. + +2014-10-23 Vincent Celier + + * gnatls.adb: Never call Targparm.Get_Target_Parameters. + +2014-10-23 Ed Schonberg + + * sem_ch6.adb (Analyze_Expression_Function): In a generic + context do not create a body, and only pre-analyze the expression, + which may include incomplete views. + 2014-10-23 Robert Dewar * sem_type.adb: Minor code reorganization (use Nkind_In, Ekind_In). diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 4cbb8cb21ef..7b8b5db2a70 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -288,10 +288,12 @@ procedure Gnat1drv is Validity_Check_In_Out_Params := True; Validity_Check_In_Params := True; - -- Turn off style check options since we are not interested in any - -- front-end warnings when we are getting CodePeer output. + -- Turn off style check options and ignore any style check pragmas + -- since we are not interested in any front-end warnings when we are + -- getting CodePeer output. Reset_Style_Check_Options; + Ignore_Style_Checks_Pragmas := True; -- Always perform semantics and generate ali files in CodePeer mode, -- so that a gnatmake -c -k will proceed further when possible. diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 11a8d411104..fa2d9421aaf 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -1378,7 +1378,7 @@ in the two situations. @noindent Syntax: @smallexample @c ada -pragma Annotate (IDENTIFIER [,IDENTIFIER @{, ARG@}] [entity => local_NAME]); +pragma Annotate (IDENTIFIER [, IDENTIFIER @{, ARG@}] [, entity => local_NAME]); ARG ::= NAME | EXPRESSION @end smallexample diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 05ff3aee886..79d9595ca50 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -42,7 +42,6 @@ with Sdefault; with Snames; with Stringt; with Switch; use Switch; -with Targparm; use Targparm; with Types; use Types; with Ada.Command_Line; use Ada.Command_Line; @@ -1632,13 +1631,6 @@ begin Osint.Add_Default_Search_Dirs; - -- Get the target parameters, but only if switch -nostdinc was not - -- specified. May not be needed any more, but is harmless. - - if not Opt.No_Stdinc then - Get_Target_Parameters; - end if; - if Verbose_Mode then Write_Eol; Display_Version ("GNATLS", "1997"); diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 943361fbc45..236a636a85e 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -1515,8 +1515,7 @@ package body MLib.Prj is ALIs.Append (new String'(ALI_Path)); -- Find out if for this ALI file, - -- libgnarl or libdecgnat is - -- necessary. + -- libgnarl is necessary. Check_Libs (ALI_Path, True); end if; @@ -2392,8 +2391,8 @@ package body MLib.Prj is -- Ignore -static and -shared, since -shared will be used -- in any case. - -- Ignore -lgnat, -lgnarl and -ldecgnat as they will be added - -- later, because they are also needed for non Stand-Alone shared + -- Ignore -lgnat and -lgnarl as they will be added later, + -- because they are also needed for non Stand-Alone shared -- libraries. -- Also ignore the shared libraries which are : @@ -2403,12 +2402,8 @@ package body MLib.Prj is if Next_Line (1 .. Nlast) /= "-static" and then Next_Line (1 .. Nlast) /= "-shared" and then - Next_Line (1 .. Nlast) /= "-ldecgnat" and then Next_Line (1 .. Nlast) /= "-lgnarl" and then Next_Line (1 .. Nlast) /= "-lgnat" and then - Next_Line - (1 .. Natural'Min (Nlast, 10 + Library_Version'Length)) /= - Shared_Lib ("decgnat") and then Next_Line (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /= Shared_Lib ("gnarl") and then diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 71a73272b26..88126e428cf 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4425,14 +4425,16 @@ package body Sem_Ch12 is Gen_Unit : Entity_Id; Act_Decl : Node_Id) is - Vis : Boolean; - Gen_Comp : constant Entity_Id := - Cunit_Entity (Get_Source_Unit (Gen_Unit)); - Curr_Comp : constant Node_Id := Cunit (Current_Sem_Unit); - Curr_Scope : Entity_Id := Empty; - Curr_Unit : constant Entity_Id := Cunit_Entity (Current_Sem_Unit); - Removed : Boolean := False; - Num_Scopes : Int := 0; + Curr_Comp : constant Node_Id := Cunit (Current_Sem_Unit); + Curr_Unit : constant Entity_Id := Cunit_Entity (Current_Sem_Unit); + Gen_Comp : constant Entity_Id := + Cunit_Entity (Get_Source_Unit (Gen_Unit)); + + Save_SM : constant SPARK_Mode_Type := SPARK_Mode; + Save_SMP : constant Node_Id := SPARK_Mode_Pragma; + -- Save all SPARK_Mode-related attributes as removing enclosing scopes + -- to provide a clean environment for analysis of the inlined body will + -- eliminate any previously set SPARK_Mode. Scope_Stack_Depth : constant Int := Scope_Stack.Last - Scope_Stack.First + 1; @@ -4440,10 +4442,14 @@ package body Sem_Ch12 is Use_Clauses : array (1 .. Scope_Stack_Depth) of Node_Id; Instances : array (1 .. Scope_Stack_Depth) of Entity_Id; Inner_Scopes : array (1 .. Scope_Stack_Depth) of Entity_Id; + Curr_Scope : Entity_Id := Empty; List : Elist_Id; Num_Inner : Int := 0; + Num_Scopes : Int := 0; N_Instances : Int := 0; + Removed : Boolean := False; S : Entity_Id; + Vis : Boolean; begin -- Case of generic unit defined in another unit. We must remove the @@ -4574,6 +4580,10 @@ package body Sem_Ch12 is pragma Assert (Num_Inner < Num_Scopes); + -- The inlined package body must be analyzed with the SPARK_Mode of + -- the enclosing context, otherwise the body may cause bogus errors + -- if a configuration SPARK_Mode pragma in in effect. + Push_Scope (Standard_Standard); Scope_Stack.Table (Scope_Stack.Last).Is_Active_Stack_Base := True; Instantiate_Package_Body @@ -4587,8 +4597,8 @@ package body Sem_Ch12 is Version => Ada_Version, Version_Pragma => Ada_Version_Pragma, Warnings => Save_Warnings, - SPARK_Mode => SPARK_Mode, - SPARK_Mode_Pragma => SPARK_Mode_Pragma)), + SPARK_Mode => Save_SM, + SPARK_Mode_Pragma => Save_SMP)), Inlined_Body => True); Pop_Scope; @@ -4692,7 +4702,9 @@ package body Sem_Ch12 is end loop; end; - -- If generic unit is in current unit, current context is correct + -- If generic unit is in current unit, current context is correct. Note + -- that the context is guaranteed to carry the correct SPARK_Mode as no + -- enclosing scopes were removed. else Instantiate_Package_Body diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index bafeb62bbdb..e29b65ace0d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -11751,6 +11751,20 @@ package body Sem_Ch3 is Set_Full_View (Prev, Id); Set_Etype (Id, Any_Type); + -- A deferred constant whose type is an anonymous array is always + -- illegal (unless imported). A detailed error message might be + -- helpful for Ada beginners. + + if Nkind (Object_Definition (Parent (Prev))) + = N_Constrained_Array_Definition + and then Nkind (Object_Definition (N)) + = N_Constrained_Array_Definition + then + Error_Msg_N ("\each anonymous array is a distinct type", N); + Error_Msg_N ("a deferred constant must have a named type", + Object_Definition (Parent (Prev))); + end if; + elsif Null_Exclusion_Present (Parent (Prev)) and then not Null_Exclusion_Present (N) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 41c7fd8dae7..88e27734483 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -312,8 +312,11 @@ package body Sem_Ch6 is -- If there are previous overloadable entities with the same name, -- check whether any of them is completed by the expression function. + -- In a generic context a formal subprogram has no completion. - if Present (Prev) and then Is_Overloadable (Prev) then + if Present (Prev) and then Is_Overloadable (Prev) + and then not Is_Formal_Subprogram (Prev) + then Def_Id := Analyze_Subprogram_Specification (Spec); Prev := Find_Corresponding_Spec (N); end if; @@ -358,7 +361,9 @@ package body Sem_Ch6 is -- scope. The entity itself may be internally created if within a body -- to be inlined. - elsif Present (Prev) and then Comes_From_Source (Parent (Prev)) then + elsif Present (Prev) and then Comes_From_Source (Parent (Prev)) + and then not Is_Formal_Subprogram (Prev) + then Set_Has_Completion (Prev, False); -- An expression function that is a completion freezes the @@ -448,6 +453,28 @@ package body Sem_Ch6 is end if; Analyze (N); + + -- Within a generic we only need to analyze the expression. The body + -- only needs to be constructed when generating code. + + if Inside_A_Generic then + declare + Id : constant Entity_Id := Defining_Entity (N); + Save_In_Spec_Expression : constant Boolean + := In_Spec_Expression; + + begin + Set_Has_Completion (Id); + In_Spec_Expression := True; + Push_Scope (Id); + Install_Formals (Id); + Preanalyze_And_Resolve (Expr, Etype (Id)); + End_Scope; + In_Spec_Expression := Save_In_Spec_Expression; + return; + end; + end if; + Set_Is_Inlined (Defining_Entity (N)); -- Establish the linkages between the spec and the body. These are diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 5ef1010e3ca..df8ec80b142 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14894,12 +14894,21 @@ package body Sem_Prag is when Pragma_Inline => - -- Inline status is Enabled if inlining option is active + -- Pragma always active unless in GNATprove mode. It is disabled + -- in GNATprove mode because frontend inlining is applied + -- independently of pragmas Inline and Inline_Always for + -- formal verification, see Can_Be_Inlined_In_GNATprove_Mode + -- in inline.ads. - if Inline_Active then - Process_Inline (Enabled); - else - Process_Inline (Disabled); + if not GNATprove_Mode then + + -- Inline status is Enabled if inlining option is active + + if Inline_Active then + Process_Inline (Enabled); + else + Process_Inline (Disabled); + end if; end if; ------------------- @@ -14911,15 +14920,15 @@ package body Sem_Prag is when Pragma_Inline_Always => GNAT_Pragma; - -- Pragma always active unless in CodePeer mode. It is disabled - -- in CodePeer mode because inlining is not helpful, and enabling - -- if caused walk order issues. - - -- Historical note: this pragma used to be disabled in GNATprove - -- mode as well, but that was odd since walk order should not be - -- an issue in that case. + -- Pragma always active unless in CodePeer mode or GNATprove + -- mode. It is disabled in CodePeer mode because inlining is + -- not helpful, and enabling it caused walk order issues. It + -- is disabled in GNATprove mode because frontend inlining is + -- applied independently of pragmas Inline and Inline_Always for + -- formal verification, see Can_Be_Inlined_In_GNATprove_Mode in + -- inline.ads. - if not CodePeer_Mode then + if not CodePeer_Mode and not GNATprove_Mode then Process_Inline (Enabled); end if; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index ccbf87c58a9..83023a48ebc 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -1041,15 +1041,6 @@ package body Sinfo is return Flag4 (N); end Elaborate_Present; - function Elaboration_Boolean - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Procedure_Specification); - return Node2 (N); - end Elaboration_Boolean; - function Else_Actions (N : Node_Id) return List_Id is begin @@ -4248,15 +4239,6 @@ package body Sinfo is Set_Flag4 (N, Val); end Set_Elaborate_Present; - procedure Set_Elaboration_Boolean - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Procedure_Specification); - Set_Node2 (N, Val); - end Set_Elaboration_Boolean; - procedure Set_Else_Actions (N : Node_Id; Val : List_Id) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index bfa33e0b9e4..613760e15f3 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1123,13 +1123,6 @@ package Sinfo is -- elaboration processing has determined that an Elaborate pragma is -- desirable for correct elaboration for this unit. - -- Elaboration_Boolean (Node2-Sem) - -- This field is present in function and procedure specification nodes. - -- If set, it points to the entity for a Boolean flag that must be tested - -- for certain calls to check for access before elaboration. See body of - -- Sem_Elab for further details. This field is Empty if no elaboration - -- boolean is required. - -- Else_Actions (List3-Sem) -- This field is present in if expression nodes. During code -- expansion we use the Insert_Actions procedure (in Exp_Util) to insert @@ -4895,7 +4888,6 @@ package Sinfo is -- N_Function_Specification -- Sloc points to FUNCTION -- Defining_Unit_Name (Node1) (the designator) - -- Elaboration_Boolean (Node2-Sem) -- Parameter_Specifications (List3) (set to No_List if no formal part) -- Null_Exclusion_Present (Flag11) -- Result_Definition (Node4) for result subtype @@ -4906,7 +4898,6 @@ package Sinfo is -- N_Procedure_Specification -- Sloc points to PROCEDURE -- Defining_Unit_Name (Node1) - -- Elaboration_Boolean (Node2-Sem) -- Parameter_Specifications (List3) (set to No_List if no formal part) -- Generic_Parent (Node5-Sem) -- Null_Present (Flag13) set for null procedure case (Ada 2005 feature) @@ -8963,9 +8954,6 @@ package Sinfo is function Elaborate_Present (N : Node_Id) return Boolean; -- Flag4 - function Elaboration_Boolean - (N : Node_Id) return Node_Id; -- Node2 - function Else_Actions (N : Node_Id) return List_Id; -- List3 @@ -9985,9 +9973,6 @@ package Sinfo is procedure Set_Elaborate_Present (N : Node_Id; Val : Boolean := True); -- Flag4 - procedure Set_Elaboration_Boolean - (N : Node_Id; Val : Node_Id); -- Node2 - procedure Set_Else_Actions (N : Node_Id; Val : List_Id); -- List3 @@ -11510,14 +11495,14 @@ package Sinfo is N_Function_Specification => (1 => True, -- Defining_Unit_Name (Node1) - 2 => False, -- Elaboration_Boolean (Node2-Sem) + 2 => False, -- unused 3 => True, -- Parameter_Specifications (List3) 4 => True, -- Result_Definition (Node4) 5 => False), -- Generic_Parent (Node5-Sem) N_Procedure_Specification => (1 => True, -- Defining_Unit_Name (Node1) - 2 => False, -- Elaboration_Boolean (Node2-Sem) + 2 => False, -- unused 3 => True, -- Parameter_Specifications (List3) 4 => False, -- unused 5 => False), -- Generic_Parent (Node5-Sem) @@ -12551,7 +12536,6 @@ package Sinfo is pragma Inline (Elaborate_All_Desirable); pragma Inline (Elaborate_All_Present); pragma Inline (Elaborate_Desirable); - pragma Inline (Elaboration_Boolean); pragma Inline (Else_Actions); pragma Inline (Else_Statements); pragma Inline (Elsif_Parts); @@ -12889,7 +12873,6 @@ package Sinfo is pragma Inline (Set_Elaborate_All_Present); pragma Inline (Set_Elaborate_Desirable); pragma Inline (Set_Elaborate_Present); - pragma Inline (Set_Elaboration_Boolean); pragma Inline (Set_Else_Actions); pragma Inline (Set_Else_Statements); pragma Inline (Set_Elsif_Parts); -- 2.30.2