hostparm.ads (Max_Line_Length): Set to Types.Column_Number'Last - 1...

2005-12-05  Thomas Quinot  <quinot@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* hostparm.ads (Max_Line_Length): Set to Types.Column_Number'Last - 1,
	which is the absolute maximum length we can support.

	* frontend.adb: For the processing of configuration pragma files,
	remove references to Opt.Max_Line_Length, which is not checked anymore.

	* namet.ads (Name_Buffer): Adjust size to reflect increase on max line
	length.

	* scn.adb, scng.adb: 
	Always check line length against the absolute supported maximum,
	Hostparm.Max_Line_Length.

	* stylesw.adb (Set_Style_Check_Options, case M): The maximum supported
	value for the maximum line length is Max_Line_Length (not
	Column_Number'Last).
	Minor error msg update
	(Set_Style_Check_Options): New interface returning error msg
	Minor code reorganization (processing for 'M' was out of alpha order)

	* switch-c.adb: New interface for Set_Style_Check_Options

	* stylesw.ads (Set_Style_Check_Options): New interface returning error
	msg.

From-SVN: r108288

8 files changed, 127 insertions, 75 deletions

diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index 49b8dd7..2cb90d8 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -127,7 +127,6 @@ begin
 
       Opt.Style_Check := False;
       Style_Check := False;
-      Opt.Max_Line_Length := Int (Column_Number'Last);
 
       --  Capture current suppress options, which may get modified
 
@@ -191,7 +190,6 @@ begin
       --  Restore style check, but if config file turned on checks, leave on!
 
       Opt.Style_Check := Save_Style_Check or Style_Check;
-      Opt.Max_Line_Length := Hostparm.Max_Line_Length;
 
       --  Capture any modifications to suppress options from config pragmas
 
diff --git a/gcc/ada/hostparm.ads b/gcc/ada/hostparm.ads
index 6f2ecc7..eae0772 100644
--- a/gcc/ada/hostparm.ads
+++ b/gcc/ada/hostparm.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -35,6 +35,8 @@
 --  are parameters that are relevant to the host machine on which the
 --  compiler is running, and thus this package is part of the compiler.
 
+with Types;
+
 package Hostparm is
 
    -----------------------
@@ -61,13 +63,15 @@ package Hostparm is
    Normalized_CWD : constant String := "./";
    --  Normalized string to access current directory
 
-   Max_Line_Length : constant := 255;
-   --  Maximum source line length. This can be set to any value up to
-   --  2**15 - 1, a limit imposed by the assumption that column numbers
-   --  can be stored in 16 bits (see Types.Column_Number). A value of
-   --  200 is the minimum value required (RM 2.2(15)), but we use 255
-   --  for most GNAT targets since this is DEC Ada compatible. The value
-   --  set here can be overridden by the explicit use of -gnatyM.
+   Max_Line_Length : constant := Types.Column_Number'Pred
+                       (Types.Column_Number'Last);
+   --  Maximum source line length. By default we set it to the maximum
+   --  value that can be supported, which is given by the range of the
+   --  Column_Number type. We subtract 1 because need to be able to
+   --  have a valid Column_Number equal to Max_Line_Length to represent
+   --  the location of a "line too long" error.
+   --  200 is the minimum value required (RM 2.2(15)). The value set here
+   --  can be reduced by the explicit use of the -gnatyM style switch.
 
    Max_Name_Length : constant := 1024;
    --  Maximum length of unit name (including all dots, and " (spec)") and
diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads
index 231fe85..4bf12e6 100644
--- a/gcc/ada/namet.ads
+++ b/gcc/ada/namet.ads
@@ -33,6 +33,7 @@
 
 with Alloc;
 with Table;
+with Hostparm; use Hostparm;
 with System;   use System;
 with Types;    use Types;
 
@@ -125,12 +126,11 @@ package Namet is
 --  binder, the Byte field is unused, and the Int field is used in various
 --  ways depending on the name involved (see binder documentation).
 
-   Name_Buffer : String (1 .. 16*1024);
+   Name_Buffer : String (1 .. 4 * Max_Line_Length);
    --  This buffer is used to set the name to be stored in the table for the
    --  Name_Find call, and to retrieve the name for the Get_Name_String call.
-   --  The plus 1 in the length allows for cases of adding ASCII.NUL. The 16K
-   --  here is intended to be an infinite value that ensures that we never
-   --  overflow the buffer (names this long are too absurd to worry!)
+   --  The limit here is intended to be an infinite value that ensures that we
+   --  never overflow the buffer (names this long are too absurd to worry!)
 
    Name_Len : Natural;
    --  Length of name stored in Name_Buffer. Used as an input parameter for
diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb
index ce8402d..4a6f4f9 100644
--- a/gcc/ada/scn.adb
+++ b/gcc/ada/scn.adb
@@ -26,6 +26,7 @@
 
 with Atree;    use Atree;
 with Csets;    use Csets;
+with Hostparm; use Hostparm;
 with Namet;    use Namet;
 with Opt;      use Opt;
 with Restrict; use Restrict;
@@ -104,7 +105,7 @@ package body Scn is
    begin
       if Style_Check then
          Style.Check_Line_Terminator (Len);
-      elsif Len > Opt.Max_Line_Length then
+      elsif Len > Max_Line_Length then
          Error_Long_Line;
       end if;
    end Check_End_Of_Line;
@@ -266,7 +267,7 @@ package body Scn is
    begin
       Error_Msg
         ("this line is too long",
-         Current_Line_Start + Source_Ptr (Opt.Max_Line_Length));
+         Current_Line_Start + Source_Ptr (Max_Line_Length));
    end Error_Long_Line;
 
    ------------------------
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 687c32b..1f1fe15 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -26,6 +26,7 @@
 
 with Csets;    use Csets;
 with Err_Vars; use Err_Vars;
+with Hostparm; use Hostparm;
 with Namet;    use Namet;
 with Opt;      use Opt;
 with Scans;    use Scans;
@@ -357,13 +358,9 @@ package body Scng is
             Style.Check_Line_Max_Length (Len);
 
          --  If style checking is inactive, check maximum line length against
-         --  standard value. Note that we take this from Opt.Max_Line_Length
-         --  rather than Hostparm.Max_Line_Length because we do not want to
-         --  impose any limit during scanning of configuration pragma files,
-         --  and Opt.Max_Line_Length (normally set to Hostparm.Max_Line_Length)
-         --  is reset to Column_Number'Max during scanning of such files.
+         --  standard value.
 
-         elsif Len > Opt.Max_Line_Length then
+         elsif Len > Max_Line_Length then
             Error_Long_Line;
          end if;
 
@@ -423,7 +420,7 @@ package body Scng is
       begin
          Error_Msg
            ("this line is too long",
-            Current_Line_Start + Source_Ptr (Opt.Max_Line_Length));
+            Current_Line_Start + Source_Ptr (Max_Line_Length));
       end Error_Long_Line;
 
       -------------------------------
diff --git a/gcc/ada/stylesw.adb b/gcc/ada/stylesw.adb
index 27e9153..4368372 100644
--- a/gcc/ada/stylesw.adb
+++ b/gcc/ada/stylesw.adb
@@ -24,7 +24,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Opt; use Opt;
+with Hostparm; use Hostparm;
+with Opt;      use Opt;
 
 package body Stylesw is
 
@@ -166,6 +167,7 @@ package body Stylesw is
       EC : Natural;
    begin
       Set_Style_Check_Options (Options, OK, EC);
+      pragma Assert (OK);
    end Set_Style_Check_Options;
 
    --  Normal version with error checking
@@ -175,19 +177,53 @@ package body Stylesw is
       OK       : out Boolean;
       Err_Col  : out Natural)
    is
