+2011-11-04 Yannick Moy <moy@adacore.com>
+
+ * sem_prag.adb: Minor refactoring (renaming of a parameter).
+
+2011-11-04 Robert Dewar <dewar@adacore.com>
+
+ * atree.ads: Minor reformatting.
+
+2011-11-04 Robert Dewar <dewar@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
+
2011-11-04 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, atree.ads, prj-env.adb, prj-env.ads: Minor reformatting.
-----------------------------------
-- This subpackage provides the functions for accessing and procedures for
- -- setting fields that are normally referenced by their logical synonyms
- -- defined in packages Sinfo and Einfo. The implementations of these
- -- packages use the package Atree.Unchecked_Access.
+ -- setting fields that are normally referenced by wrapper subprograms (e.g.
+ -- logical synonyms defined in packages Sinfo and Einfo, or specialized
+ -- routines such as Rewrite (for Original_Node), or the node creation
+ -- routines (for Set_Nkind). The implementations of these wrapper
+ -- subprograms use the package Atree.Unchecked_Access as do various
+ -- special case accesses where no wrapper applies. Documentation is always
+ -- required for such a special case access explaining why it is needed.
package Unchecked_Access is
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;
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
-- 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;
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;
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
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;
-- 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 --
----------------------
-- 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
-- case, and if found, issues an appropriate error message.
procedure Check_Expr_Is_Static_Expression
- (Argx : Node_Id;
+ (Expr : Node_Id;
Typ : Entity_Id := Empty);
- -- Check the specified expression Argx to make sure that it is a static
+ -- Check the specified expression Expr to make sure that it is a static
-- expression of the given type (i.e. it will be analyzed and resolved
-- using this type, which can be any valid argument to Resolve, e.g.
-- Any_Integer is OK). If not, given error and raise Pragma_Exit. If
-------------------------------------
procedure Check_Expr_Is_Static_Expression
- (Argx : Node_Id;
+ (Expr : Node_Id;
Typ : Entity_Id := Empty)
is
begin
if Present (Typ) then
- Analyze_And_Resolve (Argx, Typ);
+ Analyze_And_Resolve (Expr, Typ);
else
- Analyze_And_Resolve (Argx);
+ Analyze_And_Resolve (Expr);
end if;
- if Is_OK_Static_Expression (Argx) then
+ if Is_OK_Static_Expression (Expr) then
return;
- elsif Etype (Argx) = Any_Type then
+ elsif Etype (Expr) = Any_Type then
raise Pragma_Exit;
-- An interesting special case, if we have a string literal and we
-- warnings as usual, but will not cause errors.
elsif Ada_Version = Ada_83
- and then Nkind (Argx) = N_String_Literal
+ and then Nkind (Expr) = N_String_Literal
then
return;
-- Static expression that raises Constraint_Error. This has already
-- been flagged, so just exit from pragma processing.
- elsif Is_Static_Expression (Argx) then
+ elsif Is_Static_Expression (Expr) then
raise Pragma_Exit;
-- Finally, we have a real error
"argument for pragma% must be a static expression!";
begin
Fix_Error (Msg);
- Flag_Non_Static_Expr (Msg, Argx);
+ Flag_Non_Static_Expr (Msg, Expr);
end;
raise Pragma_Exit;
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;
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;
-- 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.
-- Associated_Node (Node4-Sem)
-- Do_Discriminant_Check (Flag13-Sem)
-- Is_In_Discriminant_Check (Flag11-Sem)
+ -- Atomic_Sync_Required (Flag14-Sem)
-- plus fields for expression
--------------------------
projects / thirdparty / gcc.git / commitdiff
