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

aspects.ads, [...]: Add entries for aspect Obsolescent. 

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* aspects.ads, aspects.adb: Add entries for aspect Obsolescent.
	* gnat_rm.texi: Add documentation for aspect Obsolescent.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Implement aspect
	Obsolescent.
	(Check_Aspect_At_Freeze_Point): Add dummy entry for pragma Obsolescent.
	* s-osprim-mingw.adb: Minor reformatting.
	* sem_res.adb (Is_Atomic_Ref_With_Address): New function
	(Resolve_Indexed_Component): Rework warnings for non-atomic access
	(Resolve_Selected_Component): Add warnings for non-atomic access.

From-SVN: r213588
This commit is contained in:
Robert Dewar 2014-08-04 13:17:46 +00:00 committed by Arnaud Charlet
parent 6cf7eae689
commit c2a2dbcc6b
7 changed files with 103 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
View File

@ -1,3 +1,15 @@
2014-08-04 Robert Dewar <dewar@adacore.com>
* aspects.ads, aspects.adb: Add entries for aspect Obsolescent.
* gnat_rm.texi: Add documentation for aspect Obsolescent.
* sem_ch13.adb (Analyze_Aspect_Specifications): Implement aspect
Obsolescent.
(Check_Aspect_At_Freeze_Point): Add dummy entry for pragma Obsolescent.
* s-osprim-mingw.adb: Minor reformatting.
* sem_res.adb (Is_Atomic_Ref_With_Address): New function
(Resolve_Indexed_Component): Rework warnings for non-atomic access
(Resolve_Selected_Component): Add warnings for non-atomic access.
2014-08-04 Doug Rupp <rupp@adacore.com>
* g-calend.adb (timeval_to_duration, duration_to_timeval): Change sec

1
gcc/ada/aspects.adb
View File

@ -546,6 +546,7 @@ package body Aspects is
Aspect_Machine_Radix => Aspect_Machine_Radix,
Aspect_No_Elaboration_Code_All => Aspect_No_Elaboration_Code_All,
Aspect_No_Return => Aspect_No_Return,
Aspect_Obsolescent => Aspect_Obsolescent,
Aspect_Object_Size => Aspect_Object_Size,
Aspect_Output => Aspect_Output,
Aspect_Pack => Aspect_Pack,

4
gcc/ada/aspects.ads
View File

@ -109,6 +109,7 @@ package Aspects is
Aspect_Linker_Section, -- GNAT
Aspect_Machine_Radix,
Aspect_Object_Size, -- GNAT
Aspect_Obsolescent, -- GNAT
Aspect_Output,
Aspect_Part_Of, -- GNAT
Aspect_Post,
@ -333,6 +334,7 @@ package Aspects is
Aspect_Linker_Section => Expression,
Aspect_Machine_Radix => Expression,
Aspect_Object_Size => Expression,
Aspect_Obsolescent => Optional_Expression,
Aspect_Output => Name,
Aspect_Part_Of => Expression,
Aspect_Post => Expression,
@ -433,6 +435,7 @@ package Aspects is
Aspect_No_Elaboration_Code_All => Name_No_Elaboration_Code_All,
Aspect_No_Return => Name_No_Return,
Aspect_Object_Size => Name_Object_Size,
Aspect_Obsolescent => Name_Obsolescent,
Aspect_Output => Name_Output,
Aspect_Pack => Name_Pack,
Aspect_Part_Of => Name_Part_Of,
@ -688,6 +691,7 @@ package Aspects is
Aspect_Initial_Condition => Never_Delay,
Aspect_Initializes => Never_Delay,
Aspect_No_Elaboration_Code_All => Never_Delay,
Aspect_Obsolescent => Never_Delay,
Aspect_Part_Of => Never_Delay,
Aspect_Refined_Depends => Never_Delay,
Aspect_Refined_Global => Never_Delay,

10
gcc/ada/gnat_rm.texi
View File

@ -313,6 +313,7 @@ Implementation Defined Aspects
* Aspect Linker_Section::
* Aspect No_Elaboration_Code_All::
* Aspect Object_Size::
* Aspect Obsolescent::
* Aspect Part_Of::
* Aspect Persistent_BSS::
* Aspect Predicate::
@ -8068,6 +8069,7 @@ clause.
* Aspect Lock_Free::
* Aspect No_Elaboration_Code_All::
* Aspect Object_Size::
* Aspect Obsolescent::
* Aspect Part_Of::
* Aspect Persistent_BSS::
* Aspect Predicate::
@ -8350,6 +8352,14 @@ statement for a program unit.
This aspect is equivalent to an @code{Object_Size} attribute definition
clause.
@node Aspect Obsolescent
@unnumberedsec Aspect Obsolescent
@findex Obsolsecent
@noindent
This aspect is equivalent to an @code{Obsolescent} pragma. Note that the
evaluation of this aspect happens at the point of occurrence, it is not
delayed until the freeze point.
@node Aspect Part_Of
@unnumberedsec Aspect Part_Of
@findex Part_Of

10
gcc/ada/s-osprim-mingw.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2014, 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- --
@ -87,15 +87,15 @@ package body System.OS_Primitives is
-- the base data for the changes to get undetected.
type Signature_Type is mod 2**32;
Signature : Signature_Type := 0;
Signature : Signature_Type := 0;
pragma Atomic (Signature);
procedure Get_Base_Time (Data : out Clock_Data);
-- Retrieve the base time and base ticks. These values will be used by
-- clock to compute the current time by adding to it a fraction of the
-- performance counter. This is for the implementation of a
-- high-resolution clock. Note that this routine does not change the base
-- monotonic values used by the monotonic clock.
-- performance counter. This is for the implementation of a high-resolution
-- clock. Note that this routine does not change the base monotonic values
-- used by the monotonic clock.
-----------
-- Clock --

