URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [stylesw.adb] - Blame information for rev 706

Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              S T Y L E S W                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2011, 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- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Hostparm; use Hostparm;
with Opt;      use Opt;
 
package body Stylesw is
 
   --  The following constant defines the default style options for -gnaty
 
   Default_Style : constant String :=
                     "3" &  -- indentation level is 3
                     "a" &  -- check attribute casing
                     "A" &  -- check array attribute indexes
                     "b" &  -- check no blanks at end of lines
                     "c" &  -- check comment formats
                     "e" &  -- check end/exit labels present
                     "f" &  -- check no form/feeds vertical tabs in source
                     "h" &  -- check no horizontal tabs in source
                     "i" &  -- check if-then layout
                     "k" &  -- check casing rules for keywords
                     "l" &  -- check reference manual layout
                     "m" &  -- check line length <= 79 characters
                     "n" &  -- check casing of package Standard idents
                     "p" &  -- check pragma casing
                     "r" &  -- check casing for identifier references
                     "s" &  -- check separate subprogram specs present
                     "t";   -- check token separation rules
 
   --  The following constant defines the GNAT style options, showing them
   --  as additions to the standard default style check options.
 
   GNAT_Style    : constant String := Default_Style &
                     "d" &  -- check no DOS line terminators
                     "I" &  -- check mode IN
                     "S" &  -- check separate lines after THEN or ELSE
                     "u" &  -- check no unnecessary blank lines
                     "x";   -- check extra parentheses around conditionals
 
   --  Note: we intend GNAT_Style to also include the following, but we do
   --  not yet have the whole tool suite clean with respect to this.
 
   --                "B" &  -- check boolean operators
 
   -------------------------------
   -- Reset_Style_Check_Options --
   -------------------------------
 
   procedure Reset_Style_Check_Options is
   begin
      Style_Check_Indentation           := 0;
      Style_Check_Array_Attribute_Index := False;
      Style_Check_Attribute_Casing      := False;
      Style_Check_Blanks_At_End         := False;
      Style_Check_Blank_Lines           := False;
      Style_Check_Boolean_And_Or        := False;
      Style_Check_Comments              := False;
      Style_Check_DOS_Line_Terminator   := False;
      Style_Check_End_Labels            := False;
      Style_Check_Form_Feeds            := False;
      Style_Check_Horizontal_Tabs       := False;
      Style_Check_If_Then_Layout        := False;
      Style_Check_Keyword_Casing        := False;
      Style_Check_Layout                := False;
      Style_Check_Max_Line_Length       := False;
      Style_Check_Max_Nesting_Level     := False;
      Style_Check_Missing_Overriding    := False;
      Style_Check_Mode_In               := False;
      Style_Check_Order_Subprograms     := False;
      Style_Check_Pragma_Casing         := False;
      Style_Check_References            := False;
      Style_Check_Separate_Stmt_Lines   := False;
      Style_Check_Specs                 := False;
      Style_Check_Standard              := False;
      Style_Check_Tokens                := False;
      Style_Check_Xtra_Parens           := False;
   end Reset_Style_Check_Options;
 
   ---------------------
   -- RM_Column_Check --
   ---------------------
 
   function RM_Column_Check return Boolean is
   begin
      return Style_Check and Style_Check_Layout;
   end RM_Column_Check;
 
   ------------------------------
   -- Save_Style_Check_Options --
   ------------------------------
 
   procedure Save_Style_Check_Options (Options : out Style_Check_Options) is
      P : Natural := 0;
 
      procedure Add (C : Character; S : Boolean);
      --  Add given character C to string if switch S is true
 
      procedure Add_Nat (N : Nat);
      --  Add given natural number to string
 
      ---------
      -- Add --
      ---------
 
      procedure Add (C : Character; S : Boolean) is
      begin
         if S then
            P := P + 1;
            Options (P) := C;
         end if;
      end Add;
 
      -------------
      -- Add_Nat --
      -------------
 
      procedure Add_Nat (N : Nat) is
      begin
         if N > 9 then
            Add_Nat (N / 10);
         end if;
 
         P := P + 1;
         Options (P) := Character'Val (Character'Pos ('0') + N mod 10);
      end Add_Nat;
 
   --  Start of processing for Save_Style_Check_Options
 
   begin
      for K in Options'Range loop
         Options (K) := ' ';
      end loop;
 
      Add (Character'Val (Style_Check_Indentation + Character'Pos ('0')),
           Style_Check_Indentation /= 0);
 
      Add ('a', Style_Check_Attribute_Casing);
      Add ('A', Style_Check_Array_Attribute_Index);
      Add ('b', Style_Check_Blanks_At_End);
      Add ('B', Style_Check_Boolean_And_Or);
 
      if Style_Check_Comments_Spacing = 2 then
         Add ('c', Style_Check_Comments);
      elsif Style_Check_Comments_Spacing = 1 then
         Add ('C', Style_Check_Comments);
      end if;
 
      Add ('d', Style_Check_DOS_Line_Terminator);
      Add ('e', Style_Check_End_Labels);
      Add ('f', Style_Check_Form_Feeds);
      Add ('h', Style_Check_Horizontal_Tabs);
      Add ('i', Style_Check_If_Then_Layout);
      Add ('I', Style_Check_Mode_In);
      Add ('k', Style_Check_Keyword_Casing);
      Add ('l', Style_Check_Layout);
      Add ('n', Style_Check_Standard);
      Add ('o', Style_Check_Order_Subprograms);
      Add ('O', Style_Check_Missing_Overriding);
      Add ('p', Style_Check_Pragma_Casing);
      Add ('r', Style_Check_References);
      Add ('s', Style_Check_Specs);
      Add ('S', Style_Check_Separate_Stmt_Lines);
      Add ('t', Style_Check_Tokens);
      Add ('u', Style_Check_Blank_Lines);
      Add ('x', Style_Check_Xtra_Parens);
 
      if Style_Check_Max_Line_Length then
         P := P + 1;
         Options (P) := 'M';
         Add_Nat (Style_Max_Line_Length);
      end if;
 
      if Style_Check_Max_Nesting_Level then
         P := P + 1;
         Options (P) := 'L';
         Add_Nat (Style_Max_Nesting_Level);
      end if;
 
      pragma Assert (P <= Options'Last);
 
      while P < Options'Last loop
         P := P + 1;
         Options (P) := ' ';
      end loop;
   end Save_Style_Check_Options;
 
   -------------------------------------
   -- Set_Default_Style_Check_Options --
   -------------------------------------
 
   procedure Set_Default_Style_Check_Options is
   begin
      Reset_Style_Check_Options;
      Set_Style_Check_Options (Default_Style);
   end Set_Default_Style_Check_Options;
 
   ----------------------------------
   -- Set_GNAT_Style_Check_Options --
   ----------------------------------
 
   procedure Set_GNAT_Style_Check_Options is
   begin
      Reset_Style_Check_Options;
      Set_Style_Check_Options (GNAT_Style);
   end Set_GNAT_Style_Check_Options;
 
   -----------------------------
   -- Set_Style_Check_Options --
   -----------------------------
 
   --  Version used when no error checking is required
 
   procedure Set_Style_Check_Options (Options : String) is
      OK : Boolean;
      EC : Natural;
      pragma Warnings (Off, EC);
   begin
      Set_Style_Check_Options (Options, OK, EC);
      pragma Assert (OK);
   end Set_Style_Check_Options;
 
   --  Normal version with error checking
 
   procedure Set_Style_Check_Options
     (Options  : String;
      OK       : out Boolean;
      Err_Col  : out Natural)
   is
      C : Character;
 
      On : Boolean := True;
      --  Set to False if minus encountered
      --  Set to True if plus encountered
 
      Last_Option : Character := ' ';
      --  Set to last character encountered
 
      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 set 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
      Err_Col := Options'First;
      while Err_Col <= Options'Last loop
         C := Options (Err_Col);
         Last_Option := C;
         Err_Col := Err_Col + 1;
 
         --  Turning switches on
 
         if On then
            case C is
 
            when '+' =>
               null;
 
            when '-' =>
               On := False;
 
            when '0' .. '9' =>
               Style_Check_Indentation :=
                 Character'Pos (C) - Character'Pos ('0');
 
            when 'a' =>
               Style_Check_Attribute_Casing      := True;
 
            when 'A' =>
               Style_Check_Array_Attribute_Index := True;
 
            when 'b' =>
               Style_Check_Blanks_At_End         := True;
 
            when 'B' =>
               Style_Check_Boolean_And_Or        := True;
 
            when 'c' =>
               Style_Check_Comments              := True;
               Style_Check_Comments_Spacing      := 2;
 
            when 'C' =>
               Style_Check_Comments              := True;
               Style_Check_Comments_Spacing      := 1;
 
            when 'd' =>
               Style_Check_DOS_Line_Terminator   := True;
 
            when 'e' =>
               Style_Check_End_Labels            := True;
 
            when 'f' =>
               Style_Check_Form_Feeds            := True;
 
            when 'g' =>
               Set_GNAT_Style_Check_Options;
 
            when 'h' =>
               Style_Check_Horizontal_Tabs       := True;
 
            when 'i' =>
               Style_Check_If_Then_Layout        := True;
 
            when 'I' =>
               Style_Check_Mode_In               := True;
 
            when 'k' =>
               Style_Check_Keyword_Casing        := True;
 
            when 'l' =>
               Style_Check_Layout                := True;
 
            when 'L' =>
               Style_Max_Nesting_Level := 0;
 
               if Err_Col > Options'Last
                 or else Options (Err_Col) not in '0' .. '9'
               then
                  Bad_Style_Switch ("invalid nesting level");
                  return;
               end if;
 
               loop
                  Style_Max_Nesting_Level :=
                    Style_Max_Nesting_Level * 10 +
                      Character'Pos (Options (Err_Col)) - Character'Pos ('0');
 
                  if Style_Max_Nesting_Level > 999 then
                     Bad_Style_Switch
                       ("max nesting level (999) exceeded in style check");
                     return;
                  end if;
 
                  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;
 
            when 'm' =>
               Style_Check_Max_Line_Length       := True;
               Style_Max_Line_Length             := 79;
 
            when 'M' =>
               Style_Max_Line_Length             := 0;
 
               if Err_Col > Options'Last
                 or else Options (Err_Col) not in '0' .. '9'
               then
                  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 (Err_Col)) - Character'Pos ('0');
 
                  if Style_Max_Line_Length > Int (Max_Line_Length) then
                     OK := False;
                     Style_Msg_Buf (1 .. 27) := "max line length allowed is ";
                     Style_Msg_Len := 27;
                     Add_Img (Natural (Max_Line_Length));
                     return;
                  end if;
 
                  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;
 
            when 'O' =>
               Style_Check_Missing_Overriding    := True;
 
            when 'p' =>
               Style_Check_Pragma_Casing         := True;
 
            when 'r' =>
               Style_Check_References            := True;
 
            when 's' =>
               Style_Check_Specs                 := True;
 
            when 'S' =>
               Style_Check_Separate_Stmt_Lines   := True;
 
            when 't' =>
               Style_Check_Tokens                := True;
 
            when 'u' =>
               Style_Check_Blank_Lines           := True;
 
            when 'x' =>
               Style_Check_Xtra_Parens           := True;
 
            when 'y' =>
               Set_Default_Style_Check_Options;
 
            when ' ' =>
               null;
 
            when others =>
               Err_Col := Err_Col - 1;
               Bad_Style_Switch ("invalid style switch: " & C);
               return;
            end case;
 
         --  Turning switches off
 
         else
            case C is
 
            when '+' =>
               On := True;
 
            when '-' =>
               null;
 
            when '0' .. '9' =>
               Style_Check_Indentation := 0;
 
            when 'a' =>
               Style_Check_Attribute_Casing      := False;
 
            when 'A' =>
               Style_Check_Array_Attribute_Index := False;
 
            when 'b' =>
               Style_Check_Blanks_At_End         := False;
 
            when 'B' =>
               Style_Check_Boolean_And_Or        := False;
 
            when 'c' | 'C' =>
               Style_Check_Comments              := False;
 
            when 'd' =>
               Style_Check_DOS_Line_Terminator   := False;
 
            when 'e' =>
               Style_Check_End_Labels            := False;
 
            when 'f' =>
               Style_Check_Form_Feeds            := False;
 
            when 'g' =>
               Reset_Style_Check_Options;
 
            when 'h' =>
               Style_Check_Horizontal_Tabs       := False;
 
            when 'i' =>
               Style_Check_If_Then_Layout        := False;
 
            when 'I' =>
               Style_Check_Mode_In               := False;
 
            when 'k' =>
               Style_Check_Keyword_Casing        := False;
 
            when 'l' =>
               Style_Check_Layout                := False;
 
            when 'L' =>
               Style_Max_Nesting_Level := 0;
 
            when 'm' =>
               Style_Check_Max_Line_Length       := False;
 
            when 'M' =>
               Style_Max_Line_Length             := 0;
               Style_Check_Max_Line_Length       := False;
 
            when 'n' =>
               Style_Check_Standard              := False;
 
            when 'o' =>
               Style_Check_Order_Subprograms     := False;
 
            when 'O' =>
               Style_Check_Missing_Overriding    := False;
 
            when 'p' =>
               Style_Check_Pragma_Casing         := False;
 
            when 'r' =>
               Style_Check_References            := False;
 
            when 's' =>
               Style_Check_Specs                 := False;
 
            when 'S' =>
               Style_Check_Separate_Stmt_Lines   := False;
 
            when 't' =>
               Style_Check_Tokens                := False;
 
            when 'u' =>
               Style_Check_Blank_Lines           := False;
 
            when 'x' =>
               Style_Check_Xtra_Parens           := False;
 
            when ' ' =>
               null;
 
            when others =>
               Err_Col := Err_Col - 1;
               Bad_Style_Switch ("invalid style switch: " & C);
               return;
            end case;
         end if;
      end loop;
 
      --  Turn on style checking if other than N at end of string
 
      Style_Check := (Last_Option /= 'N');
      OK := True;
   end Set_Style_Check_Options;
