From patchwork Mon Oct 29 10:17:49 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 194938 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]) by ozlabs.org (Postfix) with SMTP id DEE362C0086 for ; Mon, 29 Oct 2012 21:20:08 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1352110809; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=Tzyob45o5h0nXls1cIk4 2hmLV0I=; b=oBHiQp6HqNMKhDqhcmeA1IU9yPYMtv6b621iCeBsdkIPvSzEEnyY g17l33rsHJzYfJ2soKu+CrUlS5to3soBW+uy05wtMaclFNcVIs1sl25T3Ub27Nr6 ARVMFRx7udsSW0kplGrClDTJSvv8Z/7Mq2QNPM4ngy7mkpNsXCF2zro= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=ehean1rqA/wTtm6hl8Ocvitr5F6a6N4DBG3nX/jlLo6WedJJgJnBVMHnLNx7pv tQy+rtO8ImVE+i+TEV8u8DPwSdy2LxZfcbySAqspggyj2Skx/c840KxIiiuCL6BT 8sLtaBgIJoQFwL0H5KOLJN+cOdEMqGUMmBbrX6hLxVM+o=; Received: (qmail 10525 invoked by alias); 29 Oct 2012 10:18:44 -0000 Received: (qmail 10006 invoked by uid 22791); 29 Oct 2012 10:18:01 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO, TW_PR X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 29 Oct 2012 10:17:50 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id BFB7E1C7910; Mon, 29 Oct 2012 06:17:49 -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 t+lJegnl-gyQ; Mon, 29 Oct 2012 06:17:49 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id A400E1C750F; Mon, 29 Oct 2012 06:17:49 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id A3BD73FF09; Mon, 29 Oct 2012 06:17:49 -0400 (EDT) Date: Mon, 29 Oct 2012 06:17:49 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Warn on redefinition of standard entities Message-ID: <20121029101749.GA26188@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) 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 A new warning flag -gnatw.k causes the compiler to emit a warning if a declaration redefines an entity of package Standard. Such redefinitions are usually not a good idea, since these entities are directly visible, and this can lead to confusion. This warning is off by default. The following, compiled with -gnatw.k shows the warning in action: 1. package StandNames is 2. type Integer is new Natural; | >>> warning: redefinition of entity "Integer" in Standard 3. type Exceptions is (Tasking_Error, Storage_Error); | >>> warning: redefinition of entity "Tasking_Error" in Standard 4. end StandNames; Tested on x86_64-pc-linux-gnu, committed on trunk 2012-10-29 Robert Dewar * i-cstrea.ads: Avoid redefinition of standard symbol string. * prj-makr.adb: Add comment for OK redefinition of Stadard. * prj.ads: Add comment for OK redefinition of Stadard. * s-crtl.ads: Avoid redefinition of standard symbol string. * sinfo-cn.adb (Change_Identifier_To_Defining_Identifier): Generate warning for standard redefinition if Warn_On_Standard_Definition set. * usage.adb: Add lines for -gnatw.k and -gnatw.K * warnsw.adb: Set/reset Warn_On_Standard_Redefinition appropriately. * warnsw.ads (Warn_On_Standard_Redefinition): New flag. * s-stratt-xdr.adb: Avoid new warning. Index: i-cstrea.ads =================================================================== --- i-cstrea.ads (revision 192908) +++ i-cstrea.ads (working copy) @@ -175,7 +175,7 @@ mode : int; size : size_t) return int; - procedure tmpnam (string : chars) renames System.CRTL.tmpnam; + procedure tmpnam (str : chars) renames System.CRTL.tmpnam; -- The parameter must be a pointer to a string buffer of at least L_tmpnam -- bytes (the call with a null parameter is not supported). The returned -- value, which is just a copy of the input argument, is discarded. Index: prj.ads =================================================================== --- prj.ads (revision 192908) +++ prj.ads (working copy) @@ -68,14 +68,21 @@ type Yes_No_Unknown is (Yes, No, Unknown); -- Tri-state to decide if -lgnarl is needed when linking + pragma Warnings (Off); type Project_Qualifier is (Unspecified, + + -- The following clash with Standard is OK, and justified by the context + -- which really wants to use the same set of qualifiers. + Standard, + Library, Configuration, Dry, Aggregate, Aggregate_Library); + pragma Warnings (On); -- Qualifiers that can prefix the reserved word "project" in a project -- file: -- Standard: standard project ... @@ -1188,8 +1195,18 @@ -- The following record describes a project file representation - type Standalone is (No, Standard, Encapsulated); + pragma Warnings (Off); + type Standalone is + (No, + -- The following clash with Standard is OK, and justified by the context + -- which really wants to use the same set of qualifiers. + + Standard, + + Encapsulated); + pragma Warnings (On); + type Project_Data (Qualifier : Project_Qualifier := Unspecified) is record ------------- Index: prj-makr.adb =================================================================== --- prj-makr.adb (revision 192908) +++ prj-makr.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -120,7 +120,12 @@ Non_Empty_Node : constant Project_Node_Id := 1; -- Used for the With_Clause of the naming project + -- Turn off warnings for now around this redefinition of True and False, + -- but it really seems a bit horrible to do this redefinition ??? + + pragma Warnings (Off); type Matched_Type is (True, False, Excluded); + pragma Warnings (On); Naming_File_Suffix : constant String := "_naming"; Source_List_File_Suffix : constant String := "_source_list.txt"; Index: s-crtl.ads =================================================================== --- s-crtl.ads (revision 192908) +++ s-crtl.ads (working copy) @@ -177,7 +177,7 @@ size : size_t) return int; pragma Import (C, setvbuf, "setvbuf"); - procedure tmpnam (string : chars); + procedure tmpnam (str : chars); pragma Import (C, tmpnam, "tmpnam"); function tmpfile return FILEs; Index: sinfo-cn.adb =================================================================== --- sinfo-cn.adb (revision 192908) +++ sinfo-cn.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -30,8 +30,11 @@ -- general manner, but in some specific cases, the fields of related nodes -- have been deliberately layed out in a manner that permits such alteration. -with Atree; use Atree; -with Snames; use Snames; +with Atree; use Atree; +with Errout; use Errout; +with Sem_Util; use Sem_Util; +with Snames; use Snames; +with Warnsw; use Warnsw; package body Sinfo.CN is @@ -71,6 +74,20 @@ procedure Change_Identifier_To_Defining_Identifier (N : in out Node_Id) is begin + -- Check for redefinition of standard entity (requiring a warning) + + if Warn_On_Standard_Redefinition then + declare + C : constant Entity_Id := Current_Entity (N); + begin + if Present (C) and then Sloc (C) = Standard_Location then + Error_Msg_N ("redefinition of entity& in Standard?", N); + end if; + end; + end if; + + -- Go ahead with the change + Set_Nkind (N, N_Defining_Identifier); N := Extend_Node (N); end Change_Identifier_To_Defining_Identifier; Index: s-stratt-xdr.adb =================================================================== --- s-stratt-xdr.adb (revision 192908) +++ s-stratt-xdr.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2012, Free Software Foundation, Inc. -- -- -- -- GARLIC is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -374,12 +374,12 @@ F_Bytes : SEO renames Fields (I).F_Bytes; F_Size : Integer renames Fields (I).F_Size; - Positive : Boolean; - Exponent : Long_Unsigned; - Fraction : Long_Unsigned; - Result : Float; - S : SEA (1 .. F_L); - L : SEO; + Is_Positive : Boolean; + Exponent : Long_Unsigned; + Fraction : Long_Unsigned; + Result : Float; + S : SEA (1 .. F_L); + L : SEO; begin Ada.Streams.Read (Stream.all, S, L); @@ -397,10 +397,10 @@ Result := Float'Scaling (Float (Fraction), -F_Size); if BS <= S (1) then - Positive := False; + Is_Positive := False; Exponent := Long_Unsigned (S (1) - BS); else - Positive := True; + Is_Positive := True; Exponent := Long_Unsigned (S (1)); end if; @@ -434,7 +434,7 @@ (1.0 + Result, Integer (Exponent) - E_Bias); end if; - if not Positive then + if not Is_Positive then Result := -Result; end if; @@ -489,12 +489,12 @@ F_Bytes : SEO renames Fields (I).F_Bytes; F_Size : Integer renames Fields (I).F_Size; - Positive : Boolean; - Exponent : Long_Unsigned; - Fraction : Long_Long_Unsigned; - Result : Long_Float; - S : SEA (1 .. LF_L); - L : SEO; + Is_Positive : Boolean; + Exponent : Long_Unsigned; + Fraction : Long_Long_Unsigned; + Result : Long_Float; + S : SEA (1 .. LF_L); + L : SEO; begin Ada.Streams.Read (Stream.all, S, L); @@ -513,10 +513,10 @@ Result := Long_Float'Scaling (Long_Float (Fraction), -F_Size); if BS <= S (1) then - Positive := False; + Is_Positive := False; Exponent := Long_Unsigned (S (1) - BS); else - Positive := True; + Is_Positive := True; Exponent := Long_Unsigned (S (1)); end if; @@ -551,7 +551,7 @@ (1.0 + Result, Integer (Exponent) - E_Bias); end if; - if not Positive then + if not Is_Positive then Result := -Result; end if; @@ -617,7 +617,7 @@ F_Bytes : SEO renames Fields (I).F_Bytes; F_Size : Integer renames Fields (I).F_Size; - Positive : Boolean; + Is_Positive : Boolean; Exponent : Long_Unsigned; Fraction_1 : Long_Long_Unsigned := 0; Fraction_2 : Long_Long_Unsigned := 0; @@ -648,10 +648,10 @@ Result := Long_Long_Float'Scaling (Result, HF - F_Size); if BS <= S (1) then - Positive := False; + Is_Positive := False; Exponent := Long_Unsigned (S (1) - BS); else - Positive := True; + Is_Positive := True; Exponent := Long_Unsigned (S (1)); end if; @@ -686,7 +686,7 @@ (1.0 + Result, Integer (Exponent) - E_Bias); end if; - if not Positive then + if not Is_Positive then Result := -Result; end if; @@ -827,12 +827,12 @@ F_Bytes : SEO renames Fields (I).F_Bytes; F_Size : Integer renames Fields (I).F_Size; - Exponent : Long_Unsigned; - Fraction : Long_Unsigned; - Positive : Boolean; - Result : Short_Float; - S : SEA (1 .. SF_L); - L : SEO; + Exponent : Long_Unsigned; + Fraction : Long_Unsigned; + Is_Positive : Boolean; + Result : Short_Float; + S : SEA (1 .. SF_L); + L : SEO; begin Ada.Streams.Read (Stream.all, S, L); @@ -850,10 +850,10 @@ Result := Short_Float'Scaling (Short_Float (Fraction), -F_Size); if BS <= S (1) then - Positive := False; + Is_Positive := False; Exponent := Long_Unsigned (S (1) - BS); else - Positive := True; + Is_Positive := True; Exponent := Long_Unsigned (S (1)); end if; @@ -887,7 +887,7 @@ (1.0 + Result, Integer (Exponent) - E_Bias); end if; - if not Positive then + if not Is_Positive then Result := -Result; end if; @@ -1179,12 +1179,12 @@ F_Size : Integer renames Fields (I).F_Size; F_Mask : SE renames Fields (I).F_Mask; - Exponent : Long_Unsigned; - Fraction : Long_Unsigned; - Positive : Boolean; - E : Integer; - F : Float; - S : SEA (1 .. F_L) := (others => 0); + Exponent : Long_Unsigned; + Fraction : Long_Unsigned; + Is_Positive : Boolean; + E : Integer; + F : Float; + S : SEA (1 .. F_L) := (others => 0); begin if not Item'Valid then @@ -1193,7 +1193,7 @@ -- Compute Sign - Positive := (0.0 <= Item); + Is_Positive := (0.0 <= Item); F := abs (Item); -- Signed zero @@ -1241,7 +1241,7 @@ -- Store Sign - if not Positive then + if not Is_Positive then S (1) := S (1) + BS; end if; @@ -1293,12 +1293,12 @@ F_Size : Integer renames Fields (I).F_Size; F_Mask : SE renames Fields (I).F_Mask; - Exponent : Long_Unsigned; - Fraction : Long_Long_Unsigned; - Positive : Boolean; - E : Integer; - F : Long_Float; - S : SEA (1 .. LF_L) := (others => 0); + Exponent : Long_Unsigned; + Fraction : Long_Long_Unsigned; + Is_Positive : Boolean; + E : Integer; + F : Long_Float; + S : SEA (1 .. LF_L) := (others => 0); begin if not Item'Valid then @@ -1307,7 +1307,7 @@ -- Compute Sign - Positive := (0.0 <= Item); + Is_Positive := (0.0 <= Item); F := abs (Item); -- Signed zero @@ -1355,7 +1355,7 @@ -- Store Sign - if not Positive then + if not Is_Positive then S (1) := S (1) + BS; end if; @@ -1421,13 +1421,13 @@ HFS : constant Integer := F_Size / 2; - Exponent : Long_Unsigned; - Fraction_1 : Long_Long_Unsigned; - Fraction_2 : Long_Long_Unsigned; - Positive : Boolean; - E : Integer; - F : Long_Long_Float := Item; - S : SEA (1 .. LLF_L) := (others => 0); + Exponent : Long_Unsigned; + Fraction_1 : Long_Long_Unsigned; + Fraction_2 : Long_Long_Unsigned; + Is_Positive : Boolean; + E : Integer; + F : Long_Long_Float := Item; + S : SEA (1 .. LLF_L) := (others => 0); begin if not Item'Valid then @@ -1436,7 +1436,8 @@ -- Compute Sign - Positive := (0.0 <= Item); + Is_Positive := (0.0 <= Item); + if F < 0.0 then F := -Item; end if; @@ -1495,7 +1496,7 @@ -- Store Sign - if not Positive then + if not Is_Positive then S (1) := S (1) + BS; end if; @@ -1639,12 +1640,12 @@ F_Size : Integer renames Fields (I).F_Size; F_Mask : SE renames Fields (I).F_Mask; - Exponent : Long_Unsigned; - Fraction : Long_Unsigned; - Positive : Boolean; - E : Integer; - F : Short_Float; - S : SEA (1 .. SF_L) := (others => 0); + Exponent : Long_Unsigned; + Fraction : Long_Unsigned; + Is_Positive : Boolean; + E : Integer; + F : Short_Float; + S : SEA (1 .. SF_L) := (others => 0); begin if not Item'Valid then @@ -1653,7 +1654,7 @@ -- Compute Sign - Positive := (0.0 <= Item); + Is_Positive := (0.0 <= Item); F := abs (Item); -- Signed zero @@ -1701,7 +1702,7 @@ -- Store Sign - if not Positive then + if not Is_Positive then S (1) := S (1) + BS; end if; Index: usage.adb =================================================================== --- usage.adb (revision 192908) +++ usage.adb (working copy) @@ -435,6 +435,8 @@ Write_Switch_Char ("wxx"); Write_Line ("Enable selected warning modes, xx = list of parameters:"); + Write_Line (" * indicates default setting"); + Write_Line (" + indicates warning flag included in -gnatwa"); Write_Line (" a turn on all info/warnings marked below with +"); Write_Line (" A turn off all optional info/warnings"); Write_Line (" .a*+ turn on warnings for failing assertion"); @@ -472,6 +474,8 @@ "(annex J) feature"); Write_Line (" k+ turn on warnings on constant variable"); Write_Line (" K* turn off warnings on constant variable"); + Write_Line (" .k+ turn on warnings for standard redefinition"); + Write_Line (" .K* turn off warnings for standard redefinition"); Write_Line (" l turn on warnings for missing " & "elaboration pragma"); Write_Line (" L* turn off warnings for missing " & @@ -541,8 +545,6 @@ "unchecked conversion"); Write_Line (" Z turn off warnings for suspicious " & "unchecked conversion"); - Write_Line (" * indicates default in above list"); - Write_Line (" + indicates warning flag included in -gnatwa"); -- Line for -gnatW switch Index: warnsw.adb =================================================================== --- warnsw.adb (revision 192908) +++ warnsw.adb (working copy) @@ -87,6 +87,7 @@ Warn_On_Record_Holes := True; Warn_On_Redundant_Constructs := True; Warn_On_Reverse_Bit_Order := True; + Warn_On_Standard_Redefinition := True; Warn_On_Suspicious_Contract := True; Warn_On_Unchecked_Conversion := True; Warn_On_Unordered_Enumeration_Type := True; @@ -109,6 +110,12 @@ when 'I' => Warn_On_Overlap := False; + when 'k' => + Warn_On_Standard_Redefinition := True; + + when 'K' => + Warn_On_Standard_Redefinition := False; + when 'l' => List_Inherited_Aspects := True; @@ -307,6 +314,7 @@ Warn_On_Questionable_Missing_Parens := False; Warn_On_Redundant_Constructs := False; Warn_On_Reverse_Bit_Order := False; + Warn_On_Standard_Redefinition := False; Warn_On_Suspicious_Contract := False; Warn_On_Suspicious_Modulus_Value := False; Warn_On_Unchecked_Conversion := False; Index: warnsw.ads =================================================================== --- warnsw.ads (revision 192908) +++ warnsw.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -47,6 +47,10 @@ -- set with an explicit size clause. Off by default, set by -gnatw.s (but -- not -gnatwa). + Warn_On_Standard_Redefinition : Boolean := False; + -- Warn when a program defines an identifier that matches a name in + -- Standard. Off by default, set by -gnatw.k (and also by -gnatwa). + ----------------- -- Subprograms -- -----------------