2011-08-02 Robert Dewar <dewar@adacore.com>
+ * sem_ch12.adb, sem_ch11.adb: New calling sequence for
+ Analyze_Aspect_Specifications
+ * sem_ch13.adb
+ (Analyze_Aspect_Specifications): New handling for boolean aspects
+ * sem_ch13.ads (Analyze_Aspect_Specifications): New calling sequence
+ * sem_ch3.adb, sem_ch6.adb, sem_ch7.adb, sem_ch9.adb: New calling
+ sequence for Analyze_Aspect_Specifications
+ * sem_prag.adb (Analyze_Pragma): Remove use of Aspect_Cancel entirely
+ * sinfo.ads, sinfo.adb (Aspect_Cancel): Remove, no longer used
+
+2011-08-02 Robert Dewar <dewar@adacore.com>
+
+ * freeze.adb (Freeze_Entity): Remove handling of delayed boolean
+ aspects, since these no longer exist.
+
+2011-08-02 Robert Dewar <dewar@adacore.com>
+
+ * par-ch13.adb (Aspect_Specifications_Present): Always return false on
+ semicolon, do not try to see if there are aspects following it.
+ * par-ch3.adb (P_Declarative_Items): Better message for unexpected
+ aspect spec.
+
+2011-08-02 Robert Dewar <dewar@adacore.com>
+
* sem_ch8.adb, aspects.ads: Minor reformatting.
2011-08-02 Eric Botcazou <ebotcazou@adacore.com>
-- is required to be delayed to the freeze point, so we evaluate the
-- pragma or attribute definition clause in the tree at this point.
- -- We also have to deal with the case of Boolean aspects, where the
- -- value of the Boolean expression is represented by the setting of
- -- the Aspect_Cancel flag on the pragma.
-
if Has_Delayed_Aspects (E) then
declare
Ritem : Node_Id;
then
Aitem := Aspect_Rep_Item (Ritem);
Set_Parent (Aitem, Ritem);
-
- -- Deal with Boolean case, if no expression, True, otherwise
- -- analyze the expression, check it is static, and if its
- -- value is False, set Aspect_Cancel for the related pragma.
-
- if Is_Boolean_Aspect (Ritem) then
- declare
- Expr : constant Node_Id := Expression (Ritem);
-
- begin
- if Present (Expr) then
- Analyze_And_Resolve (Expr, Standard_Boolean);
-
- if not Is_OK_Static_Expression (Expr) then
- Error_Msg_Name_1 := Chars (Identifier (Ritem));
- Error_Msg_N
- ("expression for % aspect must be static",
- Expr);
-
- elsif Is_False (Expr_Value (Expr)) then
- Set_Aspect_Cancel (Aitem);
- end if;
- end if;
- end;
- end if;
-
- -- Analyze the pragma after possibly setting Aspect_Cancel
-
Analyze (Aitem);
end if;
Result : Boolean;
begin
- Save_Scan_State (Scan_State);
-
- -- If we have a semicolon, test for semicolon followed by Aspect
- -- Specifications, in which case we decide the semicolon is accidental.
-
- if Token = Tok_Semicolon then
- Scan; -- past semicolon
+ -- Definitely must have WITH to consider aspect specs to be present
- -- The recursive test is set Strict, since we already have one
- -- error (the unexpected semicolon), so we will ignore that semicolon
- -- only if we absolutely definitely have an aspect specification
- -- following it.
+ -- Note that this means that if we have a semicolon, we immediately
+ -- return False. There is a case in which this is not optimal, namely
+ -- something like
- if Aspect_Specifications_Present (Strict => True) then
- Error_Msg_SP ("|extra "";"" ignored");
- return True;
+ -- type R is new Integer;
+ -- with bla bla;
- else
- Restore_Scan_State (Scan_State);
- return False;
- end if;
- end if;
-
- -- Definitely must have WITH to consider aspect specs to be present
+ -- where the semicolon is redundant, but scanning forward for it would
+ -- be too expensive. Instead we pick up the aspect specifications later
+ -- as a bogus declaration, and diagnose the semicolon at that point.
if Token /= Tok_With then
return False;
when Tok_With =>
Check_Bad_Layout;
- Error_Msg_SC ("WITH can only appear in context clause");
- raise Error_Resync;
+
+ if Aspect_Specifications_Present then
+
+ -- If we are after a semicolon, complain that it was ignored.
+ -- But we don't really ignore it, since we dump the aspects,
+ -- so we make the error message a normal fatal message which
+ -- will inhibit semantic analysis anyway).
+
+ if Prev_Token = Tok_Semicolon then
+ Error_Msg_SP -- CODEFIX
+ ("extra "";"" ignored");
+
+ -- If not just past semicolon, just complain that aspects are
+ -- not allowed at this point.
+
+ else
+ Error_Msg_SC ("aspect specifications not allowed here");
+ end if;
+
+ declare
+ Dummy_Node : constant Node_Id :=
+ New_Node (N_Package_Specification, Token_Ptr);
+ pragma Warnings (Off, Dummy_Node);
+ -- Dummy node to attach aspect specifications to. We will
+ -- then throw them away.
+
+ begin
+ P_Aspect_Specifications (Dummy_Node, Semicolon => True);
+ end;
+
+ -- Here if not aspect specifications case
+
+ else
+ Error_Msg_SC ("WITH can only appear in context clause");
+ raise Error_Resync;
+ end if;
-- BEGIN terminates the scan of a sequence of declarations unless
-- there is a missing subprogram body, see section on handling
-- --
------------------------------------------------------------------------------
-with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Einfo; use Einfo;
Set_Etype (Id, Standard_Exception_Type);
Set_Is_Statically_Allocated (Id);
Set_Is_Pure (Id, PF);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Exception_Declaration;
--------------------------------
end if;
end if;
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Formal_Object_Declaration;
----------------------------------------------
Set_Scope (Pack_Id, Scope (Formal));
Set_Has_Completion (Pack_Id, True);
- <<Leave>>
- Analyze_Aspect_Specifications (N, Pack_Id, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Pack_Id);
+ end if;
end Analyze_Formal_Package_Declaration;
---------------------------------
end if;
end if;
- <<Leave>>
- Analyze_Aspect_Specifications (N, Nam, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Nam);
+ end if;
+
end Analyze_Formal_Subprogram_Declaration;
-------------------------------------
end case;
Set_Is_Generic_Type (T);
- Analyze_Aspect_Specifications (N, T, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, T);
+ end if;
end Analyze_Formal_Type_Declaration;
------------------------------------
end if;
end if;
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Generic_Package_Declaration;
--------------------------------------------
Generate_Reference_To_Formals (Id);
List_Inherited_Pre_Post_Aspects (Id);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Generic_Subprogram_Declaration;
-----------------------------------
Set_Defining_Identifier (N, Act_Decl_Id);
end if;
- <<Leave>>
- Analyze_Aspect_Specifications
- (N, Act_Decl_Id, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Act_Decl_Id);
+ end if;
exception
when Instantiation_Error =>
Generic_Renamings_HTable.Reset;
end if;
- <<Leave>>
- Analyze_Aspect_Specifications
- (N, Act_Decl_Id, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Act_Decl_Id);
+ end if;
exception
when Instantiation_Error =>
-- inherited from a derived type that is no longer appropriate for the
-- new Esize value. In this case, we reset the Alignment to unknown.
- procedure Analyze_Non_Null_Aspect_Specifications
- (N : Node_Id;
- E : Entity_Id;
- L : List_Id);
- -- This procedure is called to analyze aspect specifications for node N.
- -- E is the corresponding entity declared by the declaration node N, and
- -- L is the list of aspect specifications for this node. This procedure
- -- does the real work, as opposed to Analyze_Aspect_Specifications which
- -- is inlined to fast-track the common case.
-
procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id);
-- If Typ has predicates (indicated by Has_Predicates being set for Typ,
-- then either there are pragma Invariant entries on the rep chain for the
-- Analyze_Aspect_Specifications --
-----------------------------------
- procedure Analyze_Aspect_Specifications
- (N : Node_Id;
- E : Entity_Id;
- L : List_Id)
- is
- begin
- -- Return if no aspects
-
- if L = No_List then
- return;
- end if;
-
- Analyze_Non_Null_Aspect_Specifications (N, E, L);
- end Analyze_Aspect_Specifications;
-
- --------------------------------------------
- -- Analyze_Non_Null_Aspect_Specifications --
- --------------------------------------------
-
- procedure Analyze_Non_Null_Aspect_Specifications
- (N : Node_Id;
- E : Entity_Id;
- L : List_Id)
- is
+ procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id) is
Aspect : Node_Id;
Aitem : Node_Id;
Ent : Node_Id;
+ L : constant List_Id := Aspect_Specifications (N);
+
Ins_Node : Node_Id := N;
-- Insert pragmas (except Pre/Post/Invariant/Predicate) after this node
-- Set True if delay is required
begin
+ pragma Assert (Present (L));
+
-- Loop through aspects
Aspect := First (L);
- while Present (Aspect) loop
+ Aspect_Loop : while Present (Aspect) loop
declare
Loc : constant Source_Ptr := Sloc (Aspect);
Id : constant Node_Id := Identifier (Aspect);
Eloc : Source_Ptr := Sloc (Expr);
-- Source location of expression, modified when we split PPC's
+ procedure Check_False_Aspect_For_Derived_Type;
+ -- This procedure checks for the case of a false aspect for a
+ -- derived type, which improperly tries to cancel an aspect
+ -- inherited from the parent;
+
+ -----------------------------------------
+ -- Check_False_Aspect_For_Derived_Type --
+ -----------------------------------------
+
+ procedure Check_False_Aspect_For_Derived_Type is
+ begin
+ -- We are only checking derived types
+
+ if not Is_Derived_Type (E) then
+ return;
+ end if;
+
+ case A_Id is
+ when Aspect_Atomic | Aspect_Shared =>
+ if not Is_Atomic (E) then
+ return;
+ end if;
+
+ when Aspect_Atomic_Components =>
+ if not Has_Atomic_Components (E) then
+ return;
+ end if;
+
+ when Aspect_Discard_Names =>
+ if not Discard_Names (E) then
+ return;
+ end if;
+
+ when Aspect_Pack =>
+ if not Is_Packed (E) then
+ return;
+ end if;
+
+ when Aspect_Unchecked_Union =>
+ if not Is_Unchecked_Union (E) then
+ return;
+ end if;
+
+ when Aspect_Volatile =>
+ if not Is_Volatile (E) then
+ return;
+ end if;
+
+ when Aspect_Volatile_Components =>
+ if not Has_Volatile_Components (E) then
+ return;
+ end if;
+
+ when others =>
+ return;
+ end case;
+
+ -- Fall through means we are canceling an inherited aspect
+
+ Error_Msg_Name_1 := Nam;
+ Error_Msg_NE
+ ("derived type& inherits aspect%, cannot cancel", Expr, E);
+ end Check_False_Aspect_For_Derived_Type;
+
+ -- Start of processing for Aspect_Loop
+
begin
-- Skip aspect if already analyzed (not clear if this is needed)
raise Program_Error;
-- Aspects taking an optional boolean argument. For all of
- -- these we just create a matching pragma and insert it. When
- -- the aspect is processed to insert the pragma, the expression
- -- is analyzed, setting Cancel_Aspect if the value is False.
+ -- these we just create a matching pragma and insert it, if
+ -- the expression is missing or set to True. If the expression
+ -- is False, we can ignore the aspect with the exception that
+ -- in the case of a derived type, we must check for an illegal
+ -- attempt to cancel an inherited aspect.
when Boolean_Aspects =>
Set_Is_Boolean_Aspect (Aspect);
- -- Build corresponding pragma node
+ if Present (Expr)
+ and then Is_False (Static_Boolean (Expr))
+ then
+ Check_False_Aspect_For_Derived_Type;
+ goto Continue;
+ end if;
+
+ -- If True, build corresponding pragma node
Aitem :=
Make_Pragma (Loc,
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)));
- -- No delay required if no expression (nothing to delay!)
-
- if No (Expr) then
- Delay_Required := False;
-
- -- Expression is present, delay is required. Note that
- -- even if the expression is "True", some idiot might
- -- define True as False before the freeze point!
+ -- Never need to delay for boolean aspects
- else
- Delay_Required := True;
- Set_Is_Delayed_Aspect (Aspect);
- end if;
+ Delay_Required := False;
-- Library unit aspects. These are boolean aspects, but we
- -- always evaluate the expression right away if it is present
- -- and just ignore the aspect if the expression is False. We
- -- never delay expression evaluation in this case.
+ -- have to do special things with the insertion, since the
+ -- pragma belongs inside the declarations of a package.
when Library_Unit_Aspects =>
if Present (Expr)
<<Continue>>
Next (Aspect);
- end loop;
- end Analyze_Non_Null_Aspect_Specifications;
+ end loop Aspect_Loop;
+ end Analyze_Aspect_Specifications;
-----------------------
-- Analyze_At_Clause --
procedure Analyze_Record_Representation_Clause (N : Node_Id);
procedure Analyze_Code_Statement (N : Node_Id);
- procedure Analyze_Aspect_Specifications
- (N : Node_Id;
- E : Entity_Id;
- L : List_Id);
- -- This procedure is called to analyze aspect specifications for node N.
- -- E is the corresponding entity declared by the declaration node N, and
- -- L is the list of aspect specifications for this node. If L is No_List,
- -- the call is ignored. Note that we can't use a simpler interface of just
- -- passing the node N, since the analysis of the node may cause it to be
- -- rewritten to a node not permitting aspect specifications.
- pragma Inline (Analyze_Aspect_Specifications);
+ procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id);
+ -- This procedure is called to analyze aspect specifications for node N. E
+ -- is the corresponding entity declared by the declaration node N. Callers
+ -- should check that Has_Aspects (N) is True before calling this routine.
procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id);
-- Called from Freeze where R is a record entity for which reverse bit
-- --
------------------------------------------------------------------------------
-with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
end if;
Set_Original_Record_Component (Id, Id);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Component_Declaration;
--------------------------
Set_Optimize_Alignment_Flags (Def_Id);
Check_Eliminated (Def_Id);
- Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Def_Id);
+ end if;
end Analyze_Full_Type_Declaration;
----------------------------------
end if;
<<Leave>>
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Object_Declaration;
---------------------------
end if;
end if;
- <<Leave>>
- Analyze_Aspect_Specifications (N, T, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, T);
+ end if;
end Analyze_Private_Extension_Declaration;
---------------------------------
Check_Eliminated (Id);
<<Leave>>
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Subtype_Declaration;
--------------------------------
-- --
------------------------------------------------------------------------------
-with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
Generate_Reference_To_Formals (Designator);
Check_Eliminated (Designator);
- Analyze_Aspect_Specifications (N, Designator, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Designator);
+ end if;
end Analyze_Abstract_Subprogram_Declaration;
---------------------------------
end if;
List_Inherited_Pre_Post_Aspects (Designator);
- Analyze_Aspect_Specifications (N, Designator, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Designator);
+ end if;
end Analyze_Subprogram_Declaration;
--------------------------------------
-- handling of private and full declarations, and the construction of dispatch
-- tables for tagged types.
-with Aspects; use Aspects;
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
-- Analye aspect specifications immediately, since we need to recognize
-- things like Pure early enough to diagnose violations during analysis.
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
-- Ada 2005 (AI-217): Check if the package has been erroneously named
-- in a limited-with clause of its own context. In this case the error
New_Private_Type (N, Id, N);
Set_Depends_On_Private (Id);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Private_Type_Declaration;
----------------------------------
end if;
Generate_Reference_To_Formals (Def_Id);
- Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Def_Id);
+ end if;
end Analyze_Entry_Declaration;
---------------------------------------
end if;
end if;
- <<Leave>>
- Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+ <<Leave>>
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Def_Id);
+ end if;
end Analyze_Protected_Type_Declaration;
---------------------
-- disastrous result.
Analyze_Protected_Type_Declaration (N);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Single_Protected_Declaration;
-------------------------------------
-- disastrous result.
Analyze_Task_Type_Declaration (N);
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Single_Task_Declaration;
-----------------------
end if;
end if;
- Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Def_Id);
+ end if;
end Analyze_Task_Type_Declaration;
-----------------------------------
Pname : constant Name_Id := Pragma_Name (N);
Prag_Id : Pragma_Id;
- Sense : constant Boolean := not Aspect_Cancel (N);
- -- Sense is True if we have the normal case of a pragma that is active
- -- and turns the corresponding aspect on. It is false only for the case
- -- of a pragma coming from an aspect which is explicitly turned off by
- -- using aspect => False. If Sense is False, the effect of the pragma
- -- is to turn the corresponding aspect off.
-
Pragma_Exit : exception;
-- This exception is used to exit pragma processing completely. It is
-- used when an error is detected, and no further processing is
procedure Set_Atomic (E : Entity_Id) is
begin
- Set_Is_Atomic (E, Sense);
+ Set_Is_Atomic (E);
- if Sense and then not Has_Alignment_Clause (E) then
+ if not Has_Alignment_Clause (E) then
Set_Alignment (E, Uint_0);
end if;
end Set_Atomic;
-- Attribute belongs on the base type. If the view of the type is
-- currently private, it also belongs on the underlying type.
- Set_Is_Volatile (Base_Type (E), Sense);
- Set_Is_Volatile (Underlying_Type (E), Sense);
+ Set_Is_Volatile (Base_Type (E));
+ Set_Is_Volatile (Underlying_Type (E));
- Set_Treat_As_Volatile (E, Sense);
- Set_Treat_As_Volatile (Underlying_Type (E), Sense);
+ Set_Treat_As_Volatile (E);
+ Set_Treat_As_Volatile (Underlying_Type (E));
elsif K = N_Object_Declaration
or else (K = N_Component_Declaration
end if;
if Prag_Id /= Pragma_Volatile then
- Set_Is_Atomic (E, Sense);
+ Set_Is_Atomic (E);
-- If the object declaration has an explicit initialization, a
-- temporary may have to be created to hold the expression, to
if Nkind (Parent (E)) = N_Object_Declaration
and then Present (Expression (Parent (E)))
- and then Sense
then
Set_Has_Delayed_Freeze (E);
end if;
Get_Source_File_Index (Sloc (E)) =
Get_Source_File_Index (Sloc (Underlying_Type (Etype (E))))
then
- Set_Is_Atomic (Underlying_Type (Etype (E)), Sense);
+ Set_Is_Atomic (Underlying_Type (Etype (E)));
end if;
end if;
Subp_Id : Node_Id;
Subp : Entity_Id;
Applies : Boolean;
+
Effective : Boolean := False;
+ -- Set True if inline has some effect, i.e. if there is at least one
+ -- subprogram set as inlined as a result of the use of the pragma.
procedure Make_Inline (Subp : Entity_Id);
-- Subp is the defining unit name of the subprogram declaration. Set
-- entity (if declared in the same unit) is inlined.
if Is_Subprogram (Subp) then
-
- if not Sense then
- return;
- end if;
-
Inner_Subp := Ultimate_Alias (Inner_Subp);
if In_Same_Source_Unit (Subp, Inner_Subp) then
procedure Set_Inline_Flags (Subp : Entity_Id) is
begin
if Active then
- Set_Is_Inlined (Subp, Sense);
+ Set_Is_Inlined (Subp);
end if;
if not Has_Pragma_Inline (Subp) then
- Set_Has_Pragma_Inline (Subp, Sense);
+ Set_Has_Pragma_Inline (Subp);
Effective := True;
end if;
if Prag_Id = Pragma_Inline_Always then
- Set_Has_Pragma_Inline_Always (Subp, Sense);
+ Set_Has_Pragma_Inline_Always (Subp);
end if;
end Set_Inline_Flags;
-- Now set appropriate Ada mode
- if Sense then
- Ada_Version := Ada_2005;
- else
- Ada_Version := Ada_Version_Default;
- end if;
-
+ Ada_Version := Ada_2005;
Ada_Version_Explicit := Ada_2005;
end if;
end;
-- Now set appropriate Ada mode
- if Sense then
- Ada_Version := Ada_2012;
- else
- Ada_Version := Ada_Version_Default;
- end if;
-
+ Ada_Version := Ada_2012;
Ada_Version_Explicit := Ada_2012;
end if;
end;
E := Base_Type (E);
end if;
- Set_Has_Volatile_Components (E, Sense);
+ Set_Has_Volatile_Components (E);
if Prag_Id = Pragma_Atomic_Components then
- Set_Has_Atomic_Components (E, Sense);
+ Set_Has_Atomic_Components (E);
end if;
else
-- defined in the current declarative part, and recursively
-- to any nested scope.
- Set_Discard_Names (Current_Scope, Sense);
+ Set_Discard_Names (Current_Scope);
return;
else
(Is_Enumeration_Type (E) or else Is_Tagged_Type (E)))
or else Ekind (E) = E_Exception
then
- Set_Discard_Names (E, Sense);
+ Set_Discard_Names (E);
else
Error_Pragma_Arg
("inappropriate entity for pragma%", Arg1);
-- subtype), set the flag on that type.
if Is_Access_Subprogram_Type (Named_Entity) then
- if Sense then
- Set_Can_Use_Internal_Rep (Named_Entity, False);
- end if;
+ Set_Can_Use_Internal_Rep (Named_Entity, False);
-- Otherwise it's an error (name denotes the wrong sort of entity)
else
if not Ignore then
- Set_Is_Packed (Base_Type (Typ), Sense);
- Set_Has_Non_Standard_Rep (Base_Type (Typ), Sense);
+ Set_Is_Packed (Base_Type (Typ));
+ Set_Has_Non_Standard_Rep (Base_Type (Typ));
end if;
- Set_Has_Pragma_Pack (Base_Type (Typ), Sense);
-
- -- Complete reset action for Aspect_Cancel case
-
- if Sense = False then
-
- -- Cancel size unless explicitly set
-
- if not Has_Size_Clause (Typ)
- and then not Has_Object_Size_Clause (Typ)
- then
- Set_Esize (Typ, Uint_0);
- Set_RM_Size (Typ, Uint_0);
- Set_Alignment (Typ, Uint_0);
- Set_Packed_Array_Type (Typ, Empty);
- end if;
-
- -- Reset component size unless explicitly set
-
- if not Has_Component_Size_Clause (Typ) then
- if Known_Static_Esize (Ctyp)
- and then Known_Static_RM_Size (Ctyp)
- and then Esize (Ctyp) = RM_Size (Ctyp)
- and then Addressable (Esize (Ctyp))
- then
- Set_Component_Size
- (Base_Type (Typ), Esize (Ctyp));
- else
- Set_Component_Size
- (Base_Type (Typ), Uint_0);
- end if;
- end if;
- end if;
+ Set_Has_Pragma_Pack (Base_Type (Typ));
end if;
end if;
-- Normal case of pack request active
else
- Set_Is_Packed (Base_Type (Typ), Sense);
- Set_Has_Pragma_Pack (Base_Type (Typ), Sense);
- Set_Has_Non_Standard_Rep (Base_Type (Typ), Sense);
-
- -- Complete reset action for Aspect_Cancel case
-
- if Sense = False then
-
- -- Cancel size if not explicitly given
-
- if not Has_Size_Clause (Typ)
- and then not Has_Object_Size_Clause (Typ)
- then
- Set_Esize (Typ, Uint_0);
- Set_Alignment (Typ, Uint_0);
- end if;
- end if;
+ Set_Is_Packed (Base_Type (Typ));
+ Set_Has_Pragma_Pack (Base_Type (Typ));
+ Set_Has_Non_Standard_Rep (Base_Type (Typ));
end if;
end if;
end if;
Check_Duplicate_Pragma (Ent);
- if Sense then
- Prag :=
- Make_Linker_Section_Pragma
- (Ent, Sloc (N), ".persistent.bss");
- Insert_After (N, Prag);
- Analyze (Prag);
- end if;
+ Prag :=
+ Make_Linker_Section_Pragma
+ (Ent, Sloc (N), ".persistent.bss");
+ Insert_After (N, Prag);
+ Analyze (Prag);
-- Case of use as configuration pragma with no arguments
if Present (Ent)
and then not (Pk = N_Package_Specification
- and then Present (Generic_Parent (Pa)))
+ and then Present (Generic_Parent (Pa)))
then
if not Debug_Flag_U then
- Set_Is_Preelaborated (Ent, Sense);
- Set_Suppress_Elaboration_Warnings (Ent, Sense);
+ Set_Is_Preelaborated (Ent);
+ Set_Suppress_Elaboration_Warnings (Ent);
end if;
end if;
end Preelaborate;
("pragma% requires a function name", Arg1);
end if;
- Set_Is_Pure (Def_Id, Sense);
+ Set_Is_Pure (Def_Id);
if not Has_Pragma_Pure_Function (Def_Id) then
- Set_Has_Pragma_Pure_Function (Def_Id, Sense);
- Effective := Sense;
+ Set_Has_Pragma_Pure_Function (Def_Id);
+ Effective := True;
end if;
exit when From_Aspect_Specification (N);
exit when No (E) or else Scope (E) /= Current_Scope;
end loop;
- if Sense and then not Effective
+ if not Effective
and then Warn_On_Redundant_Constructs
then
Error_Msg_NE
Check_Arg_Count (1);
Check_Optional_Identifier (Arg1, Name_Entity);
Check_Arg_Is_Local_Name (Arg1);
- Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)), Sense);
+ Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)));
----------------------------------
-- Suppress_Exception_Locations --
end loop;
end if;
- Set_Is_Unchecked_Union (Typ, Sense);
-
- if Sense then
- Set_Convention (Typ, Convention_C);
- end if;
-
- Set_Has_Unchecked_Union (Base_Type (Typ), Sense);
- Set_Is_Unchecked_Union (Base_Type (Typ), Sense);
+ Set_Is_Unchecked_Union (Typ);
+ Set_Convention (Typ, Convention_C);
+ Set_Has_Unchecked_Union (Base_Type (Typ));
+ Set_Is_Unchecked_Union (Base_Type (Typ));
end Unchecked_Union;
------------------------
Error_Pragma_Arg ("pragma% requires type", Arg1);
end if;
- Set_Universal_Aliasing (Implementation_Base_Type (E_Id), Sense);
+ Set_Universal_Aliasing (Implementation_Base_Type (E_Id));
end Universal_Alias;
--------------------
("pragma% can only be applied to a variable",
Arg_Expr);
else
- Set_Has_Pragma_Unmodified (Arg_Ent, Sense);
+ Set_Has_Pragma_Unmodified (Arg_Ent);
end if;
end if;
Generate_Reference (Arg_Ent, N);
end if;
- Set_Has_Pragma_Unreferenced (Arg_Ent, Sense);
+ Set_Has_Pragma_Unreferenced (Arg_Ent);
end if;
Next (Arg_Node);
("argument for pragma% must be type or subtype", Arg_Node);
end if;
- Set_Has_Pragma_Unreferenced_Objects (Entity (Arg_Expr), Sense);
+ Set_Has_Pragma_Unreferenced_Objects (Entity (Arg_Expr));
Next (Arg_Node);
end loop;
end Unreferenced_Objects;
return Node3 (N);
end Array_Aggregate;
- function Aspect_Cancel
- (N : Node_Id) return Boolean is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Pragma);
- return Flag11 (N);
- end Aspect_Cancel;
-
function Aspect_Rep_Item
(N : Node_Id) return Node_Id is
begin
Set_Node3_With_Parent (N, Val);
end Set_Array_Aggregate;
- procedure Set_Aspect_Cancel
- (N : Node_Id; Val : Boolean := True) is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Pragma);
- Set_Flag11 (N, Val);
- end Set_Aspect_Cancel;
-
procedure Set_Aspect_Rep_Item
(N : Node_Id; Val : Node_Id) is
begin
-- is used for translation of the at end handler into a normal exception
-- handler.
- -- Aspect_Cancel (Flag11-Sem)
- -- Processing of aspect specifications typically generates pragmas and
- -- attribute definition clauses that are inserted into the tree after
- -- the declaration node to get the desired aspect effect. In the case
- -- of Boolean aspects that use "=> False" to cancel the effect of an
- -- aspect (i.e. turn if off), the generated pragma has the Aspect_Cancel
- -- flag set to indicate that the pragma operates in the opposite sense.
-
-- Aspect_Rep_Item (Node2-Sem)
-- Present in N_Aspect_Specification nodes. Points to the corresponding
-- pragma/attribute definition node used to process the aspect.
-- From_Aspect_Specification (Flag13-Sem)
-- Is_Delayed_Aspect (Flag14-Sem)
-- Import_Interface_Present (Flag16-Sem)
- -- Aspect_Cancel (Flag11-Sem)
-- Split_PPC (Flag17) set if corresponding aspect had Split_PPC set
-- Class_Present (Flag6) set if from Aspect with 'Class
-- From_Dynamic_Predicate (Flag7-Sem) Set if Dynamic_Predicate aspect
function Array_Aggregate
(N : Node_Id) return Node_Id; -- Node3
- function Aspect_Cancel
- (N : Node_Id) return Boolean; -- Flag11
-
function Aspect_Rep_Item
(N : Node_Id) return Node_Id; -- Node2
procedure Set_Array_Aggregate
(N : Node_Id; Val : Node_Id); -- Node3
- procedure Set_Aspect_Cancel
- (N : Node_Id; Val : Boolean := True); -- Flag11
-
procedure Set_Aspect_Rep_Item
(N : Node_Id; Val : Node_Id); -- Node2
pragma Inline (Alternatives);
pragma Inline (Ancestor_Part);
pragma Inline (Array_Aggregate);
- pragma Inline (Aspect_Cancel);
pragma Inline (Aspect_Rep_Item);
pragma Inline (Assignment_OK);
pragma Inline (Associated_Node);
pragma Inline (Set_Alternatives);
pragma Inline (Set_Ancestor_Part);
pragma Inline (Set_Array_Aggregate);
- pragma Inline (Set_Aspect_Cancel);
pragma Inline (Set_Aspect_Rep_Item);
pragma Inline (Set_Assignment_OK);
pragma Inline (Set_Associated_Node);
OSDN Git Service
