OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2015-10-23  Arnaud Charlet  <charlet@adacore.com>

	* s-taskin.ads: Minor code clean up.
	(Ada_Task_Control_Block): Move fixed size field before variable sized
	ones.
	* einfo.ads: Minor editing.

2015-10-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Check_Aggregate_Accessibility): Apply rule in RM
	6.5 (8.3) to verify that access discriminants in an aggregate
	in a return statement have the proper accessibility, i.e. do
	not lead to dangling references.

2015-10-23  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Add missing
	test on Address_Clause_Overlay_Warnings to the "constant overlays
	variable" warning. For the reverse case, also issue a warning if
	the modification is potentially made through the initialization
	of the variable.

2015-10-23  Jose Ruiz  <ruiz@adacore.com>

	* a-exetim-posix.adb (Clock): Use the pthread_getcpuclockid
	function to have access to CPU clocks for tasks other than the
	calling task.

From-SVN: r229247
This commit is contained in:
Arnaud Charlet 2015-10-23 14:48:46 +02:00
parent bf8f12c2a6
commit ed11bbfe44
6 changed files with 144 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/ChangeLog
View File

@ -1,3 +1,31 @@
2015-10-23 Arnaud Charlet <charlet@adacore.com>
* s-taskin.ads: Minor code clean up.
(Ada_Task_Control_Block): Move fixed size field before variable sized
ones.
* einfo.ads: Minor editing.
2015-10-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Check_Aggregate_Accessibility): Apply rule in RM
6.5 (8.3) to verify that access discriminants in an aggregate
in a return statement have the proper accessibility, i.e. do
not lead to dangling references.
2015-10-23 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Add missing
test on Address_Clause_Overlay_Warnings to the "constant overlays
variable" warning. For the reverse case, also issue a warning if
the modification is potentially made through the initialization
of the variable.
2015-10-23 Jose Ruiz <ruiz@adacore.com>
* a-exetim-posix.adb (Clock): Use the pthread_getcpuclockid
function to have access to CPU clocks for tasks other than the
calling task.
2015-10-23 Hristian Kirtchev <kirtchev@adacore.com>
* debug.adb: Switch -gnatd.5 is no longer in use, remove the