-      J : Natural;
       C : Character;
 
+      procedure Add_Img (N : Natural);
+      --  Concatenates image of N at end of Style_Msg_Buf
+
+      procedure Bad_Style_Switch (Msg : String);
+      --  Called if bad style switch found. Msg is mset in Style_Msg_Buf and
+      --  Style_Msg_Len. OK is set False.
+
+      -------------
+      -- Add_Img --
+      -------------
+
+      procedure Add_Img (N : Natural) is
+      begin
+         if N >= 10 then
+            Add_Img (N / 10);
+         end if;
+
+         Style_Msg_Len := Style_Msg_Len + 1;
+         Style_Msg_Buf (Style_Msg_Len) :=
+           Character'Val (N mod 10 + Character'Pos ('0'));
+      end Add_Img;
+
+      ----------------------
+      -- Bad_Style_Switch --
+      ----------------------
+
+      procedure Bad_Style_Switch (Msg : String) is
+      begin
+         OK := False;
+         Style_Msg_Len := Msg'Length;
+         Style_Msg_Buf (1 .. Style_Msg_Len) := Msg;
+      end Bad_Style_Switch;
+
+   --  Start of processing for Set_Style_Check_Options
+
    begin
-      J := Options'First;
-      while J <= Options'Last loop
-         C := Options (J);
-         J := J + 1;
+      Err_Col := Options'First;
+      while Err_Col <= Options'Last loop
+         C := Options (Err_Col);
+         Err_Col := Err_Col + 1;
 
          case C is
             when '1' .. '9' =>
