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 -- Extensive contributions were provided by Ada Core Technologies Inc. --
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);