From 1debd630ed40eec6db2f4aab4524fde4643b70a7 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Mon, 12 Aug 2019 08:59:47 +0000 Subject: [PATCH] [Ada] Adapt new extended traversal of AST to have optional part The new extended traversal of the AST for GNATprove use now optionally traverses the ranges under Itypes, based on a formal parameter. There is no impact on compilation. 2019-08-12 Yannick Moy gcc/ada/ * sem_util.adb, sem_util.ads (Traverse_More_Func, Traverse_More_Proc): Add formal parameter for Itypes traversal. From-SVN: r274291 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_util.adb | 12 +++++++----- gcc/ada/sem_util.ads | 3 +++ 3 files changed, 15 insertions(+), 5 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ca2030d95fc..5e8fd9e1b59 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-12 Yannick Moy + + * sem_util.adb, sem_util.ads (Traverse_More_Func, + Traverse_More_Proc): Add formal parameter for Itypes traversal. + 2019-08-12 Yannick Moy * exp_attr.adb, exp_attr.ads (Expand_Size_Attribute): New diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index acc257cc319..b56fa867bb6 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -25565,11 +25565,13 @@ package body Sem_Util is null; end case; - -- Then process unattached nodes which come from Itypes. This only - -- concerns currently ranges of scalar (possibly as index) types. - -- This traversal is protected against looping with Processing_Itype. + -- If Process_Itypes is True, process unattached nodes which come + -- from Itypes. This only concerns currently ranges of scalar + -- (possibly as index) types. This traversal is protected against + -- looping with Processing_Itype. - if not Processing_Itype + if Process_Itypes + and then not Processing_Itype and then Nkind (Node) in N_Has_Etype and then Present (Etype (Node)) and then Is_Itype (Etype (Node)) @@ -25628,7 +25630,7 @@ package body Sem_Util is ------------------------ procedure Traverse_More_Proc (Node : Node_Id) is - function Traverse is new Traverse_More_Func (Process); + function Traverse is new Traverse_More_Func (Process, Process_Itypes); Discard : Traverse_Final_Result; pragma Warnings (Off, Discard); begin diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 478f5707302..2c1f8a8be5b 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2814,14 +2814,17 @@ package Sem_Util is generic with function Process (N : Node_Id) return Traverse_Result is <>; + Process_Itypes : Boolean := False; function Traverse_More_Func (Node : Node_Id) return Traverse_Final_Result; -- This is a version of Atree.Traverse_Func that not only traverses -- syntactic children of nodes, but also semantic children which are -- logically children of the node. This concerns currently lists of -- action nodes and ranges under Itypes, both inserted by the compiler. + -- Itypes are only traversed when Process_Itypes is True. generic with function Process (N : Node_Id) return Traverse_Result is <>; + Process_Itypes : Boolean := False; procedure Traverse_More_Proc (Node : Node_Id); pragma Inline (Traverse_More_Proc); -- This is the same as Traverse_More_Func except that no result is -- 2.30.2