OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Thomas Quinot 2005-12-09 18:16:35 +01:00 committed by Arnaud Charlet
parent 7cdc672b77
commit 23d0d17f0d
8 changed files with 127 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gcc/ada/frontend.adb
View File

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

20
gcc/ada/hostparm.ads
View File

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

8
gcc/ada/namet.ads
View File

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

5
gcc/ada/scn.adb
View File

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

11
gcc/ada/scng.adb
View File

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

114
gcc/ada/stylesw.adb
View File

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

31
gcc/ada/stylesw.ads
View File

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

11
gcc/ada/switch-c.adb
View File

@ -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);