?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
c++/modules: Improve diagnostic when redeclaring builtin in module [PR102345]
[official-gcc.git] / gcc / ada / sinput-l.adb
blob1805cb46409b9de146ba9b133118e3dc84d82dca
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S I N P U T . L --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2024, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 with Alloc;
27 with Atree; use Atree;
28 with Debug; use Debug;
29 with Einfo; use Einfo;
30 with Einfo.Entities; use Einfo.Entities;
31 with Einfo.Utils; use Einfo.Utils;
32 with Errout; use Errout;
33 with Fname; use Fname;
34 with Lib; use Lib;
35 with Opt; use Opt;
36 with Osint; use Osint;
37 with Output; use Output;
38 with Prep; use Prep;
39 with Prepcomp; use Prepcomp;
40 with Scans; use Scans;
41 with Scn; use Scn;
42 with Sem_Aux; use Sem_Aux;
43 with Sem_Util; use Sem_Util;
44 with Sinfo; use Sinfo;
45 with Sinfo.Nodes; use Sinfo.Nodes;
46 with Snames; use Snames;
47 with System; use System;
48
49 with System.OS_Lib; use System.OS_Lib;
50
51 package body Sinput.L is
52
53 Prep_Buffer : Text_Buffer_Ptr := null;
54 -- A buffer to temporarily stored the result of preprocessing a source.
55 -- It is only allocated if there is at least one source to preprocess.
56
57 Prep_Buffer_Last : Text_Ptr := 0;
58 -- Index of the last significant character in Prep_Buffer
59
60 Initial_Size_Of_Prep_Buffer : constant := 10_000;
61 -- Size of Prep_Buffer when it is first allocated
62
63 -- When a file is to be preprocessed and the options to list symbols
64 -- has been selected (switch -s), Prep.List_Symbols is called with a
65 -- "foreword", a single line indicating what source the symbols apply to.
66 -- The following two constant String are the start and the end of this
67 -- foreword.
68
69 Foreword_Start : constant String :=
70 "Preprocessing Symbols for source """;
71
72 Foreword_End : constant String := """";
73
74 -----------------
75 -- Subprograms --
76 -----------------
77
78 procedure Put_Char_In_Prep_Buffer (C : Character);
79 -- Add one character in Prep_Buffer, extending Prep_Buffer if need be.
80 -- Used to initialize the preprocessor.
81
82 procedure New_EOL_In_Prep_Buffer;
83 -- Add an LF to Prep_Buffer (used to initialize the preprocessor)
84
85 function Load_File
86 (N : File_Name_Type;
87 T : Osint.File_Type) return Source_File_Index;
88 -- Load a source file, a configuration pragmas file or a definition file
89 -- Coding also allows preprocessing file, but not a library file ???
90
91 -------------------------------
92 -- Adjust_Instantiation_Sloc --
93 -------------------------------
94
95 procedure Adjust_Instantiation_Sloc
96 (N : Node_Id;
97 Factor : Sloc_Adjustment)
98 is
99 Loc : constant Source_Ptr := Sloc (N);
100
101 begin
102 -- We only do the adjustment if the value is between the appropriate low
103 -- and high values. It is not clear that this should ever not be the
104 -- case, but in practice there seem to be some nodes that get copied
105 -- twice, and this is a defence against that happening.
106
107 if Loc in Factor.Lo .. Factor.Hi then
108 Set_Sloc (N, Loc + Factor.Adjust);
109 end if;
110 end Adjust_Instantiation_Sloc;
111
112 --------------------------------
113 -- Complete_Source_File_Entry --
114 --------------------------------
115
116 procedure Complete_Source_File_Entry is
117 CSF : constant Source_File_Index := Current_Source_File;
118 begin
119 Trim_Lines_Table (CSF);
120 Source_File.Table (CSF).Source_Checksum := Checksum;
121 end Complete_Source_File_Entry;
122
123 ---------------------------------
124 -- Create_Instantiation_Source --
125 ---------------------------------
126
127 procedure Create_Instantiation_Source
128 (Inst_Node : Entity_Id;
129 Template_Id : Entity_Id;
130 Factor : out Sloc_Adjustment;
131 Inlined_Body : Boolean := False;
132 Inherited_Pragma : Boolean := False)
133 is
134 Dnod : constant Node_Id := Declaration_Node (Template_Id);
135 Xold : Source_File_Index;
136 Xnew : Source_File_Index;
137
138 begin
139 Xold := Get_Source_File_Index (Sloc (Template_Id));
140 Factor.Lo := Source_File.Table (Xold).Source_First;
141 Factor.Hi := Source_File.Table (Xold).Source_Last;
142
143 Source_File.Append (Source_File.Table (Xold));
144 Xnew := Source_File.Last;
145
146 if Debug_Flag_L then
147 Write_Eol;
148 Write_Str ("*** Create_Instantiation_Source: created source ");
149 Write_Int (Int (Xnew));
150 Write_Line ("");
151 end if;
152
153 declare
154 Sold : Source_File_Record renames Source_File.Table (Xold);
155 Snew : Source_File_Record renames Source_File.Table (Xnew);
156
157 Inst_Spec : Node_Id;
158
159 begin
160 Snew.Index := Xnew;
161 Snew.Inlined_Body := Inlined_Body;
162 Snew.Inherited_Pragma := Inherited_Pragma;
163 Snew.Template := Xold;
164
165 -- For a genuine generic instantiation, assign new instance id. For
166 -- inlined bodies or inherited pragmas, we retain that of the
167 -- template, but we save the call location.
168
169 if Inlined_Body or Inherited_Pragma then
170 Snew.Inlined_Call := Sloc (Inst_Node);
171
172 else
173 -- If the spec has been instantiated already, and we are now
174 -- creating the instance source for the corresponding body now,
175 -- retrieve the instance id that was assigned to the spec, which
176 -- corresponds to the same instantiation sloc.
177
178 Inst_Spec := Instance_Spec (Inst_Node);
179 if Present (Inst_Spec) then
180 declare
181 Inst_Spec_Ent : Entity_Id;
182 -- Instance spec entity
183
184 Inst_Spec_Sloc : Source_Ptr;
185 -- Virtual sloc of the spec instance source
186
187 Inst_Spec_Inst_Id : Instance_Id;
188 -- Instance id assigned to the instance spec
189
190 begin
191 Inst_Spec_Ent := Defining_Entity (Inst_Spec);
192
193 -- For a subprogram instantiation, we want the subprogram
194 -- instance, not the wrapper package.
195
196 if Present (Related_Instance (Inst_Spec_Ent)) then
197 Inst_Spec_Ent := Related_Instance (Inst_Spec_Ent);
198 end if;
199
200 -- The specification of the instance entity has a virtual
201 -- sloc within the instance sloc range.
202
203 -- ??? But the Unit_Declaration_Node has the sloc of the
204 -- instantiation, which is somewhat of an oddity.
205
206 Inst_Spec_Sloc :=
207 Sloc
208 (Specification (Unit_Declaration_Node (Inst_Spec_Ent)));
209 Inst_Spec_Inst_Id :=
210 Source_File.Table
211 (Get_Source_File_Index (Inst_Spec_Sloc)).Instance;
212
213 pragma Assert
214 (Sloc (Inst_Node) = Instances.Table (Inst_Spec_Inst_Id));
215 Snew.Instance := Inst_Spec_Inst_Id;
216 end;
217
218 else
219 Instances.Append (Sloc (Inst_Node));
220 Snew.Instance := Instances.Last;
221 end if;
222 end if;
223
224 -- Now compute the new values of Source_First and Source_Last and
225 -- adjust the source file pointer to have the correct bounds for the
226 -- new range of values.
227
228 -- Source_First must be greater than the last Source_Last value and
229 -- also must be a multiple of Source_Align.
230
231 Snew.Source_First :=
232 ((Source_File.Table (Xnew - 1).Source_Last + Source_Align) /
233 Source_Align) * Source_Align;
234 Factor.Adjust := Snew.Source_First - Factor.Lo;
235 Snew.Source_Last := Factor.Hi + Factor.Adjust;
236
237 Set_Source_File_Index_Table (Xnew);
238
239 Snew.Sloc_Adjust := Sold.Sloc_Adjust - Factor.Adjust;
240
241 -- Modify the Dope of the instance Source_Text to use the
242 -- above-computed bounds.
243
244 declare
245 Dope : constant Dope_Ptr :=
246 new Dope_Rec'(Snew.Source_First, Snew.Source_Last);
247 begin
248 Snew.Source_Text := Sold.Source_Text;
249 Set_Dope (Snew.Source_Text'Address, Dope);
250 pragma Assert (Snew.Source_Text'First = Snew.Source_First);
251 pragma Assert (Snew.Source_Text'Last = Snew.Source_Last);
252 end;
253
254 if Debug_Flag_L then
255 Write_Str (" for ");
256
257 if Nkind (Dnod) in N_Proper_Body
258 and then Was_Originally_Stub (Dnod)
259 then
260 Write_Str ("subunit ");
261
262 elsif Ekind (Template_Id) = E_Generic_Package then
263 if Nkind (Dnod) = N_Package_Body then
264 Write_Str ("body of package ");
265 else
266 Write_Str ("spec of package ");
267 end if;
268
269 elsif Ekind (Template_Id) = E_Function then
270 Write_Str ("body of function ");
271
272 elsif Ekind (Template_Id) = E_Procedure then
273 Write_Str ("body of procedure ");
274
275 elsif Ekind (Template_Id) = E_Generic_Function then
276 Write_Str ("spec of function ");
277
278 elsif Ekind (Template_Id) = E_Generic_Procedure then
279 Write_Str ("spec of procedure ");
280
281 elsif Ekind (Template_Id) = E_Package_Body then
282 Write_Str ("body of package ");
283
284 else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
285 if Nkind (Dnod) = N_Procedure_Specification then
286 Write_Str ("body of procedure ");
287 else
288 Write_Str ("body of function ");
289 end if;
290 end if;
291
292 Write_Name (Chars (Template_Id));
293 Write_Eol;
294
295 Write_Str (" copying from file name = ");
296 Write_Name (File_Name (Xold));
297 Write_Eol;
298
299 Write_Str (" old source index = ");
300 Write_Int (Int (Xold));
301 Write_Eol;
302
303 Write_Str (" old lo = ");
304 Write_Int (Int (Factor.Lo));
305 Write_Eol;
306
307 Write_Str (" old hi = ");
308 Write_Int (Int (Factor.Hi));
309 Write_Eol;
310
311 Write_Str (" new lo = ");
312 Write_Int (Int (Snew.Source_First));
313 Write_Eol;
314
315 Write_Str (" new hi = ");
316 Write_Int (Int (Snew.Source_Last));
317 Write_Eol;
318
319 Write_Str (" adjustment factor = ");
320 Write_Int (Int (Factor.Adjust));
321 Write_Eol;
322
323 Write_Str (" instantiation location: ");
324 Write_Location (Sloc (Inst_Node));
325 Write_Eol;
326 end if;
327 end;
328 end Create_Instantiation_Source;
329
330 ----------------------
331 -- Load_Config_File --
332 ----------------------
333
334 function Load_Config_File
335 (N : File_Name_Type) return Source_File_Index
336 is
337 begin
338 return Load_File (N, Osint.Config);
339 end Load_Config_File;
340
341 --------------------------
342 -- Load_Definition_File --
343 --------------------------
344
345 function Load_Definition_File
346 (N : File_Name_Type) return Source_File_Index
347 is
348 begin
349 return Load_File (N, Osint.Definition);
350 end Load_Definition_File;
351
352 ---------------
353 -- Load_File --
354 ---------------
355
356 function Load_File
357 (N : File_Name_Type;
358 T : Osint.File_Type) return Source_File_Index
359 is
360 FD : File_Descriptor;
361 Hi : Source_Ptr;
362 Lo : Source_Ptr;
363 Src : Source_Buffer_Ptr;
364 X : Source_File_Index;
365
366 Preprocessing_Needed : Boolean := False;
367
368 begin
369 -- If already there, don't need to reload file. An exception occurs
370 -- in multiple unit per file mode. It would be nice in this case to
371 -- share the same source file for each unit, but this leads to many
372 -- difficulties with assumptions (e.g. in the body of lib), that a
373 -- unit can be found by locating its source file index. Since we do
374 -- not expect much use of this mode, it's no big deal to waste a bit
375 -- of space and time by reading and storing the source multiple times.
376
377 if Multiple_Unit_Index = 0 then
378 for J in 1 .. Source_File.Last loop
379 if Source_File.Table (J).File_Name = N then
380 return J;
381 end if;
382 end loop;
383 end if;
384
385 -- Here we must build a new entry in the file table
386
387 -- But first, we must check if a source needs to be preprocessed,
388 -- because we may have to load and parse a definition file, and we want
389 -- to do that before we load the source, so that the buffer of the
390 -- source will be the last created, and we will be able to replace it
391 -- and modify Hi without stepping on another buffer.
392
393 if T = Osint.Source and then not Is_Internal_File_Name (N) then
394 Prepare_To_Preprocess
395 (Source => N, Preprocessing_Needed => Preprocessing_Needed);
396 end if;
397
398 Source_File.Increment_Last;
399 X := Source_File.Last;
400
401 if Debug_Flag_L then
402 Write_Eol;
403 Write_Str ("Sinput.L.Load_File: created source ");
404 Write_Int (Int (X));
405 Write_Str (" for ");
406 Write_Str (Get_Name_String (N));
407 end if;
408
409 -- Compute starting index, respecting alignment requirement
410
411 if X = Source_File.First then
412 Lo := First_Source_Ptr;
413 else
414 Lo := ((Source_File.Table (X - 1).Source_Last + Source_Align) /
415 Source_Align) * Source_Align;
416 end if;
417
418 Osint.Read_Source_File (N, Lo, Hi, Src, FD, T);
419
420 if Null_Source_Buffer_Ptr (Src) then
421 Source_File.Decrement_Last;
422
423 if FD = Osint.Null_FD then
424 return No_Source_File;
425 else
426 return No_Access_To_Source_File;
427 end if;
428 else
429 if Debug_Flag_L then
430 Write_Eol;
431 Write_Str ("*** Build source file table entry, Index = ");
432 Write_Int (Int (X));
433 Write_Str (", file name = ");
434 Write_Name (N);
435 Write_Eol;
436 Write_Str (" lo = ");
437 Write_Int (Int (Lo));
438 Write_Eol;
439 Write_Str (" hi = ");
440 Write_Int (Int (Hi));
441 Write_Eol;
442
443 Write_Str (" first 10 chars -->");
444
445 declare
446 procedure Wchar (C : Character);
447 -- Writes character or ? for control character
448
449 -----------
450 -- Wchar --
451 -----------
452
453 procedure Wchar (C : Character) is
454 begin
455 if C < ' '
456 or else C in ASCII.DEL .. Character'Val (16#9F#)
457 then
458 Write_Char ('?');
459 else
460 Write_Char (C);
461 end if;
462 end Wchar;
463
464 begin
465 for J in Lo .. Lo + 9 loop
466 Wchar (Src (J));
467 end loop;
468
469 Write_Str ("<--");
470 Write_Eol;
471
472 Write_Str (" last 10 chars -->");
473
474 for J in Hi - 10 .. Hi - 1 loop
475 Wchar (Src (J));
476 end loop;
477
478 Write_Str ("<--");
479 Write_Eol;
480
481 if Src (Hi) /= EOF then
482 Write_Str (" error: no EOF at end");
483 Write_Eol;
484 end if;
485 end;
486 end if;
487
488 declare
489 S : Source_File_Record renames Source_File.Table (X);
490 File_Type : Type_Of_File;
491
492 begin
493 case T is
494 when Osint.Source =>
495 File_Type := Sinput.Src;
496
497 when Osint.Library =>
498 raise Program_Error;
499
500 when Osint.Config =>
501 File_Type := Sinput.Config;
502
503 when Osint.Definition =>
504 File_Type := Def;
505
506 when Osint.Preprocessing_Data =>
507 File_Type := Preproc;
508 end case;
509
510 S := (Debug_Source_Name => N,
511 File_Name => N,
512 File_Type => File_Type,
513 First_Mapped_Line => No_Line_Number,
514 Full_Debug_Name => Osint.Full_Source_Name,
515 Full_File_Name => Osint.Full_Source_Name,
516 Full_Ref_Name => Osint.Full_Source_Name,
517 Instance => No_Instance_Id,
518 Identifier_Casing => Unknown,
519 Inlined_Call => No_Location,
520 Inlined_Body => False,
521 Inherited_Pragma => False,
522 Keyword_Casing => Unknown,
523 Last_Source_Line => 1,
524 License => Unknown,
525 Lines_Table => null,
526 Lines_Table_Max => 1,
527 Logical_Lines_Table => null,
528 Num_SRef_Pragmas => 0,
529 Reference_Name => N,
530 Sloc_Adjust => 0,
531 Source_Checksum => 0,
532 Source_First => Lo,
533 Source_Last => Hi,
534 Source_Text => Src,
535 Template => No_Source_File,
536 Unit => No_Unit,
537 Time_Stamp => Osint.Current_Source_File_Stamp,
538 Index => X);
539
540 Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
541 S.Lines_Table (1) := Lo;
542 end;
543
544 -- Preprocess the source if it needs to be preprocessed
545
546 if Preprocessing_Needed then
547
548 -- Temporarily set the Source_File_Index_Table entries for the
549 -- source, to avoid crash when reporting an error.
550
551 Set_Source_File_Index_Table (X);
552
553 if Opt.List_Preprocessing_Symbols then
554 declare
555 Foreword : constant String :=
556 Foreword_Start & Get_Name_String (N) & Foreword_End;
557 begin
558 Prep.List_Symbols (Foreword);
559 end;
560 end if;
561
562 declare
563 T : constant Nat := Total_Errors_Detected;
564 -- Used to check if there were errors during preprocessing
565
566 Save_Style_Check : Boolean;
567 -- Saved state of the Style_Check flag (which needs to be
568 -- temporarily set to False during preprocessing, see below).
569
570 Modified : Boolean;
571
572 begin
573 -- If this is the first time we preprocess a source, allocate
574 -- the preprocessing buffer.
575
576 if Prep_Buffer = null then
577 Prep_Buffer :=
578 new Text_Buffer (1 .. Initial_Size_Of_Prep_Buffer);
579 end if;
580
581 -- Make sure the preprocessing buffer is empty
582
583 Prep_Buffer_Last := 0;
584
585 -- Initialize the preprocessor hooks
586
587 Prep.Setup_Hooks
588 (Error_Msg => Errout.Error_Msg'Access,
589 Scan => Scn.Scanner.Scan'Access,
590 Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
591 Put_Char => Put_Char_In_Prep_Buffer'Access,
592 New_EOL => New_EOL_In_Prep_Buffer'Access);
593
594 -- Initialize scanner and set its behavior for preprocessing,
595 -- then preprocess. Also disable style checks, since some of
596 -- them are done in the scanner (specifically, those dealing
597 -- with line length and line termination), and cannot be done
598 -- during preprocessing (because the source file index table
599 -- has not been set yet).
600
601 Scn.Scanner.Initialize_Scanner (X);
602
603 Scn.Scanner.Set_Special_Character ('#');
604 Scn.Scanner.Set_Special_Character ('$');
605 Scn.Scanner.Set_End_Of_Line_As_Token (True);
606 Save_Style_Check := Opt.Style_Check;
607 Opt.Style_Check := False;
608
609 -- The actual preprocessing step
610
611 Preprocess (Modified);
612
613 -- Reset the scanner to its standard behavior, and restore the
614 -- Style_Checks flag.
615
616 Scn.Scanner.Reset_Special_Characters;
617 Scn.Scanner.Set_End_Of_Line_As_Token (False);
618 Opt.Style_Check := Save_Style_Check;
619
620 -- If there were errors during preprocessing, record an error
621 -- at the start of the file, and do not change the source
622 -- buffer.
623
624 if T /= Total_Errors_Detected then
625 Errout.Error_Msg
626 ("file could not be successfully preprocessed", Lo);
627 return No_Source_File;
628
629 else
630 -- Output the result of the preprocessing, if requested and
631 -- the source has been modified by the preprocessing. Only
632 -- do that for the main unit (spec, body and subunits).
633
634 if Generate_Processed_File
635 and then Modified
636 and then
637 ((Compiler_State = Parsing
638 and then Parsing_Main_Extended_Source)
639 or else
640 (Compiler_State = Analyzing
641 and then Analysing_Subunit_Of_Main))
642 then
643 declare
644 FD : File_Descriptor;
645 NB : Integer;
646 Status : Boolean;
647
648 Prep_Filename : constant String :=
649 Get_Name_String (N) & Prep_Suffix;
650
651 begin
652 Delete_File (Prep_Filename, Status);
653
654 FD := Create_New_File (Prep_Filename, Text);
655
656 Status := FD /= Invalid_FD;
657
658 if Status then
659 NB :=
660 Write
661 (FD,
662 Prep_Buffer (1)'Address,
663 Integer (Prep_Buffer_Last));
664 Status := NB = Integer (Prep_Buffer_Last);
665 end if;
666
667 if Status then
668 Close (FD, Status);
669 end if;
670
671 if not Status then
672 Errout.Error_Msg
673 ("??could not write processed file """ &
674 Name_Buffer (1 .. Name_Len) & '"',
675 Lo);
676 end if;
677 end;
678 end if;
679
680 -- Set the new value of Hi
681
682 Hi := Lo + Source_Ptr (Prep_Buffer_Last);
683
684 -- Create the new source buffer
685
686 declare
687 Var_Ptr : constant Source_Buffer_Ptr_Var :=
688 new Source_Buffer (Lo .. Hi);
689 -- Allocate source buffer, allowing extra character at
690 -- end for EOF.
691
692 begin
693 Var_Ptr (Lo .. Hi - 1) :=
694 Prep_Buffer (1 .. Prep_Buffer_Last);
695 Var_Ptr (Hi) := EOF;
696 Src := Var_Ptr.all'Access;
697 end;
698
699 -- Record in the table the new source buffer and the
700 -- new value of Hi.
701
702 Source_File.Table (X).Source_Text := Src;
703 Source_File.Table (X).Source_Last := Hi;
704
705 -- Reset Last_Line to 1, because the lines do not
706 -- have necessarily the same starts and lengths.
707
708 Source_File.Table (X).Last_Source_Line := 1;
709 end if;
710 end;
711 end if;
712
713 Set_Source_File_Index_Table (X);
714 return X;
715 end if;
716 end Load_File;
717
718 ----------------------------------
719 -- Load_Preprocessing_Data_File --
720 ----------------------------------
721
722 function Load_Preprocessing_Data_File
723 (N : File_Name_Type) return Source_File_Index
724 is
725 begin
726 return Load_File (N, Osint.Preprocessing_Data);
727 end Load_Preprocessing_Data_File;
728
729 ----------------------
730 -- Load_Source_File --
731 ----------------------
732
733 function Load_Source_File
734 (N : File_Name_Type) return Source_File_Index
735 is
736 begin
737 return Load_File (N, Osint.Source);
738 end Load_Source_File;
739
740 ----------------------------
741 -- New_EOL_In_Prep_Buffer --
742 ----------------------------
743
744 procedure New_EOL_In_Prep_Buffer is
745 begin
746 Put_Char_In_Prep_Buffer (ASCII.LF);
747 end New_EOL_In_Prep_Buffer;
748
749 -----------------------------
750 -- Put_Char_In_Prep_Buffer --
751 -----------------------------
752
753 procedure Put_Char_In_Prep_Buffer (C : Character) is
754 begin
755 -- If preprocessing buffer is not large enough, double it
756
757 if Prep_Buffer_Last = Prep_Buffer'Last then
758 declare
759 New_Prep_Buffer : constant Text_Buffer_Ptr :=
760 new Text_Buffer (1 .. 2 * Prep_Buffer_Last);
761
762 begin
763 New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all;
764 Free (Prep_Buffer);
765 Prep_Buffer := New_Prep_Buffer;
766 end;
767 end if;
768
769 Prep_Buffer_Last := Prep_Buffer_Last + 1;
770 Prep_Buffer (Prep_Buffer_Last) := C;
771 end Put_Char_In_Prep_Buffer;
772
773 -------------------------
774 -- Source_File_Is_Body --
775 -------------------------
776
777 function Source_File_Is_Body (X : Source_File_Index) return Boolean is
778 Pcount : Natural;
779
780 begin
781 Initialize_Scanner (No_Unit, X);
782
783 -- Loop to look for subprogram or package body
784
785 loop
786 case Token is
787
788 -- PRAGMA, WITH, USE (which can appear before a body)
789
790 when Tok_Pragma
791 | Tok_Use
792 | Tok_With
793 =>
794 -- We just want to skip any of these, do it by skipping to a
795 -- semicolon, but check for EOF, in case we have bad syntax.
796
797 loop
798 if Token = Tok_Semicolon then
799 Scan;
800 exit;
801 elsif Token = Tok_EOF then
802 return False;
803 else
804 Scan;
805 end if;
806 end loop;
807
808 -- PACKAGE
809
810 when Tok_Package =>
811 Scan; -- Past PACKAGE
812
813 -- We have a body if and only if BODY follows
814
815 return Token = Tok_Body;
816
817 -- FUNCTION or PROCEDURE
818
819 when Tok_Function
820 | Tok_Procedure
821 =>
822 Pcount := 0;
823
824 -- Loop through tokens following PROCEDURE or FUNCTION
825
826 loop
827 Scan;
828
829 case Token is
830
831 -- For parens, count paren level (note that paren level
832 -- can get greater than 1 if we have default parameters).
833
834 when Tok_Left_Paren =>
835 Pcount := Pcount + 1;
836
837 when Tok_Right_Paren =>
838 Pcount := Pcount - 1;
839
840 -- EOF means something weird, probably no body
841
842 when Tok_EOF =>
843 return False;
844
845 -- BEGIN or IS or END definitely means body is present
846
847 when Tok_Begin
848 | Tok_End
849 | Tok_Is
850 =>
851 return True;
852
853 -- Semicolon means no body present if at outside any
854 -- parens. If within parens, ignore, since it could be
855 -- a parameter separator.
856
857 when Tok_Semicolon =>
858 if Pcount = 0 then
859 return False;
860 end if;
861
862 -- Skip anything else
863
864 when others =>
865 null;
866 end case;
867 end loop;
868
869 -- Anything else in main scan means we don't have a body
870
871 when others =>
872 return False;
873 end case;
874 end loop;
875 end Source_File_Is_Body;
876
877 ----------------------------
878 -- Source_File_Is_No_Body --
879 ----------------------------
880
881 function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is
882 begin
883 Initialize_Scanner (No_Unit, X);
884
885 if Token /= Tok_Pragma then
886 return False;
887 end if;
888
889 Scan; -- past pragma
890
891 if Token /= Tok_Identifier
892 or else Chars (Token_Node) /= Name_No_Body
893 then
894 return False;
895 end if;
896
897 Scan; -- past No_Body
898
899 if Token /= Tok_Semicolon then
900 return False;
901 end if;
902
903 Scan; -- past semicolon
904
905 return Token = Tok_EOF;
906 end Source_File_Is_No_Body;
907
908 end Sinput.L;
Mirror of the offical gcc git repository hosted at gcc.gnu.org