From patchwork Mon Jul 4 10:09:21 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 644064 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 3rjjS52bxVz9sBG for ; Mon, 4 Jul 2016 20:09:57 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=ULbnugPe; 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=Ugo2KwBxKTVPs7xSb7Z1mZBlelx48/DMp5Jb8TQuWPMjldyAgj OJF8fdmmnPsUy/OuCU8jJJh89xjyc9JQSfNe90G1ddfb8eeoykBgz4MsatnqleRx +Mq1gApsSuLbEAl+24Sdu73A89kHgv/cOJgWizsugDXcenkx0Y/op5gXw= 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=zPmMLn8kMUuPIK49WoBVtfBcfv4=; b=ULbnugPet9SqQqa3HWQf TWVJ6g+iA2xdvZHlqPg9Gh52tIZw8sHER7slL/cipHPtqfWC0WqqvK9FtVoGk5sK j/gAMOdxyunc3RV+zQtgb63OmNJ1lCFEJSYrmUV4O2cWq/w4UFkAfMbytRXrkNnc /ImOsWk+7yn/M0Wnjk+R1tM= Received: (qmail 128637 invoked by alias); 4 Jul 2016 10:09:34 -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 128540 invoked by uid 89); 4 Jul 2016 10:09:33 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.6 required=5.0 tests=BAYES_50, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=no version=3.3.2 spammy=incomplete, Create, Ekind, Base_Type 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; Mon, 04 Jul 2016 10:09:23 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id E20DA1169A3; Mon, 4 Jul 2016 06:09:21 -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 CJExYBeLk8-w; Mon, 4 Jul 2016 06:09:21 -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 D266C11687C; Mon, 4 Jul 2016 06:09:21 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id D181E445; Mon, 4 Jul 2016 06:09:21 -0400 (EDT) Date: Mon, 4 Jul 2016 06:09:21 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Spurious type errors because of views confusion in predicate functions Message-ID: <20160704100921.GA107055@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) In the context of a predicate function the formal and the actual in a call may have different views of the same type, because of the delayed analysis of predicates aspects. This patch extends existing code that handles this discrepancy, to cover private and full views as well. Executing the following: gnatmake -q main main must yield: toto --- with GPR2.Attribute; use GPR2.Attribute; procedure Main is Q_Name : constant GPR2.Attribute.Qualified_Name := GPR2.Attribute.Create ("toto"); begin Dump (Q_Name); end Main; --- package GPR2 is subtype Name_Type is String with Dynamic_Predicate => Name_Type'Length > 0; end GPR2; --- with Text_IO; use Text_IO; package body GPR2.Attribute is function Create (Name : Name_Type) return Qualified_Name is begin return Qualified_Name (Name); end; procedure Dump (Obj : Qualified_Name) is begin Put_Line (String (Obj)); end; end GPR2.Attribute; --- with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; package GPR2.Attribute is type Qualified_Name (<>) is private; function Create (Name : Name_Type) return Qualified_Name; procedure Dump (Obj : Qualified_Name); private type Qualified_Name is new Name_Type; end GPR2.Attribute; Tested on x86_64-pc-linux-gnu, committed on trunk 2016-07-04 Ed Schonberg * sem_ch4.adb (Resolve_One_Call): In the context of a predicate function the formal and the actual in a call may have different views of the same type, because of the delayed analysis of predicates aspects. Extend the patch that handles this potential discrepancy to handle private and full views as well. * sem_ch8.adb (Find_Selected_Component): Refine predicate that produces additional error when an illegal selected component looks like a prefixed call whose first formal is untagged. Index: sem_ch4.adb =================================================================== --- sem_ch4.adb (revision 237957) +++ sem_ch4.adb (working copy) @@ -3413,9 +3413,17 @@ -- an incomplete type, while resolution of the corresponding -- predicate function may see the full view, as a consequence -- of the delayed resolution of the corresponding expressions. + -- This can occur in the body of a predicate function, or in + -- a call to such. - elsif Ekind (Etype (Formal)) = E_Incomplete_Type - and then Full_View (Etype (Formal)) = Etype (Actual) + elsif ((Ekind (Current_Scope) = E_Function + and then Is_Predicate_Function (Current_Scope)) + or else (Ekind (Nam) = E_Function + and then Is_Predicate_Function (Nam))) + and then + (Base_Type (Underlying_Type (Etype (Formal))) = + Base_Type (Underlying_Type (Etype (Actual)))) + and then Serious_Errors_Detected = 0 then Set_Etype (Formal, Etype (Actual)); Next_Actual (Actual); Index: sem_ch8.adb =================================================================== --- sem_ch8.adb (revision 237957) +++ sem_ch8.adb (working copy) @@ -6983,7 +6983,8 @@ elsif Nkind (P) /= N_Attribute_Reference then -- This may have been meant as a prefixed call to a primitive - -- of an untagged type. + -- of an untagged type. If it is a function call check type of + -- its first formal and add explanation. declare F : constant Entity_Id := @@ -6992,8 +6993,7 @@ if Present (F) and then Is_Overloadable (F) and then Present (First_Entity (F)) - and then Etype (First_Entity (F)) = Etype (P) - and then not Is_Tagged_Type (Etype (P)) + and then not Is_Tagged_Type (Etype (First_Entity (F))) then Error_Msg_N ("prefixed call is only allowed for objects "