summaryrefslogtreecommitdiff
path: root/gcc/ada/style.adb
blob: 31a05fea8fd32f451d55ce4835e6a522cb0b47da (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                                S T Y L E                                 --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision$
--                                                                          --
--          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

--  This version of the Style package implements the standard GNAT style
--  checking rules. For documentation of these rules, see comments on the
--  individual procedures.

with Atree;    use Atree;
with Casing;   use Casing;
with Csets;    use Csets;
with Einfo;    use Einfo;
with Errout;   use Errout;
with Namet;    use Namet;
with Opt;      use Opt;
with Scn;      use Scn;
with Scans;    use Scans;
with Sinfo;    use Sinfo;
with Sinput;   use Sinput;
with Stand;    use Stand;
with Stylesw;  use Stylesw;

package body Style is

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Error_Space_Not_Allowed (S : Source_Ptr);
   --  Posts an error message indicating that a space is not allowed
   --  at the given source location.

   procedure Error_Space_Required (S : Source_Ptr);
   --  Posts an error message indicating that a space is required at
   --  the given source location.

   procedure Require_Following_Space;
   pragma Inline (Require_Following_Space);
   --  Require token to be followed by white space. Used only if in GNAT
   --  style checking mode.

   procedure Require_Preceding_Space;
   pragma Inline (Require_Preceding_Space);
   --  Require token to be preceded by white space. Used only if in GNAT
   --  style checking mode.

   -----------------------
   -- Body_With_No_Spec --
   -----------------------

   --  If the check specs mode (-gnatys) is set, then all subprograms must
   --  have specs unless they are parameterless procedures that are not child
   --  units at the library level (i.e. they are possible main programs).

   procedure Body_With_No_Spec (N : Node_Id) is
   begin
      if Style_Check_Specs then
         if Nkind (Parent (N)) = N_Compilation_Unit then
            declare
               Spec  : constant Node_Id := Specification (N);
               Defnm : constant Node_Id := Defining_Unit_Name (Spec);

            begin
               if Nkind (Spec) = N_Procedure_Specification
                 and then Nkind (Defnm) = N_Defining_Identifier
                 and then No (First_Formal (Defnm))
               then
                  return;
               end if;
            end;
         end if;

         Error_Msg_N ("(style): subprogram body has no previous spec", N);
      end if;
   end Body_With_No_Spec;

   ----------------------
   -- Check_Abs_Or_Not --
   ----------------------

   --  In check tokens mode (-gnatyt), ABS/NOT must be followed by a space

   procedure Check_Abs_Not is
   begin
      if Style_Check_Tokens then
         if Source (Scan_Ptr) > ' ' then
            Error_Space_Required (Scan_Ptr);
         end if;
      end if;
   end Check_Abs_Not;

   -----------------
   -- Check_Arrow --
   -----------------

   --  In check tokens mode (-gnatys), arrow must be surrounded by spaces

   procedure Check_Arrow is
   begin
      if Style_Check_Tokens then
         Require_Preceding_Space;
         Require_Following_Space;
      end if;
   end Check_Arrow;

   --------------------------
   -- Check_Attribute_Name --
   --------------------------

   --  In check attribute casing mode (-gnatya), attribute names must be
   --  mixed case, i.e. start with an upper case letter, and otherwise
   --  lower case, except after an underline character.

   procedure Check_Attribute_Name (Reserved : Boolean) is
      pragma Warnings (Off, Reserved);

   begin
      if Style_Check_Attribute_Casing then
         if Determine_Token_Casing /= Mixed_Case then
            Error_Msg_SC ("(style) bad capitalization, mixed case required");
         end if;
      end if;
   end Check_Attribute_Name;

   ---------------------------
   -- Check_Binary_Operator --
   ---------------------------

   --  In check token mode (-gnatyt), binary operators other than the special
   --  case of exponentiation require surrounding space characters.

   procedure Check_Binary_Operator is
   begin
      if Style_Check_Tokens then
         Require_Preceding_Space;
         Require_Following_Space;
      end if;
   end Check_Binary_Operator;

   ---------------
   -- Check_Box --
   ---------------

   --  In check token mode (-gnatyt), box must be preceded by a space or by
   --  a left parenthesis. Spacing checking on the surrounding tokens takes
   --  care of the remaining checks.

   procedure Check_Box is
   begin
      if Style_Check_Tokens then
         if Prev_Token /= Tok_Left_Paren then
            Require_Preceding_Space;
         end if;
      end if;
   end Check_Box;

   -----------------
   -- Check_Colon --
   -----------------

   --  In check token mode (-gnatyt), colon must be surrounded by spaces

   procedure Check_Colon is
   begin
      if Style_Check_Tokens then
         Require_Preceding_Space;
         Require_Following_Space;
      end if;
   end Check_Colon;

   -----------------------
   -- Check_Colon_Equal --
   -----------------------

   --  In check token mode (-gnatyt), := must be surrounded by spaces

   procedure Check_Colon_Equal is
   begin
      if Style_Check_Tokens then
         Require_Preceding_Space;
         Require_Following_Space;
      end if;
   end Check_Colon_Equal;

   -----------------
   -- Check_Comma --
   -----------------

   --  In check token mode (-gnatyt), comma must be either the first
   --  token on a line, or be preceded by a non-blank character.
   --  It must also always be followed by a blank.

   procedure Check_Comma is
   begin
      if Style_Check_Tokens then
         if Token_Ptr > First_Non_Blank_Location
           and then Source (Token_Ptr - 1) = ' '
         then
            Error_Space_Not_Allowed (Token_Ptr - 1);
         end if;

         if Source (Scan_Ptr) > ' ' then
            Error_Space_Required (Scan_Ptr);
         end if;
      end if;
   end Check_Comma;

   -------------------
   -- Check_Comment --
   -------------------

   --  In check comment mode (-gnatyc) there are several requirements on the
   --  format of comments. The following are permissible comment formats:

   --    1. Any comment that is not at the start of a line, i.e. where the
   --       initial minuses are not the first non-blank characters on the
   --       line must have at least one blank after the second minus.

   --    2. A row of all minuses of any length is permitted (see procedure
   --       box above in the source of this routine).

   --    3. A comment line starting with two minuses and a space, and ending
   --       with a space and two minuses. Again see the procedure title box
   --       immediately above in the source.

   --    4. A full line comment where two spaces follow the two minus signs.
   --       This is the normal comment format in GNAT style, as typified by
   --       the comments you are reading now.

   --    5. A full line comment where the first character after the second
   --       minus is a special character, i.e. a character in the ASCII
   --       range 16#21#..16#2F# or 16#3A#..16#3F#. This allows special
   --       comments, such as those generated by gnatprep, or those that
   --       appear in the SPARK annotation language to be accepted.

   procedure Check_Comment is
      S : Source_Ptr;
      C : Character;

   begin
      --  Can never have a non-blank character preceding the first minus

      if Style_Check_Comments then
         if Scan_Ptr > Source_First (Current_Source_File)
           and then Source (Scan_Ptr - 1) > ' '
         then
            Error_Msg_S ("(style) space required");
         end if;
      end if;

      --  For a comment that is not at the start of the line, the only
      --  requirement is that we cannot have a non-blank character after
      --  the second minus sign.

      if Scan_Ptr /= First_Non_Blank_Location then
         if Style_Check_Comments then
            if Source (Scan_Ptr + 2) > ' ' then
               Error_Msg ("(style) space required", Scan_Ptr + 2);
            end if;
         end if;

         return;

      --  Case of a comment that is at the start of a line

      else
         --  First check, must be in appropriately indented column

         if Style_Check_Indentation /= 0 then
            if Start_Column rem Style_Check_Indentation /= 0 then
               Error_Msg_S ("(style) bad column");
               return;
            end if;
         end if;

         --  Now check form of the comment

         if not Style_Check_Comments then
            return;

         --  Case of not followed by a blank. Usually wrong, but there are
         --  some exceptions that we permit.

         elsif Source (Scan_Ptr + 2) /= ' ' then
            C := Source (Scan_Ptr + 2);

            --  Case of -- all on its own on a line is OK

            if C < ' ' then
               return;

            --  Case of --x, x special character is OK (gnatprep/SPARK/etc.)

            elsif Character'Pos (C) in 16#21# .. 16#2F#
                    or else
                  Character'Pos (C) in 16#3A# .. 16#3F#
            then
               return;

            --  Otherwise only cases allowed are when the entire line is
            --  made up of minus signs (case of a box comment).

            else
               S := Scan_Ptr + 2;

               while Source (S) >= ' ' loop
                  if Source (S) /= '-' then
                     Error_Space_Required (Scan_Ptr + 2);
                     return;
                  end if;

                  S := S + 1;
               end loop;
            end if;

         --  If we are followed by a blank, then the comment is OK if the
         --  character following this blank is another blank or a format
         --  effector.

         elsif Source (Scan_Ptr + 3) <= ' ' then
            return;

         --  Here is the case where we only have one blank after the two minus
         --  signs, which is an error unless the line ends with two blanks, the
         --  case of a box comment.

         else
            S := Scan_Ptr + 3;

            while Source (S) not in Line_Terminator loop
               S := S + 1;
            end loop;

            if Source (S - 1) /= '-' or else Source (S - 2) /= '-' then
               Error_Space_Required (Scan_Ptr + 3);
            end if;
         end if;
      end if;
   end Check_Comment;

   -------------------
   -- Check_Dot_Dot --
   -------------------

   --  In check token mode (-gnatyt), colon must be surrounded by spaces

   procedure Check_Dot_Dot is
   begin
      if Style_Check_Tokens then
         Require_Preceding_Space;
         Require_Following_Space;
      end if;
   end Check_Dot_Dot;

   -----------------------------------
   -- Check_Exponentiation_Operator --
   -----------------------------------

   --  No spaces are required for the ** operator in GNAT style check mode

   procedure Check_Exponentiation_Operator is
   begin
      null;
   end Check_Exponentiation_Operator;

   --------------
   -- Check_HT --
   --------------

   --  In check horizontal tab mode (-gnatyh), tab characters are not allowed

   procedure Check_HT is
   begin
      if Style_Check_Horizontal_Tabs then
         Error_Msg_S ("(style) horizontal tab not allowed");
      end if;
   end Check_HT;

   ----------------------
   -- Check_Identifier --
   ----------------------

   --  In check references mode (-gnatyr), identifier uses must be cased
   --  the same way as the corresponding identifier declaration.

   procedure Check_Identifier
     (Ref : Node_Or_Entity_Id;
      Def : Node_Or_Entity_Id)
   is
      Sref : Source_Ptr := Sloc (Ref);
      Sdef : Source_Ptr := Sloc (Def);
      Tref : Source_Buffer_Ptr;
      Tdef : Source_Buffer_Ptr;
      Nlen : Nat;
      Cas  : Casing_Type;

   begin
      --  If reference does not come from source, nothing to check

      if not Comes_From_Source (Ref) then
         return;

      --  Case of definition comes from source

      elsif Comes_From_Source (Def) then

         --  Check same casing if we are checking references

         if Style_Check_References then
            Tref := Source_Text (Get_Source_File_Index (Sref));
            Tdef := Source_Text (Get_Source_File_Index (Sdef));

            --  Ignore operator name case completely. This also catches the
            --  case of where one is an operator and the other is not. This
            --  is a phenomenon from rewriting of operators as functions,
            --  and is to be ignored.

            if Tref (Sref) = '"' or else Tdef (Sdef) = '"' then
               return;

            else
               while Tref (Sref) = Tdef (Sdef) loop

                  --  If end of identifier, all done

                  if not Identifier_Char (Tref (Sref)) then
                     return;

                  --  Otherwise loop continues

                  else
                     Sref := Sref + 1;
                     Sdef := Sdef + 1;
                  end if;
               end loop;

               --  Fall through loop when mismatch between identifiers
               --  If either identifier is not terminated, error.

               if Identifier_Char (Tref (Sref))
                    or else
                  Identifier_Char (Tdef (Sdef))
               then
                  Error_Msg_Node_1 := Def;
                  Error_Msg_Sloc := Sloc (Def);
                  Error_Msg
                    ("(style) bad casing of & declared#", Sref);
                  return;

               --  Else end of identifiers, and they match

               else
                  return;
               end if;
            end if;
         end if;

      --  Case of definition in package Standard

      elsif Sdef = Standard_Location then

         --  Check case of identifiers in Standard

         if Style_Check_Standard then
            Tref := Source_Text (Get_Source_File_Index (Sref));

            --  Ignore operators

            if Tref (Sref) = '"' then
               null;

            --  Special case of ASCII

            else
               if Entity (Ref) = Standard_ASCII then
                  Cas := All_Upper_Case;

               elsif Entity (Ref) in SE (S_LC_A) .. SE (S_LC_Z)
                       or else
                     Entity (Ref) in SE (S_NUL) .. SE (S_US)
                       or else
                     Entity (Ref) = SE (S_DEL)
               then
                  Cas := All_Upper_Case;

               else
                  Cas := Mixed_Case;
               end if;

               Nlen  := Length_Of_Name (Chars (Ref));

               if Determine_Casing
                    (Tref (Sref .. Sref + Source_Ptr (Nlen) - 1)) = Cas
               then
                  null;
               else
                  Error_Msg_N
                    ("(style) bad casing for entity in Standard", Ref);
               end if;
            end if;
         end if;
      end if;
   end Check_Identifier;

   -----------------------
   -- Check_Indentation --
   -----------------------

   --  In check indentation mode (-gnatyn for n a digit), a new statement or
   --  declaration is required to start in a column that is a multiple of the
   --  indentiation amount.

   procedure Check_Indentation is
   begin
      if Style_Check_Indentation /= 0 then
         if Token_Ptr = First_Non_Blank_Location
           and then Start_Column rem Style_Check_Indentation /= 0
         then
            Error_Msg_SC ("(style) bad indentation");
         end if;
      end if;
   end Check_Indentation;

   ----------------------
   -- Check_Left_Paren --
   ----------------------

   --  In tone check mode (-gnatyt), left paren must not be preceded by an
   --  identifier character or digit (a separating space is required) and
   --  may never be followed by a space.

   procedure Check_Left_Paren is
      S : Source_Ptr;

   begin
      if Style_Check_Tokens then
         if Token_Ptr > Source_First (Current_Source_File)
           and then Identifier_Char (Source (Token_Ptr - 1))
         then
            Error_Space_Required (Token_Ptr);
         end if;

         if Source (Scan_Ptr) = ' ' then

            --  Allow one or more spaces if followed by comment

            S := Scan_Ptr + 1;
            loop
               if Source (S) = '-' and then Source (S + 1) = '-' then
                  return;
               elsif Source (S) /= ' ' then
                  exit;
               else
                  S := S + 1;
               end if;
            end loop;

            Error_Space_Not_Allowed (Scan_Ptr);
         end if;
      end if;
   end Check_Left_Paren;

   ---------------------------
   -- Check_Line_Terminator --
   ---------------------------

   --  In check blanks at end mode (-gnatyb), lines may not end with a
   --  trailing space.

   --  In check max line length mode (-gnatym), the line length must
   --  not exceed the permitted maximum value.

   --  In check form feeds mode (-gnatyf), the line terminator may not
   --  be either of the characters FF or VT.

   procedure Check_Line_Terminator (Len : Int) is
      S : Source_Ptr;

   begin
      --  Check FF/VT terminators

      if Style_Check_Form_Feeds then
         if Source (Scan_Ptr) = ASCII.FF then
            Error_Msg_S ("(style) form feed not allowed");

         elsif Source (Scan_Ptr) = ASCII.VT then
            Error_Msg_S ("(style) vertical tab not allowed");
         end if;
      end if;

      --  Check trailing space

      if Style_Check_Blanks_At_End then
         if Scan_Ptr >= First_Non_Blank_Location then
            if Source (Scan_Ptr - 1) = ' ' then
               S := Scan_Ptr - 1;

               while Source (S - 1) = ' ' loop
                  S := S - 1;
               end loop;

               Error_Msg ("(style) trailing spaces not permitted", S);
            end if;
         end if;
      end if;

      --  Check max line length

      if Style_Check_Max_Line_Length then
         if Len > Style_Max_Line_Length then
            Error_Msg
              ("(style) this line is too long",
               Current_Line_Start + Source_Ptr (Style_Max_Line_Length));
         end if;
      end if;

   end Check_Line_Terminator;

   -----------------------
   -- Check_Pragma_Name --
   -----------------------

   --  In check pragma casing mode (-gnatyp), pragma names must be mixed
   --  case, i.e. start with an upper case letter, and otherwise lower case,
   --  except after an underline character.

   procedure Check_Pragma_Name is
   begin
      if Style_Check_Pragma_Casing then
         if Determine_Token_Casing /= Mixed_Case then
            Error_Msg_SC ("(style) bad capitalization, mixed case required");
         end if;
      end if;
   end Check_Pragma_Name;

   -----------------------
   -- Check_Right_Paren --
   -----------------------

   --  In check tokens mode (-gnatyt), right paren must never be preceded by
   --  a space unless it is the initial non-blank character on the line.

   procedure Check_Right_Paren is
   begin
      if Style_Check_Tokens then
         if Token_Ptr > First_Non_Blank_Location
           and then Source (Token_Ptr - 1) = ' '
         then
            Error_Space_Not_Allowed (Token_Ptr - 1);
         end if;
      end if;
   end Check_Right_Paren;

   ---------------------
   -- Check_Semicolon --
   ---------------------

   --  In check tokens mode (-gnatyt), semicolon does not permit a preceding
   --  space and a following space is required.

   procedure Check_Semicolon is
   begin
      if Style_Check_Tokens then
         if Scan_Ptr > Source_First (Current_Source_File)
           and then Source (Token_Ptr - 1) = ' '
         then
            Error_Space_Not_Allowed (Token_Ptr - 1);

         elsif Source (Scan_Ptr) > ' ' then
            Error_Space_Required (Scan_Ptr);
         end if;
      end if;
   end Check_Semicolon;

   ----------------
   -- Check_Then --
   ----------------

   --  In check if then layout mode (-gnatyi), we expect a THEN keyword
   --  to appear either on the same line as the IF, or on a separate line
   --  after multiple conditions. In any case, it may not appear on the
   --  line immediately following the line with the IF.

   procedure Check_Then (If_Loc : Source_Ptr) is
   begin
      if Style_Check_If_Then_Layout then
         if Get_Physical_Line_Number (Token_Ptr) =
            Get_Physical_Line_Number (If_Loc) + 1
         then
            Error_Msg_SC ("(style) misplaced THEN");
         end if;
      end if;
   end Check_Then;

   -------------------------------
   -- Check_Unary_Plus_Or_Minus --
   -------------------------------

   --  In check tokem mode (-gnatyt), unary plus or minus must not be
   --  followed by a space.

   procedure Check_Unary_Plus_Or_Minus is
   begin
      if Style_Check_Tokens then
         if Source (Scan_Ptr) = ' ' then
            Error_Space_Not_Allowed (Scan_Ptr);
         end if;
      end if;
   end Check_Unary_Plus_Or_Minus;

   ------------------------
   -- Check_Vertical_Bar --
   ------------------------

   --  In check token mode (-gnatyt), vertical bar must be surrounded by spaces

   procedure Check_Vertical_Bar is
   begin
      if Style_Check_Tokens then
         Require_Preceding_Space;
         Require_Following_Space;
      end if;
   end Check_Vertical_Bar;

   -----------------------------
   -- Error_Space_Not_Allowed --
   -----------------------------

   procedure Error_Space_Not_Allowed (S : Source_Ptr) is
   begin
      Error_Msg ("(style) space not allowed", S);
   end Error_Space_Not_Allowed;

   --------------------------
   -- Error_Space_Required --
   --------------------------

   procedure Error_Space_Required (S : Source_Ptr) is
   begin
      Error_Msg ("(style) space required", S);
   end Error_Space_Required;

   -----------------
   -- No_End_Name --
   -----------------

   --  In check end/exit labels mode (-gnatye), always require the name of
   --  a subprogram or package to be present on the END, so this is an error.

   procedure No_End_Name (Name : Node_Id) is
   begin
      if Style_Check_End_Labels then
         Error_Msg_Node_1 := Name;
         Error_Msg_SP ("(style) `END &` required");
      end if;
   end No_End_Name;

   ------------------
   -- No_Exit_Name --
   ------------------

   --  In check end/exit labels mode (-gnatye), always require the name of
   --  the loop to be present on the EXIT when exiting a named loop.

   procedure No_Exit_Name (Name : Node_Id) is
   begin
      if Style_Check_End_Labels then
         Error_Msg_Node_1 := Name;
         Error_Msg_SP ("(style) `EXIT &` required");
      end if;
   end No_Exit_Name;

   ----------------------------
   -- Non_Lower_Case_Keyword --
   ----------------------------

   --  In check casing mode (-gnatyk), reserved keywords must be be spelled
   --  in all lower case (excluding keywords range, access, delta and digits
   --  used as attribute designators).

   procedure Non_Lower_Case_Keyword is
   begin
      if Style_Check_Keyword_Casing then
         Error_Msg_SC ("(style) reserved words must be all lower case");
      end if;
   end Non_Lower_Case_Keyword;

   -----------------------------
   -- Require_Following_Space --
   -----------------------------

   procedure Require_Following_Space is
   begin
      if Source (Scan_Ptr) > ' ' then
         Error_Space_Required (Scan_Ptr);
      end if;
   end Require_Following_Space;

   -----------------------------
   -- Require_Preceding_Space --
   -----------------------------

   procedure Require_Preceding_Space is
   begin
      if Token_Ptr > Source_First (Current_Source_File)
        and then Source (Token_Ptr - 1) > ' '
      then
         Error_Space_Required (Token_Ptr);
      end if;
   end Require_Preceding_Space;

   ---------------------
   -- RM_Column_Check --
   ---------------------

   function RM_Column_Check return Boolean is
   begin
      return Style_Check and Style_Check_Layout;
   end RM_Column_Check;

   -----------------------------------
   -- Subprogram_Not_In_Alpha_Order --
   -----------------------------------

   procedure Subprogram_Not_In_Alpha_Order (Name : Node_Id) is
   begin
      if Style_Check_Subprogram_Order then
         Error_Msg_N
           ("(style) subprogram body& not in alphabetical order", Name);
      end if;
   end Subprogram_Not_In_Alpha_Order;
end Style;