+2011-08-05 Robert Dewar <dewar@adacore.com>
+
+ * a-cbmutr.adb: Minor reformatting
+ (Allocate_Node): refactor node allocation algorithm
+
+2011-08-05 Robert Dewar <dewar@adacore.com>
+
+ * opt.ads, opt.adb (Debug_Pragmas_Disabled): New switch.
+ * sem_prag.adb (Analyze_Pragma, case Debug_Policy): Implement Disable
+ mode.
+ (Analyze_Pragma, case Check_Policy): Ditto.
+ * sem_prag.ads (Check_Disabled): New function
+ * snames.ads-tmpl: Add Name_Disable.
+
+2011-08-05 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: Document implementation-defined policy DISABLE for
+ pragmas Assertion_Policy, Check_Policy, Debug_Policy.
+
2011-08-05 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Analyze_Pragma, case Inline): reject an Inline pragma
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2011, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
procedure Initialize_Node (Container : in out Tree; Index : Count_Type);
procedure Initialize_Root (Container : in out Tree);
+ procedure Allocate_Node
+ (Container : in out Tree;
+ Initialize_Element : not null access procedure (Index : Count_Type);
+ New_Node : out Count_Type);
+
procedure Allocate_Node
(Container : in out Tree;
New_Item : Element_Type;
-------------------
procedure Allocate_Node
- (Container : in out Tree;
- New_Item : Element_Type;
- New_Node : out Count_Type)
+ (Container : in out Tree;
+ Initialize_Element : not null access procedure (Index : Count_Type);
+ New_Node : out Count_Type)
is
begin
if Container.Free >= 0 then
New_Node := Container.Free;
+ pragma Assert (New_Node in Container.Elements'Range);
-- We always perform the assignment first, before we change container
-- state, in order to defend against exceptions duration assignment.
- Container.Elements (New_Node) := New_Item;
+ Initialize_Element (New_Node);
+
Container.Free := Container.Nodes (New_Node).Next;
else
-- the end of the array (Nodes'Last).
New_Node := abs Container.Free;
+ pragma Assert (New_Node in Container.Elements'Range);
-- As above, we perform this assignment first, before modifying any
-- container state.
- Container.Elements (New_Node) := New_Item;
+ Initialize_Element (New_Node);
+
Container.Free := Container.Free - 1;
+
+ if abs Container.Free > Container.Capacity then
+ Container.Free := 0;
+ end if;
end if;
Initialize_Node (Container, New_Node);
procedure Allocate_Node
(Container : in out Tree;
- Stream : not null access Root_Stream_Type'Class;
+ New_Item : Element_Type;
New_Node : out Count_Type)
is
- begin
- if Container.Free >= 0 then
- New_Node := Container.Free;
-
- -- We always perform the assignment first, before we change container
- -- state, in order to defend against exceptions duration assignment.
+ procedure Initialize_Element (Index : Count_Type);
- Element_Type'Read (Stream, Container.Elements (New_Node));
- Container.Free := Container.Nodes (New_Node).Next;
-
- else
- -- A negative free store value means that the links of the nodes in
- -- the free store have not been initialized. In this case, the nodes
- -- are physically contiguous in the array, starting at the index that
- -- is the absolute value of the Container.Free, and continuing until
- -- the end of the array (Nodes'Last).
+ procedure Initialize_Element (Index : Count_Type) is
+ begin
+ Container.Elements (Index) := New_Item;
+ end Initialize_Element;
- New_Node := abs Container.Free;
+ begin
+ Allocate_Node (Container, Initialize_Element'Access, New_Node);
+ end Allocate_Node;
- -- As above, we perform this assignment first, before modifying any
- -- container state.
+ procedure Allocate_Node
+ (Container : in out Tree;
+ Stream : not null access Root_Stream_Type'Class;
+ New_Node : out Count_Type)
+ is
+ procedure Initialize_Element (Index : Count_Type);
- Element_Type'Read (Stream, Container.Elements (New_Node));
- Container.Free := Container.Free - 1;
- end if;
+ procedure Initialize_Element (Index : Count_Type) is
+ begin
+ Element_Type'Read (Stream, Container.Elements (Index));
+ end Initialize_Element;
- Initialize_Node (Container, New_Node);
+ begin
+ Allocate_Node (Container, Initialize_Element'Access, New_Node);
end Allocate_Node;
procedure Allocate_Node
(Container : in out Tree;
New_Node : out Count_Type)
is
+ procedure Initialize_Element (Index : Count_Type) is null;
begin
- if Container.Free >= 0 then
- New_Node := Container.Free;
- Container.Free := Container.Nodes (New_Node).Next;
-
- else
- -- A negative free store value means that the links of the nodes in
- -- the free store have not been initialized. In this case, the nodes
- -- are physically contiguous in the array, starting at the index that
- -- is the absolute value of the Container.Free, and continuing until
- -- the end of the array (Nodes'Last).
-
- New_Node := abs Container.Free;
- Container.Free := Container.Free - 1;
- end if;
-
- Initialize_Node (Container, New_Node);
+ Allocate_Node (Container, Initialize_Element'Access, New_Node);
end Allocate_Node;
-------------------
with "Target capacity is less than Source count";
end if;
- Target.Clear; -- checks busy bit
+ Target.Clear; -- Checks busy bit
if Source.Count = 0 then
return;
if Parent.Container.Count = 0 then
pragma Assert (Is_Root (Parent));
pragma Assert (Child = Parent);
-
return 0;
end if;
-- the "normal" way: Container.Free points to the head of the list of
-- free (inactive) nodes, and the value 0 means the free list is
-- empty. Each node on the free list has been initialized to point to
- -- the next free node (via its Next component), and the value -1 means
- -- that this is the last free node.
+ -- the next free node (via its Next component), and the value 0 means
+ -- that this is the last node of the free list.
--
-- If Container.Free is negative, then the links on the free store have
-- not been initialized. In this case the link values are implied: the
-- the array (Nodes'Last).
--
-- We prefer to lazy-init the free store (in fact, we would prefer to
- -- not initialize it at all). The time when we need to actually
- -- initialize the nodes in the free store is if the node that becomes
- -- inactive is not at the end of the active list. The free store would
- -- then be discontigous and so its nodes would need to be linked in the
- -- traditional way.
+ -- not initialize it at all, because such initialization is an O(n)
+ -- operation). The time when we need to actually initialize the nodes in
+ -- the free store is when the node that becomes inactive is not at the
+ -- end of the active list. The free store would then be discontigous and
+ -- so its nodes would need to be linked in the traditional way.
--
-- It might be possible to perform an optimization here. Suppose that
-- the free store can be represented as having two parts: one comprising
-- nodes become inactive. ???
-- When an element is deleted from the list container, its node becomes
- -- inactive, and so we set its Prev component to a negative value, to
- -- indicate that it is now inactive. This provides a useful way to
- -- detect a dangling cursor reference.
+ -- inactive, and so we set its Parent and Prev components to an
+ -- impossible value (the index of the node itself), to indicate that it
+ -- is now inactive. This provides a useful way to detect a dangling
+ -- cursor reference.
N.Parent := X; -- Node is deallocated (not on active list)
N.Prev := X;
if Container.Free >= 0 then
- -- The free store has previously been initialized. All we need to
- -- do here is link the newly-free'd node onto the free list.
+ -- The free store has previously been initialized. All we need to do
+ -- here is link the newly-free'd node onto the free list.
N.Next := Container.Free;
Container.Free := X;
-- inactive immediately precedes the start of the free store. All
-- we need to do is move the start of the free store back by one.
- N.Next := -1; -- Not strictly necessary, but marginally safer
+ N.Next := X; -- Not strictly necessary, but marginally safer
Container.Free := Container.Free + 1;
else
-- See the comments above for an optimization opportunity. If the
-- next link for a node on the free store is negative, then this
-- means the remaining nodes on the free store are physically
- -- contiguous, starting as the absolute value of that index
- -- value. ???
+ -- contiguous, starting at the absolute value of that index value.
+ -- ???
Container.Free := abs Container.Free;
NN (J).Next := J + 1;
end loop;
- NN (Container.Capacity).Next := -1;
+ NN (Container.Capacity).Next := 0;
end if;
NN (X).Next := Container.Free;
begin
-- This is a simple utility operation to insert a list of nodes
-- (First..Last) as children of Parent. The Before node specifies where
- -- the new children should be inserted relative to the existing
- -- children.
+ -- the new children should be inserted relative to existing children.
if First <= 0 then
pragma Assert (Last <= 0);
CC : Children_Type renames NN (N.Parent).Children;
begin
- -- This is a utility operation to remove a subtree
- -- node from its parent's list of children.
+ -- This is a utility operation to remove a subtree node from its
+ -- parent's list of children.
if CC.First = Subtree then
pragma Assert (N.Prev <= 0);
---------------------
procedure Splice_Children
- (Target : in out Tree;
- Target_Parent : Cursor;
- Before : Cursor;
- Source : in out Tree;
- Source_Parent : Cursor)
+ (Target : in out Tree;
+ Target_Parent : Cursor;
+ Before : Cursor;
+ Source : in out Tree;
+ Source_Parent : Cursor)
is
begin
if Target_Parent = No_Element then
-- Before we attempt the insertion, we must count the sources nodes in
-- order to determine whether the target have enough storage
-- available. Note that calculating this value is an O(n) operation.
- --
+
-- Here is an optimization opportunity: iterate of each children the
-- source explicitly, and keep a running count of the total number of
-- nodes. Compare the running total to the capacity of the target each
-- pass through the loop. This is more efficient than summing the counts
-- of child subtree (which is what Subtree_Node_Count does) and then
-- comparing that total sum to the target's capacity. ???
- --
+
-- Here is another possibility. We currently treat the splice as an
-- all-or-nothing proposition: either we can insert all of children of
-- the source, or we raise exception with modifying the target. The
end if;
if Is_Root (Position) then
+
-- Should this be PE instead? Need ARG confirmation. ???
+
raise Constraint_Error with "Position cursor designates root";
end if;
* Pragma Ada_2012::
* Pragma Annotate::
* Pragma Assert::
+* Pragma Assertion_Policy::
* Pragma Assume_No_Invalid_Values::
* Pragma Ast_Entry::
* Pragma C_Pass_By_Copy::
* Pragma Ada_2012::
* Pragma Annotate::
* Pragma Assert::
+* Pragma Assertion_Policy::
* Pragma Assume_No_Invalid_Values::
* Pragma Ast_Entry::
* Pragma C_Pass_By_Copy::
semantic correctness whether or not assertions are enabled, so turning
assertions on and off cannot affect the legality of a program.
+Note that the implementation defined policy @code{DISABLE}, given in a
+pragma Assertion_Policy, can be used to suppress this semantic analysis.
+
+Note: this is a standard language-defined pragma in versions
+of Ada from 2005 on. In GNAT, it is implemented in all versions
+of Ada, and the DISABLE policy is an implementation-defined
+addition.
+
+
+@node Pragma Assertion_Policy
+@unnumberedsec Pragma Assertion_Policy
+@findex Debug_Policy
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Assertion_Policy (CHECK | DISABLE | IGNORE);
+@end smallexample
+
+@noindent
+If the argument is @code{CHECK}, then pragma @code{Assert} is enabled.
+If the argument is @code{IGNORE}, then pragma @code{Assert} is ignored.
+This pragma overrides the effect of the @option{-gnata} switch on the
+command line.
+
+The implementation defined policy @code{DISABLE} is like
+@code{IGNORE} except that it completely disables semantic
+checking of the argument to @code{pragma Assert}. This may
+be useful when the pragma argument references subprograms
+in a with'ed package which is replaced by a dummy package
+for the final build.
+
+Note: this is a standard language-defined pragma in versions
+of Ada from 2005 on. In GNAT, it is implemented in all versions
+of Ada, and the DISABLE policy is an implementation-defined
+addition.
+
@node Pragma Assume_No_Invalid_Values
@unnumberedsec Pragma Assume_No_Invalid_Values
@findex Assume_No_Invalid_Values
([Name =>] Identifier,
[Policy =>] POLICY_IDENTIFIER);
-POLICY_IDENTIFIER ::= On | Off | Check | Ignore
+POLICY_IDENTIFIER ::= ON | OFF | CHECK | DISABLE | IGNORE
@end smallexample
@noindent
associated @code{Check} pragmas. For example, if the pragma:
@smallexample @c ada
-pragma Check_Policy (Critical_Error, Off);
+pragma Check_Policy (Critical_Error, OFF);
@end smallexample
@noindent
of the name @code{Postcondition} controls whether @code{Postcondition} pragmas
are recognized.
-The check policy is @code{Off} to turn off corresponding checks, and @code{On}
+The check policy is @code{OFF} to turn off corresponding checks, and @code{ON}
to turn on corresponding checks. The default for a set of checks for which no
-@code{Check_Policy} is given is @code{Off} unless the compiler switch
+@code{Check_Policy} is given is @code{OFF} unless the compiler switch
@option{-gnata} is given, which turns on all checks by default.
-The check policy settings @code{Check} and @code{Ignore} are also recognized
-as synonyms for @code{On} and @code{Off}. These synonyms are provided for
+The check policy settings @code{CHECK} and @code{IGNORE} are also recognized
+as synonyms for @code{ON} and @code{OFF}. These synonyms are provided for
compatibility with the standard @code{Assertion_Policy} pragma.
+The implementation defined policy @code{DISABLE} is like
+@code{OFF} except that it completely disables semantic
+checking of the argument to the corresponding class of
+pragmas. This may be useful when the pragma arguments reference
+subprograms in a with'ed package which is replaced by a dummy package
+for the final build.
+
@node Pragma Comment
@unnumberedsec Pragma Comment
@findex Comment
Syntax:
@smallexample @c ada
-pragma Debug_Policy (CHECK | IGNORE);
+pragma Debug_Policy (CHECK | DISABLE | IGNORE);
@end smallexample
@noindent
This pragma overrides the effect of the @option{-gnata} switch on the
command line.
+The implementation defined policy @code{DISABLE} is like
+@code{IGNORE} except that it completely disables semantic
+checking of the argument to @code{pragma Debug}. This may
+be useful when the pragma argument references subprograms
+in a with'ed package which is replaced by a dummy package
+for the final build.
+
@node Pragma Detect_Blocking
@unnumberedsec Pragma Detect_Blocking
@findex Detect_Blocking
Assertions_Enabled_Config := Assertions_Enabled;
Assume_No_Invalid_Values_Config := Assume_No_Invalid_Values;
Check_Policy_List_Config := Check_Policy_List;
+ Debug_Pragmas_Disabled_Config := Debug_Pragmas_Disabled;
Debug_Pragmas_Enabled_Config := Debug_Pragmas_Enabled;
Default_Pool_Config := Default_Pool;
Dynamic_Elaboration_Checks_Config := Dynamic_Elaboration_Checks;
Assertions_Enabled := Save.Assertions_Enabled;
Assume_No_Invalid_Values := Save.Assume_No_Invalid_Values;
Check_Policy_List := Save.Check_Policy_List;
+ Debug_Pragmas_Disabled := Save.Debug_Pragmas_Disabled;
Debug_Pragmas_Enabled := Save.Debug_Pragmas_Enabled;
Default_Pool := Save.Default_Pool;
Dynamic_Elaboration_Checks := Save.Dynamic_Elaboration_Checks;
Save.Assertions_Enabled := Assertions_Enabled;
Save.Assume_No_Invalid_Values := Assume_No_Invalid_Values;
Save.Check_Policy_List := Check_Policy_List;
+ Save.Debug_Pragmas_Disabled := Debug_Pragmas_Disabled;
Save.Debug_Pragmas_Enabled := Debug_Pragmas_Enabled;
Save.Default_Pool := Default_Pool;
Save.Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks;
if Main_Unit then
Assertions_Enabled := Assertions_Enabled_Config;
Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
+ Debug_Pragmas_Disabled := Debug_Pragmas_Disabled_Config;
Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
Check_Policy_List := Check_Policy_List_Config;
else
Assertions_Enabled := False;
Assume_No_Invalid_Values := False;
+ Debug_Pragmas_Disabled := False;
Debug_Pragmas_Enabled := False;
Check_Policy_List := Empty;
end if;
Assertions_Enabled := Assertions_Enabled_Config;
Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
Check_Policy_List := Check_Policy_List_Config;
+ Debug_Pragmas_Disabled := Debug_Pragmas_Disabled_Config;
Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config;
Extensions_Allowed := Extensions_Allowed_Config;
Tree_Read_Bool (All_Errors_Mode);
Tree_Read_Bool (Assertions_Enabled);
Tree_Read_Int (Int (Check_Policy_List));
+ Tree_Read_Bool (Debug_Pragmas_Disabled);
Tree_Read_Bool (Debug_Pragmas_Enabled);
Tree_Read_Int (Int (Default_Pool));
Tree_Read_Bool (Enable_Overflow_Checks);
Tree_Write_Bool (All_Errors_Mode);
Tree_Write_Bool (Assertions_Enabled);
Tree_Write_Int (Int (Check_Policy_List));
+ Tree_Write_Bool (Debug_Pragmas_Disabled);
Tree_Write_Bool (Debug_Pragmas_Enabled);
Tree_Write_Int (Int (Default_Pool));
Tree_Write_Bool (Enable_Overflow_Checks);
-- GNAT
-- Enable debug statements from pragma Debug
+ Debug_Pragmas_Disabled : Boolean := False;
+ -- GNAT
+ -- Debug pragmas completely disabled (no semantic checking)
+
subtype Debug_Level_Value is Nat range 0 .. 3;
Debugger_Level : Debug_Level_Value := 0;
-- GNATBIND
-- terminated by Empty. The order is most recently processed first. This
-- list includes only those pragmas in configuration pragma files.
+ Debug_Pragmas_Disabled_Config : Boolean;
+ -- GNAT
+ -- This is the value of the configuration switch for debug pragmas disabled
+ -- mode, as possibly set by use of the configuration pragma Debug_Policy.
+
Debug_Pragmas_Enabled_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch for debug pragmas enabled
Assertions_Enabled : Boolean;
Assume_No_Invalid_Values : Boolean;
Check_Policy_List : Node_Id;
+ Debug_Pragmas_Disabled : Boolean;
Debug_Pragmas_Enabled : Boolean;
Default_Pool : Node_Id;
Dynamic_Elaboration_Checks : Boolean;
-- Check the specified argument Arg to make sure that it is a valid
-- locking policy name. If not give error and raise Pragma_Exit.
- procedure Check_Arg_Is_One_Of (Arg : Node_Id; N1, N2 : Name_Id);
- procedure Check_Arg_Is_One_Of (Arg : Node_Id; N1, N2, N3 : Name_Id);
- procedure Check_Arg_Is_One_Of (Arg : Node_Id; N1, N2, N3, N4 : Name_Id);
+ procedure Check_Arg_Is_One_Of
+ (Arg : Node_Id;
+ N1, N2 : Name_Id);
+ procedure Check_Arg_Is_One_Of
+ (Arg : Node_Id;
+ N1, N2, N3 : Name_Id);
+ procedure Check_Arg_Is_One_Of
+ (Arg : Node_Id;
+ N1, N2, N3, N4, N5 : Name_Id);
-- Check the specified argument Arg to make sure that it is an
- -- identifier whose name matches either N1 or N2 (or N3 if present).
- -- If not then give error and raise Pragma_Exit.
+ -- identifier whose name matches either N1 or N2 (or N3, N4, N5 if
+ -- present). If not then give error and raise Pragma_Exit.
procedure Check_Arg_Is_Queuing_Policy (Arg : Node_Id);
-- Check the specified argument Arg to make sure that it is a valid
end Check_Arg_Is_One_Of;
procedure Check_Arg_Is_One_Of
- (Arg : Node_Id;
- N1, N2, N3, N4 : Name_Id)
+ (Arg : Node_Id;
+ N1, N2, N3, N4, N5 : Name_Id)
is
Argx : constant Node_Id := Get_Pragma_Arg (Arg);
and then Chars (Argx) /= N2
and then Chars (Argx) /= N3
and then Chars (Argx) /= N4
+ and then Chars (Argx) /= N5
then
Error_Pragma_Arg ("invalid argument for pragma%", Argx);
end if;
end Check_Arg_Is_One_Of;
-
---------------------------------
-- Check_Arg_Is_Queuing_Policy --
---------------------------------
Rewrite (N,
Make_Pragma (Loc,
- Chars => Name_Check,
+ Chars => Name_Check,
Pragma_Argument_Associations => Newa));
Analyze (N);
end Assert;
-- Assertion_Policy --
----------------------
- -- pragma Assertion_Policy (Check | Ignore)
+ -- pragma Assertion_Policy (Check | Disable |Ignore)
when Pragma_Assertion_Policy => Assertion_Policy : declare
Policy : Node_Id;
Check_Valid_Configuration_Pragma;
Check_Arg_Count (1);
Check_No_Identifiers;
- Check_Arg_Is_One_Of (Arg1, Name_Check, Name_Ignore);
+ Check_Arg_Is_One_Of (Arg1, Name_Check, Name_Disable, Name_Ignore);
-- We treat pragma Assertion_Policy as equivalent to:
Check_Arg_Is_Identifier (Arg1);
+ -- Completely ignore if disabled
+
+ if Check_Disabled (Chars (Get_Pragma_Arg (Arg1))) then
+ Rewrite (N, Make_Null_Statement (Loc));
+ Analyze (N);
+ return;
+ end if;
+
-- Indicate if pragma is enabled. The Original_Node reference here
-- is to deal with pragma Assert rewritten as a Check pragma.
-- [Name =>] IDENTIFIER,
-- [Policy =>] POLICY_IDENTIFIER);
- -- POLICY_IDENTIFIER ::= ON | OFF | CHECK | IGNORE
+ -- POLICY_IDENTIFIER ::= ON | OFF | CHECK | DISABLE | IGNORE
-- Note: this is a configuration pragma, but it is allowed to appear
-- anywhere else.
Check_Optional_Identifier (Arg1, Name_Name);
Check_Optional_Identifier (Arg2, Name_Policy);
Check_Arg_Is_One_Of
- (Arg2, Name_On, Name_Off, Name_Check, Name_Ignore);
+ (Arg2, Name_On, Name_Off, Name_Check, Name_Disable, Name_Ignore);
-- A Check_Policy pragma can appear either as a configuration
-- pragma, or in a declarative part or a package spec (see RM
begin
GNAT_Pragma;
+ -- Skip analysis if disabled
+
+ if Debug_Pragmas_Disabled then
+ Rewrite (N, Make_Null_Statement (Loc));
+ Analyze (N);
+ return;
+ end if;
+
Cond :=
New_Occurrence_Of
(Boolean_Literals (Debug_Pragmas_Enabled and Expander_Active),
when Pragma_Debug_Policy =>
GNAT_Pragma;
Check_Arg_Count (1);
- Check_Arg_Is_One_Of (Arg1, Name_Check, Name_Ignore);
+ Check_Arg_Is_One_Of (Arg1, Name_Check, Name_Disable, Name_Ignore);
Debug_Pragmas_Enabled :=
Chars (Get_Pragma_Arg (Arg1)) = Name_Check;
+ Debug_Pragmas_Disabled :=
+ Chars (Get_Pragma_Arg (Arg1)) = Name_Disable;
---------------------
-- Detect_Blocking --
End_Scope;
end Analyze_TC_In_Decl_Part;
+ --------------------
+ -- Check_Disabled --
+ --------------------
+
+ function Check_Disabled (Nam : Name_Id) return Boolean is
+ PP : Node_Id;
+
+ begin
+ -- Loop through entries in check policy list
+
+ PP := Opt.Check_Policy_List;
+ loop
+ -- If there are no specific entries that matched, then nothing is
+ -- disabled, so return False.
+
+ if No (PP) then
+ return False;
+
+ -- Here we have an entry see if it matches
+
+ else
+ declare
+ PPA : constant List_Id := Pragma_Argument_Associations (PP);
+ begin
+ if Nam = Chars (Get_Pragma_Arg (First (PPA))) then
+ return Chars (Get_Pragma_Arg (Last (PPA))) = Name_Disable;
+ else
+ PP := Next_Pragma (PP);
+ end if;
+ end;
+ end if;
+ end loop;
+ end Check_Disabled;
+
-------------------
-- Check_Enabled --
-------------------
-- pragma as "spec expressions" (see section in Sem "Handling of Default
-- and Per-Object Expressions...").
+ function Check_Disabled (Nam : Name_Id) return Boolean;
+ -- This function is used in connection with pragmas Assertion, Check,
+ -- Precondition, and Postcondition, to determine if Check pragmas (or
+ -- corresponding Assert, Precondition, or Postcondition pragmas) are
+ -- currently disabled (as set by a Policy pragma with the Disabled
+
function Check_Enabled (Nam : Name_Id) return Boolean;
-- This function is used in connection with pragmas Assertion, Check,
- -- Precondition, and Postcondition to determine if Check pragmas (or
+ -- Precondition, and Postcondition, to determine if Check pragmas (or
-- corresponding Assert, Precondition, or Postcondition pragmas) are
-- currently active, as determined by the presence of -gnata on the
-- command line (which sets the default), and the appearance of pragmas
Name_Copy : constant Name_Id := N + $;
Name_D_Float : constant Name_Id := N + $;
Name_Descriptor : constant Name_Id := N + $;
+ Name_Disable : constant Name_Id := N + $;
Name_Dot_Replacement : constant Name_Id := N + $;
Name_Dynamic : constant Name_Id := N + $;
Name_Ensures : constant Name_Id := N + $;
projects / gcc.git / commitdiff