This patch cleans up and reorganizes the handling of atomic sync, and fixes some inconsistencies, e.g. an attribute reference was properly excluded for an identifier, but not for a selected component. Also the flag Atomic_Sync_Required is now on the selected component node itself not the selector name identifier, which is more consistent.
Tested on x86_64-pc-linux-gnu, committed on trunk 2011-11-04 Robert Dewar <de...@adacore.com> * checks.adb (Atomic_Synchronization_Disabled): Check -gnatd.d and -gnatd.e here * exp_ch2.adb (Expand_Entity_Reference): Use Activate_Atomic_Synchronization * exp_ch4.adb (Expand_N_Explicit_Dereference): Use Activate_Atomic_Synchronization (Expand_N_Indexed_Compoonent): Activate_Atomic_Synchronization (Expand_N_Selected_Component): Use Activate_Atomic_Synchronization * exp_util.ads, exp_util.adb (Activate_Atomic_Synchronization): New procedure. * sinfo.ads, sinfo.adb (Atomic_Sync_Required): Can now apply to N_Selected_Component node
Index: exp_util.adb =================================================================== --- exp_util.adb (revision 180934) +++ exp_util.adb (working copy) @@ -160,6 +160,53 @@ -- or body. Flag Nested_Constructs should be set when any nested packages -- declared in L must be processed. + ------------------------------------- + -- Activate_Atomic_Synchronization -- + ------------------------------------- + + procedure Activate_Atomic_Synchronization (N : Node_Id) is + Msg_Node : Node_Id; + + begin + -- Nothing to do if we are the prefix of an attribute, since we do not + -- want an atomic sync operation for things like A'Adress or A'Size). + + if Nkind (Parent (N)) = N_Attribute_Reference + and then Prefix (Parent (N)) = N + then + return; + end if; + + -- Go ahead and set the flag + + Set_Atomic_Sync_Required (N); + + -- Generate info message if requested + + if Warn_On_Atomic_Synchronization then + case Nkind (N) is + when N_Identifier => + Msg_Node := N; + + when N_Selected_Component | N_Expanded_Name => + Msg_Node := Selector_Name (N); + + when N_Explicit_Dereference | N_Indexed_Component => + Msg_Node := Empty; + + when others => + pragma Assert (False); + return; + end case; + + if Present (Msg_Node) then + Error_Msg_N ("?info: atomic synchronization set for &", Msg_Node); + else + Error_Msg_N ("?info: atomic synchronization set", N); + end if; + end if; + end Activate_Atomic_Synchronization; + ---------------------- -- Adjust_Condition -- ---------------------- Index: exp_util.ads =================================================================== --- exp_util.ads (revision 180934) +++ exp_util.ads (working copy) @@ -149,6 +149,14 @@ -- Other Subprograms -- ----------------------- + procedure Activate_Atomic_Synchronization (N : Node_Id); + -- N is a node for which atomic synchronization may be required (it is + -- either an identifier, expanded name, or selected/indexed component or + -- an explicit dereference). The caller has checked the basic conditions + -- (atomic variable appearing and Atomic_Sync not disabled). This function + -- checks if atomic synchronization is required and if so sets the flag + -- and if appropriate generates a warning (in -gnatw.n mode). + procedure Adjust_Condition (N : Node_Id); -- The node N is an expression whose root-type is Boolean, and which -- represents a boolean value used as a condition (i.e. a True/False Index: sinfo.adb =================================================================== --- sinfo.adb (revision 180943) +++ sinfo.adb (working copy) @@ -256,7 +256,8 @@ or else NT (N).Nkind = N_Expanded_Name or else NT (N).Nkind = N_Explicit_Dereference or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Indexed_Component); + or else NT (N).Nkind = N_Indexed_Component + or else NT (N).Nkind = N_Selected_Component); return Flag14 (N); end Atomic_Sync_Required; @@ -3327,7 +3328,8 @@ or else NT (N).Nkind = N_Expanded_Name or else NT (N).Nkind = N_Explicit_Dereference or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Indexed_Component); + or else NT (N).Nkind = N_Indexed_Component + or else NT (N).Nkind = N_Selected_Component); Set_Flag14 (N, Val); end Set_Atomic_Sync_Required; Index: sinfo.ads =================================================================== --- sinfo.ads (revision 180943) +++ sinfo.ads (working copy) @@ -606,16 +606,8 @@ -- harmless. -- Atomic_Sync_Required (Flag14-Sem) - -- This flag is set in an identifier or expanded name node if the - -- corresponding reference (or assignment when on the left side of - -- an assignment) requires atomic synchronization, as a result of - -- Atomic_Synchronization being enabled for the corresponding entity - -- or its type. Also set for Selector_Name of an N_Selected Component - -- node if the type is atomic and requires atomic synchronization. - -- Also set on an N_Explicit Dereference node if the resulting type - -- is atomic and requires atomic synchronization. Finally it is set - -- on an N_Indexed_Component node if the resulting type is Atomic, or - -- if the array type or the array has pragma Atomic_Components set. + -- This flag is set on a node for which atomic synchronization is + -- required for the corresponding reference or modification. -- At_End_Proc (Node1) -- This field is present in an N_Handled_Sequence_Of_Statements node. @@ -3248,6 +3240,7 @@ -- Associated_Node (Node4-Sem) -- Do_Discriminant_Check (Flag13-Sem) -- Is_In_Discriminant_Check (Flag11-Sem) + -- Atomic_Sync_Required (Flag14-Sem) -- plus fields for expression -------------------------- Index: checks.adb =================================================================== --- checks.adb (revision 180934) +++ checks.adb (working copy) @@ -2565,8 +2565,25 @@ function Atomic_Synchronization_Disabled (E : Entity_Id) return Boolean is begin - if Present (E) and then Checks_May_Be_Suppressed (E) then + -- If debug flag d.e is set, always return False, i.e. all atomic sync + -- looks enabled, since it is never disabled. + + if Debug_Flag_Dot_E then + return False; + + -- If debug flag d.d is set then always return True, i.e. all atomic + -- sync looks disabled, since it always tests True. + + elsif Debug_Flag_Dot_D then + return True; + + -- If entity present, then check result for that entity + + elsif Present (E) and then Checks_May_Be_Suppressed (E) then return Is_Check_Suppressed (E, Atomic_Synchronization); + + -- Otherwise result depends on current scope setting + else return Scope_Suppress (Atomic_Synchronization); end if; Index: exp_ch2.adb =================================================================== --- exp_ch2.adb (revision 180943) +++ exp_ch2.adb (working copy) @@ -404,35 +404,15 @@ if Nkind_In (N, N_Identifier, N_Expanded_Name) and then Ekind (E) = E_Variable and then (Is_Atomic (E) or else Is_Atomic (Etype (E))) - - -- Don't go setting the flag for the prefix of an attribute because - -- we don't want atomic sync for X'Size, X'Access etc. - - -- Is this right in all cases of attributes??? - -- Are there other exemptions required ??? - - and then (Nkind (Parent (N)) /= N_Attribute_Reference - or else Prefix (Parent (N)) /= N) then declare Set : Boolean; - MLoc : Node_Id; begin - -- Always set if debug flag d.e is set - - if Debug_Flag_Dot_E then - Set := True; - - -- Never set if debug flag d.d is set - - elsif Debug_Flag_Dot_D then - Set := False; - -- If variable is atomic, but type is not, setting depends on -- disable/enable state for the variable. - elsif Is_Atomic (E) and then not Is_Atomic (Etype (E)) then + if Is_Atomic (E) and then not Is_Atomic (Etype (E)) then Set := not Atomic_Synchronization_Disabled (E); -- If variable is not atomic, but its type is atomic, setting @@ -453,20 +433,7 @@ -- Set flag if required if Set then - Set_Atomic_Sync_Required (N); - - -- Generate info message if requested - - if Warn_On_Atomic_Synchronization then - if Nkind (N) = N_Identifier then - MLoc := N; - else - MLoc := Selector_Name (N); - end if; - - Error_Msg_N - ("?info: atomic synchronization set for &", MLoc); - end if; + Activate_Atomic_Synchronization (N); end if; end; end if; Index: exp_ch4.adb =================================================================== --- exp_ch4.adb (revision 180943) +++ exp_ch4.adb (working copy) @@ -4478,13 +4478,7 @@ if Is_Atomic (Etype (N)) and then not Atomic_Synchronization_Disabled (Etype (N)) then - Set_Atomic_Sync_Required (N); - - -- Generate info message if requested - - if Warn_On_Atomic_Synchronization then - Error_Msg_N ("?info: atomic synchronization set", N); - end if; + Activate_Atomic_Synchronization (N); end if; end Expand_N_Explicit_Dereference; @@ -5326,13 +5320,7 @@ or else (Is_Atomic (Typ) and then not Atomic_Synchronization_Disabled (Typ)) then - Set_Atomic_Sync_Required (N); - - -- Generate info message if requested - - if Warn_On_Atomic_Synchronization then - Error_Msg_N ("?info: atomic synchronization set", N); - end if; + Activate_Atomic_Synchronization (N); end if; -- All done for the non-packed case @@ -8216,14 +8204,7 @@ and then Is_Atomic (Etype (N)) and then not Atomic_Synchronization_Disabled (Etype (N)) then - Set_Atomic_Sync_Required (Selector_Name (N)); - - -- Generate info message if requested - - if Warn_On_Atomic_Synchronization then - Error_Msg_N - ("?info: atomic synchronization set for &", Selector_Name (N)); - end if; + Activate_Atomic_Synchronization (N); end if; end Expand_N_Selected_Component;