Opt.Style_Check := False;
Style_Check := False;
- Opt.Max_Line_Length := Int (Column_Number'Last);
-- Capture current suppress options, which may get modified
-- 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
-- --
-- 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- --
-- 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
-----------------------
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
with Alloc;
with Table;
+with Hostparm; use Hostparm;
with System; use System;
with Types; use Types;
-- 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
with Atree; use Atree;
with Csets; use Csets;
+with Hostparm; use Hostparm;
with Namet; use Namet;
with Opt; use Opt;
with Restrict; use Restrict;
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;
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;
------------------------
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;
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;
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;
-------------------------------
-- --
------------------------------------------------------------------------------
-with Opt; use Opt;
+with Hostparm; use Hostparm;
+with Opt; use Opt;
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
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;
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;
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;
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;
-- 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
(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);
OSDN Git Service
