From patchwork Tue May 12 15:01:05 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 471379 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 C8F19140D18 for ; Wed, 13 May 2015 01:01:49 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=P5bJn3Um; 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=B4oZyWFxipdr2IQipyRQyg9GY8ou+b5MPm/g1VISzxzdP77Zgh TwzEXzE0zrp8sAmSU2oyTgXuYrNCgIsReXnS2ukylB08ICyc3OvuDz65qoKXLveE vefg+BZLtq1ai13T4zq8O4weDSZw6qf0JtXhFXQ1nRTU1BLZyvkhKJWuk= 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=hNQe4cLOe6+XJWp7nAAGjjeyd3Q=; b=P5bJn3Um6yoeT+xiHxkQ OEraoahvoEb4dk/NiDfagUpj4DO2lxkSOZ7E0ZdjoSJM2VPs6ANCghqaJ9JSgKwV 9CywgVowu8JC6Ev+lLzHspQM6LP04K8CTFl9qJrQlUCtVFICEQKkrfw4eBB5I6Fk plWOybPlqnNw8xS3EjWzVy8= Received: (qmail 64222 invoked by alias); 12 May 2015 15:01:10 -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 64153 invoked by uid 89); 12 May 2015 15:01:09 -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 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; Tue, 12 May 2015 15:01:07 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id C4A4828715; Tue, 12 May 2015 11:01:05 -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 ogC6m0+pdwI4; Tue, 12 May 2015 11:01:05 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id B44CD28673; Tue, 12 May 2015 11:01:05 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id B2B1D439C4; Tue, 12 May 2015 11:01:05 -0400 (EDT) Date: Tue, 12 May 2015 11:01:05 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Legality checks on a formal derived type derived from previous formal. Message-ID: <20150512150105.GA6209@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.21 (2010-09-15) This patch adds a missing legality check on the instantiation of a formal derived type whose parent type is a previous formal of the same generic unit, that is not a derived type. Compiling generic_testm.adb must yield: generic_testm.adb:7:26: expect type derived from "Integer" in instantiation generic_testm.adb:7:26: instantiation abandoned generic_testm.adb:20:26: expect type derived from "Boolean" in instantiation generic_testm.adb:20:26: instantiation abandoned generic_testm.adb:26:10: "Convert" is undefined (more references follow) generic_testm.adb:32:15: "Convert_Pfff" is undefined --- with Generic_Test; procedure Generic_TestM is package Convert is new Generic_Test (Data_Type => Natural, Other_Data_Type => Boolean); From : constant Natural := Natural'First; To : Boolean; type Pfff is record Pff_1 : Natural; Pff_2 : Character; end record; package Convert_Pfff is new Generic_Test (Data_Type => Boolean, Other_Data_Type => Pfff); To_Pfff : Pfff; From_Pfff : constant Boolean := Boolean'First; begin To := Convert.Data_To_Other (Data => From); if To /= Convert.Data_To_Other (Data => 0) then raise Constraint_Error; end if; To_Pfff := Convert_Pfff.Data_To_Other (Data => From_Pfff); if not To_Pfff.Pff_1'Valid or not To_Pfff.Pff_2'Valid then raise Constraint_Error; end if; end; --- generic type Data_Type is (<>); type Other_Data_Type is new Data_Type; package Generic_Test is -- Add the parameter with provided Id and its value -- to the list of parameters. function Data_To_Other (Data : in Data_Type) return Other_Data_Type; end Generic_Test; -- package body Generic_Test is function Data_To_Other (Data : in Data_Type) return Other_Data_Type is begin return Other_Data_Type (Data); end Data_To_Other; end Generic_Test; Tested on x86_64-pc-linux-gnu, committed on trunk 2015-05-12 Ed Schonberg * sem_ch12.adb (Validate_Derived_Type_Instance): Handle properly the checks on a derived formal whose parent type is a previous formal that is not a derived type. Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 223064) +++ sem_ch12.adb (working copy) @@ -11698,6 +11698,14 @@ Get_Instance_Of (Base_Type (Get_Instance_Of (A_Gen_T))); end if; + -- Check whether parent is a previous formal of the current generic + + elsif Is_Derived_Type (A_Gen_T) + and then Is_Generic_Type (Etype (A_Gen_T)) + and then Scope (A_Gen_T) = Scope (Etype (A_Gen_T)) + then + Ancestor := Get_Instance_Of (First_Subtype (Etype (A_Gen_T))); + -- An unusual case: the actual is a type declared in a parent unit, -- but is not a formal type so there is no instance_of for it. -- Retrieve it by analyzing the record extension. @@ -11733,6 +11741,9 @@ Actual, Ancestor); end if; + -- Finally verify that the (instance of) the ancestor is an ancestor + -- of the actual. + elsif not Is_Ancestor (Base_Type (Ancestor), Act_T) then Error_Msg_NE ("expect type derived from & in instantiation",