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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                          GNAT SYSTEM UTILITIES                           --
4
--                                                                          --
5
--                             X G N A T U G N                              --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2003-2008, 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
------------------------------------------------------------------------------
22
 
23
--  This utility is used to process the source of gnat_ugn.texi to make a
24
--  version suitable for running through standard Texinfo processor. It is
25
--  invoked as follows:
26
 
27
--  xgnatugn <target> <in-file> <word-list> [ <out-file> [ <warnings> ] ]
28
 
29
--  1. <target> is the target type of the manual, which is one of:
30
 
31
--     unw       Unix and Windows platforms
32
--     vms       OpenVMS
33
 
34
--  2. <in-file> is the file name of the Texinfo file to be
35
--  preprocessed.
36
 
37
--  3. <word-list> is the name of the word list file. This file is used for
38
--  rewriting the VMS edition. Each line contains a word mapping: The source
39
--  word in the first column, the target word in the second column. The
40
--  columns are separated by a '^' character. When preprocessing for VMS, the
41
--  first word is replaced with the second. (Words consist of letters,
42
--  digits, and the four characters "?-_~". A sequence of multiple words can
43
--  be replaced if they are listed in the first column, separated by a single
44
--  space character. If multiple words are to be replaced, there must be a
45
--  replacement for each prefix.)
46
 
47
--  4. <out-file> (optional) is the name of the output file. It defaults to
48
--  gnat_ugn_unw.texi or gnat_ugn_vms.texi, depending on the target.
49
 
50
--  5. <warnings> (optional, and allowed only if <out-file> is explicit)
51
--  can be any string. If present, it indicates that warning messages are
52
--  to be output to Standard_Error. If absent, no warning messages are
53
--  generated.
54
 
55
--  The following steps are performed:
56
 
57
--     In VMS mode
58
 
59
--       Any occurrences of ^alpha^beta^ are replaced by beta. The sequence
60
--       must fit on a single line, and there can only be one occurrence on a
61
--       line.
62
 
63
--       Any occurrences of a word in the Ug_Words list are replaced by the
64
--       appropriate vms equivalents. Note that replacements do not occur
65
--       within ^alpha^beta^ sequences.
66
 
67
--       Any occurrence of [filename].extension, where extension one of the
68
--       following:
69
 
70
--           "o", "ads", "adb", "ali", "ada", "atb", "ats", "adc", "c"
71
 
72
--       replaced by the appropriate VMS names (all upper case with .o
73
--       replaced .OBJ). Note that replacements do not occur within
74
--       ^alpha^beta^ sequences.
75
 
76
--     In UNW mode
77
 
78
--       Any occurrences of ^alpha^beta^ are replaced by alpha. The sequence
79
--       must fit on a single line.
80
 
81
--     In both modes
82
 
83
--       The sequence ^^^ is replaced by a single ^. This escape sequence
84
--       must be used if the literal character ^ is to appear in the
85
--       output. A line containing this escape sequence may not also contain
86
--       a ^alpha^beta^ sequence.
87
 
88
--       Process @ifset and @ifclear for the target flags (unw, vms);
89
--       this is because we have menu problems if we let makeinfo handle
90
--       these ifset/ifclear pairs.
91
--       Note: @ifset/@ifclear commands for the edition flags (FSFEDITION,
92
--       PROEDITION, GPLEDITION) are passed through unchanged
93
 
94
with Ada.Command_Line;           use Ada.Command_Line;
95
with Ada.Strings;                use Ada.Strings;
96
with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
97
with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
98
with Ada.Strings.Maps;           use Ada.Strings.Maps;
99
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
100
with Ada.Streams.Stream_IO;      use Ada.Streams.Stream_IO;
101
with Ada.Text_IO;                use Ada.Text_IO;
102
 
103
with GNAT.Spitbol;               use GNAT.Spitbol;
104
with GNAT.Spitbol.Table_VString; use GNAT.Spitbol.Table_VString;
105
 
106
procedure Xgnatugn is
107
 
108
   procedure Usage;
109
   --  Print usage information. Invoked if an invalid command line is
110
   --  encountered.
111
 
112
   subtype Sfile is Ada.Streams.Stream_IO.File_Type;
113
 
114
   Output_File : Sfile;
115
   --  The preprocessed output is written to this file
116
 
117
   type Input_File is record
118
      Name : VString;
119
      Data : Ada.Text_IO.File_Type;
120
      Line : Natural := 0;
121
   end record;
122
   --  Records information on an input file. Name and Line are used
123
   --  in error messages, Line is updated automatically by Get_Line.
124
 
125
   function Get_Line (Input : access Input_File) return String;
126
   --  Returns a line from Input and performs the necessary
127
   --  line-oriented checks (length, character set, trailing spaces).
128
 
129
   procedure Put_Line (F : Sfile; S : String);
130
   --  Local version of Put_Line ensures Unix style line endings
131
 
132
   Number_Of_Warnings : Natural := 0;
133
   Number_Of_Errors   : Natural := 0;
134
   Warnings_Enabled   : Boolean;
135
 
136
   procedure Error
137
     (Input        : Input_File;
138
      At_Character : Natural;
139
      Message      : String);
140
   procedure Error
141
     (Input        : Input_File;
142
      Message      : String);
143
   --  Prints a message reporting an error on line Input.Line. If
144
   --  At_Character is not 0, indicate the exact character at which
145
   --  the error occurs.
146
 
147
   procedure Warning
148
     (Input        : Input_File;
149
      At_Character : Natural;
150
      Message      : String);
151
   procedure Warning
152
     (Input        : Input_File;
153
      Message      : String);
154
   --  Like Error, but just print a warning message
155
 
156
   Dictionary_File : aliased Input_File;
157
   procedure Read_Dictionary_File;
158
   --  Dictionary_File is opened using the name given on the command
159
   --  line. It contains the replacements for the Ug_Words list.
160
   --  Read_Dictionary_File reads Dictionary_File and fills the
161
   --  Ug_Words table.
162
 
163
   Source_File : aliased Input_File;
164
   procedure Process_Source_File;
165
   --  Source_File is opened using the name given on the command line.
166
   --  It contains the Texinfo source code. Process_Source_File
167
   --  performs the necessary replacements.
168
 
