From dedac3eb7331f441f24b192fa0d9d1e1162f57ba Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 5 Aug 2011 15:10:50 +0000 Subject: [PATCH] par_sco.adb, [...]: Minor reformatting. 2011-08-05 Robert Dewar * par_sco.adb, sem_ch3.adb, scos.ads, a-iteint.ads, sem_ch12.adb, a-cimutr.adb, a-cimutr.ads, sem_util.ads, sem_res.adb, a-fihema.adb, sem_ch4.adb, lib-xref-alfa.adb, exp_disp.adb, a-comutr.adb, a-comutr.ads, lib-xref.adb: Minor reformatting. 2011-08-05 Robert Dewar * sem_ch11.adb (Analyze_Raise_Statement): Kill assignment to formal warning if there is an exception handler present. From-SVN: r177451 --- gcc/ada/ChangeLog | 12 ++ gcc/ada/a-cimutr.adb | 298 ++++++++++++++++++------------------ gcc/ada/a-cimutr.ads | 28 ++-- gcc/ada/a-comutr.adb | 308 +++++++++++++++++++------------------- gcc/ada/a-comutr.ads | 66 ++++---- gcc/ada/a-fihema.adb | 16 +- gcc/ada/a-iteint.ads | 39 ++--- gcc/ada/exp_disp.adb | 4 +- gcc/ada/lib-xref-alfa.adb | 11 +- gcc/ada/lib-xref.adb | 3 +- gcc/ada/par_sco.adb | 10 +- gcc/ada/scos.ads | 2 +- gcc/ada/sem_ch11.adb | 47 ++++-- gcc/ada/sem_ch12.adb | 38 ++--- gcc/ada/sem_ch3.adb | 22 +-- gcc/ada/sem_ch4.adb | 7 +- gcc/ada/sem_res.adb | 8 +- gcc/ada/sem_util.ads | 2 +- 18 files changed, 469 insertions(+), 452 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 217b56da6eb..c686c29da1b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2011-08-05 Robert Dewar + + * par_sco.adb, sem_ch3.adb, scos.ads, a-iteint.ads, sem_ch12.adb, + a-cimutr.adb, a-cimutr.ads, sem_util.ads, sem_res.adb, a-fihema.adb, + sem_ch4.adb, lib-xref-alfa.adb, exp_disp.adb, a-comutr.adb, + a-comutr.ads, lib-xref.adb: Minor reformatting. + +2011-08-05 Robert Dewar + + * sem_ch11.adb (Analyze_Raise_Statement): Kill assignment to formal + warning if there is an exception handler present. + 2011-08-05 Pascal Obry * a-iteint.ads: Fix copyright year. diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb index 4328296b942..1e035ec62f7 100644 --- a/gcc/ada/a-cimutr.adb +++ b/gcc/ada/a-cimutr.adb @@ -134,25 +134,24 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Target_Count : Count_Type; begin - -- We first restore the target container to its - -- default-initialized state, before we attempt any - -- allocation, to ensure that invariants are preserved - -- in the event that the allocation fails. + -- We first restore the target container to its default-initialized + -- state, before we attempt any allocation, to ensure that invariants + -- are preserved in the event that the allocation fails. Container.Root.Children := Children_Type'(others => null); Container.Busy := 0; Container.Lock := 0; Container.Count := 0; - -- Copy_Children returns a count of the number of nodes - -- that it allocates, but it works by incrementing the - -- value that is passed in. We must therefore initialize - -- the count value before calling Copy_Children. + -- Copy_Children returns a count of the number of nodes that it + -- allocates, but it works by incrementing the value that is passed in. + -- We must therefore initialize the count value before calling + -- Copy_Children. Target_Count := 0; - -- Now we attempt the allocation of subtrees. The invariants - -- are satisfied even if the allocation fails. + -- Now we attempt the allocation of subtrees. The invariants are + -- satisfied even if the allocation fails. Copy_Children (Source, Root_Node (Container), Target_Count); pragma Assert (Target_Count = Source_Count); @@ -181,11 +180,10 @@ package body Ada.Containers.Indefinite_Multiway_Trees is raise Program_Error with "Position cursor not in container"; end if; - -- AI-0136 says to raise PE if Position equals the root node. - -- This does not seem correct, as this value is just the limiting - -- condition of the search. For now we omit this check, - -- pending a ruling from the ARG. ??? - -- + -- AI-0136 says to raise PE if Position equals the root node. This does + -- not seem correct, as this value is just the limiting condition of the + -- search. For now we omit this check pending a ruling from the ARG.??? + -- if Is_Root (Position) then -- raise Program_Error with "Position cursor designates root"; -- end if; @@ -241,6 +239,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Last := First; for J in Count_Type'(2) .. Count loop + -- Reclaim other nodes if Storage_Error. ??? Element := new Element_Type'(New_Item); @@ -258,10 +257,9 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Parent => Parent.Node, Before => null); -- null means "insert at end of list" - -- In order for operation Node_Count to complete - -- in O(1) time, we cache the count value. Here we - -- increment the total count by the number of nodes - -- we just inserted. + -- In order for operation Node_Count to complete in O(1) time, we cache + -- the count value. Here we increment the total count by the number of + -- nodes we just inserted. Container.Count := Container.Count + Count; end Append_Child; @@ -281,16 +279,15 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Target.Clear; -- checks busy bit - -- Copy_Children returns the number of nodes that it allocates, - -- but it does this by incrementing the count value passed in, - -- so we must initialize the count before calling Copy_Children. + -- Copy_Children returns the number of nodes that it allocates, but it + -- does this by incrementing the count value passed in, so we must + -- initialize the count before calling Copy_Children. Target_Count := 0; - -- Note that Copy_Children inserts the newly-allocated children - -- into their parent list only after the allocation of all the - -- children has succeeded. This preserves invariants even if - -- the allocation fails. + -- Note that Copy_Children inserts the newly-allocated children into + -- their parent list only after the allocation of all the children has + -- succeeded. This preserves invariants even if the allocation fails. Copy_Children (Source.Root.Children, Root_Node (Target), Target_Count); pragma Assert (Target_Count = Source_Count); @@ -303,7 +300,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is ----------- procedure Clear (Container : in out Tree) is - Container_Count, Children_Count : Count_Type; + Container_Count : Count_Type; + Children_Count : Count_Type; begin if Container.Busy > 0 then @@ -311,28 +309,24 @@ package body Ada.Containers.Indefinite_Multiway_Trees is with "attempt to tamper with cursors (tree is busy)"; end if; - -- We first set the container count to 0, in order to - -- preserve invariants in case the deallocation fails. - -- (This works because Deallocate_Children immediately - -- removes the children from their parent, and then - -- does the actual deallocation.) + -- We first set the container count to 0, in order to preserve + -- invariants in case the deallocation fails. (This works because + -- Deallocate_Children immediately removes the children from their + -- parent, and then does the actual deallocation.) Container_Count := Container.Count; Container.Count := 0; - -- Deallocate_Children returns the number of nodes that - -- it deallocates, but it does this by incrementing the - -- count value that is passed in, so we must first initialize - -- the count return value before calling it. + -- Deallocate_Children returns the number of nodes that it deallocates, + -- but it does this by incrementing the count value that is passed in, + -- so we must first initialize the count return value before calling it. Children_Count := 0; - -- See comment above. Deallocate_Children immediately - -- removes the children list from their parent node (here, - -- the root of the tree), and only after that does it - -- attempt the actual deallocation. So even if the - -- deallocation fails, the representation invariants - -- for the tree are preserved. + -- See comment above. Deallocate_Children immediately removes the + -- children list from their parent node (here, the root of the tree), + -- and only after that does it attempt the actual deallocation. So even + -- if the deallocation fails, the representation invariants Deallocate_Children (Root_Node (Container), Children_Count); pragma Assert (Children_Count = Container_Count); @@ -383,9 +377,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is C : Tree_Node_Access; begin - -- We special-case the first allocation, in order - -- to establish the representation invariants - -- for type Children_Type. + -- We special-case the first allocation, in order to establish the + -- representation invariants for type Children_Type. C := Source.First; @@ -401,9 +394,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is CC.Last := CC.First; - -- The representation invariants for the Children_Type - -- list have been established, so we can now copy - -- the remaining children of Source. + -- The representation invariants for the Children_Type list have been + -- established, so we can now copy the remaining children of Source. C := C.Next; while C /= null loop @@ -419,9 +411,9 @@ package body Ada.Containers.Indefinite_Multiway_Trees is C := C.Next; end loop; - -- We add the newly-allocated children to their parent list - -- only after the allocation has succeeded, in order to - -- preserve invariants of the parent. + -- We add the newly-allocated children to their parent list only after + -- the allocation has succeeded, in order to preserve invariants of the + -- parent. Parent.Children := CC; end Copy_Children; @@ -450,6 +442,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Result := Result + 1; Node := Node.Next; end loop; + return Result; end Child_Count; @@ -484,6 +477,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is raise Program_Error with "Parent is not ancestor of Child"; end if; end loop; + return Result; end Child_Depth; @@ -527,10 +521,10 @@ package body Ada.Containers.Indefinite_Multiway_Trees is raise Constraint_Error with "Source cursor designates root"; end if; - -- Copy_Subtree returns a count of the number of nodes - -- that it allocates, but it works by incrementing the - -- value that is passed in. We must therefore initialize - -- the count value before calling Copy_Subtree. + -- Copy_Subtree returns a count of the number of nodes that it + -- allocates, but it works by incrementing the value that is passed in. + -- We must therefore initialize the count value before calling + -- Copy_Subtree. Target_Count := 0; @@ -549,10 +543,9 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Parent => Parent.Node, Before => Before.Node); - -- In order for operation Node_Count to complete - -- in O(1) time, we cache the count value. Here we - -- increment the total count by the number of nodes - -- we just inserted. + -- In order for operation Node_Count to complete in O(1) time, we cache + -- the count value. Here we increment the total count by the number of + -- nodes we just inserted. Target.Count := Target.Count + Target_Count; end Copy_Subtree; @@ -590,9 +583,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is C : Tree_Node_Access; begin - -- We immediately remove the children from their - -- parent, in order to preserve invariants in case - -- the deallocation fails. + -- We immediately remove the children from their parent, in order to + -- preserve invariants in case the deallocation fails. Subtree.Children := Children_Type'(others => null); @@ -707,16 +699,15 @@ package body Ada.Containers.Indefinite_Multiway_Trees is X := Position.Node; Position := No_Element; - -- Restore represention invariants before attempting the - -- actual deallocation. + -- Restore represention invariants before attempting the actual + -- deallocation. Remove_Subtree (X); Container.Count := Container.Count - 1; - -- It is now safe to attempt the deallocation. This leaf - -- node has been disassociated from the tree, so even if - -- the deallocation fails, representation invariants - -- will remain satisfied. + -- It is now safe to attempt the deallocation. This leaf node has been + -- disassociated from the tree, so even if the deallocation fails, + -- representation invariants will remain satisfied. Deallocate_Node (X); end Delete_Leaf; @@ -753,38 +744,35 @@ package body Ada.Containers.Indefinite_Multiway_Trees is X := Position.Node; Position := No_Element; - -- Here is one case where a deallocation failure can - -- result in the violation of a representation invariant. - -- We disassociate the subtree from the tree now, but we - -- only decrement the total node count after we attempt - -- the deallocation. However, if the deallocation fails, - -- the total node count will not get decremented. - -- - -- One way around this dilemma is to count the nodes - -- in the subtree before attempt to delete the subtree, - -- but that is an O(n) operation, so it does not seem - -- worth it. - -- - -- Perhaps this is much ado about nothing, since the - -- only way deallocation can fail is if Controlled - -- Finalization fails: this propagates Program_Error - -- so all bets are off anyway. ??? + -- Here is one case where a deallocation failure can result in the + -- violation of a representation invariant. We disassociate the subtree + -- from the tree now, but we only decrement the total node count after + -- we attempt the deallocation. However, if the deallocation fails, the + -- total node count will not get decremented. + + -- One way around this dilemma is to count the nodes in the subtree + -- before attempt to delete the subtree, but that is an O(n) operation, + -- so it does not seem worth it. + + -- Perhaps this is much ado about nothing, since the only way + -- deallocation can fail is if Controlled Finalization fails: this + -- propagates Program_Error so all bets are off anyway. ??? Remove_Subtree (X); - -- Deallocate_Subtree returns a count of the number of nodes - -- that it deallocates, but it works by incrementing the - -- value that is passed in. We must therefore initialize - -- the count value before calling Deallocate_Subtree. + -- Deallocate_Subtree returns a count of the number of nodes that it + -- deallocates, but it works by incrementing the value that is passed + -- in. We must therefore initialize the count value before calling + -- Deallocate_Subtree. Count := 0; Deallocate_Subtree (X, Count); pragma Assert (Count <= Container.Count); - -- See comments above. We would prefer to do this - -- sooner, but there's no way to satisfy that goal - -- without an potentially severe execution penalty. + -- See comments above. We would prefer to do this sooner, but there's no + -- way to satisfy that goal without an potentially severe execution + -- penalty. Container.Count := Container.Count - Count; end Delete_Subtree; @@ -804,6 +792,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is N := N.Parent; Result := Result + 1; end loop; + return Result; end Depth; @@ -1122,10 +1111,9 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Parent => Parent.Node, Before => Before.Node); - -- In order for operation Node_Count to complete - -- in O(1) time, we cache the count value. Here we - -- increment the total count by the number of nodes - -- we just inserted. + -- In order for operation Node_Count to complete in O(1) time, we cache + -- the count value. Here we increment the total count by the number of + -- nodes we just inserted. Container.Count := Container.Count + Count; end Insert_Child; @@ -1144,11 +1132,10 @@ package body Ada.Containers.Indefinite_Multiway_Trees is C : Children_Type renames Parent.Children; begin - -- This is a simple utility operation to - -- insert a list of nodes (from First..Last) - -- as children of Parent. The Before node - -- specifies where the new children should be - -- inserted relative to the existing children. + -- This is a simple utility operation to insert a list of nodes (from + -- First..Last) as children of Parent. The Before node specifies where + -- the new children should be inserted relative to the existing + -- children. if First = null then pragma Assert (Last = null); @@ -1194,8 +1181,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Before : Tree_Node_Access) is begin - -- This is a simple wrapper operation to insert - -- a single child into the Parent's children list. + -- This is a simple wrapper operation to insert a single child into the + -- Parent's children list. Insert_Subtree_List (First => Subtree, @@ -1282,6 +1269,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Process => Process); B := B - 1; + exception when others => B := B - 1; @@ -1315,6 +1303,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is end loop; B := B - 1; + exception when others => B := B - 1; @@ -1330,13 +1319,11 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Node : Tree_Node_Access; begin - -- This is a helper function to recursively iterate over - -- all the nodes in a subtree, in depth-first fashion. - -- This particular helper just visits the children of this - -- subtree, not the root of the subtree node itself. This - -- is useful when starting from the ultimate root of the - -- entire tree (see Iterate), as that root does not have - -- an element. + -- This is a helper function to recursively iterate over all the nodes + -- in a subtree, in depth-first fashion. This particular helper just + -- visits the children of this subtree, not the root of the subtree node + -- itself. This is useful when starting from the ultimate root of the + -- entire tree (see Iterate), as that root does not have an element. Node := Subtree.Children.First; while Node /= null loop @@ -1366,12 +1353,12 @@ package body Ada.Containers.Indefinite_Multiway_Trees is if Is_Root (Position) then Iterate_Children (Position.Container, Position.Node, Process); - else Iterate_Subtree (Position.Container, Position.Node, Process); end if; B := B - 1; + exception when others => B := B - 1; @@ -1385,10 +1372,9 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Process : not null access procedure (Position : Cursor)) is begin - -- This is a helper function to recursively iterate over - -- all the nodes in a subtree, in depth-first fashion. - -- It first visits the root of the subtree, then visits - -- its children. + -- This is a helper function to recursively iterate over all the nodes + -- in a subtree, in depth-first fashion. It first visits the root of the + -- subtree, then visits its children. Process (Cursor'(Container, Subtree)); Iterate_Children (Container, Subtree, Process); @@ -1484,17 +1470,15 @@ package body Ada.Containers.Indefinite_Multiway_Trees is function Node_Count (Container : Tree) return Count_Type is begin - -- Container.Count is the number of nodes we have actually - -- allocated. We cache the value specifically so this Node_Count - -- operation can execute in O(1) time, which makes it behave - -- similarly to how the Length selector function behaves - -- for other containers. + -- Container.Count is the number of nodes we have actually allocated. We + -- cache the value specifically so this Node_Count operation can execute + -- in O(1) time, which makes it behave similarly to how the Length + -- selector function behaves for other containers. -- - -- The cached node count value only describes the nodes - -- we have allocated; the root node itself is not included - -- in that count. The Node_Count operation returns a value - -- that includes the root node (because the RM says so), so we - -- must add 1 to our cached value. + -- The cached node count value only describes the nodes we have + -- allocated; the root node itself is not included in that count. The + -- Node_Count operation returns a value that includes the root node + -- (because the RM says so), so we must add 1 to our cached value. return 1 + Container.Count; end Node_Count; @@ -1555,6 +1539,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Last := First; for J in Count_Type'(2) .. Count loop + -- Reclaim other nodes if Storage_Error. ??? Element := new Element_Type'(New_Item); @@ -1572,10 +1557,9 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Parent => Parent.Node, Before => Parent.Node.Children.First); - -- In order for operation Node_Count to complete - -- in O(1) time, we cache the count value. Here we - -- increment the total count by the number of nodes - -- we just inserted. + -- In order for operation Node_Count to complete in O(1) time, we cache + -- the count value. Here we increment the total count by the number of + -- nodes we just inserted. Container.Count := Container.Count + Count; end Prepend_Child; @@ -1632,6 +1616,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is L := L - 1; B := B - 1; + exception when others => L := L - 1; @@ -1653,7 +1638,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is function Read_Subtree (Parent : Tree_Node_Access) return Tree_Node_Access; - Total_Count, Read_Count : Count_Type; + Total_Count : Count_Type; + Read_Count : Count_Type; ------------------- -- Read_Children -- @@ -1664,8 +1650,10 @@ package body Ada.Containers.Indefinite_Multiway_Trees is pragma Assert (Subtree.Children.First = null); pragma Assert (Subtree.Children.Last = null); - Count : Count_Type; -- number of child subtrees - C : Children_Type; + Count : Count_Type; + -- Number of child subtrees + + C : Children_Type; begin Count_Type'Read (Stream, Count); @@ -1687,8 +1675,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is C.Last := C.Last.Next; end loop; - -- Now that the allocation and reads have completed successfully, - -- it is safe to link the children to their parent. + -- Now that the allocation and reads have completed successfully, it + -- is safe to link the children to their parent. Subtree.Children := C; end Read_Children; @@ -1759,8 +1747,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is C : Children_Type renames Subtree.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 C.First = Subtree then pragma Assert (Subtree.Prev = null); @@ -1850,6 +1838,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is end loop; B := B - 1; + exception when others => B := B - 1; @@ -1954,10 +1943,10 @@ package body Ada.Containers.Indefinite_Multiway_Trees is with "attempt to tamper with cursors (Source tree is busy)"; end if; - -- We cache the count of the nodes we have allocated, so that - -- operation Node_Count can execute in O(1) time. But that means - -- we must count the nodes in the subtree we remove from Source - -- and insert into Target, in order to keep the count accurate. + -- We cache the count of the nodes we have allocated, so that operation + -- Node_Count can execute in O(1) time. But that means we must count the + -- nodes in the subtree we remove from Source and insert into Target, in + -- order to keep the count accurate. Count := Subtree_Node_Count (Source_Parent.Node); pragma Assert (Count >= 1); @@ -2041,13 +2030,13 @@ package body Ada.Containers.Indefinite_Multiway_Trees is C : Tree_Node_Access; begin - -- This is a utility operation to remove the children from - -- Source parent and insert them into Target parent. + -- This is a utility operation to remove the children from Source parent + -- and insert them into Target parent. Source_Parent.Children := Children_Type'(others => null); - -- Fix up the Parent pointers of each child to designate - -- its new Target parent. + -- Fix up the Parent pointers of each child to designate its new Target + -- parent. C := CC.First; while C /= null loop @@ -2140,17 +2129,16 @@ package body Ada.Containers.Indefinite_Multiway_Trees is with "attempt to tamper with cursors (Source tree is busy)"; end if; - -- This is an unfortunate feature of this API: we must count - -- the nodes in the subtree that we remove from the source tree, - -- which is an O(n) operation. It would have been better if - -- the Tree container did not have a Node_Count selector; a - -- user that wants the number of nodes in the tree could - -- simply call Subtree_Node_Count, with the understanding that - -- such an operation is O(n). + -- This is an unfortunate feature of this API: we must count the nodes + -- in the subtree that we remove from the source tree, which is an O(n) + -- operation. It would have been better if the Tree container did not + -- have a Node_Count selector; a user that wants the number of nodes in + -- the tree could simply call Subtree_Node_Count, with the understanding + -- that such an operation is O(n). -- - -- Of course, we could choose to implement the Node_Count selector - -- as an O(n) operation, which would turn this splice operation - -- into an O(1) operation. ??? + -- Of course, we could choose to implement the Node_Count selector as an + -- O(n) operation, which would turn this splice operation into an O(1) + -- operation. ??? Subtree_Count := Subtree_Node_Count (Position.Node); pragma Assert (Subtree_Count <= Source.Count); @@ -2200,7 +2188,9 @@ package body Ada.Containers.Indefinite_Multiway_Trees is 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; @@ -2251,6 +2241,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Result := Result + Subtree_Node_Count (Node); Node := Node.Next; end loop; + return Result; end Subtree_Node_Count; @@ -2340,6 +2331,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is L := L - 1; B := B - 1; + exception when others => L := L - 1; diff --git a/gcc/ada/a-cimutr.ads b/gcc/ada/a-cimutr.ads index 609a8795766..7e8e7c80b62 100644 --- a/gcc/ada/a-cimutr.ads +++ b/gcc/ada/a-cimutr.ads @@ -231,8 +231,8 @@ package Ada.Containers.Indefinite_Multiway_Trees is -- Parent : Cursor; -- Process : not null access procedure (Position : Cursor)); -- - -- It seems that the Container parameter is there by mistake, but - -- we need an official ruling from the ARG. ??? + -- It seems that the Container parameter is there by mistake, but we need + -- an official ruling from the ARG. ??? procedure Iterate_Children (Parent : Cursor; @@ -264,19 +264,17 @@ private use Ada.Finalization; - -- The Count component of type Tree represents the number of - -- nodes that have been (dynamically) allocated. It does not - -- include the root node itself. As implementors, we decide - -- to cache this value, so that the selector function Node_Count - -- can execute in O(1) time, in order to be consistent with - -- the behavior of the Length selector function for other - -- standard container library units. This does mean, however, - -- that the two-container forms for Splice_XXX (that move subtrees - -- across tree containers) will execute in O(n) time, because - -- we must count the number of nodes in the subtree(s) that - -- get moved. (We resolve the tension between Node_Count - -- and Splice_XXX in favor of Node_Count, under the assumption - -- that Node_Count is the more common operation). + -- The Count component of type Tree represents the number of nodes that + -- have been (dynamically) allocated. It does not include the root node + -- itself. As implementors, we decide to cache this value, so that the + -- selector function Node_Count can execute in O(1) time, in order to be + -- consistent with the behavior of the Length selector function for other + -- standard container library units. This does mean, however, that the + -- two-container forms for Splice_XXX (that move subtrees across tree + -- containers) will execute in O(n) time, because we must count the number + -- of nodes in the subtree(s) that get moved. (We resolve the tension + -- between Node_Count and Splice_XXX in favor of Node_Count, under the + -- assumption that Node_Count is the more common operation). type Tree is new Controlled with record Root : aliased Tree_Node_Type; diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb index d2250dec5f1..7c7661d7e4f 100644 --- a/gcc/ada/a-comutr.adb +++ b/gcc/ada/a-comutr.adb @@ -133,25 +133,24 @@ package body Ada.Containers.Multiway_Trees is Target_Count : Count_Type; begin - -- We first restore the target container to its - -- default-initialized state, before we attempt any - -- allocation, to ensure that invariants are preserved - -- in the event that the allocation fails. + -- We first restore the target container to its default-initialized + -- state, before we attempt any allocation, to ensure that invariants + -- are preserved in the event that the allocation fails. Container.Root.Children := Children_Type'(others => null); Container.Busy := 0; Container.Lock := 0; Container.Count := 0; - -- Copy_Children returns a count of the number of nodes - -- that it allocates, but it works by incrementing the - -- value that is passed in. We must therefore initialize - -- the count value before calling Copy_Children. + -- Copy_Children returns a count of the number of nodes that it + -- allocates, but it works by incrementing the value that is passed + -- in. We must therefore initialize the count value before calling + -- Copy_Children. Target_Count := 0; - -- Now we attempt the allocation of subtrees. The invariants - -- are satisfied even if the allocation fails. + -- Now we attempt the allocation of subtrees. The invariants are + -- satisfied even if the allocation fails. Copy_Children (Source, Root_Node (Container), Target_Count); pragma Assert (Target_Count = Source_Count); @@ -180,11 +179,10 @@ package body Ada.Containers.Multiway_Trees is raise Program_Error with "Position cursor not in container"; end if; - -- AI-0136 says to raise PE if Position equals the root node. - -- This does not seem correct, as this value is just the limiting - -- condition of the search. For now we omit this check, - -- pending a ruling from the ARG. ??? - -- + -- AI-0136 says to raise PE if Position equals the root node. This does + -- not seem correct, as this value is just the limiting condition of the + -- search. For now we omit this check, pending a ruling from the ARG.??? + -- if Is_Root (Position) then -- raise Program_Error with "Position cursor designates root"; -- end if; @@ -238,7 +236,9 @@ package body Ada.Containers.Multiway_Trees is Last := First; for J in Count_Type'(2) .. Count loop + -- Reclaim other nodes if Storage_Error. ??? + Last.Next := new Tree_Node_Type'(Parent => Parent.Node, Prev => Last, Element => New_Item, @@ -253,10 +253,9 @@ package body Ada.Containers.Multiway_Trees is Parent => Parent.Node, Before => null); -- null means "insert at end of list" - -- In order for operation Node_Count to complete - -- in O(1) time, we cache the count value. Here we - -- increment the total count by the number of nodes - -- we just inserted. + -- In order for operation Node_Count to complete in O(1) time, we cache + -- the count value. Here we increment the total count by the number of + -- nodes we just inserted. Container.Count := Container.Count + Count; end Append_Child; @@ -276,16 +275,15 @@ package body Ada.Containers.Multiway_Trees is Target.Clear; -- checks busy bit - -- Copy_Children returns the number of nodes that it allocates, - -- but it does this by incrementing the count value passed in, - -- so we must initialize the count before calling Copy_Children. + -- Copy_Children returns the number of nodes that it allocates, but it + -- does this by incrementing the count value passed in, so we must + -- initialize the count before calling Copy_Children. Target_Count := 0; - -- Note that Copy_Children inserts the newly-allocated children - -- into their parent list only after the allocation of all the - -- children has succeeded. This preserves invariants even if - -- the allocation fails. + -- Note that Copy_Children inserts the newly-allocated children into + -- their parent list only after the allocation of all the children has + -- succeeded. This preserves invariants even if the allocation fails. Copy_Children (Source.Root.Children, Root_Node (Target), Target_Count); pragma Assert (Target_Count = Source_Count); @@ -306,28 +304,25 @@ package body Ada.Containers.Multiway_Trees is with "attempt to tamper with cursors (tree is busy)"; end if; - -- We first set the container count to 0, in order to - -- preserve invariants in case the deallocation fails. - -- (This works because Deallocate_Children immediately - -- removes the children from their parent, and then - -- does the actual deallocation.) + -- We first set the container count to 0, in order to preserve + -- invariants in case the deallocation fails. (This works because + -- Deallocate_Children immediately removes the children from their + -- parent, and then does the actual deallocation.) Container_Count := Container.Count; Container.Count := 0; - -- Deallocate_Children returns the number of nodes that - -- it deallocates, but it does this by incrementing the - -- count value that is passed in, so we must first initialize - -- the count return value before calling it. + -- Deallocate_Children returns the number of nodes that it deallocates, + -- but it does this by incrementing the count value that is passed in, + -- so we must first initialize the count return value before calling it. Children_Count := 0; - -- See comment above. Deallocate_Children immediately - -- removes the children list from their parent node (here, - -- the root of the tree), and only after that does it - -- attempt the actual deallocation. So even if the - -- deallocation fails, the representation invariants - -- for the tree are preserved. + -- See comment above. Deallocate_Children immediately removes the + -- children list from their parent node (here, the root of the tree), + -- and only after that does it attempt the actual deallocation. So even + -- if the deallocation fails, the representation invariants for the tree + -- are preserved. Deallocate_Children (Root_Node (Container), Children_Count); pragma Assert (Children_Count = Container_Count); @@ -378,9 +373,8 @@ package body Ada.Containers.Multiway_Trees is C : Tree_Node_Access; begin - -- We special-case the first allocation, in order - -- to establish the representation invariants - -- for type Children_Type. + -- We special-case the first allocation, in order to establish the + -- representation invariants for type Children_Type. C := Source.First; @@ -396,9 +390,8 @@ package body Ada.Containers.Multiway_Trees is CC.Last := CC.First; - -- The representation invariants for the Children_Type - -- list have been established, so we can now copy - -- the remaining children of Source. + -- The representation invariants for the Children_Type list have been + -- established, so we can now copy the remaining children of Source. C := C.Next; while C /= null loop @@ -414,9 +407,8 @@ package body Ada.Containers.Multiway_Trees is C := C.Next; end loop; - -- We add the newly-allocated children to their parent list - -- only after the allocation has succeeded, in order to - -- preserve invariants of the parent. + -- Add the newly-allocated children to their parent list only after the + -- allocation has succeeded, so as to preserve invariants of the parent. Parent.Children := CC; end Copy_Children; @@ -445,6 +437,7 @@ package body Ada.Containers.Multiway_Trees is Result := Result + 1; Node := Node.Next; end loop; + return Result; end Child_Count; @@ -479,6 +472,7 @@ package body Ada.Containers.Multiway_Trees is raise Program_Error with "Parent is not ancestor of Child"; end if; end loop; + return Result; end Child_Depth; @@ -522,10 +516,10 @@ package body Ada.Containers.Multiway_Trees is raise Constraint_Error with "Source cursor designates root"; end if; - -- Copy_Subtree returns a count of the number of nodes - -- that it allocates, but it works by incrementing the - -- value that is passed in. We must therefore initialize - -- the count value before calling Copy_Subtree. + -- Copy_Subtree returns a count of the number of nodes that it + -- allocates, but it works by incrementing the value that is passed + -- in. We must therefore initialize the count value before calling + -- Copy_Subtree. Target_Count := 0; @@ -544,10 +538,9 @@ package body Ada.Containers.Multiway_Trees is Parent => Parent.Node, Before => Before.Node); - -- In order for operation Node_Count to complete - -- in O(1) time, we cache the count value. Here we - -- increment the total count by the number of nodes - -- we just inserted. + -- In order for operation Node_Count to complete in O(1) time, we cache + -- the count value. Here we increment the total count by the number of + -- nodes we just inserted. Target.Count := Target.Count + Target_Count; end Copy_Subtree; @@ -585,9 +578,8 @@ package body Ada.Containers.Multiway_Trees is C : Tree_Node_Access; begin - -- We immediately remove the children from their - -- parent, in order to preserve invariants in case - -- the deallocation fails. + -- We immediately remove the children from their parent, in order to + -- preserve invariants in case the deallocation fails. Subtree.Children := Children_Type'(others => null); @@ -637,10 +629,10 @@ package body Ada.Containers.Multiway_Trees is with "attempt to tamper with cursors (tree is busy)"; end if; - -- Deallocate_Children returns a count of the number of nodes - -- that it deallocates, but it works by incrementing the - -- value that is passed in. We must therefore initialize - -- the count value before calling Deallocate_Children. + -- Deallocate_Children returns a count of the number of nodes that it + -- deallocates, but it works by incrementing the value that is passed + -- in. We must therefore initialize the count value before calling + -- Deallocate_Children. Count := 0; @@ -685,16 +677,15 @@ package body Ada.Containers.Multiway_Trees is X := Position.Node; Position := No_Element; - -- Restore represention invariants before attempting the - -- actual deallocation. + -- Restore represention invariants before attempting the actual + -- deallocation. Remove_Subtree (X); Container.Count := Container.Count - 1; - -- It is now safe to attempt the deallocation. This leaf - -- node has been disassociated from the tree, so even if - -- the deallocation fails, representation invariants - -- will remain satisfied. + -- It is now safe to attempt the deallocation. This leaf node has been + -- disassociated from the tree, so even if the deallocation fails, + -- representation invariants will remain satisfied. Deallocate_Node (X); end Delete_Leaf; @@ -731,38 +722,35 @@ package body Ada.Containers.Multiway_Trees is X := Position.Node; Position := No_Element; - -- Here is one case where a deallocation failure can - -- result in the violation of a representation invariant. - -- We disassociate the subtree from the tree now, but we - -- only decrement the total node count after we attempt - -- the deallocation. However, if the deallocation fails, - -- the total node count will not get decremented. - -- - -- One way around this dilemma is to count the nodes - -- in the subtree before attempt to delete the subtree, - -- but that is an O(n) operation, so it does not seem - -- worth it. - -- - -- Perhaps this is much ado about nothing, since the - -- only way deallocation can fail is if Controlled - -- Finalization fails: this propagates Program_Error - -- so all bets are off anyway. ??? + -- Here is one case where a deallocation failure can result in the + -- violation of a representation invariant. We disassociate the subtree + -- from the tree now, but we only decrement the total node count after + -- we attempt the deallocation. However, if the deallocation fails, the + -- total node count will not get decremented. + + -- One way around this dilemma is to count the nodes in the subtree + -- before attempt to delete the subtree, but that is an O(n) operation, + -- so it does not seem worth it. + + -- Perhaps this is much ado about nothing, since the only way + -- deallocation can fail is if Controlled Finalization fails: this + -- propagates Program_Error so all bets are off anyway. ??? Remove_Subtree (X); - -- Deallocate_Subtree returns a count of the number of nodes - -- that it deallocates, but it works by incrementing the - -- value that is passed in. We must therefore initialize - -- the count value before calling Deallocate_Subtree. + -- Deallocate_Subtree returns a count of the number of nodes that it + -- deallocates, but it works by incrementing the value that is passed + -- in. We must therefore initialize the count value before calling + -- Deallocate_Subtree. Count := 0; Deallocate_Subtree (X, Count); pragma Assert (Count <= Container.Count); - -- See comments above. We would prefer to do this - -- sooner, but there's no way to satisfy that goal - -- without an potentially severe execution penalty. + -- See comments above. We would prefer to do this sooner, but there's no + -- way to satisfy that goal without a potentially severe execution + -- penalty. Container.Count := Container.Count - Count; end Delete_Subtree; @@ -782,6 +770,7 @@ package body Ada.Containers.Multiway_Trees is N := N.Parent; Result := Result + 1; end loop; + return Result; end Depth; @@ -1080,7 +1069,9 @@ package body Ada.Containers.Multiway_Trees is Last := Position.Node; for J in Count_Type'(2) .. Count loop + -- Reclaim other nodes if Storage_Error. ??? + Last.Next := new Tree_Node_Type'(Parent => Parent.Node, Prev => Last, Element => New_Item, @@ -1095,10 +1086,9 @@ package body Ada.Containers.Multiway_Trees is Parent => Parent.Node, Before => Before.Node); - -- In order for operation Node_Count to complete - -- in O(1) time, we cache the count value. Here we - -- increment the total count by the number of nodes - -- we just inserted. + -- In order for operation Node_Count to complete in O(1) time, we cache + -- the count value. Here we increment the total count by the number of + -- nodes we just inserted. Container.Count := Container.Count + Count; end Insert_Child; @@ -1149,7 +1139,9 @@ package body Ada.Containers.Multiway_Trees is Last := Position.Node; for J in Count_Type'(2) .. Count loop + -- Reclaim other nodes if Storage_Error. ??? + Last.Next := new Tree_Node_Type'(Parent => Parent.Node, Prev => Last, Element => <>, @@ -1164,10 +1156,9 @@ package body Ada.Containers.Multiway_Trees is Parent => Parent.Node, Before => Before.Node); - -- In order for operation Node_Count to complete - -- in O(1) time, we cache the count value. Here we - -- increment the total count by the number of nodes - -- we just inserted. + -- In order for operation Node_Count to complete in O(1) time, we cache + -- the count value. Here we increment the total count by the number of + -- nodes we just inserted. Container.Count := Container.Count + Count; end Insert_Child; @@ -1186,11 +1177,10 @@ package body Ada.Containers.Multiway_Trees is C : Children_Type renames Parent.Children; begin - -- This is a simple utility operation to - -- insert a list of nodes (from First..Last) - -- as children of Parent. The Before node - -- specifies where the new children should be - -- inserted relative to the existing children. + -- This is a simple utility operation to insert a list of nodes (from + -- First..Last) as children of Parent. The Before node specifies where + -- the new children should be inserted relative to the existing + -- children. if First = null then pragma Assert (Last = null); @@ -1236,8 +1226,8 @@ package body Ada.Containers.Multiway_Trees is Before : Tree_Node_Access) is begin - -- This is a simple wrapper operation to insert - -- a single child into the Parent's children list. + -- This is a simple wrapper operation to insert a single child into the + -- Parent's children list. Insert_Subtree_List (First => Subtree, @@ -1324,6 +1314,7 @@ package body Ada.Containers.Multiway_Trees is Process => Process); B := B - 1; + exception when others => B := B - 1; @@ -1357,6 +1348,7 @@ package body Ada.Containers.Multiway_Trees is end loop; B := B - 1; + exception when others => B := B - 1; @@ -1372,13 +1364,11 @@ package body Ada.Containers.Multiway_Trees is Node : Tree_Node_Access; begin - -- This is a helper function to recursively iterate over - -- all the nodes in a subtree, in depth-first fashion. - -- This particular helper just visits the children of this - -- subtree, not the root of the subtree node itself. This - -- is useful when starting from the ultimate root of the - -- entire tree (see Iterate), as that root does not have - -- an element. + -- This is a helper function to recursively iterate over all the nodes + -- in a subtree, in depth-first fashion. This particular helper just + -- visits the children of this subtree, not the root of the subtree node + -- itself. This is useful when starting from the ultimate root of the + -- entire tree (see Iterate), as that root does not have an element. Node := Subtree.Children.First; while Node /= null loop @@ -1414,6 +1404,7 @@ package body Ada.Containers.Multiway_Trees is end if; B := B - 1; + exception when others => B := B - 1; @@ -1427,10 +1418,9 @@ package body Ada.Containers.Multiway_Trees is Process : not null access procedure (Position : Cursor)) is begin - -- This is a helper function to recursively iterate over - -- all the nodes in a subtree, in depth-first fashion. - -- It first visits the root of the subtree, then visits - -- its children. + -- This is a helper function to recursively iterate over all the nodes + -- in a subtree, in depth-first fashion. It first visits the root of the + -- subtree, then visits its children. Process (Cursor'(Container, Subtree)); Iterate_Children (Container, Subtree, Process); @@ -1526,17 +1516,15 @@ package body Ada.Containers.Multiway_Trees is function Node_Count (Container : Tree) return Count_Type is begin - -- Container.Count is the number of nodes we have actually - -- allocated. We cache the value specifically so this Node_Count - -- operation can execute in O(1) time, which makes it behave - -- similarly to how the Length selector function behaves - -- for other containers. - -- - -- The cached node count value only describes the nodes - -- we have allocated; the root node itself is not included - -- in that count. The Node_Count operation returns a value - -- that includes the root node (because the RM says so), so we - -- must add 1 to our cached value. + -- Container.Count is the number of nodes we have actually allocated. We + -- cache the value specifically so this Node_Count operation can execute + -- in O(1) time, which makes it behave similarly to how the Length + -- selector function behaves for other containers. + + -- The cached node count value only describes the nodes we have + -- allocated; the root node itself is not included in that count. The + -- Node_Count operation returns a value that includes the root node + -- (because the RM says so), so we must add 1 to our cached value. return 1 + Container.Count; end Node_Count; @@ -1595,7 +1583,9 @@ package body Ada.Containers.Multiway_Trees is Last := First; for J in Count_Type'(2) .. Count loop + -- Reclaim other nodes if Storage_Error. ??? + Last.Next := new Tree_Node_Type'(Parent => Parent.Node, Prev => Last, Element => New_Item, @@ -1610,10 +1600,9 @@ package body Ada.Containers.Multiway_Trees is Parent => Parent.Node, Before => Parent.Node.Children.First); - -- In order for operation Node_Count to complete - -- in O(1) time, we cache the count value. Here we - -- increment the total count by the number of nodes - -- we just inserted. + -- In order for operation Node_Count to complete in O(1) time, we cache + -- the count value. Here we increment the total count by the number of + -- nodes we just inserted. Container.Count := Container.Count + Count; end Prepend_Child; @@ -1670,6 +1659,7 @@ package body Ada.Containers.Multiway_Trees is L := L - 1; B := B - 1; + exception when others => L := L - 1; @@ -1725,8 +1715,8 @@ package body Ada.Containers.Multiway_Trees is C.Last := C.Last.Next; end loop; - -- Now that the allocation and reads have completed successfully, - -- it is safe to link the children to their parent. + -- Now that the allocation and reads have completed successfully, it + -- is safe to link the children to their parent. Subtree.Children := C; end Read_Children; @@ -1878,6 +1868,7 @@ package body Ada.Containers.Multiway_Trees is end loop; B := B - 1; + exception when others => B := B - 1; @@ -1909,11 +1900,11 @@ package body Ada.Containers.Multiway_Trees is -- Start of processing for Root_Node begin - -- This is a utility function for converting from an access type - -- that designates the distinguished root node to an access type - -- designating a non-root node. The representation of a root node - -- does not have an element, but is otherwise identical to a - -- non-root node, so the conversion itself is safe. + -- This is a utility function for converting from an access type that + -- designates the distinguished root node to an access type designating + -- a non-root node. The representation of a root node does not have an + -- element, but is otherwise identical to a non-root node, so the + -- conversion itself is safe. return To_Tree_Node_Access (Container.Root'Unrestricted_Access); end Root_Node; @@ -1997,10 +1988,10 @@ package body Ada.Containers.Multiway_Trees is with "attempt to tamper with cursors (Source tree is busy)"; end if; - -- We cache the count of the nodes we have allocated, so that - -- operation Node_Count can execute in O(1) time. But that means - -- we must count the nodes in the subtree we remove from Source - -- and insert into Target, in order to keep the count accurate. + -- We cache the count of the nodes we have allocated, so that operation + -- Node_Count can execute in O(1) time. But that means we must count the + -- nodes in the subtree we remove from Source and insert into Target, in + -- order to keep the count accurate. Count := Subtree_Node_Count (Source_Parent.Node); pragma Assert (Count >= 1); @@ -2183,17 +2174,16 @@ package body Ada.Containers.Multiway_Trees is with "attempt to tamper with cursors (Source tree is busy)"; end if; - -- This is an unfortunate feature of this API: we must count - -- the nodes in the subtree that we remove from the source tree, - -- which is an O(n) operation. It would have been better if - -- the Tree container did not have a Node_Count selector; a - -- user that wants the number of nodes in the tree could - -- simply call Subtree_Node_Count, with the understanding that - -- such an operation is O(n). - -- - -- Of course, we could choose to implement the Node_Count selector - -- as an O(n) operation, which would turn this splice operation - -- into an O(1) operation. ??? + -- This is an unfortunate feature of this API: we must count the nodes + -- in the subtree that we remove from the source tree, which is an O(n) + -- operation. It would have been better if the Tree container did not + -- have a Node_Count selector; a user that wants the number of nodes in + -- the tree could simply call Subtree_Node_Count, with the understanding + -- that such an operation is O(n). + + -- Of course, we could choose to implement the Node_Count selector as an + -- O(n) operation, which would turn this splice operation into an O(1) + -- operation. ??? Subtree_Count := Subtree_Node_Count (Position.Node); pragma Assert (Subtree_Count <= Source.Count); @@ -2243,7 +2233,9 @@ package body Ada.Containers.Multiway_Trees is 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; @@ -2294,6 +2286,7 @@ package body Ada.Containers.Multiway_Trees is Result := Result + Subtree_Node_Count (Node); Node := Node.Next; end loop; + return Result; end Subtree_Node_Count; @@ -2383,6 +2376,7 @@ package body Ada.Containers.Multiway_Trees is L := L - 1; B := B - 1; + exception when others => L := L - 1; diff --git a/gcc/ada/a-comutr.ads b/gcc/ada/a-comutr.ads index 4a7dde060f9..6a9cfdecee1 100644 --- a/gcc/ada/a-comutr.ads +++ b/gcc/ada/a-comutr.ads @@ -238,8 +238,8 @@ package Ada.Containers.Multiway_Trees is -- Parent : Cursor; -- Process : not null access procedure (Position : Cursor)); -- - -- It seems that the Container parameter is there by mistake, but - -- we need an official ruling from the ARG. ??? + -- It seems that the Container parameter is there by mistake, but we need + -- an official ruling from the ARG. ??? procedure Iterate_Children (Parent : Cursor; @@ -251,29 +251,29 @@ package Ada.Containers.Multiway_Trees is private - -- A node of this multiway tree comprises an element and a list of - -- children (that are themselves trees). The root node is distinguished - -- because it contains only children: it does not have an element itself. + -- A node of this multiway tree comprises an element and a list of children + -- (that are themselves trees). The root node is distinguished because it + -- contains only children: it does not have an element itself. -- -- This design feature puts two design goals in tension: -- (1) treat the root node the same as any other node -- (2) not declare any objects of type Element_Type unnecessarily -- - -- To satisfy (1), we could simply declare the Root node of the tree - -- using the normal Tree_Node_Type, but that would mean that (2) is not + -- To satisfy (1), we could simply declare the Root node of the tree using + -- the normal Tree_Node_Type, but that would mean that (2) is not -- satisfied. To resolve the tension (in favor of (2)), we declare the -- component Root as having a different node type, without an Element - -- component (thus satisfying goal (2)) but otherwise identical to a - -- normal node, and then use Unchecked_Conversion to convert an access - -- object designating the Root node component to the access type - -- designating a normal, non-root node (thus satisfying goal (1)). We make - -- an explicit check for Root when there is any attempt to manipulate the - -- Element component of the node (a check required by the RM anyway). + -- component (thus satisfying goal (2)) but otherwise identical to a normal + -- node, and then use Unchecked_Conversion to convert an access object + -- designating the Root node component to the access type designating a + -- normal, non-root node (thus satisfying goal (1)). We make an explicit + -- check for Root when there is any attempt to manipulate the Element + -- component of the node (a check required by the RM anyway). -- -- In order to be explicit about node (and pointer) representation, we - -- specify that the respective node types have convention C, to ensure - -- that the layout of the components of the node records is the same, - -- thus guaranteeing that (unchecked) conversions between access types + -- specify that the respective node types have convention C, to ensure that + -- the layout of the components of the node records is the same, thus + -- guaranteeing that (unchecked) conversions between access types -- designating each kind of node type is a meaningful conversion. type Tree_Node_Type; @@ -285,9 +285,8 @@ private Last : Tree_Node_Access; end record; - -- See the comment above. This declaration must exactly - -- match the declaration of Root_Node_Type (except for - -- the Element component). + -- See the comment above. This declaration must exactly match the + -- declaration of Root_Node_Type (except for the Element component). type Tree_Node_Type is record Parent : Tree_Node_Access; @@ -298,9 +297,8 @@ private end record; pragma Convention (C, Tree_Node_Type); - -- See the comment above. This declaration must match - -- the declaration of Tree_Node_Type (except for the - -- Element component). + -- See the comment above. This declaration must match the declaration of + -- Tree_Node_Type (except for the Element component). type Root_Node_Type is record Parent : Tree_Node_Access; @@ -312,19 +310,17 @@ private use Ada.Finalization; - -- The Count component of type Tree represents the number of - -- nodes that have been (dynamically) allocated. It does not - -- include the root node itself. As implementors, we decide - -- to cache this value, so that the selector function Node_Count - -- can execute in O(1) time, in order to be consistent with - -- the behavior of the Length selector function for other - -- standard container library units. This does mean, however, - -- that the two-container forms for Splice_XXX (that move subtrees - -- across tree containers) will execute in O(n) time, because - -- we must count the number of nodes in the subtree(s) that - -- get moved. (We resolve the tension between Node_Count - -- and Splice_XXX in favor of Node_Count, under the assumption - -- that Node_Count is the more common operation). + -- The Count component of type Tree represents the number of nodes that + -- have been (dynamically) allocated. It does not include the root node + -- itself. As implementors, we decide to cache this value, so that the + -- selector function Node_Count can execute in O(1) time, in order to be + -- consistent with the behavior of the Length selector function for other + -- standard container library units. This does mean, however, that the + -- two-container forms for Splice_XXX (that move subtrees across tree + -- containers) will execute in O(n) time, because we must count the number + -- of nodes in the subtree(s) that get moved. (We resolve the tension + -- between Node_Count and Splice_XXX in favor of Node_Count, under the + -- assumption that Node_Count is the more common operation). type Tree is new Controlled with record Root : aliased Root_Node_Type; diff --git a/gcc/ada/a-fihema.adb b/gcc/ada/a-fihema.adb index fbfebec1ac5..3759e712e0b 100644 --- a/gcc/ada/a-fihema.adb +++ b/gcc/ada/a-fihema.adb @@ -67,11 +67,10 @@ package body Ada.Finalization.Heap_Management is procedure Fin_Assert (Condition : Boolean; Message : String); -- Asserts that the condition is True. Used instead of pragma Assert in -- delicate places where raising an exception would cause re-invocation of - -- finalization. Instead of raising an exception, aborts the whole - -- process. + -- finalization. Instead of raising an exception, aborts the whole process. function Is_Empty (Objects : Node_Ptr) return Boolean; - -- True if the Objects list is empty. + -- True if the Objects list is empty ---------------- -- Fin_Assert -- @@ -194,6 +193,7 @@ package body Ada.Finalization.Heap_Management is -- Note: no need to unlock in case of exceptions; the above code cannot -- raise any. + end Attach; --------------- @@ -279,8 +279,10 @@ package body Ada.Finalization.Heap_Management is end if; Unlock_Task.all; + -- Note: no need to unlock in case of exceptions; the above code cannot -- raise any. + end Detach; -------------- @@ -305,9 +307,12 @@ package body Ada.Finalization.Heap_Management is -- modified. if Collection.Finalization_Started then - -- ???Needed for shared libraries. + + -- ???Needed for shared libraries + return; end if; + pragma Debug (Fin_Assert (not Collection.Finalization_Started, "Finalize: already started")); Collection.Finalization_Started := True; @@ -340,7 +345,6 @@ package body Ada.Finalization.Heap_Management is begin Collection.Finalize_Address (Object_Address); - exception when Fin_Except : others => if not Raised then @@ -403,7 +407,7 @@ package body Ada.Finalization.Heap_Management is procedure pcol (Collection : Finalization_Collection) is Head : constant Node_Ptr := Collection.Objects'Unrestricted_Access; -- "Unrestricted", because we are getting access-to-variable of a - -- constant! Normally worrisome, this is OK for debugging code. + -- constant! Normally worrisome, this is OK for debugging code. Head_Seen : Boolean := False; N_Ptr : Node_Ptr; diff --git a/gcc/ada/a-iteint.ads b/gcc/ada/a-iteint.ads index 935cb2d1208..99dd304a4e9 100644 --- a/gcc/ada/a-iteint.ads +++ b/gcc/ada/a-iteint.ads @@ -6,27 +6,10 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2011, Free Software Foundation, Inc. -- --- -- -- This specification is derived from the Ada Reference Manual for use with -- --- GNAT. The copyright notice above, and the license provisions that follow -- --- apply solely to the contents of the part following the private keyword. -- --- -- --- 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- -- -- ------------------------------------------------------------------------------ @@ -34,13 +17,21 @@ generic type Cursor is private; No_Element : Cursor; pragma Unreferenced (No_Element); + package Ada.Iterator_Interfaces is type Forward_Iterator is limited interface; + function First (Object : Forward_Iterator) return Cursor is abstract; - function Next (Object : Forward_Iterator; Position : Cursor) return Cursor - is abstract; + + function Next + (Object : Forward_Iterator; + Position : Cursor) return Cursor is abstract; + type Reversible_Iterator is limited interface and Forward_Iterator; + function Last (Object : Reversible_Iterator) return Cursor is abstract; - function Previous (Object : Reversible_Iterator; Position : Cursor) - return Cursor is abstract; + + function Previous + (Object : Reversible_Iterator; + Position : Cursor) return Cursor is abstract; end Ada.Iterator_Interfaces; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 10c0d799e7e..e7614aa8ac1 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -7870,8 +7870,8 @@ package body Exp_Disp is First_Prim : constant Elmt_Id := First_Elmt (Primitive_Operations (Typ)); The_Tag : constant Entity_Id := First_Tag_Component (Typ); - Adjusted : Boolean := False; - Finalized : Boolean := False; + Adjusted : Boolean := False; + Finalized : Boolean := False; Count_Prim : Nat; DT_Length : Nat; diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index 526fdb79360..58c4eccadb8 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -877,12 +877,11 @@ package body ALFA is procedure Detect_And_Add_ALFA_Scope (N : Node_Id) is begin - if Nkind_In (N, - N_Subprogram_Declaration, - N_Subprogram_Body, - N_Subprogram_Body_Stub, - N_Package_Declaration, - N_Package_Body) + if Nkind_In (N, N_Subprogram_Declaration, + N_Subprogram_Body, + N_Subprogram_Body_Stub, + N_Package_Declaration, + N_Package_Body) then Add_ALFA_Scope (N); end if; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 8e607644a86..b50327304d2 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -174,7 +174,8 @@ package body Lib.Xref is when N_Pragma => if Get_Pragma_Id (Result) = Pragma_Precondition - or else Get_Pragma_Id (Result) = Pragma_Postcondition + or else + Get_Pragma_Id (Result) = Pragma_Postcondition then return Empty; else diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index e4407f2963b..5a8a6956d60 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -893,6 +893,7 @@ package body Par_SCO is if Index /= 0 then declare T : SCO_Table_Entry renames SCO_Table.Table (Index); + begin -- Called multiple times for the same sloc (need to allow for -- C2 = 'P') ??? @@ -1080,7 +1081,7 @@ package body Par_SCO is SCE : SC_Entry renames SC.Table (J); Pragma_Sloc : Source_Ptr := No_Location; begin - -- For the statement SCO for a pragma controlled by + -- For the case of a statement SCO for a pragma controlled by -- Set_SCO_Pragma_Enable, set Pragma_Sloc so that the SCO (and -- those of any nested decision) is emitted only if the pragma -- is enabled. @@ -1506,10 +1507,9 @@ package body Par_SCO is when N_Generic_Instantiation => Typ := 'i'; - when - N_Representation_Clause | - N_Use_Package_Clause | - N_Use_Type_Clause => + when N_Representation_Clause | + N_Use_Package_Clause | + N_Use_Type_Clause => Typ := ASCII.NUL; when others => diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index bdf5610c59e..61a675856b9 100644 --- a/gcc/ada/scos.ads +++ b/gcc/ada/scos.ads @@ -339,7 +339,7 @@ package SCOs is -- Disabled pragmas - -- No SCO is generated for disabled pragmas. + -- No SCO is generated for disabled pragmas --------------------------------------------------------------------- -- Internal table used to store Source Coverage Obligations (SCOs) -- diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index 30b5585448d..a393680094e 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -432,6 +432,7 @@ package body Sem_Ch11 is Exception_Id : constant Node_Id := Name (N); Exception_Name : Entity_Id := Empty; P : Node_Id; + Par : Node_Id; begin Check_SPARK_Restriction ("raise statement is not allowed", N); @@ -443,9 +444,9 @@ package body Sem_Ch11 is Check_Restriction (No_Exceptions, N); end if; - -- Check for useless assignment to OUT or IN OUT scalar immediately - -- preceding the raise. Right now we only look at assignment statements, - -- we could do more. + -- Check for useless assignment to OUT or IN OUT scalar preceding the + -- raise. Right now we only look at assignment statements, we could do + -- more. if Is_List_Member (N) then declare @@ -455,21 +456,49 @@ package body Sem_Ch11 is begin P := Prev (N); + -- Skip past null statements and pragmas + + while Present (P) + and then Nkind_In (P, N_Null_Statement, N_Pragma) + loop + P := Prev (P); + end loop; + + -- See if preceding statement is an assignment + if Present (P) and then Nkind (P) = N_Assignment_Statement then L := Name (P); + -- Give warning for assignment to scalar formal + if Is_Scalar_Type (Etype (L)) and then Is_Entity_Name (L) and then Is_Formal (Entity (L)) then - Error_Msg_N - ("?assignment to pass-by-copy formal may have no effect", - P); - Error_Msg_N - ("\?RAISE statement may result in abnormal return" & - " (RM 6.4.1(17))", P); + -- Don't give warning if we are covered by an exception + -- handler, since this may result in false positives, since + -- the handler may handle the exception and return normally. + + -- First find enclosing sequence of statements + + Par := N; + loop + Par := Parent (Par); + exit when Nkind (Par) = N_Handled_Sequence_Of_Statements; + end loop; + + -- See if there is a handler, give message if not + + if No (Exception_Handlers (Par)) then + Error_Msg_N + ("?assignment to pass-by-copy formal " & + "may have no effect", P); + Error_Msg_N + ("\?RAISE statement may result in abnormal return" & + " (RM 6.4.1(17))", P); + end if; end if; end if; end; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index c25e2e9b02a..4965938c011 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3402,14 +3402,14 @@ package body Sem_Ch12 is and then not Inline_Now and then not ALFA_Mode and then (Operating_Mode = Generate_Code - or else (Operating_Mode = Check_Semantics - and then ASIS_Mode)); + or else (Operating_Mode = Check_Semantics + and then ASIS_Mode)); -- If front_end_inlining is enabled, do not instantiate body if -- within a generic context. if (Front_End_Inlining - and then not Expander_Active) + and then not Expander_Active) or else Is_Generic_Unit (Cunit_Entity (Main_Unit)) then Needs_Body := False; @@ -3430,10 +3430,10 @@ package body Sem_Ch12 is begin if Nkind (Decl) = N_Formal_Package_Declaration or else (Nkind (Decl) = N_Package_Declaration - and then Is_List_Member (Decl) - and then Present (Next (Decl)) - and then - Nkind (Next (Decl)) = + and then Is_List_Member (Decl) + and then Present (Next (Decl)) + and then + Nkind (Next (Decl)) = N_Formal_Package_Declaration) then Needs_Body := False; @@ -4014,12 +4014,12 @@ package body Sem_Ch12 is is begin if (Is_In_Main_Unit (N) - or else Is_Inlined (Subp) - or else Is_Inlined (Alias (Subp))) + or else Is_Inlined (Subp) + or else Is_Inlined (Alias (Subp))) and then not ALFA_Mode and then (Operating_Mode = Generate_Code - or else (Operating_Mode = Check_Semantics - and then ASIS_Mode)) + or else (Operating_Mode = Check_Semantics + and then ASIS_Mode)) and then (Expander_Active or else ASIS_Mode) and then not ABE_Is_Certain (N) and then not Is_Eliminated (Subp) @@ -4033,6 +4033,7 @@ package body Sem_Ch12 is Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, Version => Ada_Version)); return True; + else return False; end if; @@ -11892,14 +11893,13 @@ package body Sem_Ch12 is if Present (E) then -- If the node is an entry call to an entry in an enclosing task, - -- it is rewritten as a selected component. No global entity - -- to preserve in this case, the expansion will be redone in the - -- instance. - - if not Nkind_In (E, - N_Defining_Identifier, - N_Defining_Character_Literal, - N_Defining_Operator_Symbol) + -- it is rewritten as a selected component. No global entity to + -- preserve in this case, since the expansion will be redone in + -- the instance. + + if not Nkind_In (E, N_Defining_Identifier, + N_Defining_Character_Literal, + N_Defining_Operator_Symbol) then Set_Associated_Node (N, Empty); Set_Etype (N, Empty); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c0187d7a2dc..ea54583e718 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4243,24 +4243,24 @@ package body Sem_Ch3 is end if; when Private_Kind => - Set_Ekind (Id, Subtype_Kind (Ekind (T))); - Set_Has_Discriminants (Id, Has_Discriminants (T)); - Set_Is_Constrained (Id, Is_Constrained (T)); - Set_First_Entity (Id, First_Entity (T)); - Set_Last_Entity (Id, Last_Entity (T)); + Set_Ekind (Id, Subtype_Kind (Ekind (T))); + Set_Has_Discriminants (Id, Has_Discriminants (T)); + Set_Is_Constrained (Id, Is_Constrained (T)); + Set_First_Entity (Id, First_Entity (T)); + Set_Last_Entity (Id, Last_Entity (T)); Set_Private_Dependents (Id, New_Elmt_List); - Set_Is_Limited_Record (Id, Is_Limited_Record (T)); + Set_Is_Limited_Record (Id, Is_Limited_Record (T)); Set_Has_Implicit_Dereference - (Id, Has_Implicit_Dereference (T)); + (Id, Has_Implicit_Dereference (T)); Set_Has_Unknown_Discriminants - (Id, Has_Unknown_Discriminants (T)); + (Id, Has_Unknown_Discriminants (T)); Set_Known_To_Have_Preelab_Init (Id, Known_To_Have_Preelab_Init (T)); if Is_Tagged_Type (T) then Set_Is_Tagged_Type (Id); Set_Is_Abstract_Type (Id, Is_Abstract_Type (T)); - Set_Class_Wide_Type (Id, Class_Wide_Type (T)); + Set_Class_Wide_Type (Id, Class_Wide_Type (T)); Set_Direct_Primitive_Operations (Id, Direct_Primitive_Operations (T)); end if; @@ -4273,14 +4273,14 @@ package body Sem_Ch3 is if Has_Discriminants (T) then Set_Discriminant_Constraint - (Id, Discriminant_Constraint (T)); + (Id, Discriminant_Constraint (T)); Set_Stored_Constraint_From_Discriminant_Constraint (Id); elsif Present (Full_View (T)) and then Has_Discriminants (Full_View (T)) then Set_Discriminant_Constraint - (Id, Discriminant_Constraint (Full_View (T))); + (Id, Discriminant_Constraint (Full_View (T))); Set_Stored_Constraint_From_Discriminant_Constraint (Id); -- This would seem semantically correct, but apparently diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 3d7b48ff075..21c7a89b938 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6303,26 +6303,27 @@ package body Sem_Ch4 is Func_Name := Empty; Is_Var := False; - Ritem := First_Rep_Item (Etype (Prefix)); + Ritem := First_Rep_Item (Etype (Prefix)); while Present (Ritem) loop if Nkind (Ritem) = N_Aspect_Specification then -- Prefer Variable_Indexing, but will settle for Constant. if Get_Aspect_Id (Chars (Identifier (Ritem))) = - Aspect_Constant_Indexing + Aspect_Constant_Indexing then Func_Name := Expression (Ritem); elsif Get_Aspect_Id (Chars (Identifier (Ritem))) = - Aspect_Variable_Indexing + Aspect_Variable_Indexing then Func_Name := Expression (Ritem); Is_Var := True; exit; end if; end if; + Next_Rep_Item (Ritem); end loop; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 362e739b8ca..4de5c3d6a68 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -1756,7 +1756,7 @@ package body Sem_Res is procedure Build_Explicit_Dereference (Expr : Node_Id; Disc : Entity_Id); - -- AI05-139 : names with implicit dereference. If the expression N is a + -- AI05-139: Names with implicit dereference. If the expression N is a -- reference type and the context imposes the corresponding designated -- type, convert N into N.Disc.all. Such expressions are always over- -- loaded with both interpretations, and the dereference interpretation @@ -2312,9 +2312,9 @@ package body Sem_Res is elsif Nkind (N) = N_Conditional_Expression then Set_Etype (N, Expr_Type); - -- AI05-0139-2 : expression is overloaded because - -- type has implicit dereference. If type matches - -- context, no implicit dereference is involved. + -- AI05-0139-2: Expression is overloaded because type has + -- implicit dereference. If type matches context, no implicit + -- dereference is involved. elsif Has_Implicit_Dereference (Expr_Type) then Set_Etype (N, Expr_Type); diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index f66caf391b1..ef2d3554671 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -148,7 +148,7 @@ package Sem_Util is -- means that for sure CE cannot be raised. procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id); - -- AI05-139-2 : accessors and iterators for containers. This procedure + -- AI05-139-2: Accessors and iterators for containers. This procedure -- checks whether T is a reference type, and if so it adds an interprettion -- to Expr whose type is the designated type of the reference_discriminant. -- 2.30.2