1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1996-2002, Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
29 with Ada
.Strings
.Fixed
;
30 with Ada
.Command_Line
; use Ada
.Command_Line
;
31 with Ada
.Text_IO
; use Ada
.Text_IO
;
33 with GNAT
.Heap_Sort_G
;
34 with GNAT
.Command_Line
;
40 type Strptr
is access String;
42 Usage_Error
: exception;
43 -- Raised if a usage error is detected, causes termination of processing
44 -- with an appropriate error message and error exit status set.
46 Fatal_Error
: exception;
47 -- Exception raised if fatal error detected
49 Expression_Error
: exception;
50 -- Exception raised when an invalid boolean expression is found
51 -- on a preprocessor line
53 ------------------------
54 -- Argument Line Data --
55 ------------------------
57 Outfile_Name
: Strptr
;
58 Deffile_Name
: Strptr
;
62 type Input_Ptr
is access Input
;
68 Line_Num
: Natural := 0;
70 -- Data for the current input file (main input file or included file
71 -- or definition file).
73 Infile
: Input_Ptr
:= new Input
;
77 Opt_Comment_Deleted_Lines
: Boolean := False; -- Set if -c switch set
78 Blank_Deleted_Lines
: Boolean := False; -- Set if -b switch set
79 List_Symbols
: Boolean := False; -- Set if -s switch set
80 Source_Ref_Pragma
: Boolean := False; -- Set if -r switch set
81 Undefined_Is_False
: Boolean := False; -- Set if -u switch set
82 -- Record command line options
84 ---------------------------
85 -- Definitions File Data --
86 ---------------------------
88 Num_Syms
: Natural := 0;
89 -- Number of symbols defined in definitions file
91 Symbols
: array (0 .. 10_000
) of Strptr
;
92 Values
: array (0 .. 10_000
) of Strptr
;
93 -- Symbol names and values. Note that the zero'th element is used only
94 -- during the call to Sort (to hold a temporary value, as required by
95 -- the GNAT.Heap_Sort_G interface).
101 Current_File_Name
: Strptr
;
102 -- Holds name of file being read (definitions file or input file)
104 Line_Buffer
: String (1 .. 20_000
);
107 Line_Length
: Natural;
108 -- Length of line in Line_Buffer
111 -- Input scan pointer for line in Line_Buffer
113 type Keyword
is (K_Not
, K_Then
, K_If
, K_Else
, K_End
, K_Elsif
,
114 K_And
, K_Or
, K_Open_Paren
, K_Close_Paren
,
115 K_Defined
, K_Andthen
, K_Orelse
, K_Equal
, K_Include
,
117 -- Keywords that are recognized on preprocessor lines. K_None indicates
118 -- that no keyword was present.
123 Start_Sym
, End_Sym
: Natural;
124 -- First and last positions of scanned symbol
126 Num_Errors
: Natural := 0;
127 -- Number of errors detected
129 -----------------------
130 -- Preprocessor Data --
131 -----------------------
133 -- The following record represents the state of an #if structure:
135 type PP_Rec
is record
137 -- Line number for #if line
140 -- File name of #if line
143 -- Line number for #else line, zero = no else seen yet
146 -- True if lines currently being deleted
148 Match_Seen
: Boolean;
149 -- True if either the #if condition or one of the previously seen
150 -- #elsif lines was true, meaning that any future #elsif sections
151 -- or the #else section, is to be deleted.
156 -- Preprocessor #if nesting level. A value of zero means that we are
157 -- outside any #if structure.
159 PP
: array (0 .. 100) of PP_Rec
;
160 -- Stack of records showing state of #if structures. PP (1) is the
161 -- outer level entry, and PP (PP_Depth) is the active entry. PP (0)
162 -- contains a dummy entry whose Deleting flag is always set to False.
168 function At_End_Of_Line
return Boolean;
169 -- First advances Ptr using Skip_Spaces. Then returns True if Ptr is
170 -- either at the end of the line, or at a -- comment sequence.
172 procedure Error
(Msg
: String);
173 -- Post error message with given text. The line number is taken from
174 -- Infile.Line_Num, and the column number from Ptr.
176 function Eval_Condition
177 (Parenthesis
: Natural := 0;
178 Do_Eval
: Boolean := True)
180 -- Eval the condition found in the current Line. The condition can
181 -- include any of the 'and', 'or', 'not', and parenthesis subexpressions.
182 -- If Line is an invalid expression, then Expression_Error is raised,
183 -- after an error message has been printed. Line can include 'then'
184 -- followed by a comment, which is automatically ignored. If Do_Eval
185 -- is False, then the expression is not evaluated at all, and symbols
188 function Eval_Symbol
(Do_Eval
: Boolean) return Boolean;
189 -- Read and evaluate the next symbol or expression (A, A'Defined, A=...)
190 -- If it is followed by 'Defined or an equality test, read as many symbols
191 -- as needed. Do_Eval has the same meaning as in Eval_Condition
194 -- Print a help page to summarize the usage of gnatprep
196 function Image
(N
: Natural) return String;
197 -- Returns Natural'Image (N) without the initial space
199 function Is_Preprocessor_Line
return Boolean;
200 -- Tests if current line is a preprocessor line, i.e. that its first
201 -- non-blank character is a # character. If so, then a result of True
202 -- is returned, and Ptr is set to point to the character following the
203 -- # character. If not, False is returned and Ptr is undefined.
206 -- Make sure no junk is present on a preprocessor line. Ptr points past
207 -- the scanned preprocessor syntax.
209 function OK_Identifier
(S
: String) return Boolean;
210 -- Tests if given referenced string is valid Ada identifier
212 function Matching_Strings
(S1
, S2
: String) return Boolean;
213 -- Check if S1 and S2 are the same string (this is a case independent
214 -- comparison, lower and upper case letters are considered to match).
215 -- Duplicate quotes in S2 are considered as a single quote ("" => ")
217 procedure Parse_Def_File
;
218 -- Parse the deffile given by the user
220 function Scan_Keyword
return Keyword
;
221 -- Advances Ptr to end of line or next non-blank using Skip_Spaces. Then
222 -- attempts to scan out a recognized keyword. if a recognized keyword is
223 -- found, sets Ptr past it, and returns the code for the keyword, if not,
224 -- then Ptr is left unchanged pointing to a non-blank character or to the
227 function Symbol_Scanned
return Boolean;
228 -- On entry, Start_Sym is set to the first character of an identifier
229 -- symbol to be scanned out. On return, End_Sym is set to the last
230 -- character of the identifier, and the result indicates if the scanned
231 -- symbol is a valid identifier (True = valid). Ptr is not changed.
233 procedure Skip_Spaces
;
234 -- Skips Ptr past tabs and spaces to next non-blank, or one character
235 -- past the end of line.
237 function Variable_Index
(Name
: String) return Natural;
238 -- Returns the index of the variable in the table. If the variable is not
239 -- found, returns Natural'Last
245 function At_End_Of_Line
return Boolean is
249 return Ptr
> Line_Length
251 (Ptr
< Line_Length
and then Line_Buffer
(Ptr
.. Ptr
+ 1) = "--");
258 procedure Error
(Msg
: String) is
259 L
: constant String := Natural'Image (Infile
.Line_Num
);
260 C
: constant String := Natural'Image (Ptr
);
263 Put
(Standard_Error
, Current_File_Name
.all);
264 Put
(Standard_Error
, ':');
265 Put
(Standard_Error
, L
(2 .. L
'Length));
266 Put
(Standard_Error
, ':');
267 Put
(Standard_Error
, C
(2 .. C
'Length));
268 Put
(Standard_Error
, ": ");
270 Put_Line
(Standard_Error
, Msg
);
271 Num_Errors
:= Num_Errors
+ 1;
278 function Eval_Condition
279 (Parenthesis
: Natural := 0;
280 Do_Eval
: Boolean := True)
283 Symbol_Is_True
: Boolean := False; -- init to avoid warning
287 -- Find the next subexpression
293 Symbol_Is_True
:= Eval_Symbol
(Do_Eval
);
297 -- Not applies to the next subexpression (either a simple
298 -- evaluation like A or A'Defined, or a parenthesis expression)
302 if K
= K_Open_Paren
then
303 Symbol_Is_True
:= not Eval_Condition
(Parenthesis
+ 1, Do_Eval
);
305 elsif K
= K_None
then
306 Symbol_Is_True
:= not Eval_Symbol
(Do_Eval
);
309 Ptr
:= Start_Sym
; -- Puts the keyword back
313 Symbol_Is_True
:= Eval_Condition
(Parenthesis
+ 1, Do_Eval
);
317 Error
("invalid syntax in preprocessor line");
318 raise Expression_Error
;
321 -- Do we have a compound expression with AND, OR, ...
326 if not At_End_Of_Line
then
327 Error
("Invalid Syntax at end of line");
328 raise Expression_Error
;
331 if Parenthesis
/= 0 then
332 Error
("Unmatched opening parenthesis");
333 raise Expression_Error
;
336 return Symbol_Is_True
;
339 if Parenthesis
/= 0 then
340 Error
("Unmatched opening parenthesis");
341 raise Expression_Error
;
344 return Symbol_Is_True
;
346 when K_Close_Paren
=>
347 if Parenthesis
= 0 then
348 Error
("Unmatched closing parenthesis");
349 raise Expression_Error
;
352 return Symbol_Is_True
;
355 return Symbol_Is_True
and Eval_Condition
(Parenthesis
, Do_Eval
);
358 if not Symbol_Is_True
then
360 -- Just skip the symbols for the remaining part
362 Symbol_Is_True
:= Eval_Condition
(Parenthesis
, False);
366 return Eval_Condition
(Parenthesis
, Do_Eval
);
370 return Symbol_Is_True
or Eval_Condition
(Parenthesis
, Do_Eval
);
373 if Symbol_Is_True
then
375 -- Just skip the symbols for the remaining part
377 Symbol_Is_True
:= Eval_Condition
(Parenthesis
, False);
381 return Eval_Condition
(Parenthesis
, Do_Eval
);
385 Error
("invalid syntax in preprocessor line");
386 raise Expression_Error
;
395 function Eval_Symbol
(Do_Eval
: Boolean) return Boolean is
396 Sym
: constant String := Line_Buffer
(Start_Sym
.. End_Sym
);
399 Symbol_Defined
: Boolean := False;
400 Symbol_Is_True
: Boolean := False;
408 if not Symbol_Scanned
then
409 Error
("invalid symbol name");
410 raise Expression_Error
;
415 -- Test if we have a simple test (A) or a more complicated one
420 if K
/= K_Defined
and then K
/= K_Equal
then
421 Ptr
:= Start_Sym
; -- Puts the keyword back
424 Index
:= Variable_Index
(Sym
);
428 Symbol_Defined
:= Index
/= Natural'Last;
429 Symbol_Is_True
:= Symbol_Defined
;
433 -- Read the second part of the statement
438 if not Symbol_Scanned
439 and then End_Sym
< Start_Sym
441 Error
("No right part for the equality test");
442 raise Expression_Error
;
447 -- If the variable was not found
450 if Index
= Natural'Last then
451 if not Undefined_Is_False
then
452 Error
("symbol name """ & Sym
&
453 """ is not defined in definitions file");
458 Right
: constant String
459 := Line_Buffer
(Start_Sym
.. End_Sym
);
462 if Right
(Right
'First) = '"' then
466 Right
(Right
'First + 1 .. Right
'Last - 1));
468 Index_R
:= Variable_Index
(Right
);
469 if Index_R
= Natural'Last then
470 Error
("Variable " & Right
& " in test is "
472 raise Expression_Error
;
475 Matching_Strings
(Values
(Index
).all,
476 Values
(Index_R
).all);
485 if Index
= Natural'Last then
487 Symbol_Defined
:= False;
488 if Do_Eval
and then not Symbol_Defined
then
489 if Undefined_Is_False
then
490 Symbol_Defined
:= True;
491 Symbol_Is_True
:= False;
495 ("symbol name """ & Sym
&
496 """ is not defined in definitions file");
500 elsif not Do_Eval
then
501 Symbol_Is_True
:= True;
503 elsif Matching_Strings
(Values
(Index
).all, "True") then
504 Symbol_Is_True
:= True;
506 elsif Matching_Strings
(Values
(Index
).all, "False") then
507 Symbol_Is_True
:= False;
510 Error
("symbol value is not True or False");
511 Symbol_Is_True
:= False;
516 return Symbol_Is_True
;
523 procedure Help_Page
is
525 Put_Line
(Standard_Error
,
526 "GNAT Preprocessor " &
527 Gnatvsn
.Gnat_Version_String
&
528 " Copyright 1996-2002 Free Software Foundation, Inc.");
529 Put_Line
(Standard_Error
,
530 "Usage: gnatprep [-bcrsu] [-Dsymbol=value] infile " &
531 "outfile [deffile]");
532 New_Line
(Standard_Error
);
533 Put_Line
(Standard_Error
, " infile Name of the input file");
534 Put_Line
(Standard_Error
, " outfile Name of the output file");
535 Put_Line
(Standard_Error
, " deffile Name of the definition file");
536 New_Line
(Standard_Error
);
537 Put_Line
(Standard_Error
, "gnatprep switches:");
538 Put_Line
(Standard_Error
, " -b Replace preprocessor lines by " &
540 Put_Line
(Standard_Error
, " -c Keep preprocessor lines as comments");
541 Put_Line
(Standard_Error
, " -D Associate symbol with value");
542 Put_Line
(Standard_Error
, " -r Generate Source_Reference pragma");
543 Put_Line
(Standard_Error
, " -s Print a sorted list of symbol names " &
545 Put_Line
(Standard_Error
, " -u Treat undefined symbols as FALSE");
546 New_Line
(Standard_Error
);
553 function Image
(N
: Natural) return String is
554 Result
: constant String := Natural'Image (N
);
556 return Result
(Result
'First + 1 .. Result
'Last);
559 --------------------------
560 -- Is_Preprocessor_Line --
561 --------------------------
563 function Is_Preprocessor_Line
return Boolean is
567 while Ptr
<= Line_Length
loop
568 if Line_Buffer
(Ptr
) = '#' then
572 elsif Line_Buffer
(Ptr
) > ' ' then
581 end Is_Preprocessor_Line
;
583 ----------------------
584 -- Matching_Strings --
585 ----------------------
587 function Matching_Strings
(S1
, S2
: String) return Boolean is
588 S2_Index
: Integer := S2
'First;
591 for S1_Index
in S1
'Range loop
593 if To_Upper
(S1
(S1_Index
)) /= To_Upper
(S2
(S2_Index
)) then
597 if S2
(S2_Index
) = '"'
598 and then S2_Index
< S2
'Last
599 and then S2
(S2_Index
+ 1) = '"'
601 S2_Index
:= S2_Index
+ 2;
603 S2_Index
:= S2_Index
+ 1;
606 -- If S2 was too short then
608 if S2_Index
> S2
'Last and then S1_Index
< S1
'Last then
614 return S2_Index
= S2
'Last + 1;
615 end Matching_Strings
;
626 or else (Ptr
< Line_Length
627 and then Line_Buffer
(Ptr
.. Ptr
+ 1) /= "--")
629 Error
("extraneous text on preprocessor line ignored");
637 function OK_Identifier
(S
: String) return Boolean is
638 P
: Natural := S
'First;
641 if S
'Length /= 0 and then S
(P
) = Character'Val (39) then -- '''
646 or else not Is_Letter
(S
(P
))
651 while P
<= S
'Last loop
652 if Is_Letter
(S
(P
)) or Is_Digit
(S
(P
)) then
657 and then S
(P
+ 1) /= '_'
676 procedure Parse_Def_File
is
678 Open
(Deffile
, In_File
, Deffile_Name
.all);
680 -- Initialize data for procedure Error
682 Infile
.Line_Num
:= 0;
683 Current_File_Name
:= Deffile_Name
;
685 -- Loop through lines in symbol definitions file
687 while not End_Of_File
(Deffile
) loop
688 Get_Line
(Deffile
, Line_Buffer
, Line_Length
);
689 Infile
.Line_Num
:= Infile
.Line_Num
+ 1;
695 or else (Ptr
< Line_Length
697 Line_Buffer
(Ptr
.. Ptr
+ 1) = "--")
704 if not Symbol_Scanned
then
705 Error
("invalid symbol identifier """ &
706 Line_Buffer
(Start_Sym
.. End_Sym
) &
714 if Ptr
>= Line_Length
715 or else Line_Buffer
(Ptr
.. Ptr
+ 1) /= ":="
717 Error
("missing "":="" in symbol definition line");
724 Num_Syms
:= Num_Syms
+ 1;
725 Symbols
(Num_Syms
) := new String'(Line_Buffer (Start_Sym .. End_Sym));
730 if At_End_Of_Line then
733 elsif Line_Buffer (Start_Sym) = '"' then
734 End_Sym := End_Sym + 1;
736 End_Sym := End_Sym + 1;
738 if End_Sym > Line_Length then
739 Error ("no closing quote
for string constant");
742 elsif End_Sym < Line_Length
743 and then Line_Buffer (End_Sym .. End_Sym + 1) = """"""
745 End_Sym := End_Sym + 1;
747 elsif Line_Buffer (End_Sym) = '"' then
755 while End_Sym < Line_Length
756 and then (Is_Alphanumeric (Line_Buffer (End_Sym + 1))
758 Line_Buffer (End_Sym + 1) = '_
'
760 Line_Buffer (End_Sym + 1) = '.')
762 End_Sym := End_Sym + 1;
767 if not At_End_Of_Line then
768 Error ("incorrect symbol value syntax");
773 Values (Num_Syms) := new String'(Line_Buffer
(Start_Sym
.. End_Sym
));
780 -- Could not open the file
783 Put_Line
(Standard_Error
, "cannot open " & Deffile_Name
.all);
791 function Scan_Keyword
return Keyword
is
792 Kptr
: constant Natural := Ptr
;
798 if Symbol_Scanned
then
800 -- If the symbol was the last thing on the line, End_Sym will
801 -- point too far in Line_Buffer
803 if End_Sym
> Line_Length
then
804 End_Sym
:= Line_Length
;
810 Sym
: constant String := Line_Buffer
(Start_Sym
.. End_Sym
);
813 if Matching_Strings
(Sym
, "not") then
816 elsif Matching_Strings
(Sym
, "then") then
819 elsif Matching_Strings
(Sym
, "if") then
822 elsif Matching_Strings
(Sym
, "else") then
825 elsif Matching_Strings
(Sym
, "end") then
828 elsif Matching_Strings
(Sym
, "elsif") then
831 elsif Matching_Strings
(Sym
, "and") then
832 if Scan_Keyword
= K_Then
then
836 Ptr
:= Start_Sym
; -- Put back the last keyword read
841 elsif Matching_Strings
(Sym
, "or") then
842 if Scan_Keyword
= K_Else
then
846 Ptr
:= Start_Sym
; -- Put back the last keyword read
851 elsif Matching_Strings
(Sym
, "'defined") then
854 elsif Matching_Strings
(Sym
, "include") then
861 return K_Close_Paren
;
877 procedure Skip_Spaces
is
879 while Ptr
<= Line_Length
loop
880 if Line_Buffer
(Ptr
) /= ' '
881 and then Line_Buffer
(Ptr
) /= ASCII
.HT
894 function Symbol_Scanned
return Boolean is
896 End_Sym
:= Start_Sym
- 1;
898 case Line_Buffer
(End_Sym
+ 1) is
900 when '(' |
')' |
'=' =>
901 End_Sym
:= End_Sym
+ 1;
905 End_Sym
:= End_Sym
+ 1;
906 while End_Sym
< Line_Length
loop
908 if Line_Buffer
(End_Sym
+ 1) = '"' then
910 if End_Sym
+ 2 < Line_Length
911 and then Line_Buffer
(End_Sym
+ 2) = '"'
913 End_Sym
:= End_Sym
+ 2;
918 End_Sym
:= End_Sym
+ 1;
922 if End_Sym
>= Line_Length
then
923 Error
("Invalid string ");
924 raise Expression_Error
;
927 End_Sym
:= End_Sym
+ 1;
931 End_Sym
:= End_Sym
+ 1;
937 while End_Sym
< Line_Length
938 and then (Is_Alphanumeric
(Line_Buffer
(End_Sym
+ 1))
939 or else Line_Buffer
(End_Sym
+ 1) = '_')
941 End_Sym
:= End_Sym
+ 1;
944 return OK_Identifier
(Line_Buffer
(Start_Sym
.. End_Sym
));
951 function Variable_Index
(Name
: String) return Natural is
953 for J
in 1 .. Num_Syms
loop
954 if Matching_Strings
(Symbols
(J
).all, Name
) then
962 -- Start of processing for GNATprep
966 -- Parse the switches
969 case GNAT
.Command_Line
.Getopt
("D: b c r s u") is
975 S
: String := GNAT
.Command_Line
.Parameter
;
979 Index
:= Ada
.Strings
.Fixed
.Index
(S
, "=");
982 Num_Syms
:= Num_Syms
+ 1;
983 Symbols
(Num_Syms
) := new String'(S);
984 Values (Num_Syms) := new String'("True");
987 Num_Syms
:= Num_Syms
+ 1;
988 Symbols
(Num_Syms
) := new String'(S (S'First .. Index - 1));
989 Values (Num_Syms) := new String'(S
(Index
+ 1 .. S
'Last));
994 Blank_Deleted_Lines
:= True;
997 Opt_Comment_Deleted_Lines
:= True;
1000 Source_Ref_Pragma
:= True;
1003 List_Symbols
:= True;
1006 Undefined_Is_False
:= True;
1013 -- Get the file names
1017 S
: constant String := GNAT
.Command_Line
.Get_Argument
;
1020 exit when S
'Length = 0;
1022 if Infile
.Name
= null then
1023 Infile
.Name
:= new String'(S);
1024 elsif Outfile_Name = null then
1025 Outfile_Name := new String'(S
);
1026 elsif Deffile_Name
= null then
1027 Deffile_Name
:= new String'(S);
1034 -- Test we had all the arguments needed
1036 if Infile.Name = null
1037 or else Outfile_Name = null
1042 if Source_Ref_Pragma and (not Opt_Comment_Deleted_Lines) then
1043 Blank_Deleted_Lines := True;
1046 -- Get symbol definitions
1048 if Deffile_Name /= null then
1052 if Num_Errors > 0 then
1055 elsif List_Symbols and then Num_Syms > 0 then
1056 List_Symbols_Case : declare
1058 function Lt (Op1, Op2 : Natural) return Boolean;
1059 -- Comparison routine for sort call
1061 procedure Move (From : Natural; To : Natural);
1062 -- Move routine for sort call
1064 function Lt (Op1, Op2 : Natural) return Boolean is
1065 L1 : constant Natural := Symbols (Op1)'Length;
1066 L2 : constant Natural := Symbols (Op2)'Length;
1067 MinL : constant Natural := Natural'Min (L1, L2);
1072 for J in 0 .. MinL - 1 loop
1073 C1 := To_Upper (Symbols (Op1).all (Symbols (Op1)'First + J));
1074 C2 := To_Upper (Symbols (Op2).all (Symbols (Op2)'First + J));
1087 procedure Move (From : Natural; To : Natural) is
1089 Symbols (To) := Symbols (From);
1090 Values (To) := Values (From);
1093 package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
1096 -- Maximum length of any symbol
1098 -- Start of processing for List_Symbols_Case
1101 Sort_Syms.Sort (Num_Syms);
1104 for J in 1 .. Num_Syms loop
1105 Max_L := Natural'Max (Max_L, Symbols (J)'Length);
1111 for J in 1 .. Max_L - 5 loop
1119 for J in 1 .. Max_L - 5 loop
1123 Put_Line ("------");
1125 for J in 1 .. Num_Syms loop
1126 Put (Symbols (J).all);
1128 for K in 1 .. Max_L - Symbols (J)'Length + 1 loop
1132 Put_Line (Values (J).all);
1136 end List_Symbols_Case;
1139 -- Open files and initialize preprocessing
1142 Open (Infile.File, In_File, Infile.Name.all);
1146 Put_Line (Standard_Error, "cannot open " & Infile.Name.all);
1151 Create (Outfile, Out_File, Outfile_Name.all);
1155 Put_Line (Standard_Error, "cannot create " & Outfile_Name.all);
1159 Infile.Line_Num := 0;
1160 Current_File_Name := Infile.Name;
1163 PP (0).Deleting := False;
1165 -- We return here after we start reading an include file and after
1166 -- we have finished reading an include file.
1170 -- If we generate Source_Reference pragmas, then generate one
1171 -- either with line number 1 for a newly included file, or
1172 -- with the number of the next line when we have returned to the
1175 if Source_Ref_Pragma then
1177 (Outfile, "pragma Source_Reference (" &
1178 Image (Infile.Line_Num + 1) &
1179 ", """ & Infile.Name.all & """);");
1182 -- Loop through lines in input file
1184 while not End_Of_File (Infile.File) loop
1185 Get_Line (Infile.File, Line_Buffer, Line_Length);
1186 Infile.Line_Num := Infile.Line_Num + 1;
1188 -- Handle preprocessor line
1190 if Is_Preprocessor_Line then
1198 -- Ignore if Deleting is True
1200 if PP (PP_Depth).Deleting then
1206 if Ptr >= Line_Length then
1207 Error ("no file to include");
1209 elsif Line_Buffer (Ptr) /= '"' then
1211 ("file to include must be specified as a literal
string");
1215 Start_File : constant Positive := Ptr + 1;
1220 while Line_Buffer (Ptr) = ' '
1221 or else Line_Buffer (Ptr) = ASCII.HT
1226 if Ptr <= Start_File
1227 or else Line_Buffer (Ptr) /= '"'
1229 Error ("no string literal for included file");
1232 if Infile.Next = null then
1233 Infile.Next := new Input;
1234 Infile.Next.Prev := Infile;
1237 Infile := Infile.Next;
1239 new String'(Line_Buffer
(Start_File
.. Ptr
- 1));
1241 -- Check for circularity: an file including itself,
1242 -- either directly or indirectly.
1245 File
: Input_Ptr
:= Infile
.Prev
;
1249 and then File
.Name
.all /= Infile
.Name
.all
1254 if File
/= null then
1255 Infile
:= Infile
.Prev
;
1256 Error
("circularity in included files");
1258 while File
.Prev
/= null loop
1262 while File
/= Infile
.Next
loop
1263 Error
('"' & File
.Name
.all &
1265 File
.Next
.Name
.all & '"');
1270 -- We have a file name and no circularity.
1271 -- Open the file and record an error if the
1272 -- file cannot be opened.
1275 Open
(Infile
.File
, In_File
, Infile
.Name
.all);
1276 Current_File_Name
:= Infile
.Name
;
1277 Infile
.Line_Num
:= 0;
1279 -- If we use Source_Reference pragma,
1280 -- we need to output one for this new file.
1286 -- We need to set the input file to
1287 -- the including file, so that the
1288 -- line number is correct when reporting
1291 Infile
:= Infile
.Prev
;
1292 Error
("cannot open """ &
1293 Infile
.Next
.Name
.all & '"');
1301 -- If/Elsif processing
1303 when K_If | K_Elsif
=>
1305 -- If differs from elsif only in that an initial stack entry
1306 -- must be made for the new if range. We set the match seen
1307 -- entry to a copy of the deleting status in the range above
1308 -- us. If we are deleting in the range above us, then we want
1309 -- all the branches of the nested #if to delete.
1312 PP_Depth
:= PP_Depth
+ 1;
1314 (If_Line
=> Infile
.Line_Num
,
1315 If_Name
=> Infile
.Name
,
1318 Match_Seen
=> PP
(PP_Depth
- 1).Deleting
);
1320 elsif PP_Depth
= 0 then
1321 Error
("no matching #if for this #elsif");
1326 PP
(PP_Depth
).Deleting
:= True;
1328 if not PP
(PP_Depth
).Match_Seen
1329 and then Eval_Condition
= True
1332 -- Case of match and no match yet in this #if
1334 PP
(PP_Depth
).Deleting
:= False;
1335 PP
(PP_Depth
).Match_Seen
:= True;
1339 -- Processing for #else
1343 if PP_Depth
= 0 then
1344 Error
("no matching #if for this #else");
1346 elsif PP
(PP_Depth
).Else_Line
/= 0 then
1347 Error
("duplicate #else line (previous was on line" &
1348 Natural'Image (PP
(PP_Depth
).Else_Line
) &
1352 PP
(PP_Depth
).Else_Line
:= Infile
.Line_Num
;
1353 PP
(PP_Depth
).Deleting
:= PP
(PP_Depth
).Match_Seen
;
1362 if PP_Depth
= 0 then
1363 Error
("no matching #if for this #end");
1368 if Scan_Keyword
/= K_If
then
1369 Error
("expected if after #end");
1370 Ptr
:= Line_Length
+ 1;
1375 if Ptr
> Line_Length
1376 or else Line_Buffer
(Ptr
) /= ';'
1378 Error
("missing semicolon after #end if");
1385 PP_Depth
:= PP_Depth
- 1;
1389 Error
("invalid preprocessor keyword syntax");
1393 -- Handle symbol substitution
1395 -- Substitution is not allowed in string (which we simply skip),
1396 -- but is allowed inside character constants. The last case is
1397 -- because there is no way to know whether the user want to
1398 -- substitute the name of an attribute ('Min or 'Max for instance)
1399 -- or actually meant to substitue a character ('$name' is probably
1400 -- a character constant, but my_type'$name'Min is probably an
1401 -- attribute, with $name=Base)
1406 while Ptr
< Line_Length
loop
1407 exit when At_End_Of_Line
;
1409 case Line_Buffer
(Ptr
) is
1413 -- Two special cases here:
1414 -- '"' => we don't want the " sign to appear as belonging
1416 -- '$' => this is obviously not a substitution, just skip it
1418 if Ptr
< Line_Length
- 1
1419 and then Line_Buffer
(Ptr
+ 1) = '"'
1422 elsif Ptr
< Line_Length
- 2
1423 and then Line_Buffer
(Ptr
+ 1 .. Ptr
+ 2) = "$'"
1430 -- The special case of "" inside the string is easy to
1431 -- handle: just ignore them. The second one will be seen
1432 -- as the beginning of a second string
1435 while Ptr
< Line_Length
1436 and then Line_Buffer
(Ptr
) /= '"'
1443 -- $ found, so scan out possible following symbol
1445 Start_Sym
:= Ptr
+ 1;
1447 if Symbol_Scanned
then
1449 -- Look up symbol in table and if found do replacement
1451 for J
in 1 .. Num_Syms
loop
1453 (Symbols
(J
).all, Line_Buffer
(Start_Sym
.. End_Sym
))
1456 OldL
: constant Positive :=
1457 End_Sym
- Start_Sym
+ 2;
1458 NewL
: constant Positive := Values
(J
)'Length;
1459 AdjL
: constant Integer := NewL
- OldL
;
1460 NewP
: constant Positive := Ptr
+ NewL
- 1;
1463 Line_Buffer
(NewP
+ 1 .. Line_Length
+ AdjL
) :=
1464 Line_Buffer
(End_Sym
+ 1 .. Line_Length
);
1465 Line_Buffer
(Ptr
.. NewP
) := Values
(J
).all;
1468 Line_Length
:= Line_Length
+ AdjL
;
1484 -- Here after dealing with preprocessor line, output current line
1488 if Is_Preprocessor_Line
or else PP
(PP_Depth
).Deleting
then
1489 if Blank_Deleted_Lines
then
1492 elsif Opt_Comment_Deleted_Lines
then
1493 if Line_Length
= 0 then
1494 Put_Line
(Outfile
, "--!");
1496 Put
(Outfile
, "--! ");
1497 Put_Line
(Outfile
, Line_Buffer
(1 .. Line_Length
));
1502 Put_Line
(Outfile
, Line_Buffer
(1 .. Line_Length
));
1506 -- If we have finished reading an included file, close it and continue
1507 -- with the next line of the including file.
1509 if Infile
.Prev
/= null then
1510 Close
(Infile
.File
);
1511 Infile
:= Infile
.Prev
;
1512 Current_File_Name
:= Infile
.Name
;
1516 for J
in 1 .. PP_Depth
loop
1517 if PP
(J
).If_Name
= Infile
.Name
then
1518 Error
("no matching #end for #if at line" &
1519 Natural'Image (PP
(J
).If_Line
));
1521 Error
("no matching #end for #if at line" &
1522 Natural'Image (PP
(J
).If_Line
) &
1523 " of file """ & PP
(J
).If_Name
.all & '"');
1527 if Num_Errors
= 0 then
1529 Set_Exit_Status
(0);
1532 Set_Exit_Status
(1);
1538 Set_Exit_Status
(1);
1540 when GNAT
.Command_Line
.Invalid_Parameter
=>
1541 Put_Line
(Standard_Error
, "No parameter given for -"
1542 & GNAT
.Command_Line
.Full_Switch
);
1544 Set_Exit_Status
(1);
1546 when GNAT
.Command_Line
.Invalid_Switch
=>
1547 Put_Line
(Standard_Error
, "Invalid Switch: -"
1548 & GNAT
.Command_Line
.Full_Switch
);
1550 Set_Exit_Status
(1);
1553 Set_Exit_Status
(1);
1555 when Expression_Error
=>
1556 Set_Exit_Status
(1);