From patchwork Mon Aug 29 10:02:24 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 112006 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 73FD2B6F90 for ; Mon, 29 Aug 2011 20:02:48 +1000 (EST) Received: (qmail 2849 invoked by alias); 29 Aug 2011 10:02:43 -0000 Received: (qmail 2836 invoked by uid 22791); 29 Aug 2011 10:02:40 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 29 Aug 2011 10:02:25 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 080532BB103; Mon, 29 Aug 2011 06:02:25 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 0Qeqt9wR7Cqf; Mon, 29 Aug 2011 06:02:24 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id E4BD62BB0E4; Mon, 29 Aug 2011 06:02:24 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id D6F4D3FEE8; Mon, 29 Aug 2011 06:02:24 -0400 (EDT) Date: Mon, 29 Aug 2011 06:02:24 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Matthew Heaney Subject: [Ada] Test for common parent before testing for sibling Message-ID: <20110829100224.GA19600@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Splice_Subtree specifies a position in the target container to which the source subtree should be moved. The target position is a 2-tuple comprising the new parent of the subtree and its new (next) sibling (parameter Before). Before attempting to move the subtree, the implementation must perform two tests. If the Subtree node is the same as the Before node, then the operation does nothing. If the Subtree node's next sibling is the same as Before, then there is nothing else to do. If neither of these conditions hold, then the subtree is moved from the source to the target. However, these tests are only appropriate if the Subtree node and the Before node have the same parent. The bug was that the sibling tests were performed without also testing the parent. The fix is to test the sibling only after also testing the parent. There is one additional change for the bounded from of the tree container. Instead of moving the subtree (which does not make sense for a bounded form), that container first copies the subtree from the source to the target, and then deletes the subtree from the source. There was a bug in which only the children of the source subtree were deleted from the source (the root node of the subtree was not deleted). The fix is to remove all of the subtree node and its children from the source tree. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-29 Matthew Heaney * a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Splice_Subtree): Only check for sibling when common parent. Index: a-cimutr.adb =================================================================== --- a-cimutr.adb (revision 178159) +++ a-cimutr.adb (working copy) @@ -2101,10 +2101,14 @@ end if; if Target'Address = Source'Address then - if Position.Node = Before.Node - or else Position.Node.Next = Before.Node - then - return; + if Position.Node.Parent = Parent.Node then + if Position.Node = Before.Node then + return; + end if; + + if Position.Node.Next = Before.Node then + return; + end if; end if; if Target.Busy > 0 then @@ -2199,10 +2203,14 @@ raise Constraint_Error with "Position cursor designates root"; end if; - if Position.Node = Before.Node - or else Position.Node.Next = Before.Node - then - return; + if Position.Node.Parent = Parent.Node then + if Position.Node = Before.Node then + return; + end if; + + if Position.Node.Next = Before.Node then + return; + end if; end if; if Container.Busy > 0 then Index: a-comutr.adb =================================================================== --- a-comutr.adb (revision 178159) +++ a-comutr.adb (working copy) @@ -2147,10 +2147,14 @@ end if; if Target'Address = Source'Address then - if Position.Node = Before.Node - or else Position.Node.Next = Before.Node - then - return; + if Position.Node.Parent = Parent.Node then + if Position.Node = Before.Node then + return; + end if; + + if Position.Node.Next = Before.Node then + return; + end if; end if; if Target.Busy > 0 then @@ -2245,10 +2249,14 @@ raise Constraint_Error with "Position cursor designates root"; end if; - if Position.Node = Before.Node - or else Position.Node.Next = Before.Node - then - return; + if Position.Node.Parent = Parent.Node then + if Position.Node = Before.Node then + return; + end if; + + if Position.Node.Next = Before.Node then + return; + end if; end if; if Container.Busy > 0 then Index: a-cbmutr.adb =================================================================== --- a-cbmutr.adb (revision 178159) +++ a-cbmutr.adb (working copy) @@ -2676,13 +2676,18 @@ end if; if Target'Address = Source'Address then - if Before = No_Element then - if Target.Nodes (Position.Node).Next <= 0 then -- last child + if Target.Nodes (Position.Node).Parent = Parent.Node then + if Before = No_Element then + if Target.Nodes (Position.Node).Next <= 0 then -- last child + return; + end if; + + elsif Position.Node = Before.Node then return; + + elsif Target.Nodes (Position.Node).Next = Before.Node then + return; end if; - - elsif Position.Node = Before.Node then - return; end if; if Target.Busy > 0 then @@ -2769,13 +2774,18 @@ raise Constraint_Error with "Position cursor designates root"; end if; - if Before = No_Element then - if Container.Nodes (Position.Node).Next <= 0 then -- last child + if Container.Nodes (Position.Node).Parent = Parent.Node then + if Before = No_Element then + if Container.Nodes (Position.Node).Next <= 0 then -- last child + return; + end if; + + elsif Position.Node = Before.Node then return; + + elsif Container.Nodes (Position.Node).Next = Before.Node then + return; end if; - - elsif Position.Node = Before.Node then - return; end if; if Container.Busy > 0 then @@ -2809,6 +2819,11 @@ Target_Count : Count_Type; begin + -- This is a utility operation to do the heavy lifting associated with + -- splicing a subtree from one tree to another. Note that "splicing" + -- is a bit of a misnomer here in the case of a bounded tree, because + -- the elements must be copied from the source to the target. + if Target.Count > Target.Capacity - Source_Count then raise Capacity_Error -- ??? with "Source count exceeds available storage on Target"; @@ -2830,6 +2845,8 @@ pragma Assert (Target_Count = Source_Count); + -- Now link the newly-allocated subtree into the target. + Insert_Subtree_Node (Container => Target, Subtree => Target_Subtree, @@ -2838,6 +2855,11 @@ Target.Count := Target.Count + Target_Count; + -- The manipulation of the Target container is complete. Now we remove + -- the subtree from the Source container. + + Remove_Subtree (Source, Position); -- unlink the subtree + -- As with Copy_Subtree, operation Deallocate_Subtree returns a count of -- the number of nodes it deallocates, but it works by incrementing the -- value passed in. We must therefore initialize the count before @@ -2845,7 +2867,7 @@ Source_Count := 0; - Deallocate_Children (Source, Position, Source_Count); + Deallocate_Subtree (Source, Position, Source_Count); pragma Assert (Source_Count = Target_Count); Source.Count := Source.Count - Source_Count;