169
   type Flag_Type is (UNW, VMS, FSFEDITION, PROEDITION, GPLEDITION);
170
   --  The flags permitted in @ifset or @ifclear commands:
171
   --
172
   --  Targets for preprocessing
173
   --    UNW (Unix and Windows) or VMS
174
   --
175
   --  Editions of the manual
176
   --    FSFEDITION, PROEDITION, or GPLEDITION
177
   --
178
   --  Conditional commands for target are processed by xgnatugn
179
   --
180
   --  Conditional commands for edition are passed through unchanged
181
 
182
   subtype Target_Type is Flag_Type range UNW .. VMS;
183
   subtype Edition_Type is Flag_Type range FSFEDITION .. GPLEDITION;
184
 
185
   Target : Target_Type;
186
   --  The Target variable is initialized using the command line
187
 
188
   Valid_Characters : constant Character_Set :=
189
                        To_Set (Span => (' ',  '~'));
190
   --  This array controls which characters are permitted in the input
191
   --  file (after line breaks have been removed). Valid characters
192
   --  are all printable ASCII characters and the space character.
193
 
194
   Word_Characters : constant Character_Set :=
195
                       (To_Set (Ranges =>
196
                                  (('0', '9'), ('a', 'z'), ('A', 'Z')))
197
                        or To_Set ("?-_~"));
198
   --  The characters which are permitted in words. Other (valid)
199
   --  characters are assumed to be delimiters between words. Note that
200
   --  this set has to include all characters of the source words of the
201
   --  Ug_Words dictionary.
202
 
203
   Reject_Trailing_Spaces : constant Boolean := True;
204
   --  Controls whether Xgnatug rejects superfluous space characters
205
   --  at the end of lines.
206
 
207
   Maximum_Line_Length     : constant Positive := 79;
208
   Fatal_Line_Length_Limit : constant Positive := 5000;
209
   Fatal_Line_Length       : exception;
210
   --  If Maximum_Line_Length is exceeded in an input file, an error
211
   --  message is printed. If Fatal_Line_Length is exceeded,
212
   --  execution terminates with a Fatal_Line_Length exception.
213
 
214
   VMS_Escape_Character : constant Character := '^';
215
   --  The character used to mark VMS alternatives (^alpha^beta^)
216
 
217
   Extensions : GNAT.Spitbol.Table_VString.Table (20);
218
   procedure Initialize_Extensions;
219
   --  This table records extensions and their replacement for
220
   --  rewriting filenames in the VMS version of the manual.
221
 
222
   function Is_Extension (Extension : String) return Boolean;
223
   function Get_Replacement_Extension (Extension : String) return String;
224
   --  These functions query the replacement table. Is_Extension
225
   --  checks if the given string is a known extension.
226
   --  Get_Replacement returns the replacement extension.
227
 
228
   Ug_Words : GNAT.Spitbol.Table_VString.Table (200);
229
   function Is_Known_Word (Word : String) return Boolean;
230
   function Get_Replacement_Word (Word : String) return String;
231
   --  The Ug_Words table lists replacement words for the VMS version
232
   --  of the manual. Is_Known_Word and Get_Replacement_Word query
233
   --  this table. The table is filled using Read_Dictionary_File.
234
 
235
   function Rewrite_Source_Line (Line : String) return String;
236
   --  This subprogram takes a line and rewrites it according to Target.
237
   --  It relies on information in Source_File to generate error messages.
238
 
239
   type Conditional is (Set, Clear);
240
   procedure Push_Conditional (Cond : Conditional; Flag : Target_Type);
241
   procedure Pop_Conditional  (Cond : Conditional);
242
   --  These subprograms deal with conditional processing (@ifset/@ifclear).
243
   --  They rely on information in Source_File to generate error messages.
244
 
245
   function Currently_Excluding return Boolean;
246
   --  Returns true if conditional processing directives imply that the
247
   --  current line should not be included in the output.
248
 
249
   function VMS_Context_Determined return Boolean;
250
   --  Returns true if, in the current conditional preprocessing context, we
251
   --  always have a VMS or a non-VMS version, regardless of the value of
252
   --  Target.
253
 
254
   function In_VMS_Section return Boolean;
255
   --  Returns True if in an "@ifset vms" section
256
 
257
   procedure Check_No_Pending_Conditional;
258
   --  Checks that all preprocessing directives have been properly matched by
259
   --  their @end counterpart. If this is not the case, print an error
260
   --  message.
261
 
262
   --  The following definitions implement a stack to track the conditional
263
   --  preprocessing context.
264
 
265
   type Conditional_Context is record
266
      Starting_Line : Positive;
267
      Cond          : Conditional;
268
      Flag          : Flag_Type;
269
      Excluding     : Boolean;
270
   end record;
271
 
272
   Conditional_Stack_Depth : constant := 3;
273
 
274
   Conditional_Stack :
275
     array (1 .. Conditional_Stack_Depth) of Conditional_Context;
276
 
277
   Conditional_TOS : Natural := 0;
278
   --  Pointer to the Top Of Stack for Conditional_Stack
279
 
280
   -----------
281
   -- Usage --
282
   -----------
283
 
284
   procedure Usage is
285
   begin
286
      Put_Line (Standard_Error,
287
            "usage: xgnatugn TARGET SOURCE DICTIONARY [OUTFILE [WARNINGS]]");
288
      New_Line;
289
      Put_Line (Standard_Error, "TARGET is one of:");
290
 
291
      for T in Target_Type'Range loop
