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
;
39 pragma Ident
(Gnatvsn
.Gnat_Version_String
);
41 type Strptr
is access String;
43 Usage_Error
: exception;
44 -- Raised if a usage error is detected, causes termination of processing
45 -- with an appropriate error message and error exit status set.
47 Fatal_Error
: exception;
48 -- Exception raised if fatal error detected
50 Expression_Error
: exception;
51 -- Exception raised when an invalid boolean expression is found
52 -- on a preprocessor line
54 ------------------------
55 -- Argument Line Data --
56 ------------------------
58 Outfile_Name
: Strptr
;
59 Deffile_Name
: Strptr
;
63 type Input_Ptr
is access Input
;
69 Line_Num
: Natural := 0;
71 -- Data for the current input file (main input file or included file
72 -- or definition file).
74 Infile
: Input_Ptr
:= new Input
;
78 Opt_Comment_Deleted_Lines
: Boolean := False; -- Set if -c switch set
79 Blank_Deleted_Lines
: Boolean := False; -- Set if -b switch set
80 List_Symbols
: Boolean := False; -- Set if -s switch set
81 Source_Ref_Pragma
: Boolean := False; -- Set if -r switch set
82 Undefined_Is_False
: Boolean := False; -- Set if -u switch set
83 -- Record command line options
85 ---------------------------
86 -- Definitions File Data --
87 ---------------------------
89 Num_Syms
: Natural := 0;
90 -- Number of symbols defined in definitions file
92 Symbols
: array (0 .. 10_000
) of Strptr
;
93 Values
: array (0 .. 10_000
) of Strptr
;
94 -- Symbol names and values. Note that the zero'th element is used only
95 -- during the call to Sort (to hold a temporary value, as required by
96 -- the GNAT.Heap_Sort_G interface).
100 ---------------------
102 Current_File_Name
: Strptr
;
103 -- Holds name of file being read (definitions file or input file)
105 Line_Buffer
: String (1 .. 20_000
);
108 Line_Length
: Natural;
109 -- Length of line in Line_Buffer
112 -- Input scan pointer for line in Line_Buffer
114 type Keyword
is (K_Not
, K_Then
, K_If
, K_Else
, K_End
, K_Elsif
,
115 K_And
, K_Or
, K_Open_Paren
, K_Close_Paren
,
116 K_Defined
, K_Andthen
, K_Orelse
, K_Equal
, K_Include
,
118 -- Keywords that are recognized on preprocessor lines. K_None indicates
119 -- that no keyword was present.
124 Start_Sym
, End_Sym
: Natural;
125 -- First and last positions of scanned symbol
127 Num_Errors
: Natural := 0;
128 -- Number of errors detected
130 -----------------------
131 -- Preprocessor Data --
132 -----------------------
134 -- The following record represents the state of an #if structure:
136 type PP_Rec
is record
138 -- Line number for #if line
141 -- File name of #if line
144 -- Line number for #else line, zero = no else seen yet
147 -- True if lines currently being deleted
149 Match_Seen
: Boolean;
150 -- True if either the #if condition or one of the previously seen
151 -- #elsif lines was true, meaning that any future #elsif sections
152 -- or the #else section, is to be deleted.
157 -- Preprocessor #if nesting level. A value of zero means that we are
158 -- outside any #if structure.
160 PP
: array (0 .. 100) of PP_Rec
;
161 -- Stack of records showing state of #if structures. PP (1) is the
162 -- outer level entry, and PP (PP_Depth) is the active entry. PP (0)
163 -- contains a dummy entry whose Deleting flag is always set to False.
169 function At_End_Of_Line
return Boolean;
170 -- First advances Ptr using Skip_Spaces. Then returns True if Ptr is
171 -- either at the end of the line, or at a -- comment sequence.
173 procedure Error
(Msg
: String);
174 -- Post error message with given text. The line number is taken from
175 -- Infile.Line_Num, and the column number from Ptr.
177 function Eval_Condition
178 (Parenthesis
: Natural := 0;
179 Do_Eval
: Boolean := True)
181 -- Eval the condition found in the current Line. The condition can
182 -- include any of the 'and', 'or', 'not', and parenthesis subexpressions.
183 -- If Line is an invalid expression, then Expression_Error is raised,
184 -- after an error message has been printed. Line can include 'then'
185 -- followed by a comment, which is automatically ignored. If Do_Eval
186 -- is False, then the expression is not evaluated at all, and symbols
189 function Eval_Symbol
(Do_Eval
: Boolean) return Boolean;
190 -- Read and evaluate the next symbol or expression (A, A'Defined, A=...)
191 -- If it is followed by 'Defined or an equality test, read as many symbols
192 -- as needed. Do_Eval has the same meaning as in Eval_Condition
195 -- Print a help page to summarize the usage of gnatprep
197 function Image
(N
: Natural) return String;
198 -- Returns Natural'Image (N) without the initial space
200 function Is_Preprocessor_Line
return Boolean;
201 -- Tests if current line is a preprocessor line, i.e. that its first
202 -- non-blank character is a # character. If so, then a result of True
203 -- is returned, and Ptr is set to point to the character following the
204 -- # character. If not, False is returned and Ptr is undefined.
207 -- Make sure no junk is present on a preprocessor line. Ptr points past
208 -- the scanned preprocessor syntax.
210 function OK_Identifier
(S
: String) return Boolean;
211 -- Tests if given referenced string is valid Ada identifier
213 function Matching_Strings
(S1
, S2
: String) return Boolean;
214 -- Check if S1 and S2 are the same string (this is a case independent
215 -- comparison, lower and upper case letters are considered to match).
216 -- Duplicate quotes in S2 are considered as a single quote ("" => ")
218 procedure Parse_Def_File
;
219 -- Parse the deffile given by the user
221 function Scan_Keyword
return Keyword
;
222 -- Advances Ptr to end of line or next non-blank using Skip_Spaces. Then
223 -- attempts to scan out a recognized keyword. if a recognized keyword is
224 -- found, sets Ptr past it, and returns the code for the keyword, if not,
225 -- then Ptr is left unchanged pointing to a non-blank character or to the
228 function Symbol_Scanned
return Boolean;
229 -- On entry, Start_Sym is set to the first character of an identifier
230 -- symbol to be scanned out. On return, End_Sym is set to the last
231 -- character of the identifier, and the result indicates if the scanned
232 -- symbol is a valid identifier (True = valid). Ptr is not changed.
234 procedure Skip_Spaces
;
235 -- Skips Ptr past tabs and spaces to next non-blank, or one character
236 -- past the end of line.
238 function Variable_Index
(Name
: String) return Natural;
239 -- Returns the index of the variable in the table. If the variable is not
240 -- found, returns Natural'Last
246 function At_End_Of_Line
return Boolean is
250 return Ptr
> Line_Length
252 (Ptr
< Line_Length
and then Line_Buffer
(Ptr
.. Ptr
+ 1) = "--");
259 procedure Error
(Msg
: String) is
260 L
: constant String := Natural'Image (Infile
.Line_Num
);
261 C
: constant String := Natural'Image (Ptr
);
264 Put
(Standard_Error
, Current_File_Name
.all);
265 Put
(Standard_Error
, ':');
266 Put
(Standard_Error
, L
(2 .. L
'Length));
267 Put
(Standard_Error
, ':');
268 Put
(Standard_Error
, C
(2 .. C
'Length));
269 Put
(Standard_Error
, ": ");
271 Put_Line
(Standard_Error
, Msg
);
272 Num_Errors
:= Num_Errors
+ 1;
279 function Eval_Condition
280 (Parenthesis
: Natural := 0;
281 Do_Eval
: Boolean := True)
284 Symbol_Is_True
: Boolean := False; -- init to avoid warning
288 -- Find the next subexpression
294 Symbol_Is_True
:= Eval_Symbol
(Do_Eval
);
298 -- Not applies to the next subexpression (either a simple
299 -- evaluation like A or A'Defined, or a parenthesis expression)
303 if K
= K_Open_Paren
then
304 Symbol_Is_True
:= not Eval_Condition
(Parenthesis
+ 1, Do_Eval
);
306 elsif K
= K_None
then
307 Symbol_Is_True
:= not Eval_Symbol
(Do_Eval
);
310 Ptr
:= Start_Sym
; -- Puts the keyword back
314 Symbol_Is_True
:= Eval_Condition
(Parenthesis
+ 1, Do_Eval
);
318 Error
("invalid syntax in preprocessor line");
319 raise Expression_Error
;
322 -- Do we have a compound expression with AND, OR, ...
327 if not At_End_Of_Line
then
328 Error
("Invalid Syntax at end of line");
329 raise Expression_Error
;
332 if Parenthesis
/= 0 then
333 Error
("Unmatched opening parenthesis");
334 raise Expression_Error
;
337 return Symbol_Is_True
;
340 if Parenthesis
/= 0 then
341 Error
("Unmatched opening parenthesis");
342 raise Expression_Error
;
345 return Symbol_Is_True
;
347 when K_Close_Paren
=>
348 if Parenthesis
= 0 then
349 Error
("Unmatched closing parenthesis");
350 raise Expression_Error
;
353 return Symbol_Is_True
;
356 return Symbol_Is_True
and Eval_Condition
(Parenthesis
, Do_Eval
);
359 if not Symbol_Is_True
then
361 -- Just skip the symbols for the remaining part
363 Symbol_Is_True
:= Eval_Condition
(Parenthesis
, False);
367 return Eval_Condition
(Parenthesis
, Do_Eval
);
371 return Symbol_Is_True
or Eval_Condition
(Parenthesis
, Do_Eval
);
374 if Symbol_Is_True
then
376 -- Just skip the symbols for the remaining part
378 Symbol_Is_True
:= Eval_Condition
(Parenthesis
, False);
382 return Eval_Condition
(Parenthesis
, Do_Eval
);
386 Error
("invalid syntax in preprocessor line");
387 raise Expression_Error
;
396 function Eval_Symbol
(Do_Eval
: Boolean) return Boolean is
397 Sym
: constant String := Line_Buffer
(Start_Sym
.. End_Sym
);
400 Symbol_Defined
: Boolean := False;
401 Symbol_Is_True
: Boolean := False;
409 if not Symbol_Scanned
then
410 Error
("invalid symbol name");
411 raise Expression_Error
;
416 -- Test if we have a simple test (A) or a more complicated one
421 if K
/= K_Defined
and then K
/= K_Equal
then
422 Ptr
:= Start_Sym
; -- Puts the keyword back
425 Index
:= Variable_Index
(Sym
);
429 Symbol_Defined
:= Index
/= Natural'Last;
430 Symbol_Is_True
:= Symbol_Defined
;
434 -- Read the second part of the statement
439 if not Symbol_Scanned
440 and then End_Sym
< Start_Sym
442 Error
("No right part for the equality test");
443 raise Expression_Error
;
448 -- If the variable was not found
451 if Index
= Natural'Last then
452 if not Undefined_Is_False
then
453 Error
("symbol name """ & Sym
&
454 """ is not defined in definitions file");
459 Right
: constant String
460 := Line_Buffer
(Start_Sym
.. End_Sym
);
463 if Right
(Right
'First) = '"' then
467 Right
(Right
'First + 1 .. Right
'Last - 1));
469 Index_R
:= Variable_Index
(Right
);
470 if Index_R
= Natural'Last then
471 Error
("Variable " & Right
& " in test is "
473 raise Expression_Error
;
476 Matching_Strings
(Values
(Index
).all,
477 Values
(Index_R
).all);
486 if Index
= Natural'Last then
488 Symbol_Defined
:= False;
489 if Do_Eval
and then not Symbol_Defined
then
490 if Undefined_Is_False
then
491 Symbol_Defined
:= True;
492 Symbol_Is_True
:= False;
496 ("symbol name """ & Sym
&
497 """ is not defined in definitions file");
501 elsif not Do_Eval
then
502 Symbol_Is_True
:= True;
504 elsif Matching_Strings
(Values
(Index
).all, "True") then
505 Symbol_Is_True
:= True;
507 elsif Matching_Strings
(Values
(Index
).all, "False") then
508 Symbol_Is_True
:= False;
511 Error
("symbol value is not True or False");
512 Symbol_Is_True
:= False;
517 return Symbol_Is_True
;
524 procedure Help_Page
is
526 Put_Line
(Standard_Error
,
527 "GNAT Preprocessor " &
528 Gnatvsn
.Gnat_Version_String
&
529 " Copyright 1996-2002 Free Software Foundation, Inc.");
530 Put_Line
(Standard_Error
,
531 "Usage: gnatprep [-bcrsu] [-Dsymbol=value] infile " &
532 "outfile [deffile]");
533 New_Line
(Standard_Error
);
534 Put_Line
(Standard_Error
, " infile Name of the input file");
535 Put_Line
(Standard_Error
, " outfile Name of the output file");
536 Put_Line
(Standard_Error
, " deffile Name of the definition file");
537 New_Line
(Standard_Error
);
538 Put_Line
(Standard_Error
, "gnatprep switches:");
539 Put_Line
(Standard_Error
, " -b Replace preprocessor lines by " &
541 Put_Line
(Standard_Error
, " -c Keep preprocessor lines as comments");
542 Put_Line
(Standard_Error
, " -D Associate symbol with value");
543 Put_Line
(Standard_Error
, " -r Generate Source_Reference pragma");
544 Put_Line
(Standard_Error
, " -s Print a sorted list of symbol names " &
546 Put_Line
(Standard_Error
, " -u Treat undefined symbols as FALSE");
547 New_Line
(Standard_Error
);
554 function Image
(N
: Natural) return String is
555 Result
: constant String := Natural'Image (N
);
557 return Result
(Result
'First + 1 .. Result
'Last);
560 --------------------------
561 -- Is_Preprocessor_Line --
562 --------------------------
564 function Is_Preprocessor_Line
return Boolean is
568 while Ptr
<= Line_Length
loop
569 if Line_Buffer
(Ptr
) = '#' then
573 elsif Line_Buffer
(Ptr
) > ' ' then
582 end Is_Preprocessor_Line
;
584 ----------------------
585 -- Matching_Strings --
586 ----------------------
588 function Matching_Strings
(S1
, S2
: String) return Boolean is
589 S2_Index
: Integer := S2
'First;
592 for S1_Index
in S1
'Range loop
594 if To_Upper
(S1
(S1_Index
)) /= To_Upper
(S2
(S2_Index
)) then
598 if S2
(S2_Index
) = '"'
599 and then S2_Index
< S2
'Last
600 and then S2
(S2_Index
+ 1) = '"'
602 S2_Index
:= S2_Index
+ 2;
604 S2_Index
:= S2_Index
+ 1;
607 -- If S2 was too short then
609 if S2_Index
> S2
'Last and then S1_Index
< S1
'Last then
615 return S2_Index
= S2
'Last + 1;
616 end Matching_Strings
;
627 or else (Ptr
< Line_Length
628 and then Line_Buffer
(Ptr
.. Ptr
+ 1) /= "--")
630 Error
("extraneous text on preprocessor line ignored");
638 function OK_Identifier
(S
: String) return Boolean is
639 P
: Natural := S
'First;
642 if S
'Length /= 0 and then S
(P
) = Character'Val (39) then -- '''
647 or else not Is_Letter
(S
(P
))
652 while P
<= S
'Last loop
653 if Is_Letter
(S
(P
)) or Is_Digit
(S
(P
)) then
658 and then S
(P
+ 1) /= '_'
677 procedure Parse_Def_File
is
679 Open
(Deffile
, In_File
, Deffile_Name
.all);
681 -- Initialize data for procedure Error
683 Infile
.Line_Num
:= 0;
684 Current_File_Name
:= Deffile_Name
;
686 -- Loop through lines in symbol definitions file
688 while not End_Of_File
(Deffile
) loop
689 Get_Line
(Deffile
, Line_Buffer
, Line_Length
);
690 Infile
.Line_Num
:= Infile
.Line_Num
+ 1;
696 or else (Ptr
< Line_Length
698 Line_Buffer
(Ptr
.. Ptr
+ 1) = "--")
705 if not Symbol_Scanned
then
706 Error
("invalid symbol identifier """ &
707 Line_Buffer
(Start_Sym
.. End_Sym
) &
715 if Ptr
>= Line_Length
716 or else Line_Buffer
(Ptr
.. Ptr
+ 1) /= ":="
718 Error
("missing "":="" in symbol definition line");
725 Num_Syms
:= Num_Syms
+ 1;
726 Symbols
(Num_Syms
) := new String'(Line_Buffer (Start_Sym .. End_Sym));
731 if At_End_Of_Line then
734 elsif Line_Buffer (Start_Sym) = '"' then
735 End_Sym := End_Sym + 1;
737 End_Sym := End_Sym + 1;
739 if End_Sym > Line_Length then
740 Error ("no closing quote
for string constant");
743 elsif End_Sym < Line_Length
744 and then Line_Buffer (End_Sym .. End_Sym + 1) = """"""
746 End_Sym := End_Sym + 1;
748 elsif Line_Buffer (End_Sym) = '"' then
756 while End_Sym < Line_Length
757 and then (Is_Alphanumeric (Line_Buffer (End_Sym + 1))
759 Line_Buffer (End_Sym + 1) = '_
'
761 Line_Buffer (End_Sym + 1) = '.')
763 End_Sym := End_Sym + 1;
768 if not At_End_Of_Line then
769 Error ("incorrect symbol value syntax");
774 Values (Num_Syms) := new String'(Line_Buffer
(Start_Sym
.. End_Sym
));
781 -- Could not open the file
784 Put_Line
(Standard_Error
, "cannot open " & Deffile_Name
.all);
792 function Scan_Keyword
return Keyword
is
793 Kptr
: constant Natural := Ptr
;
799 if Symbol_Scanned
then
801 -- If the symbol was the last thing on the line, End_Sym will
802 -- point too far in Line_Buffer
804 if End_Sym
> Line_Length
then
805 End_Sym
:= Line_Length
;
811 Sym
: constant String := Line_Buffer
(Start_Sym
.. End_Sym
);
814 if Matching_Strings
(Sym
, "not") then
817 elsif Matching_Strings
(Sym
, "then") then
820 elsif Matching_Strings
(Sym
, "if") then
823 elsif Matching_Strings
(Sym
, "else") then
826 elsif Matching_Strings
(Sym
, "end") then
829 elsif Matching_Strings
(Sym
, "elsif") then
832 elsif Matching_Strings
(Sym
, "and") then
833 if Scan_Keyword
= K_Then
then
837 Ptr
:= Start_Sym
; -- Put back the last keyword read
842 elsif Matching_Strings
(Sym
, "or") then
843 if Scan_Keyword
= K_Else
then
847 Ptr
:= Start_Sym
; -- Put back the last keyword read
852 elsif Matching_Strings
(Sym
, "'defined") then
855 elsif Matching_Strings
(Sym
, "include") then
862 return K_Close_Paren
;
878 procedure Skip_Spaces
is
880 while Ptr
<= Line_Length
loop
881 if Line_Buffer
(Ptr
) /= ' '
882 and then Line_Buffer
(Ptr
) /= ASCII
.HT
895 function Symbol_Scanned
return Boolean is
897 End_Sym
:= Start_Sym
- 1;
899 case Line_Buffer
(End_Sym
+ 1) is
901 when '(' |
')' |
'=' =>
902 End_Sym
:= End_Sym
+ 1;
906 End_Sym
:= End_Sym
+ 1;
907 while End_Sym
< Line_Length
loop
909 if Line_Buffer
(End_Sym
+ 1) = '"' then
911 if End_Sym
+ 2 < Line_Length
912 and then Line_Buffer
(End_Sym
+ 2) = '"'
914 End_Sym
:= End_Sym
+ 2;
919 End_Sym
:= End_Sym
+ 1;
923 if End_Sym
>= Line_Length
then
924 Error
("Invalid string ");
925 raise Expression_Error
;
928 End_Sym
:= End_Sym
+ 1;
932 End_Sym
:= End_Sym
+ 1;
938 while End_Sym
< Line_Length
939 and then (Is_Alphanumeric
(Line_Buffer
(End_Sym
+ 1))
940 or else Line_Buffer
(End_Sym
+ 1) = '_')
942 End_Sym
:= End_Sym
+ 1;
945 return OK_Identifier
(Line_Buffer
(Start_Sym
.. End_Sym
));
952 function Variable_Index
(Name
: String) return Natural is
954 for J
in 1 .. Num_Syms
loop
955 if Matching_Strings
(Symbols
(J
).all, Name
) then
963 -- Start of processing for GNATprep
967 -- Parse the switches
970 case GNAT
.Command_Line
.Getopt
("D: b c r s u") is
976 S
: String := GNAT
.Command_Line
.Parameter
;
980 Index
:= Ada
.Strings
.Fixed
.Index
(S
, "=");
983 Num_Syms
:= Num_Syms
+ 1;
984 Symbols
(Num_Syms
) := new String'(S);
985 Values (Num_Syms) := new String'("True");
988 Num_Syms
:= Num_Syms
+ 1;
989 Symbols
(Num_Syms
) := new String'(S (S'First .. Index - 1));
990 Values (Num_Syms) := new String'(S
(Index
+ 1 .. S
'Last));
995 Blank_Deleted_Lines
:= True;
998 Opt_Comment_Deleted_Lines
:= True;
1001 Source_Ref_Pragma
:= True;
1004 List_Symbols
:= True;
1007 Undefined_Is_False
:= True;
1014 -- Get the file names
1018 S
: constant String := GNAT
.Command_Line
.Get_Argument
;
1021 exit when S
'Length = 0;
1023 if Infile
.Name
= null then
1024 Infile
.Name
:= new String'(S);
1025 elsif Outfile_Name = null then
1026 Outfile_Name := new String'(S
);
1027 elsif Deffile_Name
= null then
1028 Deffile_Name
:= new String'(S);
1035 -- Test we had all the arguments needed
1037 if Infile.Name = null
1038 or else Outfile_Name = null
1043 if Source_Ref_Pragma and (not Opt_Comment_Deleted_Lines) then
1044 Blank_Deleted_Lines := True;
1047 -- Get symbol definitions
1049 if Deffile_Name /= null then
1053 if Num_Errors > 0 then
1056 elsif List_Symbols and then Num_Syms > 0 then
1057 List_Symbols_Case : declare
1059 function Lt (Op1, Op2 : Natural) return Boolean;
1060 -- Comparison routine for sort call
1062 procedure Move (From : Natural; To : Natural);
1063 -- Move routine for sort call
1065 function Lt (Op1, Op2 : Natural) return Boolean is
1066 L1 : constant Natural := Symbols (Op1)'Length;
1067 L2 : constant Natural := Symbols (Op2)'Length;
1068 MinL : constant Natural := Natural'Min (L1, L2);
1073 for J in 0 .. MinL - 1 loop
1074 C1 := To_Upper (Symbols (Op1).all (Symbols (Op1)'First + J));
1075 C2 := To_Upper (Symbols (Op2).all (Symbols (Op2)'First + J));
1088 procedure Move (From : Natural; To : Natural) is
1090 Symbols (To) := Symbols (From);
1091 Values (To) := Values (From);
1094 package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
1097 -- Maximum length of any symbol
1099 -- Start of processing for List_Symbols_Case
1102 Sort_Syms.Sort (Num_Syms);
1105 for J in 1 .. Num_Syms loop
1106 Max_L := Natural'Max (Max_L, Symbols (J)'Length);
1112 for J in 1 .. Max_L - 5 loop
1120 for J in 1 .. Max_L - 5 loop
1124 Put_Line ("------");
1126 for J in 1 .. Num_Syms loop
1127 Put (Symbols (J).all);
1129 for K in 1 .. Max_L - Symbols (J)'Length + 1 loop
1133 Put_Line (Values (J).all);
1137 end List_Symbols_Case;
1140 -- Open files and initialize preprocessing
1143 Open (Infile.File, In_File, Infile.Name.all);
1147 Put_Line (Standard_Error, "cannot open " & Infile.Name.all);
1152 Create (Outfile, Out_File, Outfile_Name.all);
1156 Put_Line (Standard_Error, "cannot create " & Outfile_Name.all);
1160 Infile.Line_Num := 0;
1161 Current_File_Name := Infile.Name;
1164 PP (0).Deleting := False;
1166 -- We return here after we start reading an include file and after
1167 -- we have finished reading an include file.
1171 -- If we generate Source_Reference pragmas, then generate one
1172 -- either with line number 1 for a newly included file, or
1173 -- with the number of the next line when we have returned to the
1176 if Source_Ref_Pragma then
1178 (Outfile, "pragma Source_Reference (" &
1179 Image (Infile.Line_Num + 1) &
1180 ", """ & Infile.Name.all & """);");
1183 -- Loop through lines in input file
1185 while not End_Of_File (Infile.File) loop
1186 Get_Line (Infile.File, Line_Buffer, Line_Length);
1187 Infile.Line_Num := Infile.Line_Num + 1;
1189 -- Handle preprocessor line
1191 if Is_Preprocessor_Line then
1199 -- Ignore if Deleting is True
1201 if PP (PP_Depth).Deleting then
1207 if Ptr >= Line_Length then
1208 Error ("no file to include");
1210 elsif Line_Buffer (Ptr) /= '"' then
1212 ("file to include must be specified as a literal
string");
1216 Start_File : constant Positive := Ptr + 1;
1221 while Line_Buffer (Ptr) = ' '
1222 or else Line_Buffer (Ptr) = ASCII.HT
1227 if Ptr <= Start_File
1228 or else Line_Buffer (Ptr) /= '"'
1230 Error ("no string literal for included file");
1233 if Infile.Next = null then
1234 Infile.Next := new Input;
1235 Infile.Next.Prev := Infile;
1238 Infile := Infile.Next;
1240 new String'(Line_Buffer
(Start_File
.. Ptr
- 1));
1242 -- Check for circularity: an file including itself,
1243 -- either directly or indirectly.
1246 File
: Input_Ptr
:= Infile
.Prev
;
1250 and then File
.Name
.all /= Infile
.Name
.all
1255 if File
/= null then
1256 Infile
:= Infile
.Prev
;
1257 Error
("circularity in included files");
1259 while File
.Prev
/= null loop
1263 while File
/= Infile
.Next
loop
1264 Error
('"' & File
.Name
.all &
1266 File
.Next
.Name
.all & '"');
1271 -- We have a file name and no circularity.
1272 -- Open the file and record an error if the
1273 -- file cannot be opened.
1276 Open
(Infile
.File
, In_File
, Infile
.Name
.all);
1277 Current_File_Name
:= Infile
.Name
;
1278 Infile
.Line_Num
:= 0;
1280 -- If we use Source_Reference pragma,
1281 -- we need to output one for this new file.
1287 -- We need to set the input file to
1288 -- the including file, so that the
1289 -- line number is correct when reporting
1292 Infile
:= Infile
.Prev
;
1293 Error
("cannot open """ &
1294 Infile
.Next
.Name
.all & '"');
1302 -- If/Elsif processing
1304 when K_If | K_Elsif
=>
1306 -- If differs from elsif only in that an initial stack entry
1307 -- must be made for the new if range. We set the match seen
1308 -- entry to a copy of the deleting status in the range above
1309 -- us. If we are deleting in the range above us, then we want
1310 -- all the branches of the nested #if to delete.
1313 PP_Depth
:= PP_Depth
+ 1;
1315 (If_Line
=> Infile
.Line_Num
,
1316 If_Name
=> Infile
.Name
,
1319 Match_Seen
=> PP
(PP_Depth
- 1).Deleting
);
1321 elsif PP_Depth
= 0 then
1322 Error
("no matching #if for this #elsif");
1327 PP
(PP_Depth
).Deleting
:= True;
1329 if not PP
(PP_Depth
).Match_Seen
1330 and then Eval_Condition
= True
1333 -- Case of match and no match yet in this #if
1335 PP
(PP_Depth
).Deleting
:= False;
1336 PP
(PP_Depth
).Match_Seen
:= True;
1340 -- Processing for #else
1344 if PP_Depth
= 0 then
1345 Error
("no matching #if for this #else");
1347 elsif PP
(PP_Depth
).Else_Line
/= 0 then
1348 Error
("duplicate #else line (previous was on line" &
1349 Natural'Image (PP
(PP_Depth
).Else_Line
) &
1353 PP
(PP_Depth
).Else_Line
:= Infile
.Line_Num
;
1354 PP
(PP_Depth
).Deleting
:= PP
(PP_Depth
).Match_Seen
;
1363 if PP_Depth
= 0 then
1364 Error
("no matching #if for this #end");
1369 if Scan_Keyword
/= K_If
then
1370 Error
("expected if after #end");
1371 Ptr
:= Line_Length
+ 1;
1376 if Ptr
> Line_Length
1377 or else Line_Buffer
(Ptr
) /= ';'
1379 Error
("missing semicolon after #end if");
1386 PP_Depth
:= PP_Depth
- 1;
1390 Error
("invalid preprocessor keyword syntax");
1394 -- Handle symbol substitution
1396 -- Substitution is not allowed in string (which we simply skip),
1397 -- but is allowed inside character constants. The last case is
1398 -- because there is no way to know whether the user want to
1399 -- substitute the name of an attribute ('Min or 'Max for instance)
1400 -- or actually meant to substitue a character ('$name' is probably
1401 -- a character constant, but my_type'$name'Min is probably an
1402 -- attribute, with $name=Base)
1407 while Ptr
< Line_Length
loop
1408 exit when At_End_Of_Line
;
1410 case Line_Buffer
(Ptr
) is
1414 -- Two special cases here:
1415 -- '"' => we don't want the " sign to appear as belonging
1417 -- '$' => this is obviously not a substitution, just skip it
1419 if Ptr
< Line_Length
- 1
1420 and then Line_Buffer
(Ptr
+ 1) = '"'
1423 elsif Ptr
< Line_Length
- 2
1424 and then Line_Buffer
(Ptr
+ 1 .. Ptr
+ 2) = "$'"
1431 -- The special case of "" inside the string is easy to
1432 -- handle: just ignore them. The second one will be seen
1433 -- as the beginning of a second string
1436 while Ptr
< Line_Length
1437 and then Line_Buffer
(Ptr
) /= '"'
1444 -- $ found, so scan out possible following symbol
1446 Start_Sym
:= Ptr
+ 1;
1448 if Symbol_Scanned
then
1450 -- Look up symbol in table and if found do replacement
1452 for J
in 1 .. Num_Syms
loop
1454 (Symbols
(J
).all, Line_Buffer
(Start_Sym
.. End_Sym
))
1457 OldL
: constant Positive :=
1458 End_Sym
- Start_Sym
+ 2;
1459 NewL
: constant Positive := Values
(J
)'Length;
1460 AdjL
: constant Integer := NewL
- OldL
;
1461 NewP
: constant Positive := Ptr
+ NewL
- 1;
1464 Line_Buffer
(NewP
+ 1 .. Line_Length
+ AdjL
) :=
1465 Line_Buffer
(End_Sym
+ 1 .. Line_Length
);
1466 Line_Buffer
(Ptr
.. NewP
) := Values
(J
).all;
1469 Line_Length
:= Line_Length
+ AdjL
;
1485 -- Here after dealing with preprocessor line, output current line
1489 if Is_Preprocessor_Line
or else PP
(PP_Depth
).Deleting
then
1490 if Blank_Deleted_Lines
then
1493 elsif Opt_Comment_Deleted_Lines
then
1494 if Line_Length
= 0 then
1495 Put_Line
(Outfile
, "--!");
1497 Put
(Outfile
, "--! ");
1498 Put_Line
(Outfile
, Line_Buffer
(1 .. Line_Length
));
1503 Put_Line
(Outfile
, Line_Buffer
(1 .. Line_Length
));
1507 -- If we have finished reading an included file, close it and continue
1508 -- with the next line of the including file.
1510 if Infile
.Prev
/= null then
1511 Close
(Infile
.File
);
1512 Infile
:= Infile
.Prev
;
1513 Current_File_Name
:= Infile
.Name
;
1517 for J
in 1 .. PP_Depth
loop
1518 if PP
(J
).If_Name
= Infile
.Name
then
1519 Error
("no matching #end for #if at line" &
1520 Natural'Image (PP
(J
).If_Line
));
1522 Error
("no matching #end for #if at line" &
1523 Natural'Image (PP
(J
).If_Line
) &
1524 " of file """ & PP
(J
).If_Name
.all & '"');
1528 if Num_Errors
= 0 then
1530 Set_Exit_Status
(0);
1533 Set_Exit_Status
(1);
1539 Set_Exit_Status
(1);
1541 when GNAT
.Command_Line
.Invalid_Parameter
=>
1542 Put_Line
(Standard_Error
, "No parameter given for -"
1543 & GNAT
.Command_Line
.Full_Switch
);
1545 Set_Exit_Status
(1);
1547 when GNAT
.Command_Line
.Invalid_Switch
=>
1548 Put_Line
(Standard_Error
, "Invalid Switch: -"
1549 & GNAT
.Command_Line
.Full_Switch
);
1551 Set_Exit_Status
(1);
1554 Set_Exit_Status
(1);
1556 when Expression_Error
=>
1557 Set_Exit_Status
(1);