From patchwork Thu Jan 11 09:09:16 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: 858950 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-470796-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="s1FUTLUA"; 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 3zHKnk05wqz9t3F for ; Thu, 11 Jan 2018 20:09:29 +1100 (AEDT) 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=sXKfwkgi8WWhnzOQSyuLkV/xIXasJGzg1tugHHIVwys6i3lR8R iwPTcuJWKFCs75kydNGe82z8/aeVSzRMyBo3jJS0jEP+Yxf+deHSFCIwewJGHjXb qpYR31lnBI9UjaBbVjjXZ05mN0p1CmIIsIkxpsnwrlp2RdYL6h/En0Dyw= 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=MmhptLTi9FBttP3ywtoYkF8VV3I=; b=s1FUTLUAotYHa5oo2kYr S2jfXYiG7D8AX7bHmwhmY2WvITws4Brd7A1dy7m6laRR9ccyM/bG0v/fCs3g6shE kJs5erVz5apIleGCrtLnUq/ex4lVetEAPs/ed62fZ54zpSb0k0WO+emepGFAQzR7 joSVrAMc549GWzmWsAh45qc= Received: (qmail 62358 invoked by alias); 11 Jan 2018 09:09:20 -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 62255 invoked by uid 89); 11 Jan 2018 09:09:19 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy= 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; Thu, 11 Jan 2018 09:09:17 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 6C3FF117BC3; Thu, 11 Jan 2018 04:09:16 -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 DCiibFDmUiEB; Thu, 11 Jan 2018 04:09:16 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 5C206117BBE; Thu, 11 Jan 2018 04:09:16 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id 5ADB350B; Thu, 11 Jan 2018 04:09:16 -0500 (EST) Date: Thu, 11 Jan 2018 04:09:16 -0500 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Warning on use of predefined operations on an actual fixed-point type Message-ID: <20180111090916.GA103274@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes The compiler warns when a generic actual is a fixed-point type, because arithmetic operations in the instance will use the predefined operations on it, even if the type has user-defined primitive operations (unless formsl surprograms for these operations appear in the generic). This patch refines this warning to exclude the case where the formsal type is private, because in this case there can be no suspicious arithmetic operastions in the generic unit. Tested on x86_64-pc-linux-gnu, committed on trunk 2018-01-11 Ed Schonberg gcc/ada/ * sem_ch12.adb (Check_Fixed_Point_Type): Do not apply check if the formsl type corresponding to the actual fixed point type is private, because in this case there can be no suspicious arithmetic operations in the generic unless they reference a formal subprogram. Clarify warning. gcc/testsuite/ * gnat.dg/fixedpnt2.adb, gnat.dg/fixedpnt2.ads: New testcase. --- gcc/ada/sem_ch12.adb +++ gcc/ada/sem_ch12.adb @@ -1279,7 +1279,8 @@ package body Sem_Ch12 is if No (Formal) then Error_Msg_Sloc := Sloc (Node (Elem)); Error_Msg_NE - ("?instance does not use primitive operation&#", + ("?instance uses predefined operation, " + & "not primitive operation&#", Actual, Node (Elem)); end if; end if; @@ -1717,7 +1718,16 @@ package body Sem_Ch12 is (Formal, Match, Analyzed_Formal, Assoc_List), Assoc_List); - if Is_Fixed_Point_Type (Entity (Match)) then + -- Warn when an actual is a fixed-point with user- + -- defined promitives. The warning is superfluous + -- if the fornal is private, because there can be + -- no arithmetic operations in the generic so there + -- no danger of confusion. + + if Is_Fixed_Point_Type (Entity (Match)) + and then not Is_Private_Type + (Defining_Identifier (Analyzed_Formal)) + then Check_Fixed_Point_Actual (Match); end if; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/fixedpnt2.adb @@ -0,0 +1,25 @@ +-- { dg-do compile } + +with Ada.Unchecked_Conversion; + +package body Fixedpnt2 is + + function To_Integer_64 is + new Ada.Unchecked_Conversion (Source => My_Type, + Target => T_Integer_64); + + function To_T is + new Ada.Unchecked_Conversion (Source => T_Integer_64, + Target => My_Type); + + function "*" (Left : in T_Integer_32; + Right : in My_Type) + return My_Type is + (To_T (S => T_Integer_64 (Left) * To_Integer_64 (S => Right))); + + function "*" (Left : in My_Type; + Right : in T_Integer_32) + return My_Type is + (To_T (S => To_Integer_64 (S => Left) * T_Integer_64 (Right))); + +end Fixedpnt2;--- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/fixedpnt2.ads @@ -0,0 +1,23 @@ +package Fixedpnt2 is + + type T_Integer_32 is range -2 ** 31 .. 2 ** 31 - 1 + with Size => 32; + + type T_Integer_64 is range -2 ** 63 .. 2 ** 63 - 1 + with Size => 64; + + C_Unit : constant := 0.001; -- One millisecond. + C_First : constant := (-2 ** 63) * C_Unit; + C_Last : constant := (2 ** 63 - 1) * C_Unit; + + type My_Type is + delta C_Unit range C_First .. C_Last + with Size => 64, + Small => C_Unit; + + function "*" (Left : in T_Integer_32; Right : in My_Type) + return My_Type; + function "*" (Left : in My_Type; Right : in T_Integer_32) + return My_Type; + +end Fixedpnt2;