28
gcc/ada/a-exetim-posix.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2012, Free Software Foundation, Inc. --
-- Copyright (C) 2007-2015, Free Software Foundation, Inc. --
-- --
-- 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- --
@ -34,8 +34,9 @@
with Ada.Task_Identification; use Ada.Task_Identification;
with Ada.Unchecked_Conversion;
with System.OS_Constants; use System.OS_Constants;
with System.Tasking;
with System.OS_Interface; use System.OS_Interface;
with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
with Interfaces.C; use Interfaces.C;
@ -97,14 +98,18 @@ package body Ada.Execution_Time is
(T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task) return CPU_Time
is
TS : aliased timespec;
Result : Interfaces.C.int;
TS : aliased timespec;
Clock_Id : aliased Interfaces.C.int;
Result : Interfaces.C.int;
function To_CPU_Time is
new Ada.Unchecked_Conversion (Duration, CPU_Time);
-- Time is equal to Duration (although it is a private type) and
-- CPU_Time is equal to Time.
function Convert_Ids is new
Ada.Unchecked_Conversion (Task_Id, System.Tasking.Task_Id);
function clock_gettime
(clock_id : Interfaces.C.int;
tp : access timespec)
@ -112,13 +117,26 @@ package body Ada.Execution_Time is
pragma Import (C, clock_gettime, "clock_gettime");
-- Function from the POSIX.1b Realtime Extensions library
function pthread_getcpuclockid
(tid : Thread_Id;
clock_id : access Interfaces.C.int)
return int;
pragma Import (C, pthread_getcpuclockid, "pthread_getcpuclockid");
-- Function from the Thread CPU-Time Clocks option
begin
if T = Ada.Task_Identification.Null_Task_Id then
raise Program_Error;
else
-- Get the CPU clock for the task passed as parameter
Result := pthread_getcpuclockid
(Get_Thread_Id (Convert_Ids (T)), Clock_Id'Access);
pragma Assert (Result = 0);
end if;
Result := clock_gettime
(clock_id => CLOCK_THREAD_CPUTIME_ID, tp => TS'Unchecked_Access);
(clock_id => Clock_Id, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_CPU_Time (To_Duration (TS));

2
gcc/ada/einfo.ads
View File

@ -3945,7 +3945,7 @@ package Einfo is
-- Rewritten_For_C (Flag287)
-- Defined on functions that return a constrained array type, when
-- Modify_Tree_For_C is set. indicates that a procedure with an extra
-- Modify_Tree_For_C is set. Indicates that a procedure with an extra
-- out parameter has been created for it, and calls must be rewritten as
-- calls to the new procedure.

17
gcc/ada/s-taskin.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -1135,20 +1135,23 @@ package System.Tasking is
-- User-writeable location, for use in debugging tasks; also provides a
-- simple task specific data.
Free_On_Termination : Boolean := False;
-- Deallocate the ATCB when the task terminates. This flag is normally
-- False, and is set True when Unchecked_Deallocation is called on a
-- non-terminated task so that the associated storage is automatically
-- reclaimed when the task terminates.
Attributes : Attribute_Array := (others => 0);
-- Task attributes
-- IMPORTANT Note: the Entry_Queues field is last for efficiency of
-- access to other fields, do not put new fields after this one.
Entry_Queues : Task_Entry_Queue_Array (1 .. Entry_Num);
-- An array of task entry queues
--
-- Protection: Self.L. Once a task has set Self.Stage to Completing, it
-- has exclusive access to this field.
Free_On_Termination : Boolean := False;
-- Deallocate the ATCB when the task terminates. This flag is normally
-- False, and is set True when Unchecked_Deallocation is called on a
-- non-terminated task so that the associated storage is automatically
-- reclaimed when the task terminates.
end record;
--------------------

27
gcc/ada/sem_ch13.adb
View File

@ -4728,7 +4728,12 @@ package body Sem_Ch13 is
Make_Raise_Program_Error (Loc,
Reason => PE_Overlaid_Controlled_Object));
elsif Present (O_Ent)
-- Issue an unconditional warning for a constant overlaying
-- a variable. For the reverse case, we will issue it only
-- if the variable is modified, see below.
elsif Address_Clause_Overlay_Warnings
and then Present (O_Ent)
and then Ekind (U_Ent) = E_Constant
and then not Is_Constant_Object (O_Ent)
then
@ -4859,13 +4864,27 @@ package body Sem_Ch13 is
-- If variable overlays a constant view, and we are
-- warning on overlays, then mark the variable as
-- overlaying a constant (we will give warnings later
-- if this variable is assigned).
-- overlaying a constant and warn immediately if it
-- is initialized. We will give other warnings later
-- if the variable is assigned.
if Is_Constant_Object (O_Ent)
and then Ekind (U_Ent) = E_Variable
then
Set_Overlays_Constant (U_Ent);
declare
Init : constant Node_Id :=
Expression (Declaration_Node (U_Ent));
begin
Set_Overlays_Constant (U_Ent);
if Present (Init)
and then Comes_From_Source (Init)
then
Error_Msg_Sloc := Sloc (N);
Error_Msg_NE
("??constant& may be modified via address "
& "clause#", Declaration_Node (U_Ent), O_Ent);
end if;
end;
end if;
end if;
end;

59
gcc/ada/sem_ch6.adb
View File

@ -619,6 +619,10 @@ package body Sem_Ch6 is
R_Type : constant Entity_Id := Etype (Scope_Id);
-- Function result subtype
procedure Check_Aggregate_Accessibility (Aggr : Node_Id);
-- Apply legality rule of 6.5 (8.2) to the access discriminants of
-- an aggregate in a return statement.
procedure Check_Limited_Return (Expr : Node_Id);
-- Check the appropriate (Ada 95 or Ada 2005) rules for returning
-- limited types. Used only for simple return statements.
@ -628,6 +632,57 @@ package body Sem_Ch6 is
-- Check that the return_subtype_indication properly matches the result
-- subtype of the function, as required by RM-6.5(5.1/2-5.3/2).
-----------------------------------
-- Check_Aggregate_Accessibility --
-----------------------------------
procedure Check_Aggregate_Accessibility (Aggr : Node_Id) is
Typ : constant Entity_Id := Etype (Aggr);
Assoc : Node_Id;
Discr : Entity_Id;
Expr : Node_Id;
Obj : Node_Id;
begin
if Is_Record_Type (Typ)
and then Has_Discriminants (Typ)
then
Discr := First_Discriminant (Typ);
Assoc := First (Component_Associations (Aggr));
while Present (Discr) loop
if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
Expr := Expression (Assoc);
if Nkind (Expr) = N_Attribute_Reference
and then Attribute_Name (Expr) /= Name_Unrestricted_Access
then
Obj := Prefix (Expr);
while Nkind_In (Obj,
N_Selected_Component, N_Indexed_Component)
loop
Obj := Prefix (Obj);
end loop;
if Is_Entity_Name (Obj)
and then Is_Formal (Entity (Obj))
then
-- A run-time check may be needed ???
null;
elsif Object_Access_Level (Obj) >
Scope_Depth (Scope (Scope_Id))
then
Error_Msg_N
("access discriminant in return aggregate " &
"will be a dangling reference", Obj);
end if;
end if;
end if;
Next_Discriminant (Discr);
end loop;
end if;
end Check_Aggregate_Accessibility;
--------------------------
-- Check_Limited_Return --
--------------------------
@ -931,6 +986,10 @@ package body Sem_Ch6 is
Resolve (Expr, R_Type);
Check_Limited_Return (Expr);
if Present (Expr) and then Nkind (Expr) = N_Aggregate then
Check_Aggregate_Accessibility (Expr);
end if;
end if;
-- RETURN only allowed in SPARK as the last statement in function