From d1b83e6253d01de1e917f2f32a0142a765e9be5b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 16 Jun 2016 12:27:34 +0200 Subject: [PATCH] [multiple changes] 2016-06-16 Ed Schonberg * sem_prag.adb (Overridden_Ancestor): Clean up code to use controlling type of desired primitive rather than its scope, because the primitive that inherits the classwide condition may comes from several derivation steps. 2016-06-16 Javier Miranda * einfo.adb (Set_Default_Init_Cond_Procedure): Allow calls setting this attribute to Empty (only if the attribute has not been set). * sem_util.adb (Build_Default_Init_Cond_Procedure_Body): No action needed if the spec was not built. (Build_Default_Init_Cond_Procedure_Declaration): The spec is not built if DIC is set to NULL or no condition was specified. * exp_ch3.adb (Expand_N_Object_Declaration): Check availability of the Init_Cond procedure before generating code to call it. 2016-06-16 Emmanuel Briot * s-regpat.adb: Fix invalid index check when matching end-of-line on substrings. 2016-06-16 Arnaud Charlet * gnat1drv.adb: Minor reformatting. From-SVN: r237516 --- gcc/ada/ChangeLog | 27 +++++++++++++++++++++++++++ gcc/ada/einfo.adb | 7 +++++++ gcc/ada/exp_ch3.adb | 1 + gcc/ada/gnat1drv.adb | 2 +- gcc/ada/s-regpat.adb | 8 ++++---- gcc/ada/sem_prag.adb | 7 ++++++- gcc/ada/sem_util.adb | 23 +++++++++++++++++++---- 7 files changed, 65 insertions(+), 10 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5f24e357f25..10ccf7ef46a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2016-06-16 Ed Schonberg + + * sem_prag.adb (Overridden_Ancestor): Clean up code to use + controlling type of desired primitive rather than its scope, + because the primitive that inherits the classwide condition may + comes from several derivation steps. + +2016-06-16 Javier Miranda + + * einfo.adb (Set_Default_Init_Cond_Procedure): Allow calls setting + this attribute to Empty (only if the attribute has not been set). + * sem_util.adb (Build_Default_Init_Cond_Procedure_Body): + No action needed if the spec was not built. + (Build_Default_Init_Cond_Procedure_Declaration): The spec is + not built if DIC is set to NULL or no condition was specified. + * exp_ch3.adb (Expand_N_Object_Declaration): Check availability + of the Init_Cond procedure before generating code to call it. + +2016-06-16 Emmanuel Briot + + * s-regpat.adb: Fix invalid index check when matching end-of-line + on substrings. + +2016-06-16 Arnaud Charlet + + * gnat1drv.adb: Minor reformatting. + 2016-06-16 Ed Schonberg * sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index f812026ce75..39cfe35c302 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -8567,6 +8567,13 @@ package body Einfo is Subp_Id : Entity_Id; begin + -- Once set this attribute it cannot be reset + + if No (V) then + pragma Assert (No (Default_Init_Cond_Procedure (Id))); + return; + end if; + pragma Assert (Is_Type (Id) and then (Has_Default_Init_Cond (Id) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 06252736c7e..43d27ba613a 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6963,6 +6963,7 @@ package body Exp_Ch3 is or else Has_Inherited_Default_Init_Cond (Typ)) and then not Has_Init_Expression (N) + and then Present (Default_Init_Cond_Procedure (Typ)) then declare DIC_Call : constant Node_Id := diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 7da8e9a52a7..702545a1718 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -317,7 +317,7 @@ procedure Gnat1drv is Assertions_Enabled := True; -- Set normal RM validity checking and checking of copies (to catch - -- e.g. wrong values used in unchecked conversions). + -- e.g. wrong values used in unchecked conversions). -- All other validity checking is turned off, since this can generate -- very complex trees that only confuse CodePeer and do not bring -- enough useful info. diff --git a/gcc/ada/s-regpat.adb b/gcc/ada/s-regpat.adb index 4127ec99523..f672b9e92a1 100644 --- a/gcc/ada/s-regpat.adb +++ b/gcc/ada/s-regpat.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1986 by University of Toronto. -- --- Copyright (C) 1999-2015, AdaCore -- +-- Copyright (C) 1999-2016, AdaCore -- -- -- -- 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- -- @@ -2614,16 +2614,16 @@ package body System.Regpat is exit State_Machine when Input_Pos /= BOL_Pos; when EOL => - exit State_Machine when Input_Pos <= Data'Last + exit State_Machine when Input_Pos <= Last_In_Data and then ((Self.Flags and Multiple_Lines) = 0 or else Data (Input_Pos) /= ASCII.LF); when MEOL => - exit State_Machine when Input_Pos <= Data'Last + exit State_Machine when Input_Pos <= Last_In_Data and then Data (Input_Pos) /= ASCII.LF; when SEOL => - exit State_Machine when Input_Pos <= Data'Last; + exit State_Machine when Input_Pos <= Last_In_Data; when BOUND | NBOUND => diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 86086a7fa6f..fd835239858 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -26342,13 +26342,18 @@ package body Sem_Prag is ------------------------- function Overridden_Ancestor (S : Entity_Id) return Entity_Id is + Par : constant Entity_Id := Find_Dispatching_Type (Inher_Id); Anc : Entity_Id; begin Anc := S; + + -- Locate the ancestor subprogram with the proper controlling + -- type. + while Present (Overridden_Operation (Anc)) loop - exit when Scope (Anc) = Scope (Inher_Id); Anc := Overridden_Operation (Anc); + exit when Find_Dispatching_Type (Anc) = Par; end loop; return Anc; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 014d86ad2ce..43b08912504 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1214,9 +1214,9 @@ package body Sem_Util is Prag : constant Node_Id := Get_Pragma (Typ, Pragma_Default_Initial_Condition); Proc_Id : constant Entity_Id := Default_Init_Cond_Procedure (Typ); - Spec_Decl : constant Node_Id := Unit_Declaration_Node (Proc_Id); Body_Decl : Node_Id; Expr : Node_Id; + Spec_Decl : Node_Id; Stmt : Node_Id; Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; @@ -1230,11 +1230,14 @@ package body Sem_Util is pragma Assert (Has_Default_Init_Cond (Typ)); pragma Assert (Present (Prag)); - pragma Assert (Present (Proc_Id)); - -- Nothing to do if the body was already built + -- No action needed if the spec was not built or if the body was + -- already built. - if Present (Corresponding_Body (Spec_Decl)) then + if No (Proc_Id) + or else + Present (Corresponding_Body (Unit_Declaration_Node (Proc_Id))) + then return; end if; @@ -1293,6 +1296,7 @@ package body Sem_Util is -- ; -- end Default_Init_Cond; + Spec_Decl := Unit_Declaration_Node (Proc_Id); Body_Decl := Make_Subprogram_Body (Loc, Specification => @@ -1378,6 +1382,17 @@ package body Sem_Util is if Present (Default_Init_Cond_Procedure (Typ)) then return; + + -- The procedure must not be generated when DIC has one of these two + -- forms: 1. Default_Initial_Condition => null + -- 2. Default_Initial_Condition + + elsif No (Pragma_Argument_Associations (Prag)) + or else + Nkind (Get_Pragma_Arg (First (Pragma_Argument_Associations (Prag)))) + = N_Null + then + return; end if; -- The related type may be subject to pragma Ghost. Set the mode now to -- 2.30.2