From patchwork Mon Jun 11 09:23:44 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 927579 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-479443-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="NqQCOPEA"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 41470c3rPwz9ryk for ; Mon, 11 Jun 2018 19:25:36 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=DyX6MOqJcjyIh4Fm/IdOrwJtieEGMUONmkhj3hUlOLi03Q422D LgsenfA8PoERHnU7yuyjqg8D5c26r4IS1yqlDr0mA4mwmalLeLVAPIzJCEYviSRI nrWB09wb+aQpJ8Ucf7Wk32d67Z1cM2DsAfOlNi/FFl74Fma4jaM/Kd72g= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=E6nXvyGOHmfbuKo/3Ss444eP+fY=; b=NqQCOPEAXn+3UfJh61+O yMIWnfxEVu58UtcU8s87aWhoah8xZWcj01Sz/sneDDqiEqcIIjoHUTOw/I9EKzXS NFnJV/pvi+asKsuUjuIRrMpeG9GUJWfj7I4AZoNBTfH/yFA5jdfRkfPucbowgbl8 Y8sSnYEr9pVUF2lzRIy20Sk= Received: (qmail 34554 invoked by alias); 11 Jun 2018 09:23:50 -0000 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 Received: (qmail 34427 invoked by uid 89); 11 Jun 2018 09:23:49 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=bob, Bob, duff, obligated X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 11 Jun 2018 09:23:47 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id E549A560FA; Mon, 11 Jun 2018 05:23:45 -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 7HG8V1stfABd; Mon, 11 Jun 2018 05:23:45 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id B7D65560ED; Mon, 11 Jun 2018 05:23:44 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id B548354C; Mon, 11 Jun 2018 05:23:44 -0400 (EDT) Date: Mon, 11 Jun 2018 05:23:44 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] Dangling cursor checks in Element function Message-ID: <20180611092344.GA135092@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes In Ada.Containers.Ordered_Maps, if a dangling cursor is passed to the Element function, execution is erroneous. Therefore, the compiler is not obligated to detect this error. However, this patch inserts code that will detect this error in some cases, and raise Program_Error. The same applies to Ordered_Sets, Ordered_Multisets, Indefinite_Ordered_Maps, Indefinite_Ordered_Sets, and Indefinite_Ordered_Multisets. No test available for erroneous execution. Tested on x86_64-pc-linux-gnu, committed on trunk 2018-06-11 Bob Duff gcc/ada/ * libgnat/a-ciorma.adb, libgnat/a-ciormu.adb, libgnat/a-ciorse.adb, libgnat/a-coorma.adb, libgnat/a-coormu.adb, libgnat/a-coorse.adb: (Element): Add code to detect dangling cursors in some cases. --- gcc/ada/libgnat/a-ciorma.adb +++ gcc/ada/libgnat/a-ciorma.adb @@ -541,6 +541,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is "Position cursor of function Element is bad"; end if; + if Checks and then + (Left (Position.Node) = Position.Node + or else Right (Position.Node) = Position.Node) + then + raise Program_Error with "dangling cursor"; + end if; + pragma Assert (Vet (Position.Container.Tree, Position.Node), "Position cursor of function Element is bad"); --- gcc/ada/libgnat/a-ciormu.adb +++ gcc/ada/libgnat/a-ciormu.adb @@ -545,6 +545,13 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is raise Program_Error with "Position cursor is bad"; end if; + if Checks and then + (Left (Position.Node) = Position.Node + or else Right (Position.Node) = Position.Node) + then + raise Program_Error with "dangling cursor"; + end if; + pragma Assert (Vet (Position.Container.Tree, Position.Node), "bad cursor in Element"); --- gcc/ada/libgnat/a-ciorse.adb +++ gcc/ada/libgnat/a-ciorse.adb @@ -534,6 +534,13 @@ package body Ada.Containers.Indefinite_Ordered_Sets is raise Program_Error with "Position cursor is bad"; end if; + if Checks and then + (Left (Position.Node) = Position.Node + or else Right (Position.Node) = Position.Node) + then + raise Program_Error with "dangling cursor"; + end if; + pragma Assert (Vet (Position.Container.Tree, Position.Node), "bad cursor in Element"); --- gcc/ada/libgnat/a-coorma.adb +++ gcc/ada/libgnat/a-coorma.adb @@ -481,6 +481,13 @@ package body Ada.Containers.Ordered_Maps is "Position cursor of function Element equals No_Element"; end if; + if Checks and then + (Left (Position.Node) = Position.Node + or else Right (Position.Node) = Position.Node) + then + raise Program_Error with "dangling cursor"; + end if; + pragma Assert (Vet (Position.Container.Tree, Position.Node), "Position cursor of function Element is bad"); --- gcc/ada/libgnat/a-coormu.adb +++ gcc/ada/libgnat/a-coormu.adb @@ -502,6 +502,13 @@ package body Ada.Containers.Ordered_Multisets is raise Constraint_Error with "Position cursor equals No_Element"; end if; + if Checks and then + (Left (Position.Node) = Position.Node + or else Right (Position.Node) = Position.Node) + then + raise Program_Error with "dangling cursor"; + end if; + pragma Assert (Vet (Position.Container.Tree, Position.Node), "bad cursor in Element"); --- gcc/ada/libgnat/a-coorse.adb +++ gcc/ada/libgnat/a-coorse.adb @@ -480,6 +480,13 @@ package body Ada.Containers.Ordered_Sets is raise Constraint_Error with "Position cursor equals No_Element"; end if; + if Checks and then + (Left (Position.Node) = Position.Node + or else Right (Position.Node) = Position.Node) + then + raise Program_Error with "dangling cursor"; + end if; + pragma Assert (Vet (Position.Container.Tree, Position.Node), "bad cursor in Element");