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);