From 5904016a5c1d7df58877678583a3f65ebecc052d Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 18 Nov 2015 11:03:44 +0100 Subject: [PATCH] [multiple changes] 2015-11-18 Hristian Kirtchev * sem_util.adb (Has_Full_Default_Initialization): Perform the test for the presence of pragma Default_Initial_Condition prior to the specialized type checks. Add a missing case where the lack of a pragma argument yields full default initialization. 2015-11-18 Hristian Kirtchev * sem_res.adb (Resolve_Entity_Name): Do not check for elaboration issues when a variable appears as the name of an object renaming declaration as this constitutes an aliasing, not a read. 2015-11-18 Ed Schonberg * checks.adb (Overlap_Check): An actual that is an aggregate cannot overlap with another actual, and no check should be generated for it. * targparm.ads: Fix typos. 2015-11-18 Pascal Obry * adaint.c: Routine __gnat_killprocesstree only implemented on Linux and Windows. 2015-11-18 Pascal Obry * g-ctrl_c.adb: Minor style fixes. From-SVN: r230523 --- gcc/ada/ChangeLog | 31 +++++++++++++++++++++++++++++ gcc/ada/adaint.c | 8 +++++++- gcc/ada/checks.adb | 14 ++++++++++++-- gcc/ada/g-ctrl_c.adb | 10 +++++++++- gcc/ada/sem_res.adb | 8 ++++++-- gcc/ada/sem_util.adb | 46 ++++++++++++++++++++++++++++++-------------- gcc/ada/targparm.ads | 4 ++-- 7 files changed, 99 insertions(+), 22 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f330589e46a..0d3923a31f9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2015-11-18 Hristian Kirtchev + + * sem_util.adb (Has_Full_Default_Initialization): + Perform the test for the presence of pragma + Default_Initial_Condition prior to the specialized type + checks. Add a missing case where the lack of a pragma argument + yields full default initialization. + +2015-11-18 Hristian Kirtchev + + * sem_res.adb (Resolve_Entity_Name): Do not check + for elaboration issues when a variable appears as the name of + an object renaming declaration as this constitutes an aliasing, + not a read. + +2015-11-18 Ed Schonberg + + * checks.adb (Overlap_Check): An actual that is an aggregate + cannot overlap with another actual, and no check should be + generated for it. + * targparm.ads: Fix typos. + +2015-11-18 Pascal Obry + + * adaint.c: Routine __gnat_killprocesstree only implemented on + Linux and Windows. + +2015-11-18 Pascal Obry + + * g-ctrl_c.adb: Minor style fixes. + 2015-11-18 Pascal Obry * adaint.c, s-os_lib.adb, s-os_lib.ads (Kill_Process_Tree): New. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 4f162e9e267..5a0bdd951df 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -3259,7 +3259,11 @@ void __gnat_killprocesstree (int pid, int sig_num) /* kill process */ __gnat_kill (pid, sig_num, 1); -#else + +#elif defined (__vxworks) + /* not implemented */ + +#elif defined (__linux__) DIR *dir; struct dirent *d; @@ -3307,6 +3311,8 @@ void __gnat_killprocesstree (int pid, int sig_num) /* kill process */ + __gnat_kill (pid, sig_num, 1); +#else __gnat_kill (pid, sig_num, 1); #endif /* Note on Solaris it is possible to read /proc//status. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index b5086cc38d3..64dcf57ae8a 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2359,9 +2359,19 @@ package body Checks is -- Ensure that the actual is an object that is not passed by value. -- Elementary types are always passed by value, therefore actuals of - -- such types cannot lead to aliasing. + -- such types cannot lead to aliasing. An aggregate is an object in + -- Ada 2012, but an actual that is an aggregate cannot overlap with + -- another actual. - if Is_Object_Reference (Original_Actual (Actual_1)) + if Nkind (Original_Actual (Actual_1)) = N_Aggregate + or else + (Nkind (Original_Actual (Actual_1)) = N_Qualified_Expression + and then Nkind (Expression (Original_Actual (Actual_1))) = + N_Aggregate) + then + null; + + elsif Is_Object_Reference (Original_Actual (Actual_1)) and then not Is_Elementary_Type (Etype (Original_Actual (Actual_1))) then Actual_2 := Next_Actual (Actual_1); diff --git a/gcc/ada/g-ctrl_c.adb b/gcc/ada/g-ctrl_c.adb index e8329201cf4..edd7dc637fa 100644 --- a/gcc/ada/g-ctrl_c.adb +++ b/gcc/ada/g-ctrl_c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2010, AdaCore -- +-- Copyright (C) 2002-2015, 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- -- @@ -39,11 +39,19 @@ package body GNAT.Ctrl_C is procedure C_Handler; pragma Convention (C, C_Handler); + --------------- + -- C_Handler -- + --------------- + procedure C_Handler is begin Ada_Handler.all; end C_Handler; + --------------------- + -- Install_Handler -- + --------------------- + procedure Install_Handler (Handler : Handler_Type) is procedure Internal (Handler : C_Handler_Type); pragma Import (C, Internal, "__gnat_install_int_handler"); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index f6d71ce98c4..0e2d1c79f01 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7231,9 +7231,13 @@ package body Sem_Res is & "(SPARK RM 7.1.3(12))", N); end if; - -- Check possible elaboration issues with respect to variables + -- Check for possible elaboration issues with respect to reads of + -- variables. The act of renaming the variable is not considered a + -- read as it simply establishes an alias. - if Ekind (E) = E_Variable then + if Ekind (E) = E_Variable + and then Nkind (Par) /= N_Object_Renaming_Declaration + then Check_Elab_Call (N); end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 435f03b90ec..036cc0cfe48 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8852,9 +8852,41 @@ package body Sem_Util is ------------------------------------- function Has_Full_Default_Initialization (Typ : Entity_Id) return Boolean is + Arg : Node_Id; Comp : Entity_Id; + Prag : Node_Id; begin + -- A private type and its full view is fully default initialized when it + -- is subject to pragma Default_Initial_Condition without an argument or + -- with a non-null argument. Since any type may act as the full view of + -- a private type, this check must be performed prior to the specialized + -- tests below. + + if Has_Default_Init_Cond (Typ) + or else Has_Inherited_Default_Init_Cond (Typ) + then + Prag := Get_Pragma (Typ, Pragma_Default_Initial_Condition); + + -- Pragma Default_Initial_Condition must be present if one of the + -- related entity flags is set. + + pragma Assert (Present (Prag)); + Arg := First (Pragma_Argument_Associations (Prag)); + + -- A non-null argument guarantees full default initialization + + if Present (Arg) then + return Nkind (Arg) /= N_Null; + + -- Otherwise the missing argument defaults the pragma to "True" which + -- is considered a non-null argument (see above). + + else + return True; + end if; + end if; + -- A scalar type is fully default initialized if it is subject to aspect -- Default_Value. @@ -8911,20 +8943,6 @@ package body Sem_Util is elsif Is_Task_Type (Typ) then return True; - end if; - - -- A private type and by extension its full view is fully default - -- initialized if it is subject to pragma Default_Initial_Condition - -- with a non-null argument or inherits the pragma from a parent type. - -- Since any type can act as the full view of a private type, this check - -- is separated from the circuitry above. - - if Has_Default_Init_Cond (Typ) - or else Has_Inherited_Default_Init_Cond (Typ) - then - return - Nkind (First (Pragma_Argument_Associations (Get_Pragma - (Typ, Pragma_Default_Initial_Condition)))) /= N_Null; -- Otherwise the type is not fully default initialized diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index 21780d1b12c..ed24ea7f280 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -53,7 +53,7 @@ -- 1. Configuration pragmas, that must appear at the start of the file. -- Any such pragmas automatically apply to any unit compiled in the -- presence of this system file. Only a limited set of such pragmas --- may appear as documented in the corresponding section below, +-- may appear as documented in the corresponding section below. -- 2. Target parameters. These are boolean constants that are defined -- in the private part of the package giving fixed information @@ -107,7 +107,7 @@ package Targparm is -- If a pragma Detect_Blocking appears, then the flag Opt.Detect_Blocking -- is set to True. - -- if a pragma Suppress_Exception_Locations appears, then the flag + -- If a pragma Suppress_Exception_Locations appears, then the flag -- Opt.Exception_Locations_Suppressed is set to True. -- If a pragma Profile with a valid profile argument appears, then