20
gcc/ada/sem_ch13.adb
View File

@ -2388,6 +2388,25 @@ package body Sem_Ch13 is
goto Continue;
end Initializes;
-- Obsolescent
when Aspect_Obsolescent => declare
Args : List_Id;
begin
if No (Expr) then
Args := No_List;
else
Args := New_List (
Make_Pragma_Argument_Association (Sloc (Expr),
Expression => Relocate_Node (Expr)));
end if;
Make_Aitem_Pragma
(Pragma_Argument_Associations => Args,
Pragma_Name => Chars (Id));
end;
-- Part_Of
when Aspect_Part_Of =>
@ -8758,6 +8777,7 @@ package body Sem_Ch13 is
Aspect_Implicit_Dereference |
Aspect_Initial_Condition |
Aspect_Initializes |
Aspect_Obsolescent |
Aspect_Part_Of |
Aspect_Post |
Aspect_Postcondition |

73
gcc/ada/sem_res.adb
View File

@ -128,6 +128,11 @@ package body Sem_Res is
-- for restriction No_Direct_Boolean_Operators. This procedure also handles
-- the style check for Style_Check_Boolean_And_Or.
function Is_Atomic_Ref_With_Address (N : Node_Id) return Boolean;
-- N is either an indexed component or a selected component. This function
-- returns true if the prefix refers to an object that has an address
-- clause (the case in which we may want to issue a warning).
function Is_Definite_Access_Type (E : Entity_Id) return Boolean;
-- Determine whether E is an access type declared by an access declaration,
-- and not an (anonymous) allocator type.
@ -1131,6 +1136,29 @@ package body Sem_Res is
end if;
end Check_Parameterless_Call;
--------------------------------
-- Is_Atomic_Ref_With_Address --
--------------------------------
function Is_Atomic_Ref_With_Address (N : Node_Id) return Boolean is
Pref : constant Node_Id := Prefix (N);
begin
if not Is_Entity_Name (Pref) then
return False;
else
declare
Pent : constant Entity_Id := Entity (Pref);
Ptyp : constant Entity_Id := Etype (Pent);
begin
return not Is_Access_Type (Ptyp)
and then (Is_Atomic (Ptyp) or else Is_Atomic (Pent))
and then Present (Address_Clause (Pent));
end;
end if;
end Is_Atomic_Ref_With_Address;
-----------------------------
-- Is_Definite_Access_Type --
-----------------------------
@ -7973,19 +8001,20 @@ package body Sem_Res is
Eval_Indexed_Component (N);
end if;
-- If the array type is atomic, and is packed, and we are in a left side
-- context, then this is worth a warning, since we have a situation
-- where the access to the component may cause extra read/writes of
-- the atomic array object, which could be considered unexpected.
-- If the array type is atomic, and the component is not atomic, then
-- this is worth a warning, since we have a situation where the access
-- to the component may cause extra read/writes of the atomic array
-- object, or partial word accesses, which could be unexpected.
if Nkind (N) = N_Indexed_Component
and then (Is_Atomic (Array_Type)
or else (Is_Entity_Name (Prefix (N))
and then Is_Atomic (Entity (Prefix (N)))))
and then Is_Bit_Packed_Array (Array_Type)
and then Is_LHS (N) = Yes
and then Is_Atomic_Ref_With_Address (N)
and then not (Has_Atomic_Components (Array_Type)
or else (Is_Entity_Name (Prefix (N))
and then Has_Atomic_Components
(Entity (Prefix (N)))))
and then not Is_Atomic (Component_Type (Array_Type))
then
Error_Msg_N ("??assignment to component of packed atomic array",
Error_Msg_N ("??access to non-atomic component of atomic array",
Prefix (N));
Error_Msg_N ("??\may cause unexpected accesses to atomic object",
Prefix (N));
@ -9293,7 +9322,7 @@ package body Sem_Res is
procedure Resolve_Selected_Component (N : Node_Id; Typ : Entity_Id) is
Comp : Entity_Id;
Comp1 : Entity_Id := Empty; -- prevent junk warning
P : constant Node_Id := Prefix (N);
P : constant Node_Id := Prefix (N);
S : constant Node_Id := Selector_Name (N);
T : Entity_Id := Etype (P);
I : Interp_Index;
@ -9470,22 +9499,22 @@ package body Sem_Res is
-- Note: No Eval processing is required, because the prefix is of a
-- record type, or protected type, and neither can possibly be static.
-- If the array type is atomic, and is packed, and we are in a left side
-- context, then this is worth a warning, since we have a situation
-- where the access to the component may cause extra read/writes of the
-- atomic array object, which could be considered unexpected.
-- If the record type is atomic, and the component is non-atomic, then
-- this is worth a warning, since we have a situation where the access
-- to the component may cause extra read/writes of the atomic array
-- object, or partial word accesses, both of which may be unexpected.
if Nkind (N) = N_Selected_Component
and then (Is_Atomic (T)
or else (Is_Entity_Name (Prefix (N))
and then Is_Atomic (Entity (Prefix (N)))))
and then Is_Packed (T)
and then Is_LHS (N) = Yes
and then Is_Atomic_Ref_With_Address (N)
and then not Is_Atomic (Entity (S))
and then not Is_Atomic (Etype (Entity (S)))
then
Error_Msg_N
("??assignment to component of packed atomic record", Prefix (N));
("??access to non-atomic component of atomic record",
Prefix (N));
Error_Msg_N
("\??may cause unexpected accesses to atomic object", Prefix (N));
("\??may cause unexpected accesses to atomic object",
Prefix (N));
end if;
Analyze_Dimension (N);