From 23d0d17f0debecb8cfbcf2ed0761d9bbc6866969 Mon Sep 17 00:00:00 2001 From: Thomas Quinot Date: Fri, 9 Dec 2005 18:16:35 +0100 Subject: [PATCH] hostparm.ads (Max_Line_Length): Set to Types.Column_Number'Last - 1... 2005-12-05 Thomas Quinot Robert Dewar * 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 --- gcc/ada/frontend.adb | 2 - gcc/ada/hostparm.ads | 20 +++++--- gcc/ada/namet.ads | 8 +-- gcc/ada/scn.adb | 5 +- gcc/ada/scng.adb | 11 ++--- gcc/ada/stylesw.adb | 114 ++++++++++++++++++++++++++++--------------- gcc/ada/stylesw.ads | 31 +++++++----- gcc/ada/switch-c.adb | 11 ++++- 8 files changed, 127 insertions(+), 75 deletions(-) diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 49b8dd729ac..2cb90d81d3f 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 6f2ecc7dd2f..eae07726a67 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 231fe852919..4bf12e6a85c 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 ce8402d7745..4a6f4f964ec 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 687c32b11d5..1f1fe156266 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 27e9153c9c6..4368372d2a3 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 ae7f113152e..4dd662672d1 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 fe7545edadf..eaefef90430 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); -- 2.30.2