From patchwork Fri Nov 13 11:31:24 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 544253 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]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id E2A2614141E for ; Fri, 13 Nov 2015 22:31:47 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=DwkU48eW; dkim-atps=neutral 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=SVkVdkLIUflMmq3RQE2dSaWUeENtbSa9kVOHSaxNFiI+RCXLrt CQ/gKdGdP5I3pQuoFnwecLalFji0WRUt8PBkX7HA7NzGShbLjxUT1xRjdh3eFCMo mIa8VTUN2bcYiBVeN8P7cO0QY3omlajZPMegwwbBhR+LemE47/Y0LKC0U= 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=Rwwf236pSRhHc1AiOLSiANae/zo=; b=DwkU48eWgJtr8UygLLHk fX3ATAFKP9Yd9h2oT1sKQS8qcPXcpAXMo4dDBcPDhesxff9+WmjYOtQhFqxrYvSn 3twyOhXb2Db8nDMXfTCS8m1OW/vL739y4eahwnujsyTiCjhXg3TPaZQJqvs5le52 /ZzoLs5zkV0fK1oX114dReM= Received: (qmail 72293 invoked by alias); 13 Nov 2015 11:31:29 -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 72055 invoked by uid 89); 13 Nov 2015 11:31:28 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.1 required=5.0 tests=AWL, BAYES_50, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_LOW autolearn=no version=3.3.2 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 (AES256-SHA encrypted) ESMTPS; Fri, 13 Nov 2015 11:31:26 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5B4B7299B5; Fri, 13 Nov 2015 06:31:24 -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 HPnBE2qQzMvF; Fri, 13 Nov 2015 06:31:24 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 4B0142905C; Fri, 13 Nov 2015 06:31:24 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4192) id 4764F18B; Fri, 13 Nov 2015 06:31:24 -0500 (EST) Date: Fri, 13 Nov 2015 06:31:24 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Iterable aspect for an integer type Message-ID: <20151113113124.GA102727@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch fixes a spurious error on an iterator loop over an integer type on which the Iterable aspect has been specified. Analysis of the loop uses the base type to find the required primitive operations, but the signature of the First primitive and others uses the first subtype instead. Executing gnatmake -q vect1 vect1 must yield: iteration over cursors 0 1 2 3 4 iteration over elements 0 1 2 3 4 --- with Text_IO; use Text_IO; procedure Vect1 is package Iter is type Vector_Id is new Natural with Iterable => (First => First, Next => Next, Has_Element => Has_Element, Element => Element); type Cursor is new Natural; function First (Vector : Vector_Id) return Cursor; function Next (Vector : Vector_Id; Position : Cursor) return Cursor; function Has_Element (Vector : Vector_Id; Position : Cursor) return Boolean; function Element (Vector : Vector_Id; Position : Cursor) return Natural; end Iter; package body Iter is function First (Vector : Vector_Id) return Cursor is begin return 0; end First; function Next (Vector : Vector_Id; Position : Cursor) return Cursor is begin return Position + 1; end Next; function Has_Element (Vector : Vector_Id; Position : Cursor) return Boolean is begin return Position < Cursor (Vector); end Has_Element; function Element (Vector : Vector_Id; Position : Cursor) return Natural is begin return Natural (Position); end Element; end Iter; use Iter; V : Vector_Id; begin V := 5; Put_Line ("iteration over cursors"); for I in V loop put_line (integer'image (Integer (I))); null; end loop; Put_Line ("iteration over elements"); for I of V loop put_line (integer'image (Integer (I))); null; end loop; end Vect1; Tested on x86_64-pc-linux-gnu, committed on trunk 2015-11-13 Ed Schonberg * sem_util.adb (Get_Cursor_Type): To determine whether a function First is the proper Iterable primitive, use the base type of the first formal rather than the type. This is needed in the unusual case where the Iterable aspect is specified for an integer type. Index: sem_util.adb =================================================================== --- sem_util.adb (revision 230301) +++ sem_util.adb (working copy) @@ -7553,13 +7553,16 @@ Cursor := Any_Type; -- Locate function with desired name and profile in scope of type + -- In the rare case where the type is an integer type, a base type + -- is created for it, check that the base type of the first formal + -- of First matches the base type of the domain. Func := First_Entity (Scope (Typ)); while Present (Func) loop if Chars (Func) = Chars (First_Op) and then Ekind (Func) = E_Function and then Present (First_Formal (Func)) - and then Etype (First_Formal (Func)) = Typ + and then Base_Type (Etype (First_Formal (Func))) = Base_Type (Typ) and then No (Next_Formal (First_Formal (Func))) then if Cursor /= Any_Type then