From c2a2dbcc6ba197d3e6921ac220a097ac617c1493 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Mon, 4 Aug 2014 13:17:46 +0000 Subject: [PATCH] aspects.ads, [...]: Add entries for aspect Obsolescent. 2014-08-04 Robert Dewar * 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 --- gcc/ada/ChangeLog | 12 +++++++ gcc/ada/aspects.adb | 1 + gcc/ada/aspects.ads | 4 +++ gcc/ada/gnat_rm.texi | 10 ++++++ gcc/ada/s-osprim-mingw.adb | 10 +++--- gcc/ada/sem_ch13.adb | 20 +++++++++++ gcc/ada/sem_res.adb | 73 ++++++++++++++++++++++++++------------ 7 files changed, 103 insertions(+), 27 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 57abdb5a46b..2423d29a62e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2014-08-04 Robert Dewar + + * 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 * g-calend.adb (timeval_to_duration, duration_to_timeval): Change sec diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index b1e2e101104..82f0c911a67 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -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, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 8e47172803a..a7477bef66f 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -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, diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 8dce342e154..c782ea3b65c 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -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 diff --git a/gcc/ada/s-osprim-mingw.adb b/gcc/ada/s-osprim-mingw.adb index a2c466406c4..f8a41dd509c 100644 --- a/gcc/ada/s-osprim-mingw.adb +++ b/gcc/ada/s-osprim-mingw.adb @@ -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 -- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index dc226b37ec4..a73712bfb5f 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 | diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 1594f23a036..f45e07e06cc 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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);