function Has_Single_Return_In_GNATprove_Mode return Boolean is
Last_Statement : Node_Id := Empty;
+ Body_To_Inline : constant Node_Id := N;
function Check_Return (N : Node_Id) return Traverse_Result;
-- Returns OK on node N if this is not a return statement different
function Check_Return (N : Node_Id) return Traverse_Result is
begin
- if Nkind_In (N, N_Simple_Return_Statement,
- N_Extended_Return_Statement)
- then
- if N = Last_Statement then
- return OK;
- else
- return Abandon;
- end if;
+ case Nkind (N) is
+ when N_Simple_Return_Statement
+ | N_Extended_Return_Statement
+ =>
+ if N = Last_Statement then
+ return OK;
+ else
+ return Abandon;
+ end if;
- else
- return OK;
- end if;
+ -- Skip locally declared subprogram bodies inside the body to
+ -- inline, as the return statements inside those do not count.
+
+ when N_Subprogram_Body =>
+ if N = Body_To_Inline then
+ return OK;
+ else
+ return Skip;
+ end if;
+
+ when others =>
+ return OK;
+ end case;
end Check_Return;
function Check_All_Returns is new Traverse_Func (Check_Return);
Subtype_Mark => New_Occurrence_Of (Etype (F), Loc),
Expression => Relocate_Node (Expression (A)));
- -- In GNATprove mode, keep the most precise type of the actual
- -- for the temporary variable. Otherwise, the AST may contain
- -- unexpected assignment statements to a temporary variable of
- -- unconstrained type renaming a local variable of constrained
- -- type, which is not expected by GNATprove.
+ -- In GNATprove mode, keep the most precise type of the actual for
+ -- the temporary variable, when the formal type is unconstrained.
+ -- Otherwise, the AST may contain unexpected assignment statements
+ -- to a temporary variable of unconstrained type renaming a
+ -- local variable of constrained type, which is not expected
+ -- by GNATprove.
- elsif Etype (F) /= Etype (A) and then not GNATprove_Mode then
+ elsif Etype (F) /= Etype (A)
+ and then (not GNATprove_Mode or else Is_Constrained (Etype (F)))
+ then
New_A := Unchecked_Convert_To (Etype (F), Relocate_Node (A));
Temp_Typ := Etype (F);
package body Sem_Util is
- ----------------------------------------
- -- Global Variables for New_Copy_Tree --
- ----------------------------------------
-
- -- These global variables are used by New_Copy_Tree. See description of the
- -- body of this subprogram for details. Global variables can be safely used
- -- by New_Copy_Tree, since there is no case of a recursive call from the
- -- processing inside New_Copy_Tree.
-
- NCT_Hash_Threshold : constant := 20;
- -- If there are more than this number of pairs of entries in the map, then
- -- Hash_Tables_Used will be set, and the hash tables will be initialized
- -- and used for the searches.
-
- NCT_Hash_Tables_Used : Boolean := False;
- -- Set to True if hash tables are in use
-
- NCT_Table_Entries : Nat := 0;
- -- Count entries in table to see if threshold is reached
-
- NCT_Hash_Table_Setup : Boolean := False;
- -- Set to True if hash table contains data. We set this True if we setup
- -- the hash table with data, and leave it set permanently from then on,
- -- this is a signal that second and subsequent users of the hash table
- -- must clear the old entries before reuse.
-
- subtype NCT_Header_Num is Int range 0 .. 511;
- -- Defines range of headers in hash tables (512 headers)
-
-----------------------
-- Local Subprograms --
-----------------------
function Contains (List : Elist_Id; N : Node_Id) return Boolean;
-- Returns True if List has a node whose Entity is Entity (N)
- -------------------------
- -- Check_Function_Call --
- -------------------------
+ ----------------
+ -- Check_Node --
+ ----------------
function Check_Node (N : Node_Id) return Traverse_Result is
Is_Writable_Actual : Boolean := False;
end if;
end New_Copy_List_Tree;
- --------------------------------------------------
- -- New_Copy_Tree Auxiliary Data and Subprograms --
- --------------------------------------------------
-
- use Atree.Unchecked_Access;
- use Atree_Private_Part;
-
- -- Our approach here requires a two pass traversal of the tree. The
- -- first pass visits all nodes that eventually will be copied looking
- -- for defining Itypes. If any defining Itypes are found, then they are
- -- copied, and an entry is added to the replacement map. In the second
- -- phase, the tree is copied, using the replacement map to replace any
- -- Itype references within the copied tree.
-
- -- The following hash tables are used if the Map supplied has more
- -- than hash threshold entries to speed up access to the map. If
- -- there are fewer entries, then the map is searched sequentially
- -- (because setting up a hash table for only a few entries takes
- -- more time than it saves.
-
- function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num;
- -- Hash function used for hash operations
-
- -------------------
- -- New_Copy_Hash --
- -------------------
-
- function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is
- begin
- return Nat (E) mod (NCT_Header_Num'Last + 1);
- end New_Copy_Hash;
-
- ---------------
- -- NCT_Assoc --
- ---------------
-
- -- The hash table NCT_Assoc associates old entities in the table with their
- -- corresponding new entities (i.e. the pairs of entries presented in the
- -- original Map argument are Key-Element pairs).
-
- package NCT_Assoc is new Simple_HTable (
- Header_Num => NCT_Header_Num,
- Element => Entity_Id,
- No_Element => Empty,
- Key => Entity_Id,
- Hash => New_Copy_Hash,
- Equal => Types."=");
-
- ---------------------
- -- NCT_Itype_Assoc --
- ---------------------
-
- -- The hash table NCT_Itype_Assoc contains entries only for those old
- -- nodes which have a non-empty Associated_Node_For_Itype set. The key
- -- is the associated node, and the element is the new node itself (NOT
- -- the associated node for the new node).
-
- package NCT_Itype_Assoc is new Simple_HTable (
- Header_Num => NCT_Header_Num,
- Element => Entity_Id,
- No_Element => Empty,
- Key => Entity_Id,
- Hash => New_Copy_Hash,
- Equal => Types."=");
-
-------------------
-- New_Copy_Tree --
-------------------
-- (and normally is) initialized to No_Elist, and if we have mapped
-- entities, we have to reset it to point to a real Elist.
+ NCT_Hash_Threshold : constant := 20;
+ -- If there are more than this number of pairs of entries in the map,
+ -- then Hash_Tables_Used will be set, and the hash tables will be
+ -- initialized and used for the searches.
+
+ NCT_Hash_Tables_Used : Boolean := False;
+ -- Set to True if hash tables are in use
+
+ NCT_Table_Entries : Nat := 0;
+ -- Count entries in table to see if threshold is reached
+
+ NCT_Hash_Table_Setup : Boolean := False;
+ -- Set to True if hash table contains data. We set this True if we setup
+ -- the hash table with data. This is a signal that we must clear its
+ -- contents before returning the tree copy.
+
+ ------------------------------------
+ -- Auxiliary Data and Subprograms --
+ ------------------------------------
+
+ use Atree.Unchecked_Access;
+ use Atree_Private_Part;
+
+ -- Our approach here requires a two pass traversal of the tree. The
+ -- first pass visits all nodes that eventually will be copied looking
+ -- for defining Itypes. If any defining Itypes are found, then they are
+ -- copied, and an entry is added to the replacement map. In the second
+ -- phase, the tree is copied, using the replacement map to replace any
+ -- Itype references within the copied tree.
+
+ -- The following hash tables are used if the Map supplied has more
+ -- than hash threshold entries to speed up access to the map. If
+ -- there are fewer entries, then the map is searched sequentially
+ -- (because setting up a hash table for only a few entries takes
+ -- more time than it saves.
+
+ subtype NCT_Header_Num is Int range 0 .. 511;
+ -- Defines range of headers in hash tables (512 headers)
+
+ function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num;
+ -- Hash function used for hash operations
+
+ ---------------
+ -- NCT_Assoc --
+ ---------------
+
+ -- The hash table NCT_Assoc associates old entities in the table with
+ -- their corresponding new entities (i.e. the pairs of entries presented
+ -- in the original Map argument are Key-Element pairs).
+
+ package NCT_Assoc is new Simple_HTable (
+ Header_Num => NCT_Header_Num,
+ Element => Entity_Id,
+ No_Element => Empty,
+ Key => Entity_Id,
+ Hash => New_Copy_Hash,
+ Equal => Types."=");
+
+ ---------------------
+ -- NCT_Itype_Assoc --
+ ---------------------
+
+ -- The hash table NCT_Itype_Assoc contains entries only for those old
+ -- nodes which have a non-empty Associated_Node_For_Itype set. The key
+ -- is the associated node, and the element is the new node itself (NOT
+ -- the associated node for the new node).
+
+ package NCT_Itype_Assoc is new Simple_HTable (
+ Header_Num => NCT_Header_Num,
+ Element => Entity_Id,
+ No_Element => Empty,
+ Key => Entity_Id,
+ Hash => New_Copy_Hash,
+ Equal => Types."=");
+
function Assoc (N : Node_Or_Entity_Id) return Node_Id;
-- Called during second phase to map entities into their corresponding
-- copies using Actual_Map. If the argument is not an entity, or is not
Ent : Entity_Id;
begin
- if NCT_Hash_Table_Setup then
- NCT_Assoc.Reset;
- NCT_Itype_Assoc.Reset;
- end if;
-
Elmt := First_Elmt (Actual_Map);
while Present (Elmt) loop
Ent := Node (Elmt);
return New_Node;
end Copy_Node_With_Replacement;
+ -------------------
+ -- New_Copy_Hash --
+ -------------------
+
+ function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is
+ begin
+ return Nat (E) mod (NCT_Header_Num'Last + 1);
+ end New_Copy_Hash;
+
-----------------
-- Visit_Elist --
-----------------
-- Now we can copy the actual tree
- return Copy_Node_With_Replacement (Source);
+ declare
+ Result : constant Node_Id := Copy_Node_With_Replacement (Source);
+
+ begin
+ if NCT_Hash_Table_Setup then
+ NCT_Assoc.Reset;
+ NCT_Itype_Assoc.Reset;
+ end if;
+
+ return Result;
+ end;
end New_Copy_Tree;
-------------------------
projects / gcc.git / commitdiff