[multiple changes]

2015-11-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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  <kirtchev@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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  <obry@adacore.com>

	* adaint.c: Routine __gnat_killprocesstree only implemented on
	Linux and Windows.

2015-11-18  Pascal Obry  <obry@adacore.com>

	* g-ctrl_c.adb: Minor style fixes.

From-SVN: r230523
This commit is contained in:
Arnaud Charlet 2015-11-18 11:03:44 +01:00
parent 287aa0ed92
commit 5904016a5c
7 changed files with 99 additions and 22 deletions

View File

@ -1,3 +1,34 @@
2015-11-18 Hristian Kirtchev <kirtchev@adacore.com>
* 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 <kirtchev@adacore.com>
* 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 <schonberg@adacore.com>
* 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 <obry@adacore.com>
* adaint.c: Routine __gnat_killprocesstree only implemented on
Linux and Windows.
2015-11-18 Pascal Obry <obry@adacore.com>
* g-ctrl_c.adb: Minor style fixes.
2015-11-18 Pascal Obry <obry@adacore.com>
* adaint.c, s-os_lib.adb, s-os_lib.ads (Kill_Process_Tree): New.

View File

@ -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/<PID>/status.

View File

@ -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);

View File

@ -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");

View File

@ -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;

View File

@ -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

View File

@ -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