Patchwork [Ada] Clean up obsolescent stuff handling in scng

login
register
mail settings
Submitter Arnaud Charlet
Date Sept. 9, 2010, 12:31 p.m.
Message ID <20100909123144.GA15334@adacore.com>
Download mbox | patch
Permalink /patch/64290/
State New
Headers show

Comments

Arnaud Charlet - Sept. 9, 2010, 12:31 p.m.
Scng had circuitry to handle obsolescent features ('%' for string
constants, ':' instead of '#' for based literals, and '!' in place
of '|'). But this was messy since scng is a generic used by several
callers only one of which (the compiler) is interested in obsolescent
features (other callers just accept the obsolescent forms without
complaint). This patch moves the diagnoses of these obsolescent
features to Post_Scan in scn.adb, which is much cleaner and removes
a lot of special junk handling for obsolescent features in other
users.

This has no functional effect, but the following test is useful
in ensuring this has been done correctly, compiled with -gnat12
-gnatwa -gnatld7.

     1. package warnobs1 is
     2.    w : String := %ABC%;
                         |
        >>> warning: use of "%" is an obsolescent feature (RM J.2(4))
        >>> warning: use """ instead

     3.    x : integer := (case true is when true ! false => 3);
                                                  |
        >>> warning: use of "!" is an obsolescent feature (RM J.2(2))
        >>> warning: use "|" instead

     4.    y : integer := 16:12:;
                            |
        >>> warning: use of ":" is an obsolescent feature (RM J.2(3))
        >>> warning: use "#" instead

     5.    z : float := 16#2.0#E+3;
     6. end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* ali-util.adb (Obsolescent_Check): Removed.
	* gprep.adb (Obsolescent_Check): Removed.
	Remove Obsolescent_Check parameter in Scng instantiation
	* prj-err.adb (Obsolescent_Check): Removed.
	* prj-err.ads (Obsolescent_Check): Removed.
	Remove Obsolescent_Check parameter in Scng instantiation
	* scans.ads (Based_Literal_Uses_Colon): New flag
	* scn.adb (Obsolscent_Check_Flag): Removed
	(Obsolscent_Check): Removed
	(Set_Obsolescent_Check): Removed
	(Post_Scan): Add handling for obsolescent features
	* scn.ads (Obsolscent_Check): Removed
	(Set_Obsolescent_Check): Removed
	(Post_Scan): Can no longer be inlined
	Remove Obsolescent_Check from instantiation of Scng
	* scng.adb (Nlit): Set Based_Literal_Uses_Colon
	(Nlit): Remove handling of obsolescent check
	(Scan, case '%'): Remove handling of obsolescent check
	(Scan, case '|'): Call Post_Scan
	(Scan, case '!'): Remove handling of obsolescent check, call Post_Scan
	* scng.ads Remove Obsolescent_Check argument from Scng generic
	(Post_Scan): Now called for Tok_Vertical_Bar
	* sinput-l.adb: Remove calls to Set_Obsolescent_Check

Patch

Index: ali-util.adb
===================================================================
--- ali-util.adb	(revision 164000)
+++ ali-util.adb	(working copy)
@@ -50,8 +50,6 @@  package body ALI.Util is
 
    procedure Error_Msg_SP (Msg : String);
 
-   procedure Obsolescent_Check (S : Source_Ptr);
-
    --  Instantiation of Styleg, needed to instantiate Scng
 
    package Style is new Styleg
@@ -61,8 +59,7 @@  package body ALI.Util is
    --  Get_File_Checksum).
 
    package Scanner is new Scng
-     (Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP,
-      Obsolescent_Check, Style);
+     (Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP, Style);
 
    type Header_Num is range 0 .. 1_000;
 
@@ -201,16 +198,6 @@  package body ALI.Util is
       Interfaces.Reset;
    end Initialize_ALI_Source;
 
-   -----------------------
-   -- Obsolescent_Check --
-   -----------------------
-
-   procedure Obsolescent_Check (S : Source_Ptr) is
-      pragma Warnings (Off, S);
-   begin
-      null;
-   end Obsolescent_Check;
-
    ---------------
    -- Post_Scan --
    ---------------
Index: scng.adb
===================================================================
--- scng.adb	(revision 164000)
+++ scng.adb	(working copy)
@@ -516,6 +516,7 @@  package body Scng is
          Base := 10;
          UI_Base := Uint_10;
          UI_Int_Value := Uint_0;
+         Based_Literal_Uses_Colon := False;
          Scale := 0;
          Scan_Integer;
          Point_Scanned := False;
@@ -568,20 +569,14 @@  package body Scng is
                          or else
                        Source (Scan_Ptr + 1) in 'a' .. 'z'))
          then
-            if C = ':' then
-               Obsolescent_Check (Scan_Ptr);
-
-               if Warn_On_Obsolescent_Feature then
-                  Error_Msg_S
-                    ("use of "":"" is an obsolescent feature (RM J.2(3))?");
-                  Error_Msg_S ("\use ""'#"" instead?");
-               end if;
-            end if;
-
             Accumulate_Checksum (C);
             Base_Char := C;
             UI_Base := UI_Int_Value;
 
+            if Base_Char = ':' then
+               Based_Literal_Uses_Colon := True;
+            end if;
+
             if UI_Base < 2 or else UI_Base > 16 then
                Error_Msg_SC ("base not 2-16");
                UI_Base := Uint_16;
@@ -753,7 +748,6 @@  package body Scng is
          end if;
 
          Accumulate_Token_Checksum;
-
          return;
       end Nlit;
 
@@ -1579,24 +1573,9 @@  package body Scng is
             end if;
          end Minus_Case;
 
-         --  Double quote starting a string literal
-
-         when '"' =>
-            Slit;
-            Post_Scan;
-            return;
-
-         --  Percent starting a string literal
-
-         when '%' =>
-            Obsolescent_Check (Token_Ptr);
-
-            if Warn_On_Obsolescent_Feature then
-               Error_Msg_S
-                 ("use of ""'%"" is an obsolescent feature (RM J.2(4))?");
-               Error_Msg_S ("\use """""" instead?");
-            end if;
+         --  Double quote or percent starting a string literal
 
+         when '"' | '%' =>
             Slit;
             Post_Scan;
             return;
@@ -1808,6 +1787,7 @@  package body Scng is
                   Style.Check_Vertical_Bar;
                end if;
 
+               Post_Scan;
                return;
             end if;
          end Vertical_Bar_Case;
@@ -1816,13 +1796,6 @@  package body Scng is
 
          when '!' => Exclamation_Case : begin
             Accumulate_Checksum ('!');
-            Obsolescent_Check (Token_Ptr);
-
-            if Warn_On_Obsolescent_Feature then
-               Error_Msg_S
-                 ("use of ""'!"" is an obsolescent feature (RM J.2(2))?");
-               Error_Msg_S ("\use ""'|"" instead?");
-            end if;
 
             if Source (Scan_Ptr + 1) = '=' then
                Error_Msg_S -- CODEFIX
@@ -1834,6 +1807,7 @@  package body Scng is
             else
                Scan_Ptr := Scan_Ptr + 1;
                Token := Tok_Vertical_Bar;
+               Post_Scan;
                return;
             end if;
          end Exclamation_Case;
Index: scng.ads
===================================================================
--- scng.ads	(revision 164000)
+++ scng.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -33,9 +33,10 @@  with Types;  use Types;
 
 generic
    with procedure Post_Scan;
-   --  Procedure called by Scan for the following tokens:
-   --  Tok_Char_Literal, Tok_Identifier, Tok_Real_Literal, Tok_Real_Literal,
-   --  Tok_Integer_Literal, Tok_String_Literal, Tok_Operator_Symbol.
+   --  Procedure called by Scan for the following tokens: Tok_Char_Literal,
+   --  Tok_Identifier, Tok_Real_Literal, Tok_Real_Literal, Tok_Integer_Literal,
+   --  Tok_String_Literal, Tok_Operator_Symbol, and Tok_Vertical_Bar. Used to
+   --  build Token_Node and also check for obsolescent features.
 
    with procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
    --  Output a message at specified location
@@ -49,10 +50,6 @@  generic
    with procedure Error_Msg_SP (Msg : String);
    --  Output a message at the start of the previous token
 
-   with procedure Obsolescent_Check (S : Source_Ptr);
-   --  Called when one of the obsolescent character replacements is
-   --  used with S pointing to the character in question.
-
    with package Style is new Styleg
      (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
    --  Instantiation of Styleg with the same error reporting routines
Index: scans.ads
===================================================================
--- scans.ads	(revision 164000)
+++ scans.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -415,27 +415,34 @@  package Scans is
    --  We do things this way to minimize the impact on comment scanning.
 
    Character_Code : Char_Code;
-   --  Valid only when Token is Tok_Char_Literal
+   --  Valid only when Token is Tok_Char_Literal. Contains the value of the
+   --  scanned literal.
 
    Real_Literal_Value : Ureal;
-   --  Valid only when Token is Tok_Real_Literal
+   --  Valid only when Token is Tok_Real_Literal, contains the value of the
+   --  scanned literal.
 
    Int_Literal_Value : Uint;
-   --  Valid only when Token = Tok_Integer_Literal;
+   --  Valid only when Token = Tok_Integer_Literal, contains the value of the
+   --  scanned literal.
+
+   Based_Literal_Uses_Colon : Boolean;
+   --  Valid only when Token = Tok_Integer_Literal or Tok_Real_Literal. Set
+   --  True only for the case of a based literal using ':' instead of '#'.
 
    String_Literal_Id : String_Id;
-   --  Id for currently scanned string value.
    --  Valid only when Token = Tok_String_Literal or Tok_Operator_Symbol.
+   --  Contains the Id for currently scanned string value.
 
    Wide_Character_Found : Boolean := False;
-   --  Set True if wide character found (i.e. a character that does not fit
-   --  in Character, but fits in Wide_Wide_Character).
-   --  Valid only when Token = Tok_String_Literal.
+   --  Valid only when Token = Tok_String_Literal. Set True if wide character
+   --  found (i.e. a character that does not fit in Character, but fits in
+   --  Wide_Wide_Character).
 
    Wide_Wide_Character_Found : Boolean := False;
-   --  Set True if wide wide character found (i.e. a character that does
-   --  not fit in Character or Wide_Character).
-   --  Valid only when Token = Tok_String_Literal.
+   --  Valid only when Token = Tok_String_Literal. Set True if wide wide
+   --  character found (i.e. a character that does not fit in Character or
+   --  Wide_Character).
 
    Special_Character : Character;
    --  Valid only when Token = Tok_Special. Returns one of the characters
Index: sinput-l.adb
===================================================================
--- sinput-l.adb	(revision 164000)
+++ sinput-l.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -530,12 +530,9 @@  package body Sinput.L is
                Save_Style_Check := Opt.Style_Check;
                Opt.Style_Check := False;
 
-               --  Make sure that there will be no check of pragma Restrictions
-               --  for obsolescent features while preprocessing the source.
+               --  The actual preprocessing step
 
-               Scn.Set_Obsolescent_Check (False);
                Preprocess (Modified);
-               Scn.Set_Obsolescent_Check (True);
 
                --  Reset the scanner to its standard behavior, and restore the
                --  Style_Checks flag.
Index: gprep.adb
===================================================================
--- gprep.adb	(revision 164058)
+++ gprep.adb	(working copy)
@@ -91,9 +91,6 @@  package body GPrep is
    procedure Display_Copyright;
    --  Display the copyright notice
 
-   procedure Obsolescent_Check (S : Source_Ptr);
-   --  Null procedure, needed by instantiation of Scng below
-
    procedure Post_Scan;
    --  Null procedure, needed by instantiation of Scng below
 
@@ -103,7 +100,6 @@  package body GPrep is
       Errutil.Error_Msg_S,
       Errutil.Error_Msg_SC,
       Errutil.Error_Msg_SP,
-      Obsolescent_Check,
       Errutil.Style);
    --  The scanner for the preprocessor
 
@@ -311,16 +307,6 @@  package body GPrep is
       New_Line (Outfile.all);
    end New_EOL_To_Outfile;
 
-   -----------------------
-   -- Obsolescent_Check --
-   -----------------------
-
-   procedure Obsolescent_Check (S : Source_Ptr) is
-      pragma Warnings (Off, S);
-   begin
-      null;
-   end Obsolescent_Check;
-
    ---------------
    -- Post_Scan --
    ---------------
Index: scn.adb
===================================================================
--- scn.adb	(revision 164000)
+++ scn.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -44,10 +44,6 @@  package body Scn is
 
    use ASCII;
 
-   Obsolescent_Check_Flag : Boolean := True;
-   --  Obsolescent check activation. Set to False during integrated
-   --  preprocessing.
-
    Used_As_Identifier : array (Token_Type) of Boolean;
    --  Flags set True if a given keyword is used as an identifier (used to
    --  make sure that we only post an error message for incorrect use of a
@@ -340,28 +336,61 @@  package body Scn is
       end loop;
    end Initialize_Scanner;
 
-   -----------------------
-   -- Obsolescent_Check --
-   -----------------------
-
-   procedure Obsolescent_Check (S : Source_Ptr) is
-   begin
-      if Obsolescent_Check_Flag then
-         --  This is a pain in the neck case, since we normally need a node to
-         --  call Check_Restrictions, and all we have is a source pointer. The
-         --  easiest thing is to construct a dummy node. A bit kludgy, but this
-         --  is a marginal case. It's not worth trying to do things more
-         --  cleanly.
-
-         Check_Restriction (No_Obsolescent_Features, New_Node (N_Empty, S));
-      end if;
-   end Obsolescent_Check;
-
    ---------------
    -- Post_Scan --
    ---------------
 
    procedure Post_Scan is
+      procedure Check_Obsolescent_Features_Restriction (S : Source_Ptr);
+      --  This checks for Obsolescent_Features restriction being active, and
+      --  if so, flags the restriction as occurring at the given scan location.
+
+      procedure Check_Obsolete_Base_Char;
+      --  Check for numeric literal using ':' instead of '#' for based case
+
+      --------------------------------------------
+      -- Check_Obsolescent_Features_Restriction --
+      --------------------------------------------
+
+      procedure Check_Obsolescent_Features_Restriction (S : Source_Ptr) is
+      begin
+         --  Normally we have a node handy for posting restrictions. We don't
+         --  have such a node here, so construct a dummy one with the right
+         --  scan pointer. This is only used to get the Sloc value anyway.
+
+         Check_Restriction (No_Obsolescent_Features, New_Node (N_Empty, S));
+      end Check_Obsolescent_Features_Restriction;
+
+      ------------------------------
+      -- Check_Obsolete_Base_Char --
+      ------------------------------
+
+      procedure Check_Obsolete_Base_Char is
+         S : Source_Ptr;
+
+      begin
+         if Based_Literal_Uses_Colon then
+
+            --  Find the : for the restriction or warning message
+
+            S := Token_Ptr;
+            while Source (S) /= ':' loop
+               S := S + 1;
+            end loop;
+
+            Check_Obsolescent_Features_Restriction (S);
+
+            if Warn_On_Obsolescent_Feature then
+               Error_Msg
+                 ("use of "":"" is an obsolescent feature (RM J.2(3))?", S);
+               Error_Msg
+                 ("\use ""'#"" instead?", S);
+            end if;
+         end if;
+      end Check_Obsolete_Base_Char;
+
+   --  Start of processing for Post_Scan
+
    begin
       case Token is
          when Tok_Char_Literal =>
@@ -376,10 +405,12 @@  package body Scn is
          when Tok_Real_Literal =>
             Token_Node := New_Node (N_Real_Literal, Token_Ptr);
             Set_Realval (Token_Node, Real_Literal_Value);
+            Check_Obsolete_Base_Char;
 
          when Tok_Integer_Literal =>
             Token_Node := New_Node (N_Integer_Literal, Token_Ptr);
             Set_Intval (Token_Node, Int_Literal_Value);
+            Check_Obsolete_Base_Char;
 
          when Tok_String_Literal =>
             Token_Node := New_Node (N_String_Literal, Token_Ptr);
@@ -389,11 +420,32 @@  package body Scn is
               (Token_Node, Wide_Wide_Character_Found);
             Set_Strval (Token_Node, String_Literal_Id);
 
+            if Source (Token_Ptr) = '%' then
+               Check_Obsolescent_Features_Restriction (Token_Ptr);
+
+               if Warn_On_Obsolescent_Feature then
+                  Error_Msg_SC
+                    ("use of ""'%"" is an obsolescent feature (RM J.2(4))?");
+                  Error_Msg_SC ("\use """""" instead?");
+               end if;
+            end if;
+
          when Tok_Operator_Symbol =>
             Token_Node := New_Node (N_Operator_Symbol, Token_Ptr);
             Set_Chars (Token_Node, Token_Name);
             Set_Strval (Token_Node, String_Literal_Id);
 
+         when Tok_Vertical_Bar =>
+            if Source (Token_Ptr) = '!' then
+               Check_Obsolescent_Features_Restriction (Token_Ptr);
+
+               if Warn_On_Obsolescent_Feature then
+                  Error_Msg_SC
+                    ("use of ""'!"" is an obsolescent feature (RM J.2(2))?");
+                  Error_Msg_SC ("\use ""'|"" instead?");
+               end if;
+            end if;
+
          when others =>
             null;
       end case;
@@ -430,13 +482,4 @@  package body Scn is
       Set_Chars (Token_Node, Token_Name);
    end Scan_Reserved_Identifier;
 
-   ---------------------------
-   -- Set_Obsolescent_Check --
-   ---------------------------
-
-   procedure Set_Obsolescent_Check (Value : Boolean) is
-   begin
-      Obsolescent_Check_Flag := Value;
-   end Set_Obsolescent_Check;
-
 end Scn;
Index: scn.ads
===================================================================
--- scn.ads	(revision 164000)
+++ scn.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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,15 +47,7 @@  package Scn is
    --  Determines the casing style of the current token, which is
    --  either a keyword or an identifier. See also package Casing.
 
-   procedure Obsolescent_Check (S : Source_Ptr);
-   --  Called to handle pragma restrictions check for usage of obsolescent
-   --  character replacements during the scan.
-
-   procedure Set_Obsolescent_Check (Value : Boolean);
-   --  Activate or not obsolescent check
-
    procedure Post_Scan;
-   pragma Inline (Post_Scan);
    --  Create nodes for tokens: Char_Literal, Identifier, Real_Literal,
    --  Integer_Literal, String_Literal and Operator_Symbol.
 
@@ -75,13 +67,12 @@  package Scn is
    --  generic package Scng with routines appropriate to the compiler
 
    package Scanner is new Scng
-     (Post_Scan         => Post_Scan,
-      Error_Msg         => Error_Msg,
-      Error_Msg_S       => Error_Msg_S,
-      Error_Msg_SC      => Error_Msg_SC,
-      Error_Msg_SP      => Error_Msg_SP,
-      Obsolescent_Check => Obsolescent_Check,
-      Style             => Style.Style_Inst);
+     (Post_Scan    => Post_Scan,
+      Error_Msg    => Error_Msg,
+      Error_Msg_S  => Error_Msg_S,
+      Error_Msg_SC => Error_Msg_SC,
+      Error_Msg_SP => Error_Msg_SP,
+      Style        => Style.Style_Inst);
 
    procedure Scan renames Scanner.Scan;
    --  Scan scans out the next token, and advances the scan state accordingly
Index: prj-err.adb
===================================================================
--- prj-err.adb	(revision 164000)
+++ prj-err.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2002-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-2010, 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- --
@@ -29,16 +29,6 @@  with Stringt;  use Stringt;
 
 package body Prj.Err is
 
-   -----------------------
-   -- Obsolescent_Check --
-   -----------------------
-
-   procedure Obsolescent_Check (S : Source_Ptr) is
-      pragma Warnings (Off, S);
-   begin
-      null;
-   end Obsolescent_Check;
-
    ---------------
    -- Post_Scan --
    ---------------
Index: prj-err.ads
===================================================================
--- prj-err.ads	(revision 164000)
+++ prj-err.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2002-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-2010, 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- --
@@ -82,20 +82,16 @@  package Prj.Err is
    -- Scanner --
    -------------
 
-   procedure Obsolescent_Check (S : Source_Ptr);
-   --  Dummy null procedure for Scng instantiation
-
    procedure Post_Scan;
    --  Convert an Ada operator symbol into a standard string
 
    package Scanner is new Scng
-     (Post_Scan         => Post_Scan,
-      Error_Msg         => Errutil.Error_Msg,
-      Error_Msg_S       => Errutil.Error_Msg_S,
-      Error_Msg_SC      => Errutil.Error_Msg_SC,
-      Error_Msg_SP      => Errutil.Error_Msg_SP,
-      Obsolescent_Check => Obsolescent_Check,
-      Style             => Errutil.Style);
+     (Post_Scan    => Post_Scan,
+      Error_Msg    => Errutil.Error_Msg,
+      Error_Msg_S  => Errutil.Error_Msg_S,
+      Error_Msg_SC => Errutil.Error_Msg_SC,
+      Error_Msg_SP => Errutil.Error_Msg_SP,
+      Style        => Errutil.Style);
    --  Instantiation of the generic scanner
 
 end Prj.Err;