-               Style_Check_Indentation
-                  := Character'Pos (C) - Character'Pos ('0');
+               Style_Check_Indentation :=
+                 Character'Pos (C) - Character'Pos ('0');
 
             when 'a' =>
                Style_Check_Attribute_Casing    := True;
@@ -222,28 +258,27 @@ package body Stylesw is
             when 'L' =>
                Style_Max_Nesting_Level := 0;
 
-               if J > Options'Last
-                 or else Options (J) not in '0' .. '9'
+               if Err_Col > Options'Last
+                 or else Options (Err_Col) not in '0' .. '9'
                then
-                  OK := False;
-                  Err_Col := J;
+                  Bad_Style_Switch ("invalid nesting level");
                   return;
                end if;
 
                loop
                   Style_Max_Nesting_Level :=
                     Style_Max_Nesting_Level * 10 +
-                      Character'Pos (Options (J)) - Character'Pos ('0');
+                      Character'Pos (Options (Err_Col)) - Character'Pos ('0');
 
                   if Style_Max_Nesting_Level > 999 then
-                     OK := False;
-                     Err_Col := J;
+                     Bad_Style_Switch
+                       ("max nesting level (999) exceeded in style check");
                      return;
                   end if;
 
-                  J := J + 1;
-                  exit when J > Options'Last
-                    or else Options (J) not in '0' .. '9';
+                  Err_Col := Err_Col + 1;
+                  exit when Err_Col > Options'Last
+                    or else Options (Err_Col) not in '0' .. '9';
                end loop;
 
                Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0;
@@ -252,41 +287,43 @@ package body Stylesw is
                Style_Check_Max_Line_Length     := True;
                Style_Max_Line_Length           := 79;
 
-            when 'n' =>
-               Style_Check_Standard            := True;
-
-            when 'N' =>
-               Reset_Style_Check_Options;
-
             when 'M' =>
                Style_Max_Line_Length := 0;
 
-               if J > Options'Last
-                 or else Options (J) not in '0' .. '9'
+               if Err_Col > Options'Last
+                 or else Options (Err_Col) not in '0' .. '9'
                then
-                  OK := False;
-                  Err_Col := J;
+                  Bad_Style_Switch
+                    ("invalid line length in style check");
                   return;
                end if;
 
                loop
                   Style_Max_Line_Length :=
                     Style_Max_Line_Length * 10 +
-                      Character'Pos (Options (J)) - Character'Pos ('0');
+                      Character'Pos (Options (Err_Col)) - Character'Pos ('0');
 