end Stylesw;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [stylesw.adb] - Blame information for rev 706

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT COMPILER COMPONENTS --`
4			`-- --`
5			`-- S T Y L E S W --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --`
10			`-- --`
11			`-- GNAT is free software; you can redistribute it and/or modify it under --`
12			`-- terms of the GNU General Public License as published by the Free Soft- --`
13			`-- ware Foundation; either version 3, or (at your option) any later ver- --`
14			`-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --`
15			`-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --`
16			`-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --`
17			`-- for more details. You should have received a copy of the GNU General --`
18			`-- Public License distributed with GNAT; see file COPYING3. If not, go to --`
19			`-- http://www.gnu.org/licenses for a complete copy of the license. --`
20			`-- --`
21			`-- GNAT was originally developed by the GNAT team at New York University. --`
22			`-- Extensive contributions were provided by Ada Core Technologies Inc. --`
23			`-- --`
24			`------------------------------------------------------------------------------`
25
26			`with Hostparm; use Hostparm;`
27			`with Opt; use Opt;`
28
29			`package body Stylesw is`
30
31			`-- The following constant defines the default style options for -gnaty`
32
33			`Default_Style : constant String :=`
34			`"3" & -- indentation level is 3`
35			`"a" & -- check attribute casing`
36			`"A" & -- check array attribute indexes`
37			`"b" & -- check no blanks at end of lines`
38			`"c" & -- check comment formats`
39			`"e" & -- check end/exit labels present`
40			`"f" & -- check no form/feeds vertical tabs in source`
41			`"h" & -- check no horizontal tabs in source`
42			`"i" & -- check if-then layout`
43			`"k" & -- check casing rules for keywords`
44			`"l" & -- check reference manual layout`
45			`"m" & -- check line length <= 79 characters`
46			`"n" & -- check casing of package Standard idents`
47			`"p" & -- check pragma casing`
48			`"r" & -- check casing for identifier references`
49			`"s" & -- check separate subprogram specs present`
50			`"t"; -- check token separation rules`
51
52			`-- The following constant defines the GNAT style options, showing them`
53			`-- as additions to the standard default style check options.`
54
55			`GNAT_Style : constant String := Default_Style &`
56			`"d" & -- check no DOS line terminators`
57			`"I" & -- check mode IN`
58			`"S" & -- check separate lines after THEN or ELSE`
59			`"u" & -- check no unnecessary blank lines`
60			`"x"; -- check extra parentheses around conditionals`
61
62			`-- Note: we intend GNAT_Style to also include the following, but we do`
63			`-- not yet have the whole tool suite clean with respect to this.`
64
65			`-- "B" & -- check boolean operators`
66
67			`-------------------------------`
68			`-- Reset_Style_Check_Options --`
69			`-------------------------------`
70
71			`procedure Reset_Style_Check_Options is`
72			`begin`
73			`Style_Check_Indentation := 0;`
74			`Style_Check_Array_Attribute_Index := False;`
75			`Style_Check_Attribute_Casing := False;`
76			`Style_Check_Blanks_At_End := False;`
77			`Style_Check_Blank_Lines := False;`
78			`Style_Check_Boolean_And_Or := False;`
79			`Style_Check_Comments := False;`
80			`Style_Check_DOS_Line_Terminator := False;`
81			`Style_Check_End_Labels := False;`
82			`Style_Check_Form_Feeds := False;`
83			`Style_Check_Horizontal_Tabs := False;`
84			`Style_Check_If_Then_Layout := False;`
85			`Style_Check_Keyword_Casing := False;`
86			`Style_Check_Layout := False;`
87			`Style_Check_Max_Line_Length := False;`
88			`Style_Check_Max_Nesting_Level := False;`
89			`Style_Check_Missing_Overriding := False;`
90			`Style_Check_Mode_In := False;`
91			`Style_Check_Order_Subprograms := False;`
92			`Style_Check_Pragma_Casing := False;`
93			`Style_Check_References := False;`
94			`Style_Check_Separate_Stmt_Lines := False;`
95			`Style_Check_Specs := False;`
96			`Style_Check_Standard := False;`
97			`Style_Check_Tokens := False;`
98			`Style_Check_Xtra_Parens := False;`
99			`end Reset_Style_Check_Options;`
100
101			`---------------------`
102			`-- RM_Column_Check --`
103			`---------------------`
104
105			`function RM_Column_Check return Boolean is`
106			`begin`
107			`return Style_Check and Style_Check_Layout;`
108			`end RM_Column_Check;`
109
110			`------------------------------`
111			`-- Save_Style_Check_Options --`
112			`------------------------------`
113
114			`procedure Save_Style_Check_Options (Options : out Style_Check_Options) is`
115			`P : Natural := 0;`
116
117			`procedure Add (C : Character; S : Boolean);`
118			`-- Add given character C to string if switch S is true`
119
120			`procedure Add_Nat (N : Nat);`
121			`-- Add given natural number to string`
122
123			`---------`
124			`-- Add --`
125			`---------`
126
127			`procedure Add (C : Character; S : Boolean) is`
128			`begin`
129			`if S then`
130			`P := P + 1;`
131			`Options (P) := C;`
132			`end if;`
133			`end Add;`
134
135			`-------------`
136			`-- Add_Nat --`
137			`-------------`
138
139			`procedure Add_Nat (N : Nat) is`
140			`begin`
141			`if N > 9 then`
142			`Add_Nat (N / 10);`
143			`end if;`
144
145			`P := P + 1;`
146			`Options (P) := Character'Val (Character'Pos ('0') + N mod 10);`
147			`end Add_Nat;`
148
149			`-- Start of processing for Save_Style_Check_Options`
150
151			`begin`
152			`for K in Options'Range loop`
153			`Options (K) := ' ';`
154			`end loop;`
155
156			`Add (Character'Val (Style_Check_Indentation + Character'Pos ('0')),`
157			`Style_Check_Indentation /= 0);`
158
159			`Add ('a', Style_Check_Attribute_Casing);`
160			`Add ('A', Style_Check_Array_Attribute_Index);`
161			`Add ('b', Style_Check_Blanks_At_End);`
162			`Add ('B', Style_Check_Boolean_And_Or);`
163
164			`if Style_Check_Comments_Spacing = 2 then`
165			`Add ('c', Style_Check_Comments);`
166			`elsif Style_Check_Comments_Spacing = 1 then`
167			`Add ('C', Style_Check_Comments);`
168			`end if;`
169
170			`Add ('d', Style_Check_DOS_Line_Terminator);`
171			`Add ('e', Style_Check_End_Labels);`
172			`Add ('f', Style_Check_Form_Feeds);`
173			`Add ('h', Style_Check_Horizontal_Tabs);`
174			`Add ('i', Style_Check_If_Then_Layout);`
175			`Add ('I', Style_Check_Mode_In);`
176			`Add ('k', Style_Check_Keyword_Casing);`
177			`Add ('l', Style_Check_Layout);`
178			`Add ('n', Style_Check_Standard);`
179			`Add ('o', Style_Check_Order_Subprograms);`
180			`Add ('O', Style_Check_Missing_Overriding);`
181			`Add ('p', Style_Check_Pragma_Casing);`
182			`Add ('r', Style_Check_References);`
183			`Add ('s', Style_Check_Specs);`
184			`Add ('S', Style_Check_Separate_Stmt_Lines);`
185			`Add ('t', Style_Check_Tokens);`
186			`Add ('u', Style_Check_Blank_Lines);`
187			`Add ('x', Style_Check_Xtra_Parens);`
188
189			`if Style_Check_Max_Line_Length then`
190			`P := P + 1;`
191			`Options (P) := 'M';`
192			`Add_Nat (Style_Max_Line_Length);`
193			`end if;`
194
195			`if Style_Check_Max_Nesting_Level then`
196			`P := P + 1;`
197			`Options (P) := 'L';`
198			`Add_Nat (Style_Max_Nesting_Level);`
199			`end if;`
200
201			`pragma Assert (P <= Options'Last);`
202
203			`while P < Options'Last loop`
204			`P := P + 1;`
205			`Options (P) := ' ';`
206			`end loop;`
207			`end Save_Style_Check_Options;`
208
209			`-------------------------------------`
210			`-- Set_Default_Style_Check_Options --`
211			`-------------------------------------`
212
213			`procedure Set_Default_Style_Check_Options is`
214			`begin`
215			`Reset_Style_Check_Options;`
216			`Set_Style_Check_Options (Default_Style);`
217			`end Set_Default_Style_Check_Options;`
218
219			`----------------------------------`
220			`-- Set_GNAT_Style_Check_Options --`
221			`----------------------------------`
222
223			`procedure Set_GNAT_Style_Check_Options is`
224			`begin`
225			`Reset_Style_Check_Options;`
226			`Set_Style_Check_Options (GNAT_Style);`
227			`end Set_GNAT_Style_Check_Options;`
228
229			`-----------------------------`
230			`-- Set_Style_Check_Options --`
231			`-----------------------------`
232
233			`-- Version used when no error checking is required`
234
235			`procedure Set_Style_Check_Options (Options : String) is`
236			`OK : Boolean;`
237			`EC : Natural;`
238			`pragma Warnings (Off, EC);`
239			`begin`
240			`Set_Style_Check_Options (Options, OK, EC);`
241			`pragma Assert (OK);`
242			`end Set_Style_Check_Options;`
243
244			`-- Normal version with error checking`
245
246			`procedure Set_Style_Check_Options`
247			`(Options : String;`
248			`OK : out Boolean;`
249			`Err_Col : out Natural)`
250			`is`
251			`C : Character;`
252
253			`On : Boolean := True;`
254			`-- Set to False if minus encountered`
255			`-- Set to True if plus encountered`
256
257			`Last_Option : Character := ' ';`
258			`-- Set to last character encountered`
259
260			`procedure Add_Img (N : Natural);`
261			`-- Concatenates image of N at end of Style_Msg_Buf`
262
263			`procedure Bad_Style_Switch (Msg : String);`
264			`-- Called if bad style switch found. Msg is set in Style_Msg_Buf and`
265			`-- Style_Msg_Len. OK is set False.`
266
267			`-------------`
268			`-- Add_Img --`
269			`-------------`
270
271			`procedure Add_Img (N : Natural) is`
272			`begin`
273			`if N >= 10 then`
274			`Add_Img (N / 10);`
275			`end if;`
276
277			`Style_Msg_Len := Style_Msg_Len + 1;`
278			`Style_Msg_Buf (Style_Msg_Len) :=`
279			`Character'Val (N mod 10 + Character'Pos ('0'));`
280			`end Add_Img;`
281
282			`----------------------`
283			`-- Bad_Style_Switch --`
284			`----------------------`
285
286			`procedure Bad_Style_Switch (Msg : String) is`
287			`begin`
288			`OK := False;`
289			`Style_Msg_Len := Msg'Length;`
290			`Style_Msg_Buf (1 .. Style_Msg_Len) := Msg;`
291			`end Bad_Style_Switch;`
292
293			`-- Start of processing for Set_Style_Check_Options`
294
295			`begin`
296			`Err_Col := Options'First;`
297			`while Err_Col <= Options'Last loop`
298			`C := Options (Err_Col);`
299			`Last_Option := C;`
300			`Err_Col := Err_Col + 1;`
301
302			`-- Turning switches on`
303
304			`if On then`
305			`case C is`
306
307			`when '+' =>`
308			`null;`
309
310			`when '-' =>`
311			`On := False;`
312
313			`when '0' .. '9' =>`
314			`Style_Check_Indentation :=`
315			`Character'Pos (C) - Character'Pos ('0');`
316
317			`when 'a' =>`
318			`Style_Check_Attribute_Casing := True;`
319
320			`when 'A' =>`
321			`Style_Check_Array_Attribute_Index := True;`
322
323			`when 'b' =>`
324			`Style_Check_Blanks_At_End := True;`
325
326			`when 'B' =>`
327			`Style_Check_Boolean_And_Or := True;`
328
329			`when 'c' =>`
330			`Style_Check_Comments := True;`
331			`Style_Check_Comments_Spacing := 2;`
332
333			`when 'C' =>`
334			`Style_Check_Comments := True;`
335			`Style_Check_Comments_Spacing := 1;`
336
337			`when 'd' =>`
338			`Style_Check_DOS_Line_Terminator := True;`
339
340			`when 'e' =>`
341			`Style_Check_End_Labels := True;`
342
343			`when 'f' =>`
344			`Style_Check_Form_Feeds := True;`
345
346			`when 'g' =>`
347			`Set_GNAT_Style_Check_Options;`
348
349			`when 'h' =>`
350			`Style_Check_Horizontal_Tabs := True;`
351
352			`when 'i' =>`
353			`Style_Check_If_Then_Layout := True;`
354
355			`when 'I' =>`
356			`Style_Check_Mode_In := True;`
357
358			`when 'k' =>`
359			`Style_Check_Keyword_Casing := True;`
360
361			`when 'l' =>`
362			`Style_Check_Layout := True;`
363
364			`when 'L' =>`
365			`Style_Max_Nesting_Level := 0;`
366
367			`if Err_Col > Options'Last`
368			`or else Options (Err_Col) not in '0' .. '9'`
369			`then`
370			`Bad_Style_Switch ("invalid nesting level");`
371			`return;`
372			`end if;`
373
374			`loop`
375			`Style_Max_Nesting_Level :=`
376			`Style_Max_Nesting_Level * 10 +`
377			`Character'Pos (Options (Err_Col)) - Character'Pos ('0');`
378
379			`if Style_Max_Nesting_Level > 999 then`
380			`Bad_Style_Switch`
381			`("max nesting level (999) exceeded in style check");`
382			`return;`
383			`end if;`
384
385			`Err_Col := Err_Col + 1;`
386			`exit when Err_Col > Options'Last`
387			`or else Options (Err_Col) not in '0' .. '9';`
388			`end loop;`
389
390			`Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0;`
391
392			`when 'm' =>`
393			`Style_Check_Max_Line_Length := True;`
394			`Style_Max_Line_Length := 79;`
395
396			`when 'M' =>`
397			`Style_Max_Line_Length := 0;`
398
399			`if Err_Col > Options'Last`
400			`or else Options (Err_Col) not in '0' .. '9'`
401			`then`
402			`Bad_Style_Switch`
403			`("invalid line length in style check");`
404			`return;`
405			`end if;`
406
407			`loop`
408			`Style_Max_Line_Length :=`
409			`Style_Max_Line_Length * 10 +`
410			`Character'Pos (Options (Err_Col)) - Character'Pos ('0');`
411
412			`if Style_Max_Line_Length > Int (Max_Line_Length) then`
413			`OK := False;`
414			`Style_Msg_Buf (1 .. 27) := "max line length allowed is ";`
415			`Style_Msg_Len := 27;`
416			`Add_Img (Natural (Max_Line_Length));`
417			`return;`
418			`end if;`
419
420			`Err_Col := Err_Col + 1;`
421			`exit when Err_Col > Options'Last`
422			`or else Options (Err_Col) not in '0' .. '9';`
423			`end loop;`
424
425			`Style_Check_Max_Line_Length := Style_Max_Line_Length /= 0;`
426
427			`when 'n' =>`
428			`Style_Check_Standard := True;`
429
430			`when 'N' =>`
431			`Reset_Style_Check_Options;`
432
433			`when 'o' =>`
434			`Style_Check_Order_Subprograms := True;`
435
436			`when 'O' =>`
437			`Style_Check_Missing_Overriding := True;`
438
439			`when 'p' =>`
440			`Style_Check_Pragma_Casing := True;`
441
442			`when 'r' =>`
443			`Style_Check_References := True;`
444
445			`when 's' =>`
446			`Style_Check_Specs := True;`
447
448			`when 'S' =>`
449			`Style_Check_Separate_Stmt_Lines := True;`
450
451			`when 't' =>`
452			`Style_Check_Tokens := True;`
453
454			`when 'u' =>`
455			`Style_Check_Blank_Lines := True;`
456
457			`when 'x' =>`
458			`Style_Check_Xtra_Parens := True;`
459
460			`when 'y' =>`
461			`Set_Default_Style_Check_Options;`
462
463			`when ' ' =>`
464			`null;`
465
466			`when others =>`
467			`Err_Col := Err_Col - 1;`
468			`Bad_Style_Switch ("invalid style switch: " & C);`
469			`return;`
470			`end case;`
471
472			`-- Turning switches off`
473
474			`else`
475			`case C is`
476
477			`when '+' =>`
478			`On := True;`
479
480			`when '-' =>`
481			`null;`
482
483			`when '0' .. '9' =>`
484			`Style_Check_Indentation := 0;`
485
486			`when 'a' =>`
487			`Style_Check_Attribute_Casing := False;`
488
489			`when 'A' =>`
490			`Style_Check_Array_Attribute_Index := False;`
491
492			`when 'b' =>`
493			`Style_Check_Blanks_At_End := False;`
494
495			`when 'B' =>`
496			`Style_Check_Boolean_And_Or := False;`
497
498			`when 'c' \| 'C' =>`
499			`Style_Check_Comments := False;`
500
501			`when 'd' =>`
502			`Style_Check_DOS_Line_Terminator := False;`
503
504			`when 'e' =>`
505			`Style_Check_End_Labels := False;`
506
507			`when 'f' =>`
508			`Style_Check_Form_Feeds := False;`
509
510			`when 'g' =>`
511			`Reset_Style_Check_Options;`
512
513			`when 'h' =>`
514			`Style_Check_Horizontal_Tabs := False;`
515
516			`when 'i' =>`
517			`Style_Check_If_Then_Layout := False;`
518
519			`when 'I' =>`
520			`Style_Check_Mode_In := False;`
521
522			`when 'k' =>`
523			`Style_Check_Keyword_Casing := False;`
524
525			`when 'l' =>`
526			`Style_Check_Layout := False;`
527
528			`when 'L' =>`
529			`Style_Max_Nesting_Level := 0;`
530
531			`when 'm' =>`
532			`Style_Check_Max_Line_Length := False;`
533
534			`when 'M' =>`
535			`Style_Max_Line_Length := 0;`
536			`Style_Check_Max_Line_Length := False;`
537
538			`when 'n' =>`
539			`Style_Check_Standard := False;`
540
541			`when 'o' =>`
542			`Style_Check_Order_Subprograms := False;`
543
544			`when 'O' =>`
545			`Style_Check_Missing_Overriding := False;`
546
547			`when 'p' =>`
548			`Style_Check_Pragma_Casing := False;`
549
550			`when 'r' =>`
551			`Style_Check_References := False;`
552
553			`when 's' =>`
554			`Style_Check_Specs := False;`
555
556			`when 'S' =>`
557			`Style_Check_Separate_Stmt_Lines := False;`
558
559			`when 't' =>`
560			`Style_Check_Tokens := False;`
561
562			`when 'u' =>`
563			`Style_Check_Blank_Lines := False;`
564
565			`when 'x' =>`
566			`Style_Check_Xtra_Parens := False;`
567
568			`when ' ' =>`
569			`null;`
570
571			`when others =>`
572			`Err_Col := Err_Col - 1;`
573			`Bad_Style_Switch ("invalid style switch: " & C);`
574			`return;`
575			`end case;`
576			`end if;`
577			`end loop;`
578
579			`-- Turn on style checking if other than N at end of string`
580
581			`Style_Check := (Last_Option /= 'N');`
582			`OK := True;`
583			`end Set_Style_Check_Options;`
584			`end Stylesw;`