292
         Put_Line (Standard_Error, "  " & Target_Type'Image (T));
293
      end loop;
294
 
295
      New_Line;
296
      Put_Line (Standard_Error, "SOURCE is the source file to process.");
297
      New_Line;
298
      Put_Line (Standard_Error, "DICTIONARY is the name of a file "
299
                & "that contains word replacements");
300
      Put_Line (Standard_Error, "for the VMS version.");
301
      New_Line;
302
      Put_Line (Standard_Error,
303
                "OUT-FILE, if present, is the output file to be created;");
304
      Put_Line (Standard_Error,
305
                "If OUT-FILE is absent, the output file is either " &
306
                "gnat_ugn_unw.texi, ");
307
      Put_Line (Standard_Error,
308
                "or gnat_ugn_vms.texi, depending on TARGET.");
309
      New_Line;
310
      Put_Line (Standard_Error,
311
                "WARNINGS, if present, is any string;");
312
      Put_Line (Standard_Error,
313
                "it will result in warning messages (e.g., line too long))");
314
      Put_Line (Standard_Error,
315
                "being output to Standard_Error.");
316
   end Usage;
317
 
318
   --------------
319
   -- Get_Line --
320
   --------------
321
 
322
   function Get_Line (Input : access Input_File) return String is
323
      Line_Buffer : String (1 .. Fatal_Line_Length_Limit);
324
      Last        : Natural;
325
 
326
   begin
327
      Input.Line := Input.Line + 1;
328
      Get_Line (Input.Data, Line_Buffer, Last);
329
 
330
      if Last = Line_Buffer'Last then
331
         Error (Input.all, "line exceeds fatal line length limit");
332
         raise Fatal_Line_Length;
333
      end if;
334
 
335
      declare
336
         Line : String renames Line_Buffer (Line_Buffer'First .. Last);
337
 
338
      begin
339
         for J in Line'Range loop
340
            if not Is_In (Line (J), Valid_Characters) then
341
               Error (Input.all, J, "invalid character");
342
               exit;
343
            end if;
344
         end loop;
345
 
346
         if Line'Length > Maximum_Line_Length then
347
            Warning (Input.all, Maximum_Line_Length + 1, "line too long");
348
         end if;
349
 
350
         if Reject_Trailing_Spaces
351
           and then Line'Length > 0
352
           and then Line (Line'Last) = ' '
353
         then
354
            Error (Input.all, Line'Last, "trailing space character");
355
         end if;
356
 
357
         return Trim (Line, Right);
358
      end;
359
   end Get_Line;
360
 
361
   --------------
362
   -- Put_Line --
363
   --------------
364
 
365
   procedure Put_Line (F : Sfile; S : String) is
366
   begin
367
      String'Write (Stream (F), S);
368
      Character'Write (Stream (F), ASCII.LF);
369
   end Put_Line;
370
 
371
   -----------
372
   -- Error --
373
   -----------
374
 
375
   procedure Error
376
     (Input   : Input_File;
377
      Message : String)
378
   is
379
   begin
380
      Error (Input, 0, Message);
381
   end Error;
382
 
383
   procedure Error
384
     (Input        : Input_File;
385
      At_Character : Natural;
386
      Message      : String)
387
   is
388
      Line_Image         : constant String := Integer'Image (Input.Line);
389
      At_Character_Image : constant String := Integer'Image (At_Character);
390
      --  These variables are required because we have to drop the leading
391
      --  space character.
392
 
393
   begin
394
      Number_Of_Errors := Number_Of_Errors + 1;
395
 
396
      if At_Character > 0 then
397
         Put_Line (Standard_Error,
398
                   S (Input.Name) & ':'
399
                   & Line_Image (Line_Image'First + 1 .. Line_Image'Last) & ':'
400
                   & At_Character_Image (At_Character_Image'First + 1
401
                                         .. At_Character_Image'Last)
402
                   & ": "
403
                   & Message);
404
      else
405
         Put_Line (Standard_Error,
406
                   S (Input.Name) & ':'
407
                   & Line_Image (Line_Image'First + 1 .. Line_Image'Last)
408
                   & ": "
409
                   & Message);
410
      end if;
411
   end Error;
412
 
413
   -------------
414
   -- Warning --
415
   -------------
416
 
417
   procedure Warning
418
     (Input   : Input_File;
419
      Message : String)
420
   is
421
   begin
422
      if Warnings_Enabled then
423
         Warning (Input, 0, Message);
424
      end if;
425
   end Warning;
426
 
427
   procedure Warning
428
     (Input        : Input_File;
429
      At_Character : Natural;
430
      Message      : String)
431
   is
432
      Line_Image         : constant String := Integer'Image (Input.Line);
433
      At_Character_Image : constant String := Integer'Image (At_Character);
434
      --  These variables are required because we have to drop the leading
435
      --  space character.
436
 
437
   begin
438
      if not Warnings_Enabled then
439
         return;
440
      end if;
441
 
442
      Number_Of_Warnings := Number_Of_Warnings + 1;
443
 
444
      if At_Character > 0 then
445
         Put_Line (Standard_Error,
446
                   S (Input.Name) & ':'
447
                   & Line_Image (Line_Image'First + 1 .. Line_Image'Last) & ':'
448
                   & At_Character_Image (At_Character_Image'First + 1
449
                                         .. At_Character_Image'Last)
450
                   & ": warning: "
451
                   & Message);
452
      else
453
         Put_Line (Standard_Error,
454
                   S (Input.Name) & ':'
455
                   & Line_Image (Line_Image'First + 1 .. Line_Image'Last)
456
                   & ": warning: "
457
                   & Message);
458
      end if;
459
   end Warning;
460
 
461
   --------------------------
462
   -- Read_Dictionary_File --
463
   --------------------------
464
 
465
   procedure Read_Dictionary_File is
466
   begin
467
      while not End_Of_File (Dictionary_File.Data) loop
468
         declare
469
            Line  : constant String :=
470
                      Get_Line (Dictionary_File'Access);
471
            Split : constant Natural :=
472
                      Index (Line, (1 => VMS_Escape_Character));
473
 
474
         begin
475
            if Line'Length = 0 then
476
               Error (Dictionary_File, "empty line in dictionary file");
477
 
478
            elsif Line (Line'First) = ' ' then
479
               Error (Dictionary_File, 1, "line starts with space character");
480
 
481
            elsif Split = 0 then
482
               Error (Dictionary_File, "line does not contain "
483
                      & VMS_Escape_Character & " character");
484
            else
485
               declare
486
                  Source : constant String :=
487
                             Trim (Line (1 .. Split - 1), Both);
488
                  Target : constant String :=
489
                             Trim (Line (Split + 1 .. Line'Last), Both);
490
                  Two_Spaces : constant Natural :=
491
                                 Index (Source, "  ");
492
                  Non_Word_Character : constant Natural :=
493
                                         Index (Source,
494
                                                Word_Characters or
495
                                                  To_Set (" ."),
496
                                                Outside);
497
 
498
               begin
499
                  if Two_Spaces /= 0 then
500
                     Error (Dictionary_File, Two_Spaces,
501
                            "multiple space characters in source word");
502
                  end if;
503
 
504
                  if Non_Word_Character /= 0 then
505
                     Error (Dictionary_File, Non_Word_Character,
506
                            "illegal character in source word");
507
                  end if;
508
 
509
                  if Source'Length = 0 then
510
                     Error (Dictionary_File, "source is empty");
511
 
512
                  elsif Target'Length = 0 then
513
                     Error (Dictionary_File, "target is empty");
514
 
515
                  else
516
                     Set (Ug_Words, Source, V (Target));
517
 
518
                     --  Ensure that if Source is a sequence of words
519
                     --  "WORD1 WORD2 ...", we already have a mapping for
520
                     --  "WORD1".
521
 
522
                     for J in Source'Range loop
523
                        if Source (J) = ' ' then
524
                           declare
525
                              Prefix : String renames
526
                                         Source (Source'First .. J - 1);
527
 
528
                           begin
529
                              if not Is_Known_Word (Prefix) then
530
                                 Error (Dictionary_File,
531
                                        "prefix '" & Prefix
532
                                        & "' not known at this point");
533
                              end if;
534
                           end;
535
                        end if;
536
                     end loop;
537
                  end if;
538
               end;
539
            end if;
540
         end;
541
      end loop;
542
   end Read_Dictionary_File;
543
 
544
   -------------------------
545
   -- Rewrite_Source_Line --
546
   -------------------------
547
 
548
   function Rewrite_Source_Line (Line : String) return String is
549
 
550
      --  We use a simple lexer to split the line into tokens:
551
 
552
      --    Word             consisting entirely of Word_Characters
553
      --    VMS_Alternative  ^alpha^beta^ replacement (but not ^^^)
554
      --    Space            a space character
555
      --    Other            everything else (sequence of non-word characters)
556
      --    VMS_Error        incomplete VMS alternative
557
      --    End_Of_Line      no more characters on this line
558
 
559
      --   A sequence of three VMS_Escape_Characters is automatically
560
      --   collapsed to an Other token.
561
 
562
      type Token_Span is record
563
         First, Last : Positive;
564
      end record;
565
      --  The character range covered by a token in Line
566
 
567
      type Token_Kind is (End_Of_Line, Word, Other,
568
                          VMS_Alternative, VMS_Error);
569
      type Token_Record (Kind : Token_Kind := End_Of_Line) is record
570
         First : Positive;
571
         case Kind is
572
            when Word | Other =>
573
               Span : Token_Span;
574
            when VMS_Alternative =>
575
               Non_VMS, VMS : Token_Span;
576
            when VMS_Error | End_Of_Line =>
577
               null;
578
         end case;
579
      end record;
580
 
581
      Input_Position : Positive := Line'First;
582
      Token : Token_Record;
583
      --  The position of the next character to be processed by Next_Token
584
 
585
      procedure Next_Token;
586
      --  Returns the next token in Line, starting at Input_Position
587
 
588
      Rewritten_Line : VString;
589
      --  Collects the line as it is rewritten
590
 
591
      procedure Rewrite_Word;
592
      --  The current token is assumed to be a Word. When processing the VMS
593
      --  version of the manual, additional tokens are gathered to check if
594
      --  we have a file name or a sequence of known words.
595
 
596
      procedure Maybe_Rewrite_Extension;
597
      --  The current token is assumed to be Other. When processing the VMS
598
      --  version of the manual and the token represents a single dot ".",
599
      --  the following word is rewritten according to the rules for
600
      --  extensions.
601
 
602
      VMS_Token_Seen : Boolean := False;
603
      --  This is set to true if a VMS_Alternative has been encountered, or a
604
      --  ^^^ token.
605
 
606
      ----------------
607
      -- Next_Token --
608
      ----------------
609
 
610
      procedure Next_Token is
611
         Remaining_Line : String renames Line (Input_Position .. Line'Last);
612
         Last_Character : Natural;
613
 
614
      begin
615
         if Remaining_Line'Length = 0 then
616
            Token := (End_Of_Line, Remaining_Line'First);
617
            return;
618
         end if;
619
 
620
         --  ^alpha^beta^, the VMS_Alternative case
621
 
622
         if Remaining_Line (Remaining_Line'First) = VMS_Escape_Character then
623
            declare
624
               VMS_Second_Character, VMS_Third_Character : Natural;
625
 
626
            begin
627
               if VMS_Token_Seen then
628
                  Error (Source_File, Remaining_Line'First,
629
                         "multiple " & VMS_Escape_Character
630
                         & " characters on a single line");
631
               else
632
                  VMS_Token_Seen := True;
633
               end if;
634
 
635
               --  Find the second and third escape character. If one of
636
               --  them is not present, generate an error token.
637
 
638
               VMS_Second_Character :=
639
                 Index (Remaining_Line (Remaining_Line'First + 1
640
                                           .. Remaining_Line'Last),
641
                        (1 => VMS_Escape_Character));
642
 
643
               if VMS_Second_Character = 0 then
644
                  Input_Position := Remaining_Line'Last + 1;
645
                  Token := (VMS_Error, Remaining_Line'First);
646
                  return;
647
               end if;
648
 
649
               VMS_Third_Character :=
650
                 Index (Remaining_Line (VMS_Second_Character + 1
651
                                           .. Remaining_Line'Last),
652
                        (1 => VMS_Escape_Character));
653
 
654
               if VMS_Third_Character = 0 then
655
                  Input_Position := Remaining_Line'Last + 1;
656
                  Token := (VMS_Error, Remaining_Line'First);
657
                  return;
658
               end if;
659
 
660
               --  Consume all the characters we are about to include in
661
               --  the token.
662
 
663
               Input_Position := VMS_Third_Character + 1;
664
 
665
               --  Check if we are in a ^^^ situation, and return an Other
666
               --  token in this case.
667
 
668
               if Remaining_Line'First + 1 = VMS_Second_Character
669
                 and then Remaining_Line'First + 2 = VMS_Third_Character
670
               then
671
                  Token := (Other, Remaining_Line'First,
672
                            (Remaining_Line'First, Remaining_Line'First));
673
                  return;
674
               end if;
675
 
676
               Token := (VMS_Alternative, Remaining_Line'First,
677
                         (Remaining_Line'First + 1, VMS_Second_Character - 1),
678
                         (VMS_Second_Character + 1, VMS_Third_Character - 1));
679
               return;
680
            end;
681
         end if;                        --  VMS_Alternative
682
 
683
         --  The Word case. Search for characters not in Word_Characters.
684
         --  We have found a word if the first non-word character is not
685
         --  the first character in Remaining_Line, i.e. if Remaining_Line
686
         --  starts with a word character.
687
 
688
         Last_Character := Index (Remaining_Line, Word_Characters, Outside);
689
         if Last_Character /= Remaining_Line'First then
690
 
691
            --  If we haven't found a character which is not in
692
            --  Word_Characters, all remaining characters are part of the
693
            --  current Word token.
694
 
695
            if Last_Character = 0 then
696
               Last_Character := Remaining_Line'Last + 1;
697
            end if;
698
 
699
            Input_Position := Last_Character;
700
            Token := (Word, Remaining_Line'First,
701
                      (Remaining_Line'First, Last_Character - 1));
702
            return;
703
         end if;
704
 
705
         --  Remaining characters are in the Other category. To speed
706
         --  up processing, we collect them together if there are several
707
         --  of them.
708
 
709
         Input_Position := Last_Character + 1;
710
         Token := (Other,
711
                   Remaining_Line'First,
712
                   (Remaining_Line'First, Last_Character));
713
      end Next_Token;
714
 
715
      ------------------
716
      -- Rewrite_Word --
717
      ------------------
718
 
719
      procedure Rewrite_Word is
720
         First_Word : String
721
           renames Line (Token.Span.First .. Token.Span.Last);
722
 
723
      begin
724
         --  We do not perform any error checking below, so we can just skip
725
         --  all processing for the non-VMS version.
726
 
727
         if Target /= VMS then
728
            Append (Rewritten_Line, First_Word);
729
            Next_Token;
730
            return;
731
         end if;
732
 
733
         if Is_Known_Word (First_Word) then
734
 
735
            --  If we have a word from the dictionary, we look for the
736
            --  longest possible sequence we can rewrite.
737
 
738
            declare
739
               Seq : Token_Span := Token.Span;
740
               Lost_Space : Boolean := False;
741
 
742
            begin
743
               Next_Token;
744
               loop
745
                  if Token.Kind = Other
746
                    and then Line (Token.Span.First .. Token.Span.Last) = " "
747
                  then
748
                     Next_Token;
749
                     if Token.Kind /= Word
750
                       or else not Is_Known_Word (Line (Seq.First
751
                                                        .. Token.Span.Last))
752
                     then
753
                        --  When we reach this point, the following
754
                        --  conditions are true:
755
                        --
756
                        --  Seq is a known word.
757
                        --  The previous token was a space character.
758
                        --  Seq extended to the current token is not a
759
                        --  known word.
760
 
761
                        Lost_Space := True;
762
                        exit;
763
 
764
                     else
765
 
766
                        --  Extend Seq to cover the current (known) word
767
 
768
                        Seq.Last := Token.Span.Last;
769
                        Next_Token;
770
                     end if;
771
 
772
                  else
773
                     --  When we reach this point, the following conditions
774
                     --  are true:
775
                     --
776
                     --  Seq is a known word.
777
                     --  The previous token was a word.
778
                     --  The current token is not a space character.
779
 
780
                     exit;
781
                  end if;
782
               end loop;
783
 
784
               --  Rewrite Seq, and add the lost space if necessary
785
 
786
               Append (Rewritten_Line,
787
                       Get_Replacement_Word (Line (Seq.First .. Seq.Last)));
788
               if Lost_Space then
789
                  Append (Rewritten_Line, ' ');
790
               end if;
791
 
792
               --  The unknown token will be processed during the
793
               --  next iteration of the main loop.
794
               return;
795
            end;
796
         end if;
797
 
798
         Next_Token;
799
 
800
         if Token.Kind = Other
801
           and then Line (Token.Span.First .. Token.Span.Last) = "."
802
         then
803
            --  Deal with extensions
804
 
805
            Next_Token;
806
            if Token.Kind = Word
807
              and then Is_Extension (Line (Token.Span.First
808
                                           .. Token.Span.Last))
809
            then
810
               --  We have discovered a file extension. Convert the file
811
               --  name to upper case.
812
 
813
               Append (Rewritten_Line,
814
                       Translate (First_Word, Upper_Case_Map) & '.');
815
               Append (Rewritten_Line,
816
                       Get_Replacement_Extension
817
                       (Line (Token.Span.First .. Token.Span.Last)));
818
               Next_Token;
819
            else
820
               --  We already have: Word ".", followed by an unknown token
821
 
822
               Append (Rewritten_Line, First_Word & '.');
823
 
824
               --  The unknown token will be processed during the next
825
               --  iteration of the main loop.
826
            end if;
827
 
828
         else
829
            --  We have an unknown Word, followed by an unknown token.
830
            --  The unknown token will be processed by the outer loop.
831
 
832
            Append (Rewritten_Line, First_Word);
833
         end if;
834
      end Rewrite_Word;
835
 
836
      -----------------------------
837
      -- Maybe_Rewrite_Extension --
838
      -----------------------------
839
 
840
      procedure Maybe_Rewrite_Extension is
841
      begin
842
         --  Again, we need no special processing in the non-VMS case
843
 
844
         if Target = VMS
845
           and then Line (Token.Span.First .. Token.Span.Last) = "."
846
         then
847
            --  This extension is not preceded by a word, otherwise
848
            --  Rewrite_Word would have handled it.
849
 
850
            Next_Token;
851
            if Token.Kind = Word
852
              and then Is_Extension (Line (Token.Span.First
853
                                           .. Token.Span.Last))
854
            then
855
               Append (Rewritten_Line, '.' & Get_Replacement_Extension
856
                       (Line (Token.Span.First .. Token.Span.Last)));
857
               Next_Token;
858
            else
859
               Append (Rewritten_Line, '.');
860
            end if;
861
         else
862
            Append (Rewritten_Line, Line (Token.Span.First
863
                                          .. Token.Span.Last));
864
            Next_Token;
865
         end if;
866
      end Maybe_Rewrite_Extension;
867
 
868
   --  Start of processing for Process_Source_Line
869
 
870
   begin
871
      --  The following parser recognizes the following special token
872
      --  sequences:
873
 
874
      --     Word "." Word    rewrite as file name if second word is extension
875
      --     Word " " Word    rewrite as a single word using Ug_Words table
876
 
877
      Next_Token;
878
      loop
879
         case Token.Kind is
880
            when End_Of_Line =>
881
               exit;
882
 
883
            when Word  =>
884
               Rewrite_Word;
885
 
886
            when Other =>
887
               Maybe_Rewrite_Extension;
888
 
889
            when VMS_Alternative =>
890
               if VMS_Context_Determined then
891
                  if (not In_VMS_Section)
892
                    or else
893
                    Line (Token.VMS.First .. Token.VMS.Last) /=
894
                    Line (Token.Non_VMS.First .. Token.Non_VMS.Last)
895
                  then
896
                     Warning (Source_File, Token.First,
897
                              "VMS alternative already determined "
898
                                & "by conditionals");
899
                  end if;
900
               end if;
901
               if Target = VMS then
902
                  Append (Rewritten_Line, Line (Token.VMS.First
903
                                                .. Token.VMS.Last));
904
               else
905
                  Append (Rewritten_Line, Line (Token.Non_VMS.First
906
                                                .. Token.Non_VMS.Last));
907
               end if;
908
               Next_Token;
909
 
910
            when VMS_Error =>
911
               Error (Source_File, Token.First, "invalid VMS alternative");
912
               Next_Token;
913
         end case;
914
      end loop;
915
 
916
      return S (Rewritten_Line);
917
   end Rewrite_Source_Line;
918
 
919
   -------------------------
920
   -- Process_Source_File --
921
   -------------------------
922
 
923
   procedure Process_Source_File is
924
      Ifset       : constant String := "@ifset ";
925
      Ifclear     : constant String := "@ifclear ";
926
      Endsetclear : constant String := "@end ";
927
      --  Strings to be recognized for conditional processing
928
 
929
   begin
930
      while not End_Of_File (Source_File.Data) loop
931
         declare
932
            Line      : constant String := Get_Line (Source_File'Access);
933
            Rewritten : constant String := Rewrite_Source_Line (Line);
934
            --  We unconditionally rewrite the line so that we can check the
935
            --  syntax of all lines, and not only those which are actually
936
            --  included in the output.
937
 
938
            Have_Conditional : Boolean := False;
939
            --  True if we have encountered a conditional preprocessing
940
            --  directive.
941
 
942
            Cond : Conditional;
943
            --  The kind of the directive
944
 
945
            Flag : Flag_Type;
946
            --  Its flag
947
 
948
         begin
949
            --  If the line starts with @ifset or @ifclear, we try to convert
950
            --  the following flag to one of our flag types. If we fail,
951
            --  Have_Conditional remains False.
952
 
953
            if Line'Length >= Ifset'Length
954
              and then Line (1 .. Ifset'Length) = Ifset
955
            then
956
               Cond := Set;
957
 
958
               declare
959
                  Arg : constant String :=
960
                          Trim (Line (Ifset'Length + 1 .. Line'Last), Both);
961
 
962
               begin
963
                  Flag := Flag_Type'Value (Arg);
964
                  Have_Conditional := True;
965
 
966
                  case Flag is
967
                     when Target_Type =>
968
                        if Translate (Target_Type'Image (Flag),
969
                                      Lower_Case_Map)
970
                                                      /= Arg
971
                        then
972
                           Error (Source_File, "flag has to be lowercase");
973
                        end if;
974
 
975
                     when Edition_Type =>
976
                        null;
977
                  end case;
978
               exception
979
                  when Constraint_Error =>
980
                     Error (Source_File, "unknown flag for '@ifset'");
981
               end;
982
 
983
            elsif Line'Length >= Ifclear'Length
984
              and then Line (1 .. Ifclear'Length) = Ifclear
985
            then
986
               Cond := Clear;
987
 
988
               declare
989
                  Arg : constant String :=
990
                          Trim (Line (Ifclear'Length + 1 .. Line'Last), Both);
991
 
992
               begin
993
                  Flag := Flag_Type'Value (Arg);
994
                  Have_Conditional := True;
995
 
996
                  case Flag is
997
                     when Target_Type =>
998
                        if Translate (Target_Type'Image (Flag),
999
                                      Lower_Case_Map)
1000
                                                      /= Arg
1001
                        then
1002
                           Error (Source_File, "flag has to be lowercase");
1003
                        end if;
1004
 
1005
                     when Edition_Type =>
1006
                        null;
1007
                  end case;
1008
               exception
1009
                  when Constraint_Error =>
1010
                     Error (Source_File, "unknown flag for '@ifclear'");
1011
               end;
1012
            end if;
1013
 
1014
            if Have_Conditional and (Flag in Target_Type) then
1015
 
1016
               --  We create a new conditional context and suppress the
1017
               --  directive in the output.
1018
 
1019
               Push_Conditional (Cond, Flag);
1020
 
1021
            elsif Line'Length >= Endsetclear'Length
1022
              and then Line (1 .. Endsetclear'Length) = Endsetclear
1023
              and then (Flag in Target_Type)
1024
            then
1025
               --  The '@end ifset'/'@end ifclear' case is handled here. We
1026
               --  have to pop the conditional context.
1027
 
1028
               declare
1029
                  First, Last : Natural;
1030
 
1031
               begin
1032
                  Find_Token (Source => Line (Endsetclear'Length + 1
1033
                                              .. Line'Length),
1034
                              Set    => Letter_Set,
1035
                              Test   => Inside,
1036
                              First  => First,
1037
                              Last   => Last);
1038
 
1039
                  if Last = 0 then
1040
                     Error (Source_File, "'@end' without argument");
1041
                  else
1042
                     if Line (First .. Last) = "ifset" then
1043
                        Have_Conditional := True;
1044
                        Cond := Set;
1045
                     elsif Line (First .. Last) = "ifclear" then
1046
                        Have_Conditional := True;
1047
                        Cond := Clear;
1048
                     end if;
1049
 
1050
                     if Have_Conditional then
1051
                        Pop_Conditional (Cond);
1052
                     end if;
1053
 
1054
                     --  We fall through to the ordinary case for other @end
1055
                     --  directives.
1056
 
1057
                  end if;               --  @end without argument
1058
               end;
1059
            end if;                     --  Have_Conditional
1060
 
1061
            if (not Have_Conditional) or (Flag in Edition_Type) then
1062
 
1063
               --  The ordinary case
1064
 
1065
               if not Currently_Excluding then
1066
                  Put_Line (Output_File, Rewritten);
1067
               end if;
1068
            end if;
1069
         end;
1070
      end loop;
1071
 
1072
      Check_No_Pending_Conditional;
1073
   end Process_Source_File;
1074
 
1075
   ---------------------------
1076
   -- Initialize_Extensions --
1077
   ---------------------------
1078
 
1079
   procedure Initialize_Extensions is
1080
 
1081
      procedure Add (Extension : String);
1082
      --  Adds an extension which is replaced with itself (in upper
1083
      --  case).
1084
 
1085
      procedure Add (Extension, Replacement : String);
1086
      --  Adds an extension with a custom replacement
1087
 
1088
      ---------
1089
      -- Add --
1090
      ---------
1091
 
1092
      procedure Add (Extension : String) is
1093
      begin
1094
         Add (Extension, Translate (Extension, Upper_Case_Map));
1095
      end Add;
1096
 
1097
      procedure Add (Extension, Replacement : String) is
1098
      begin
1099
         Set (Extensions, Extension, V (Replacement));
1100
      end Add;
1101
 
1102
   --  Start of processing for Initialize_Extensions
1103
 
1104
   begin
1105
      --  To avoid performance degradation, increase the constant in the
1106
      --  definition of Extensions above if you add more extensions here.
1107
 
1108
      Add ("o", "OBJ");
1109
      Add ("ads");
1110
      Add ("adb");
1111
      Add ("ali");
1112
      Add ("ada");
1113
      Add ("atb");
1114
      Add ("ats");
1115
      Add ("adc");
1116
      Add ("c");
1117
   end Initialize_Extensions;
1118
 
1119
   ------------------
1120
   -- Is_Extension --
1121
   ------------------
1122
 
1123
   function Is_Extension (Extension : String) return Boolean is
1124
   begin
1125
      return Present (Extensions, Extension);
1126
   end Is_Extension;
1127
 
1128
   -------------------------------
1129
   -- Get_Replacement_Extension --
1130
   -------------------------------
1131
 
1132
   function Get_Replacement_Extension (Extension : String) return String is
1133
   begin
1134
      return S (Get (Extensions, Extension));
1135
   end Get_Replacement_Extension;
1136
 
1137
   -------------------
1138
   -- Is_Known_Word --
1139
   -------------------
1140
 
1141
   function Is_Known_Word (Word : String) return Boolean is
1142
   begin
1143
      return Present (Ug_Words, Word);
1144
   end Is_Known_Word;
1145
 
1146
   --------------------------
1147
   -- Get_Replacement_Word --
1148
   --------------------------
1149
 
1150
   function Get_Replacement_Word (Word : String) return String is
1151
   begin
1152
      return S (Get (Ug_Words, Word));
1153
   end Get_Replacement_Word;
1154
 
1155
   ----------------------
1156
   -- Push_Conditional --
1157
   ----------------------
1158
 
1159
   procedure Push_Conditional (Cond : Conditional; Flag : Target_Type) is
1160
      Will_Exclude : Boolean;
1161
 
1162
   begin
1163
      --  If we are already in an excluding context, inherit this property,
1164
      --  otherwise calculate it from scratch.
1165
 
1166
      if Conditional_TOS > 0
1167
        and then Conditional_Stack (Conditional_TOS).Excluding
1168
      then
1169
         Will_Exclude := True;
1170
      else
1171
         case Cond is
1172
            when Set =>
1173
               Will_Exclude := Flag /= Target;
1174
            when Clear =>
1175
               Will_Exclude := Flag = Target;
1176
         end case;
1177
      end if;
1178
 
1179
      --  Check if the current directive is pointless because of a previous,
1180
      --  enclosing directive.
1181
 
1182
      for J in 1 .. Conditional_TOS loop
1183
         if Conditional_Stack (J).Flag = Flag then
1184
            Warning (Source_File, "directive without effect because of line"
1185
                     & Integer'Image (Conditional_Stack (J).Starting_Line));
1186
         end if;
1187
      end loop;
1188
 
1189
      Conditional_TOS := Conditional_TOS + 1;
1190
      Conditional_Stack (Conditional_TOS) :=
1191
        (Starting_Line => Source_File.Line,
1192
         Cond          => Cond,
1193
         Flag          => Flag,
1194
         Excluding     => Will_Exclude);
1195
   end Push_Conditional;
1196
 
1197
   ---------------------
1198
   -- Pop_Conditional --
1199
   ---------------------
1200
 
1201
   procedure Pop_Conditional (Cond : Conditional) is
1202
   begin
1203
      if Conditional_TOS > 0 then
1204
         case Cond is
1205
            when Set =>
1206
               if Conditional_Stack (Conditional_TOS).Cond /= Set then
1207
                  Error (Source_File,
1208
                         "'@end ifset' does not match '@ifclear' at line"
1209
                         & Integer'Image (Conditional_Stack
1210
                                          (Conditional_TOS).Starting_Line));
1211
               end if;
1212
 
1213
            when Clear =>
1214
               if Conditional_Stack (Conditional_TOS).Cond /= Clear then
1215
                  Error (Source_File,
1216
                         "'@end ifclear' does not match '@ifset' at line"
1217
                         & Integer'Image (Conditional_Stack
1218
                                          (Conditional_TOS).Starting_Line));
1219
               end if;
1220
         end case;
1221
 
1222
         Conditional_TOS := Conditional_TOS - 1;
1223
 
1224
      else
1225
         case Cond is
1226
            when Set =>
1227
               Error (Source_File,
1228
                      "'@end ifset' without corresponding '@ifset'");
1229
 
1230
            when Clear =>
1231
               Error (Source_File,
1232
                      "'@end ifclear' without corresponding '@ifclear'");
1233
         end case;
1234
      end if;
1235
   end Pop_Conditional;
1236
 
1237
   -------------------------
1238
   -- Currently_Excluding --
1239
   -------------------------
1240
 
1241
   function Currently_Excluding return Boolean is
1242
   begin
1243
      return Conditional_TOS > 0
1244
        and then Conditional_Stack (Conditional_TOS).Excluding;
1245
   end Currently_Excluding;
1246
 
1247
   ----------------------------
1248
   -- VMS_Context_Determined --
1249
   ----------------------------
1250
 
1251
   function VMS_Context_Determined return Boolean is
1252
   begin
1253
      for J in 1 .. Conditional_TOS loop
1254
         if Conditional_Stack (J).Flag = VMS then
1255
            return True;
1256
         end if;
1257
      end loop;
1258
 
1259
      return False;
1260
   end VMS_Context_Determined;
1261
 
1262
   --------------------
1263
   -- In_VMS_Section --
1264
   --------------------
1265
 
1266
   function In_VMS_Section return Boolean is
1267
   begin
1268
      for J in 1 .. Conditional_TOS loop
1269
         if Conditional_Stack (J).Flag = VMS then
1270
            return Conditional_Stack (J).Cond = Set;
1271
         end if;
1272
      end loop;
1273
 
1274
      return False;
1275
   end In_VMS_Section;
1276
 
1277
   ----------------------------------
1278
   -- Check_No_Pending_Conditional --
1279
   ----------------------------------
1280
 
1281
   procedure Check_No_Pending_Conditional is
1282
   begin
1283
      for J in 1 .. Conditional_TOS loop
1284
         case Conditional_Stack (J).Cond is
1285
            when Set =>
1286
               Error (Source_File, "Missing '@end ifset' for '@ifset' at line"
1287
                      & Integer'Image (Conditional_Stack (J).Starting_Line));
1288
 
1289
            when Clear =>
1290
               Error (Source_File,
1291
                      "Missing '@end ifclear' for '@ifclear' at line"
1292
                      & Integer'Image (Conditional_Stack (J).Starting_Line));
1293
         end case;
1294
      end loop;
1295
   end Check_No_Pending_Conditional;
1296
 
1297
--  Start of processing for Xgnatugn
1298
 
1299
   Valid_Command_Line : Boolean;
1300
   Output_File_Name   : VString;
1301
 
1302
begin
1303
   Initialize_Extensions;
1304
   Valid_Command_Line := Argument_Count in 3 .. 5;
1305
 
1306
   --  First argument: Target
1307
 
1308
   if Valid_Command_Line then
1309
      begin
1310
         Target := Flag_Type'Value (Argument (1));
1311
 
1312
         if not Target'Valid then
1313
            Valid_Command_Line := False;
1314
         end if;
1315
 
1316
      exception
1317
         when Constraint_Error =>
1318
            Valid_Command_Line := False;
1319
      end;
1320
   end if;
1321
 
1322
   --  Second argument: Source_File
1323
 
1324
   if Valid_Command_Line then
1325
      begin
1326
         Source_File.Name := V (Argument (2));
1327
         Open (Source_File.Data, In_File, Argument (2));
1328
 
1329
      exception
1330
         when Ada.Text_IO.Name_Error =>
1331
            Valid_Command_Line := False;
1332
      end;
1333
   end if;
1334
 
1335
   --  Third argument: Dictionary_File
1336
 
1337
   if Valid_Command_Line then
1338
      begin
1339
         Dictionary_File.Name := V (Argument (3));
1340
         Open (Dictionary_File.Data, In_File, Argument (3));
1341
 
1342
      exception
1343
         when Ada.Text_IO.Name_Error =>
1344
            Valid_Command_Line := False;
1345
      end;
1346
   end if;
1347
 
1348
   --  Fourth argument: Output_File
1349
 
1350
   if Valid_Command_Line then
1351
      if Argument_Count in 4 .. 5 then
1352
         Output_File_Name := V (Argument (4));
1353
      else
1354
         case Target is
1355
            when UNW =>
1356
               Output_File_Name := V ("gnat_ugn_unw.texi");
1357
            when VMS =>
1358
               Output_File_Name := V ("gnat_ugn_vms.texi");
1359
         end case;
1360
      end if;
1361
 
1362
      Warnings_Enabled := Argument_Count = 5;
1363
 
1364
      begin
1365
         Create (Output_File, Out_File, S (Output_File_Name));
1366
 
1367
      exception
1368
         when Ada.Text_IO.Name_Error | Ada.Text_IO.Use_Error =>
1369
            Valid_Command_Line := False;
1370
      end;
1371
   end if;
1372
 
1373
   if not Valid_Command_Line then
1374
      Usage;
1375
      Set_Exit_Status (Failure);
1376
 
1377
   else
1378
      Read_Dictionary_File;
1379
      Close (Dictionary_File.Data);
1380
 
1381
      --  Main processing starts here
1382
 
1383
      Process_Source_File;
1384
      Close (Output_File);
1385
      Close (Source_File.Data);
1386
 
1387
      New_Line (Standard_Error);
1388
 
1389
      if Number_Of_Warnings = 0 then
1390
         Put_Line (Standard_Error, " NO Warnings");
1391
 
1392
      else
1393
         Put (Standard_Error, Integer'Image (Number_Of_Warnings));
1394
         Put (Standard_Error, " Warning");
1395
 
1396
         if Number_Of_Warnings > 1 then
1397
            Put (Standard_Error, "s");
1398
         end if;
1399
 
1400
         New_Line (Standard_Error);
1401
      end if;
1402
 
1403
      if Number_Of_Errors = 0 then
1404
         Put_Line (Standard_Error, " NO Errors");
1405
 
1406
      else
1407
         Put (Standard_Error, Integer'Image (Number_Of_Errors));
1408
         Put (Standard_Error, " Error");
1409
 
1410
         if Number_Of_Errors > 1 then
1411
            Put (Standard_Error, "s");
1412
         end if;
1413
 
1414
         New_Line (Standard_Error);
1415
      end if;
1416
 
1417
      if Number_Of_Errors /= 0  then
1418
         Set_Exit_Status (Failure);
1419
      else
1420
         Set_Exit_Status (Success);
1421
      end if;
1422
   end if;
1423
end Xgnatugn;

powered by: WebSVN 2.1.0

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