-                  if Style_Max_Line_Length > Int (Column_Number'Last) then
+                  if Style_Max_Line_Length > Int (Max_Line_Length) then
                      OK := False;
-                     Err_Col := J;
+                     Style_Msg_Buf (1 .. 27) := "max line length allowed is ";
+                     Style_Msg_Len := 27;
+                     Add_Img (Natural (Max_Line_Length));
                      return;
                   end if;
 
-                  J := J + 1;
-                  exit when J > Options'Last
-                    or else Options (J) not in '0' .. '9';
+                  Err_Col := Err_Col + 1;
+                  exit when Err_Col > Options'Last
+                    or else Options (Err_Col) not in '0' .. '9';
                end loop;
 
                Style_Check_Max_Line_Length   := Style_Max_Line_Length /= 0;
 
+            when 'n' =>
+               Style_Check_Standard            := True;
+
+            when 'N' =>
+               Reset_Style_Check_Options;
+
             when 'o' =>
                Style_Check_Order_Subprograms   := True;
 
@@ -312,15 +349,16 @@ package body Stylesw is
                null;
 
             when others =>
-               OK      := False;
-               Err_Col := J - 1;
+               Err_Col := Err_Col - 1;
+               Style_Msg_Buf (1 .. 21) := "invalid style switch:";
+               Style_Msg_Len := 22;
+               Style_Msg_Buf (Style_Msg_Len) := C;
+               OK := False;
                return;
          end case;
       end loop;
 
       Style_Check := True;
       OK := True;
-      Err_Col := Options'Last + 1;
    end Set_Style_Check_Options;
-
 end Stylesw;
diff --git a/gcc/ada/stylesw.ads b/gcc/ada/stylesw.ads
index ae7f113..4dd6626 100644
--- a/gcc/ada/stylesw.ads
+++ b/gcc/ada/stylesw.ads
@@ -254,24 +254,31 @@ package Stylesw is
    --  This procedure is called to set the default style checking options
    --  in response to a -gnaty switch with no suboptions.
 
+   Style_Msg_Buf : String (1 .. 80);
+   Style_Msg_Len : Natural;
+   --  Used to return
+
    procedure Set_Style_Check_Options
      (Options  : String;
       OK       : out Boolean;
       Err_Col  : out Natural);
-   --  This procedure is called to set the style check options that
-   --  correspond to the characters in the given Options string. If
-   --  all options are valid, they are set in an additive manner:
-   --  any previous options are retained unless overridden. If any
-   --  invalid character is found, then OK is False on exit, and
-   --  Err_Col is the index in options of the bad character. If all
-   --  options are valid, OK is True on return, and Err_Col is set
-   --  to Options'Last + 1.
+   --  This procedure is called to set the style check options that correspond
+   --  to the characters in the given Options string. If all options are valid,
+   --  they are set in an additive manner: any previous options are retained
+   --  unless overridden.
+   --
+   --  If all options given are valid, then OK is True, Err_Col is set to
+   --  Options'Last + 1, and Style_Msg_Buf/Style_Msg_Len are unchanged.
+   --
+   --  If an invalid character is found, then OK is False on exit, and Err_Col
+   --  is the index in options of the bad character. In this case Style_Msg_Len
+   --  is set and Style_Msg_Buf (1 .. Style_Msg_Len) has a detailed message
+   --  describing the error.
 
    procedure Set_Style_Check_Options (Options : String);
-   --  Like the above procedure, except that the call is simply ignored if
-   --  there are any error conditions, this is for example appopriate for
-   --  calls where the string is known to be valid, e.g. because it was
-   --  obtained by Save_Style_Check_Options.
+   --  Like the above procedure, but used when the Options string is known to
+   --  be valid. This is for example appopriate for calls where the string ==
+   --  was obtained by Save_Style_Check_Options.
 
    procedure Reset_Style_Check_Options;
    --  Sets all style check options to off
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index fe7545e..eaefef9 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -852,11 +852,18 @@ package body Switch.C is
                        (Switch_Chars (Ptr .. Max), OK, Ptr);
 
                      if not OK then
-                        Bad_Switch (C);
+                        declare
+                           R : String (1 .. Style_Msg_Len + 20);
+                        begin
+                           R (1 .. 19) := "bad -gnaty switch (";
+                           R (20 .. R'Last - 1) :=
+                             Style_Msg_Buf (1 .. Style_Msg_Len);
+                           R (R'Last) := ')';
+                           Osint.Fail (R);
+                        end;
                      end if;
 
                      Ptr := First_Char + 1;
-
                      while Ptr <= Max loop
                         Last_Stored := First_Stored + 1;
                         Storing (Last_Stored) := Switch_Chars (Ptr);