From patchwork Fri Dec 2 14:46:25 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 128879 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 879001007D4 for ; Sat, 3 Dec 2011 01:46:52 +1100 (EST) Received: (qmail 18655 invoked by alias); 2 Dec 2011 14:46:43 -0000 Received: (qmail 18361 invoked by uid 22791); 2 Dec 2011 14:46:41 -0000 X-SWARE-Spam-Status: No, hits=-0.4 required=5.0 tests=AWL, BAYES_00, FILL_THIS_FORM, FILL_THIS_FORM_LOAN 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; Fri, 02 Dec 2011 14:46:26 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 33FDD2BB063; Fri, 2 Dec 2011 09:46:25 -0500 (EST) 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 DmJwg7P4EY1W; Fri, 2 Dec 2011 09:46:25 -0500 (EST) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 16B682BAF65; Fri, 2 Dec 2011 09:46:25 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id 108E23FEE8; Fri, 2 Dec 2011 09:46:25 -0500 (EST) Date: Fri, 2 Dec 2011 09:46:25 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Matthew Heaney Subject: [Ada] Check preconditions for child iterator of multiway tree container Message-ID: <20111202144625.GA23381@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 The iterator for visiting children of a node in a multiway tree must check the value of the Parent parameter to ensure that it is non-null, and that it actually designates a node in the tree. There were also several instances where cursor values returned by iterator operations were not well-formed. That has been corrected by forwarding the iterator operation to the corresponding cursor-based operation. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-12-02 Matthew Heaney * a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Iterator): Rename Position component. (Finalize): Remove unnecessary access check. (First): Forward to First_Child. (Last): Forward to Last_Child. (Iterate): Check preconditions for parent node parameter. (Next): Forward to Next_Sibling. (Previous): Forward to Previous_Sibling. Index: a-cimutr.adb =================================================================== --- a-cimutr.adb (revision 181912) +++ a-cimutr.adb (working copy) @@ -45,7 +45,7 @@ Tree_Iterator_Interfaces.Reversible_Iterator with record Container : Tree_Access; - Position : Cursor; + Parent : Tree_Node_Access; end record; overriding procedure Finalize (Object : in out Iterator); @@ -937,25 +937,15 @@ -------------- procedure Finalize (Object : in out Iterator) is + B : Natural renames Object.Container.Busy; begin - if Object.Container /= null then - declare - B : Natural renames Object.Container.all.Busy; - begin - B := B - 1; - end; - end if; + B := B - 1; end Finalize; procedure Finalize (Object : in out Child_Iterator) is + B : Natural renames Object.Container.Busy; begin - if Object.Container /= null then - declare - B : Natural renames Object.Container.all.Busy; - begin - B := B - 1; - end; - end if; + B := B - 1; end Finalize; ---------- @@ -988,7 +978,7 @@ function First (Object : Child_Iterator) return Cursor is begin - return (Object.Container, Object.Position.Node.Children.First); + return First_Child (Cursor'(Object.Container, Object.Parent)); end First; ----------------- @@ -1433,13 +1423,22 @@ Parent : Cursor) return Tree_Iterator_Interfaces.Reversible_Iterator'Class is - B : Natural renames Container'Unrestricted_Access.all.Busy; + C : constant Tree_Access := Container'Unrestricted_Access; + B : Natural renames C.Busy; begin + if Parent = No_Element then + raise Constraint_Error with "Parent cursor has no element"; + end if; + + if Parent.Container /= C then + raise Program_Error with "Parent cursor not in container"; + end if; + return It : constant Child_Iterator := Child_Iterator'(Limited_Controlled with - Container => Parent.Container, - Position => Parent) + Container => C, + Parent => Parent.Node) do B := B + 1; end return; @@ -1516,7 +1515,7 @@ overriding function Last (Object : Child_Iterator) return Cursor is begin - return (Object.Container, Object.Position.Node.Children.Last); + return Last_Child (Cursor'(Object.Container, Object.Parent)); end Last; ---------------- @@ -1646,18 +1645,20 @@ end Next; function Next - (Object : Child_Iterator; + (Object : Child_Iterator; Position : Cursor) return Cursor is - C : constant Tree_Node_Access := Position.Node.Next; - begin - if C = null then + if Position.Container = null then return No_Element; + end if; - else - return (Object.Container, C); + if Position.Container /= Object.Container then + raise Program_Error with + "Position cursor of Next designates wrong tree"; end if; + + return Next_Sibling (Position); end Next; ------------------ @@ -1787,18 +1788,20 @@ -------------- overriding function Previous - (Object : Child_Iterator; + (Object : Child_Iterator; Position : Cursor) return Cursor is - C : constant Tree_Node_Access := Position.Node.Prev; - begin - if C = null then + if Position.Container = null then return No_Element; + end if; - else - return (Object.Container, C); + if Position.Container /= Object.Container then + raise Program_Error with + "Position cursor of Previous designates wrong tree"; end if; + + return Previous_Sibling (Position); end Previous; ---------------------- Index: a-comutr.adb =================================================================== --- a-comutr.adb (revision 181913) +++ a-comutr.adb (working copy) @@ -46,7 +46,7 @@ Tree_Iterator_Interfaces.Reversible_Iterator with record Container : Tree_Access; - Position : Cursor; + Parent : Tree_Node_Access; end record; overriding procedure Finalize (Object : in out Iterator); @@ -910,25 +910,15 @@ -------------- procedure Finalize (Object : in out Iterator) is + B : Natural renames Object.Container.Busy; begin - if Object.Container /= null then - declare - B : Natural renames Object.Container.all.Busy; - begin - B := B - 1; - end; - end if; + B := B - 1; end Finalize; procedure Finalize (Object : in out Child_Iterator) is + B : Natural renames Object.Container.Busy; begin - if Object.Container /= null then - declare - B : Natural renames Object.Container.all.Busy; - begin - B := B - 1; - end; - end if; + B := B - 1; end Finalize; ---------- @@ -960,7 +950,7 @@ function First (Object : Child_Iterator) return Cursor is begin - return (Object.Container, Object.Position.Node.Children.First); + return First_Child (Cursor'(Object.Container, Object.Parent)); end First; ----------------- @@ -1461,12 +1451,22 @@ Parent : Cursor) return Tree_Iterator_Interfaces.Reversible_Iterator'Class is - B : Natural renames Container'Unrestricted_Access.all.Busy; + C : constant Tree_Access := Container'Unrestricted_Access; + B : Natural renames C.Busy; + begin + if Parent = No_Element then + raise Constraint_Error with "Parent cursor has no element"; + end if; + + if Parent.Container /= C then + raise Program_Error with "Parent cursor not in container"; + end if; + return It : constant Child_Iterator := Child_Iterator'(Limited_Controlled with - Container => Parent.Container, - Position => Parent) + Container => C, + Parent => Parent.Node) do B := B + 1; end return; @@ -1542,7 +1542,7 @@ overriding function Last (Object : Child_Iterator) return Cursor is begin - return (Object.Container, Object.Position.Node.Children.Last); + return Last_Child (Cursor'(Object.Container, Object.Parent)); end Last; ---------------- @@ -1675,9 +1675,17 @@ (Object : Child_Iterator; Position : Cursor) return Cursor is - C : constant Tree_Node_Access := Position.Node.Next; begin - return (if C = null then No_Element else (Object.Container, C)); + if Position.Container = null then + return No_Element; + end if; + + if Position.Container /= Object.Container then + raise Program_Error with + "Position cursor of Next designates wrong tree"; + end if; + + return Next_Sibling (Position); end Next; ------------------ @@ -1807,9 +1815,17 @@ (Object : Child_Iterator; Position : Cursor) return Cursor is - C : constant Tree_Node_Access := Position.Node.Prev; begin - return (if C = null then No_Element else (Object.Container, C)); + if Position.Container = null then + return No_Element; + end if; + + if Position.Container /= Object.Container then + raise Program_Error with + "Position cursor of Previous designates wrong tree"; + end if; + + return Previous_Sibling (Position); end Previous; ---------------------- Index: a-cbmutr.adb =================================================================== --- a-cbmutr.adb (revision 181912) +++ a-cbmutr.adb (working copy) @@ -55,7 +55,7 @@ Tree_Iterator_Interfaces.Reversible_Iterator with record Container : Tree_Access; - Position : Cursor; + Parent : Count_Type; end record; overriding procedure Finalize (Object : in out Child_Iterator); @@ -1243,25 +1243,15 @@ -------------- procedure Finalize (Object : in out Iterator) is + B : Natural renames Object.Container.Busy; begin - if Object.Container /= null then - declare - B : Natural renames Object.Container.all.Busy; - begin - B := B - 1; - end; - end if; + B := B - 1; end Finalize; procedure Finalize (Object : in out Child_Iterator) is + B : Natural renames Object.Container.Busy; begin - if Object.Container /= null then - declare - B : Natural renames Object.Container.all.Busy; - begin - B := B - 1; - end; - end if; + B := B - 1; end Finalize; ---------- @@ -1294,10 +1284,8 @@ end First; function First (Object : Child_Iterator) return Cursor is - Node : Count_Type'Base; begin - Node := Object.Container.Nodes (Object.Position.Node).Children.First; - return (Object.Container, Node); + return First_Child (Cursor'(Object.Container, Object.Parent)); end First; ----------------- @@ -1876,13 +1864,22 @@ Parent : Cursor) return Tree_Iterator_Interfaces.Reversible_Iterator'Class is - B : Natural renames Container'Unrestricted_Access.all.Busy; + C : constant Tree_Access := Container'Unrestricted_Access; + B : Natural renames C.Busy; begin + if Parent = No_Element then + raise Constraint_Error with "Parent cursor has no element"; + end if; + + if Parent.Container /= C then + raise Program_Error with "Parent cursor not in container"; + end if; + return It : constant Child_Iterator := Child_Iterator'(Limited_Controlled with - Container => Parent.Container, - Position => Parent) + Container => C, + Parent => Parent.Node) do B := B + 1; end return; @@ -1965,7 +1962,7 @@ overriding function Last (Object : Child_Iterator) return Cursor is begin - return Last_Child (Object.Position); + return Last_Child (Cursor'(Object.Container, Object.Parent)); end Last; ---------------- @@ -2089,15 +2086,20 @@ end if; end Next; - function Next + overriding function Next (Object : Child_Iterator; Position : Cursor) return Cursor is begin - if Object.Container /= Position.Container then - raise Program_Error; + if Position.Container = null then + return No_Element; end if; + if Position.Container /= Object.Container then + raise Program_Error with + "Position cursor of Next designates wrong tree"; + end if; + return Next_Sibling (Position); end Next; @@ -2255,10 +2257,15 @@ Position : Cursor) return Cursor is begin - if Object.Container /= Position.Container then - raise Program_Error; + if Position.Container = null then + return No_Element; end if; + if Position.Container /= Object.Container then + raise Program_Error with + "Position cursor of Previous designates wrong tree"; + end if; + return Previous_Sibling (Position); end Previous;