diff mbox

[Ada] Warn on redefinition of standard entities

Message ID 20121029101749.GA26188@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 29, 2012, 10:17 a.m. UTC 
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  <dewar@adacore.com>

	* 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.
diff mbox

Patch

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 --
    -----------------