[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:
parent
287aa0ed92
commit
5904016a5c
|
@ -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>
|
2015-11-18 Pascal Obry <obry@adacore.com>
|
||||||
|
|
||||||
* adaint.c, s-os_lib.adb, s-os_lib.ads (Kill_Process_Tree): New.
|
* adaint.c, s-os_lib.adb, s-os_lib.ads (Kill_Process_Tree): New.
|
||||||
|
|
|
@ -3259,7 +3259,11 @@ void __gnat_killprocesstree (int pid, int sig_num)
|
||||||
/* kill process */
|
/* kill process */
|
||||||
|
|
||||||
__gnat_kill (pid, sig_num, 1);
|
__gnat_kill (pid, sig_num, 1);
|
||||||
#else
|
|
||||||
|
#elif defined (__vxworks)
|
||||||
|
/* not implemented */
|
||||||
|
|
||||||
|
#elif defined (__linux__)
|
||||||
DIR *dir;
|
DIR *dir;
|
||||||
struct dirent *d;
|
struct dirent *d;
|
||||||
|
|
||||||
|
@ -3307,6 +3311,8 @@ void __gnat_killprocesstree (int pid, int sig_num)
|
||||||
|
|
||||||
/* kill process */
|
/* kill process */
|
||||||
|
|
||||||
|
__gnat_kill (pid, sig_num, 1);
|
||||||
|
#else
|
||||||
__gnat_kill (pid, sig_num, 1);
|
__gnat_kill (pid, sig_num, 1);
|
||||||
#endif
|
#endif
|
||||||
/* Note on Solaris it is possible to read /proc/<PID>/status.
|
/* Note on Solaris it is possible to read /proc/<PID>/status.
|
||||||
|
|
|
@ -2359,9 +2359,19 @@ package body Checks is
|
||||||
|
|
||||||
-- Ensure that the actual is an object that is not passed by value.
|
-- Ensure that the actual is an object that is not passed by value.
|
||||||
-- Elementary types are always passed by value, therefore actuals of
|
-- 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)))
|
and then not Is_Elementary_Type (Etype (Original_Actual (Actual_1)))
|
||||||
then
|
then
|
||||||
Actual_2 := Next_Actual (Actual_1);
|
Actual_2 := Next_Actual (Actual_1);
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- 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;
|
procedure C_Handler;
|
||||||
pragma Convention (C, C_Handler);
|
pragma Convention (C, C_Handler);
|
||||||
|
|
||||||
|
---------------
|
||||||
|
-- C_Handler --
|
||||||
|
---------------
|
||||||
|
|
||||||
procedure C_Handler is
|
procedure C_Handler is
|
||||||
begin
|
begin
|
||||||
Ada_Handler.all;
|
Ada_Handler.all;
|
||||||
end C_Handler;
|
end C_Handler;
|
||||||
|
|
||||||
|
---------------------
|
||||||
|
-- Install_Handler --
|
||||||
|
---------------------
|
||||||
|
|
||||||
procedure Install_Handler (Handler : Handler_Type) is
|
procedure Install_Handler (Handler : Handler_Type) is
|
||||||
procedure Internal (Handler : C_Handler_Type);
|
procedure Internal (Handler : C_Handler_Type);
|
||||||
pragma Import (C, Internal, "__gnat_install_int_handler");
|
pragma Import (C, Internal, "__gnat_install_int_handler");
|
||||||
|
|
|
@ -7231,9 +7231,13 @@ package body Sem_Res is
|
||||||
& "(SPARK RM 7.1.3(12))", N);
|
& "(SPARK RM 7.1.3(12))", N);
|
||||||
end if;
|
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);
|
Check_Elab_Call (N);
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
|
@ -8852,9 +8852,41 @@ package body Sem_Util is
|
||||||
-------------------------------------
|
-------------------------------------
|
||||||
|
|
||||||
function Has_Full_Default_Initialization (Typ : Entity_Id) return Boolean is
|
function Has_Full_Default_Initialization (Typ : Entity_Id) return Boolean is
|
||||||
|
Arg : Node_Id;
|
||||||
Comp : Entity_Id;
|
Comp : Entity_Id;
|
||||||
|
Prag : Node_Id;
|
||||||
|
|
||||||
begin
|
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
|
-- A scalar type is fully default initialized if it is subject to aspect
|
||||||
-- Default_Value.
|
-- Default_Value.
|
||||||
|
|
||||||
|
@ -8911,20 +8943,6 @@ package body Sem_Util is
|
||||||
|
|
||||||
elsif Is_Task_Type (Typ) then
|
elsif Is_Task_Type (Typ) then
|
||||||
return True;
|
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
|
-- Otherwise the type is not fully default initialized
|
||||||
|
|
||||||
|
|
|
@ -53,7 +53,7 @@
|
||||||
-- 1. Configuration pragmas, that must appear at the start of the file.
|
-- 1. Configuration pragmas, that must appear at the start of the file.
|
||||||
-- Any such pragmas automatically apply to any unit compiled in the
|
-- Any such pragmas automatically apply to any unit compiled in the
|
||||||
-- presence of this system file. Only a limited set of such pragmas
|
-- 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
|
-- 2. Target parameters. These are boolean constants that are defined
|
||||||
-- in the private part of the package giving fixed information
|
-- 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
|
-- If a pragma Detect_Blocking appears, then the flag Opt.Detect_Blocking
|
||||||
-- is set to True.
|
-- 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.
|
-- Opt.Exception_Locations_Suppressed is set to True.
|
||||||
|
|
||||||
-- If a pragma Profile with a valid profile argument appears, then
|
-- If a pragma Profile with a valid profile argument appears, then
|
||||||
|
|
Loading…
Reference in New Issue