2014-07-29 Robert Dewar <dewar@adacore.com>
+ * gnat_rm.texi: Document pragma Unevaluated_Use_Of_Old.
+ * opt.adb: Handle Uneval_Old.
+ * opt.ads (Uneval_Old, Uneval_Old_Config): New variables.
+ * par-prag.adb: Add dummy entry for pragma Unevaluated_Use_Of_Old.
+ * sem.ads (Save_Uneval_Old): New field in Scope_Stack_Entry.
+ * sem_attr.adb (Uneval_Old_Msg): New procedure.
+ * sem_ch8.adb (Push_Scope): Save Uneval_Old.
+ (Pop_Scope): Restore Uneval_Old.
+ * sem_prag.adb (Analyze_Pragma, case Unevaluated_Use_Of_Old):
+ Implemented.
+ * snames.ads-tmpl: Add entries for pragma Unevaluated_Use_Of_Old
+ Add entries for Name_Warn, Name_Allow.
+
+2014-07-29 Robert Dewar <dewar@adacore.com>
+
* sem_aggr.adb (Resolve_Array_Aggregate): Change Is_Static_Range
to Is_OK_Static_Range.
* sem_attr.adb (Eval_Attribute): Make sure we properly flag
-- cases are like this. Notably conversions can involve two types.
if Source_Base_Type = Target_Base_Type then
+
+ -- Insert the explicit range check. Note that we suppress checks for
+ -- this code, since we don't want a recursive range check popping up.
+
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Not_In (Loc,
Left_Opnd => Duplicate_Subexpr (N),
Right_Opnd => New_Occurrence_Of (Target_Type, Loc)),
- Reason => Reason));
+ Reason => Reason),
+ Suppress => All_Checks);
-- Next test for the case where the target type is within the bounds
-- of the base type of the source type, since in this case we can
-- itself does not require a check.
elsif In_Subrange_Of (Target_Type, Source_Base_Type) then
+
+ -- Insert the explicit range check. Note that we suppress checks for
+ -- this code, since we don't want a recursive range check popping up.
+
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Condition =>
Prefix =>
New_Occurrence_Of (Target_Type, Loc),
Attribute_Name => Name_Last)))),
- Reason => Reason));
+ Reason => Reason),
+ Suppress => All_Checks);
-- Note that at this stage we now that the Target_Base_Type is not in
-- the range of the Source_Base_Type (since even the Target_Type itself
-- Then the conversion itself is replaced by an occurrence of Tnn
+ -- Insert the explicit range check. Note that we suppress checks for
+ -- this code, since we don't want a recursive range check popping up.
+
declare
Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
Left_Opnd => New_Occurrence_Of (Tnn, Loc),
Right_Opnd => New_Occurrence_Of (Target_Type, Loc)),
- Reason => Reason)));
+ Reason => Reason)),
+ Suppress => All_Checks);
Rewrite (N, New_Occurrence_Of (Tnn, Loc));
-- Has_Static_Predicate Flag269
-- Stores_Attribute_Old_Prefix Flag270
+ -- (Has_Protected) Flag271
+
-- (unused) Flag1
-- (unused) Flag2
-- (unused) Flag3
- -- (unused) Flag271
-- (unused) Flag272
-- (unused) Flag273
-- (unused) Flag274
return Flag155 (Id);
end Has_Private_Declaration;
+ function Has_Protected (Id : E) return B is
+ begin
+ return Flag271 (Id);
+ end Has_Protected;
+
function Has_Qualified_Name (Id : E) return B is
begin
return Flag161 (Id);
Set_Flag155 (Id, V);
end Set_Has_Private_Declaration;
+ procedure Set_Has_Protected (Id : E; V : B := True) is
+ begin
+ Set_Flag271 (Id, V);
+ end Set_Has_Protected;
+
procedure Set_Has_Qualified_Name (Id : E; V : B := True) is
begin
Set_Flag161 (Id, V);
W ("Has_Primitive_Operations", Flag120 (Id));
W ("Has_Private_Ancestor", Flag151 (Id));
W ("Has_Private_Declaration", Flag155 (Id));
+ W ("Has_Protected", Flag271 (Id));
W ("Has_Qualified_Name", Flag161 (Id));
W ("Has_RACW", Flag214 (Id));
W ("Has_Record_Rep_Clause", Flag65 (Id));
-- indicate if a full type declaration is a completion. Used for semantic
-- checks in E.4(18) and elsewhere.
+-- Has_Protected (Flag271) [base type only]
+-- Defined in all type entities. Set on protected types themselves, and
+-- also (recursively) on any composite type which has a component for
+-- which Has_Protected is set. The meaning is that an allocator for
+-- or declaration of such an object must create the required protected
+-- objects. Note: the flag is not set on access types, even if they
+-- designate an object that Has_Protected.
+
-- Has_Qualified_Name (Flag161)
-- Defined in all entities. Set if the name in the Chars field has
-- been replaced by its qualified name, as used for debug output. See
-- Has_Pragma_Unreferenced_Objects (Flag212)
-- Has_Predicates (Flag250)
-- Has_Primitive_Operations (Flag120) (base type only)
+ -- Has_Protected (Flag271) (base type only)
-- Has_Size_Clause (Flag29)
-- Has_Specified_Layout (Flag100) (base type only)
-- Has_Specified_Stream_Input (Flag190)
function Has_Primitive_Operations (Id : E) return B;
function Has_Private_Ancestor (Id : E) return B;
function Has_Private_Declaration (Id : E) return B;
+ function Has_Protected (Id : E) return B;
function Has_Qualified_Name (Id : E) return B;
function Has_RACW (Id : E) return B;
function Has_Record_Rep_Clause (Id : E) return B;
procedure Set_Has_Primitive_Operations (Id : E; V : B := True);
procedure Set_Has_Private_Ancestor (Id : E; V : B := True);
procedure Set_Has_Private_Declaration (Id : E; V : B := True);
+ procedure Set_Has_Protected (Id : E; V : B := True);
procedure Set_Has_Qualified_Name (Id : E; V : B := True);
procedure Set_Has_RACW (Id : E; V : B := True);
procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True);
pragma Inline (Has_Primitive_Operations);
pragma Inline (Has_Private_Ancestor);
pragma Inline (Has_Private_Declaration);
+ pragma Inline (Has_Protected);
pragma Inline (Has_Qualified_Name);
pragma Inline (Has_RACW);
pragma Inline (Has_Record_Rep_Clause);
pragma Inline (Set_Has_Primitive_Operations);
pragma Inline (Set_Has_Private_Ancestor);
pragma Inline (Set_Has_Private_Declaration);
+ pragma Inline (Set_Has_Protected);
pragma Inline (Set_Has_Qualified_Name);
pragma Inline (Set_Has_RACW);
pragma Inline (Set_Has_Record_Rep_Clause);
procedure Remove_Warning_Messages (N : Node_Id);
-- Remove any warning messages corresponding to the Sloc of N or any
-- of its descendent nodes. No effect if no such warnings. Note that
- -- style messages (identified by the fact that they start with "(style)"
+ -- style messages (identified by the fact that they start with "(style)")
-- are not removed by this call. Basically the idea behind this procedure
-- is to remove warnings about execution conditions from known dead code.
-- If the component contains tasks, so does the array type. This may
-- not be indicated in the array type because the component may have
-- been a private type at the point of definition. Same if component
- -- type is controlled.
+ -- type is controlled or contains protected objects.
- Set_Has_Task (Base, Has_Task (Comp_Typ));
- Set_Has_Controlled_Component (Base,
- Has_Controlled_Component (Comp_Typ)
- or else Is_Controlled (Comp_Typ));
+ Set_Has_Task (Base, Has_Task (Comp_Typ));
+ Set_Has_Protected (Base, Has_Protected (Comp_Typ));
+ Set_Has_Controlled_Component
+ (Base, Has_Controlled_Component
+ (Comp_Typ)
+ or else
+ Is_Controlled (Comp_Typ));
if No (Init_Proc (Base)) then
Check_Stream_Attributes (Def_Id);
end if;
- -- Update task and controlled component flags, because some of the
- -- component types may have been private at the point of the record
- -- declaration. Detect anonymous access-to-controlled components.
+ -- Update task, protected, and controlled component flags, because some
+ -- of the component types may have been private at the point of the
+ -- record declaration. Detect anonymous access-to-controlled components.
Has_AACC := False;
if Has_Task (Comp_Typ) then
Set_Has_Task (Def_Id);
+ end if;
+
+ if Has_Protected (Comp_Typ) then
+ Set_Has_Protected (Def_Id);
+ end if;
-- Do not set Has_Controlled_Component on a class-wide equivalent
-- type. See Make_CW_Equivalent_Type.
- elsif not Is_Class_Wide_Equivalent_Type (Def_Id)
+ if not Is_Class_Wide_Equivalent_Type (Def_Id)
and then (Has_Controlled_Component (Comp_Typ)
or else (Chars (Comp) /= Name_uParent
and then Is_Controlled (Comp_Typ)))
then
Set_Has_Controlled_Component (Def_Id);
+ end if;
-- Non-self-referential anonymous access-to-controlled component
- elsif Ekind (Comp_Typ) = E_Anonymous_Access_Type
+ if Ekind (Comp_Typ) = E_Anonymous_Access_Type
and then Needs_Finalization (Designated_Type (Comp_Typ))
and then Designated_Type (Comp_Typ) /= Def_Id
then
* Pragma Type_Invariant::
* Pragma Type_Invariant_Class::
* Pragma Unchecked_Union::
+* Pragma Unevaluated_Use_Of_Old::
* Pragma Unimplemented_Unit::
* Pragma Universal_Aliasing ::
* Pragma Universal_Data::
* Pragma Type_Invariant::
* Pragma Type_Invariant_Class::
* Pragma Unchecked_Union::
+* Pragma Unevaluated_Use_Of_Old::
* Pragma Unimplemented_Unit::
* Pragma Universal_Aliasing ::
* Pragma Universal_Data::
version in all language modes (Ada 83, Ada 95, and Ada 2005). For full
details, consult the Ada 2012 Reference Manual, section B.3.3.
+@node Pragma Unevaluated_Use_Of_Old
+@unnumberedsec Pragma Unevaluated_Use_Of_Old
+@cindex Attribute Old
+@cindex Attribute Loop_Entry
+@cindex Unevaluated_Use_Of_Old
+@findex Unevaluated_Use_Of_Old
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Unevaluated_Use_Of_Old (Error | Warn | Allow);
+@end smallexample
+
+@noindent
+This pragma controls the processing of attributes Old and Loop_Entry.
+If either of these attributes is used in a potentially unevaluated
+expression (e.g. the then or else parts of an if expression), then
+normally this usage is considered illegal if the prefix of the attribute
+is other than an entity name. The language requires this
+behavior for Old, and GNAT copies the same rule for Loop_Entry.
+
+The reason for this rule is that otherwise, we can have a situation
+where we save the Old value, and this results in an exception, even
+though we might not evaluate the attribute. Consider this example:
+
+@smallexample @c ada
+package UnevalOld is
+ K : Character;
+ procedure U (A : String; C : Boolean) -- ERROR
+ with Post => (if C then A(1)'Old = K else True);
+end;
+@end smallexample
+
+@noindent
+If procedure U is called with a string with a lower bound of 2, and
+C false, then an exception would be raised trying to evaluate A(1)
+on entry even though the value would not be actually used.
+
+Although the rule guarantees against this possibility, it is sometimes
+too restrictive. For example if we know that the string has a lower
+bound of 1, then we will never raise an exception.
+The pragma @code{Unevaluated_Use_Of_Old} can be
+used to modify this behavior. If the argument is @code{Error} then an
+error is given (this is the default RM behavior). If the argument is
+@code{Warn} then the usage is allowed as legal but with a warning
+that an exception might be raised. If the argument is @code{Allow}
+then the usage is allowed as legal without generating a warning.
+
+This pragma may appear as a configuration pragma, or in a declarative
+part or package specification. In the latter case it applies to
+uses up to the end of the corresponding statement sequence or
+sequence of package declarations.
+
@node Pragma Unimplemented_Unit
@unnumberedsec Pragma Unimplemented_Unit
@findex Unimplemented_Unit
Short_Descriptors_Config := Short_Descriptors;
SPARK_Mode_Config := SPARK_Mode;
SPARK_Mode_Pragma_Config := SPARK_Mode_Pragma;
+ Uneval_Old_Config := Uneval_Old;
Use_VADS_Size_Config := Use_VADS_Size;
Warnings_As_Errors_Count_Config := Warnings_As_Errors_Count;
Short_Descriptors := Save.Short_Descriptors;
SPARK_Mode := Save.SPARK_Mode;
SPARK_Mode_Pragma := Save.SPARK_Mode_Pragma;
+ Uneval_Old := Save.Uneval_Old;
Use_VADS_Size := Save.Use_VADS_Size;
Warnings_As_Errors_Count := Save.Warnings_As_Errors_Count;
Save.Short_Descriptors := Short_Descriptors;
Save.SPARK_Mode := SPARK_Mode;
Save.SPARK_Mode_Pragma := SPARK_Mode_Pragma;
+ Save.Uneval_Old := Uneval_Old;
Save.Use_VADS_Size := Use_VADS_Size;
Save.Warnings_As_Errors_Count := Warnings_As_Errors_Count;
end Save_Opt_Config_Switches;
External_Name_Imp_Casing := Lowercase;
Optimize_Alignment := 'O';
Persistent_BSS_Mode := False;
+ Uneval_Old := 'E';
Use_VADS_Size := False;
Optimize_Alignment_Local := True;
Persistent_BSS_Mode := Persistent_BSS_Mode_Config;
SPARK_Mode := SPARK_Mode_Config;
SPARK_Mode_Pragma := SPARK_Mode_Pragma_Config;
+ Uneval_Old := Uneval_Old_Config;
Use_VADS_Size := Use_VADS_Size_Config;
Warnings_As_Errors_Count := Warnings_As_Errors_Count_Config;
-- file for the compiler. Indicates that while preprocessing sources,
-- symbols that are not defined have the value FALSE.
+ Uneval_Old : Character := 'E';
+ -- GNAT
+ -- Set to 'E'/'W'/'A' for use of Error/Warn/Allow in a valid pragma
+ -- Unevaluated_Use_Of_Old.
+
Unique_Error_Tag : Boolean := Tag_Errors;
-- GNAT
-- Indicates if error messages are to be prefixed by the string error:
-- If a SPARK_Mode pragma appeared in the configuration pragmas (setting
-- SPARK_Mode_Config appropriately), then this points to the N_Pragma node.
+ Uneval_Old_Config : Character;
+ -- GNAT
+ -- The setting of Uneval_Old from configuration pragmas
+
Use_VADS_Size_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch that controls the use of
Short_Descriptors : Boolean;
SPARK_Mode : SPARK_Mode_Type;
SPARK_Mode_Pragma : Node_Id;
+ Uneval_Old : Character;
Use_VADS_Size : Boolean;
Warnings_As_Errors_Count : Natural;
end record;
Pragma_Type_Invariant |
Pragma_Type_Invariant_Class |
Pragma_Unchecked_Union |
+ Pragma_Unevaluated_Use_Of_Old |
Pragma_Unimplemented_Unit |
Pragma_Universal_Aliasing |
Pragma_Universal_Data |
Save_SPARK_Mode_Pragma : Node_Id;
-- Setting of SPARK_Mode_Pragma on entry to restore on exit
+ Save_Uneval_Old : Character;
+ -- Setting of Uneval_Old on entry to restore on exit
+
Is_Transient : Boolean;
-- Marks transient scopes (see Exp_Ch7 body for details)
-- node is rewritten with an integer literal of the given value which
-- is marked as static.
+ procedure Uneval_Old_Msg;
+ -- Called when Loop_Entry or Old is used in a potentially unevaluated
+ -- expression. Generates appropriate message or warning depending on
+ -- the setting of Opt.Uneval_Old. The caller has put the Name_Id of
+ -- the attribute in Error_Msg_Name_1 prior to the call.
+
procedure Unexpected_Argument (En : Node_Id);
-- Signal unexpected attribute argument (En is the argument)
Set_Is_Static_Expression (N, True);
end Standard_Attribute;
+ --------------------
+ -- Uneval_Old_Msg --
+ --------------------
+
+ procedure Uneval_Old_Msg is
+ begin
+ case Uneval_Old is
+ when 'E' =>
+ Error_Attr_P
+ ("prefix of attribute % that is potentially "
+ & "unevaluated must denote an entity");
+
+ when 'W' =>
+ Error_Attr_P
+ ("??prefix of attribute % appears in potentially "
+ & "unevaluated context, exception may be raised");
+
+ when 'A' =>
+ null;
+
+ when others =>
+ raise Program_Error;
+ end case;
+ end Uneval_Old_Msg;
+
-------------------------
-- Unexpected Argument --
-------------------------
& "outer loop must denote an entity");
elsif Is_Potentially_Unevaluated (P) then
- Error_Attr_P
- ("prefix of attribute % that is potentially "
- & "unevaluated must denote an entity");
+ Uneval_Old_Msg;
end if;
-- Finally, if the Loop_Entry attribute appears within a pragma
and then Is_Potentially_Unevaluated (N)
and then not Is_Entity_Name (P)
then
- Error_Attr_P
- ("prefix of attribute % that is potentially unevaluated must "
- & "denote an entity");
+ Uneval_Old_Msg;
end if;
-- The attribute appears within a pre/postcondition, but refers to
-- Note that Has_Task is always false, since the access type itself
-- is not a task type. See Einfo for more description on this point.
- -- Exactly the same consideration applies to Has_Controlled_Component.
+ -- Exactly the same consideration applies to Has_Controlled_Component
+ -- and to Has_Protected.
- Set_Has_Task (T, False);
+ Set_Has_Task (T, False);
Set_Has_Controlled_Component (T, False);
+ Set_Has_Protected (T, False);
-- Initialize field Finalization_Master explicitly to Empty, to avoid
-- problems where an incomplete view of this entity has been previously
Set_Etype (T, Parent_Base);
Set_Has_Task (T, Has_Task (Parent_Base));
+ Set_Has_Protected (T, Has_Task (Parent_Base));
Set_Convention (T, Convention (Parent_Type));
Set_First_Rep_Item (T, First_Rep_Item (Parent_Type));
Set_First_Index (Implicit_Base, First_Index (T));
Set_Component_Type (Implicit_Base, Element_Type);
Set_Has_Task (Implicit_Base, Has_Task (Element_Type));
+ Set_Has_Protected (Implicit_Base, Has_Protected (Element_Type));
Set_Component_Size (Implicit_Base, Uint_0);
Set_Packed_Array_Impl_Type (Implicit_Base, Empty);
Set_Has_Controlled_Component
Set_First_Index (T, First (Subtype_Marks (Def)));
Set_Has_Delayed_Freeze (T, True);
Set_Has_Task (T, Has_Task (Element_Type));
+ Set_Has_Protected (T, Has_Protected (Element_Type));
Set_Has_Controlled_Component (T, Has_Controlled_Component
(Element_Type)
or else
Set_Scope (Derived_Type, Current_Scope);
- Set_Ekind (Derived_Type, Ekind (Parent_Base));
- Set_Etype (Derived_Type, Parent_Base);
- Set_Has_Task (Derived_Type, Has_Task (Parent_Base));
+ Set_Etype (Derived_Type, Parent_Base);
+ Set_Ekind (Derived_Type, Ekind (Parent_Base));
+ Set_Has_Task (Derived_Type, Has_Task (Parent_Base));
+ Set_Has_Protected (Derived_Type, Has_Protected (Parent_Base));
Set_Size_Info (Derived_Type, Parent_Type);
Set_RM_Size (Derived_Type, RM_Size (Parent_Type));
Set_Component_Size (T1, Component_Size (T2));
Set_Has_Controlled_Component (T1, Has_Controlled_Component (T2));
Set_Has_Non_Standard_Rep (T1, Has_Non_Standard_Rep (T2));
+ Set_Has_Protected (T1, Has_Protected (T2));
Set_Has_Task (T1, Has_Task (T2));
Set_Is_Packed (T1, Is_Packed (T2));
Set_Has_Aliased_Components (T1, Has_Aliased_Components (T2));
Set_Class_Wide_Type
(Base_Type (Full_T), Class_Wide_Type (Priv_T));
- Set_Has_Task (Class_Wide_Type (Priv_T), Has_Task (Full_T));
+ Set_Has_Task (Class_Wide_Type (Priv_T), Has_Task (Full_T));
+ Set_Has_Protected
+ (Class_Wide_Type (Priv_T), Has_Protected (Full_T));
end if;
end;
end if;
Set_Has_Task (T);
end if;
+ if Has_Protected (Etype (Component)) then
+ Set_Has_Protected (T);
+ end if;
+
if Ekind (Component) /= E_Component then
null;
-- a similar test should be applied to an allocator with a
-- qualified expression ???
- if Is_Protected_Type (Type_Id) then
+ if Has_Protected (Type_Id) then
Check_Restriction (No_Protected_Type_Allocators, N);
end if;
-- Check that an allocator of a nested access type doesn't create a
-- protected object when restriction No_Local_Protected_Objects applies.
- -- We don't have an equivalent to Has_Task for protected types, so only
- -- cases where the designated type itself is a protected type are
- -- currently checked. ???
- if Is_Protected_Type (Designated_Type (Acc_Type))
+ if Has_Protected (Designated_Type (Acc_Type))
and then not Is_Library_Level_Entity (Acc_Type)
then
Check_Restriction (No_Local_Protected_Objects, N);
if Priv_Is_Base_Type then
Set_Is_Controlled (Priv, Is_Controlled (Base_Type (Full)));
- Set_Finalize_Storage_Only (Priv, Finalize_Storage_Only
- (Base_Type (Full)));
- Set_Has_Task (Priv, Has_Task (Base_Type (Full)));
- Set_Has_Controlled_Component (Priv, Has_Controlled_Component
- (Base_Type (Full)));
+ Set_Finalize_Storage_Only
+ (Priv, Finalize_Storage_Only
+ (Base_Type (Full)));
+ Set_Has_Task (Priv, Has_Task (Base_Type (Full)));
+ Set_Has_Protected (Priv, Has_Protected (Base_Type (Full)));
+ Set_Has_Controlled_Component
+ (Priv, Has_Controlled_Component
+ (Base_Type (Full)));
end if;
Set_Freeze_Node (Priv, Freeze_Node (Full));
Default_Pool := SST.Save_Default_Storage_Pool;
SPARK_Mode := SST.Save_SPARK_Mode;
SPARK_Mode_Pragma := SST.Save_SPARK_Mode_Pragma;
+ Uneval_Old := SST.Save_Uneval_Old;
if Debug_Flag_W then
Write_Str ("<-- exiting scope: ");
SST.Save_Default_Storage_Pool := Default_Pool;
SST.Save_SPARK_Mode := SPARK_Mode;
SST.Save_SPARK_Mode_Pragma := SPARK_Mode_Pragma;
+ SST.Save_Uneval_Old := Uneval_Old;
if Scope_Stack.Last > Scope_Stack.First then
SST.Component_Alignment_Default := Scope_Stack.Table
or else Has_Task (Etype (E))
then
Set_Has_Task (Current_Scope);
+
+ elsif Is_Protected_Type (Etype (E))
+ or else Has_Protected (Etype (E))
+ then
+ Set_Has_Protected (Current_Scope);
end if;
Next_Entity (E);
Set_Ekind (T, E_Protected_Type);
Set_Is_First_Subtype (T, True);
+ Set_Has_Protected (T, True);
Init_Size_Align (T);
Set_Etype (T, T);
Set_Has_Delayed_Freeze (T, True);
Ada_2005_Pragma;
Process_Suppress_Unsuppress (False);
+ ----------------------------
+ -- Unevaluated_Use_Of_Old --
+ ----------------------------
+
+ -- pragma Unevaluated_Use_Of_Old (Error | Warn | Allow);
+
+ when Pragma_Unevaluated_Use_Of_Old =>
+ GNAT_Pragma;
+ Check_Arg_Count (1);
+ Check_No_Identifiers;
+ Check_Arg_Is_One_Of (Arg1, Name_Error, Name_Warn, Name_Allow);
+
+ -- Suppress/Unsuppress can appear as a configuration pragma, or in
+ -- a declarative part or a package spec.
+
+ if not Is_Configuration_Pragma then
+ Check_Is_In_Decl_Part_Or_Package_Spec;
+ end if;
+
+ -- Store proper setting of Uneval_Old
+
+ Get_Name_String (Chars (Get_Pragma_Arg (Arg1)));
+ Uneval_Old := Fold_Upper (Name_Buffer (1));
+
-------------------
-- Use_VADS_Size --
-------------------
Pragma_Unreferenced_Objects => -1,
Pragma_Unreserve_All_Interrupts => -1,
Pragma_Unsuppress => 0,
+ Pragma_Unevaluated_Use_Of_Old => 0,
Pragma_Use_VADS_Size => -1,
Pragma_Validity_Checks => -1,
Pragma_Volatile => 0,
Name_Suppress : constant Name_Id := N + $;
Name_Suppress_Exception_Locations : constant Name_Id := N + $; -- GNAT
Name_Task_Dispatching_Policy : constant Name_Id := N + $;
+ Name_Unevaluated_Use_Of_Old : constant Name_Id := N + $; -- GNAT
Name_Universal_Data : constant Name_Id := N + $; -- AAMP
Name_Unsuppress : constant Name_Id := N + $; -- Ada 05
Name_Use_VADS_Size : constant Name_Id := N + $; -- GNAT
-- Other special names used in processing pragmas
+ Name_Allow : constant Name_Id := N + $;
Name_Amount : constant Name_Id := N + $;
Name_As_Is : constant Name_Id := N + $;
Name_Assertion : constant Name_Id := N + $;
Name_Vector : constant Name_Id := N + $;
Name_VMS : constant Name_Id := N + $;
Name_Vtable_Ptr : constant Name_Id := N + $;
+ Name_Warn : constant Name_Id := N + $;
Name_Working_Storage : constant Name_Id := N + $;
-- Names of recognized attributes. The entries with the comment "Ada 83"
Pragma_Suppress,
Pragma_Suppress_Exception_Locations,
Pragma_Task_Dispatching_Policy,
+ Pragma_Unevaluated_Use_Of_Old,
Pragma_Universal_Data,
Pragma_Unsuppress,
Pragma_Use_VADS_Size,
projects / platform / upstream / gcc.git / commitdiff