OpenCores
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

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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.