Bug Summary

File:build/gcc/fortran/scanner.c
Warning:line 957, column 4
Value stored to 'c' is never read

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-unknown-linux-gnu -analyze -disable-free -disable-llvm-verifier -discard-value-names -main-file-name scanner.c -analyzer-store=region -analyzer-opt-analyze-nested-blocks -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model static -mframe-pointer=none -fmath-errno -fno-rounding-math -mconstructor-aliases -munwind-tables -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -resource-dir /usr/lib64/clang/13.0.0 -D IN_GCC_FRONTEND -D IN_GCC -D HAVE_CONFIG_H -I . -I fortran -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../include -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcpp/include -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcody -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber/bid -I ../libdecnumber -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libbacktrace -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/11/../../../../include/c++/11 -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/11/../../../../include/c++/11/x86_64-suse-linux -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/11/../../../../include/c++/11/backward -internal-isystem /usr/lib64/clang/13.0.0/include -internal-isystem /usr/local/include -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/11/../../../../x86_64-suse-linux/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -Wno-narrowing -Wwrite-strings -Wno-error=format-diag -Wno-long-long -Wno-variadic-macros -Wno-overlength-strings -fdeprecated-macro -fdebug-compilation-dir=/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -ferror-limit 19 -fno-rtti -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -analyzer-output=plist-html -analyzer-config silence-checkers=core.NullDereference -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/clang-static-analyzer/2021-11-20-133755-20252-1/report-oPnusD.plist -x c++ /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/scanner.c
1/* Character scanner.
2 Copyright (C) 2000-2021 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
20
21/* Set of subroutines to (ultimately) return the next character to the
22 various matching subroutines. This file's job is to read files and
23 build up lines that are parsed by the parser. This means that we
24 handle continuation lines and "include" lines.
25
26 The first thing the scanner does is to load an entire file into
27 memory. We load the entire file into memory for a couple reasons.
28 The first is that we want to be able to deal with nonseekable input
29 (pipes, stdin) and there is a lot of backing up involved during
30 parsing.
31
32 The second is that we want to be able to print the locus of errors,
33 and an error on line 999999 could conflict with something on line
34 one. Given nonseekable input, we've got to store the whole thing.
35
36 One thing that helps are the column truncation limits that give us
37 an upper bound on the size of individual lines. We don't store the
38 truncated stuff.
39
40 From the scanner's viewpoint, the higher level subroutines ask for
41 new characters and do a lot of jumping backwards. */
42
43#include "config.h"
44#include "system.h"
45#include "coretypes.h"
46#include "gfortran.h"
47#include "toplev.h" /* For set_src_pwd. */
48#include "debug.h"
49#include "options.h"
50#include "diagnostic-core.h" /* For fatal_error. */
51#include "cpp.h"
52#include "scanner.h"
53
54/* List of include file search directories. */
55gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
56
57static gfc_file *file_head, *current_file;
58
59static int continue_flag, end_flag, gcc_attribute_flag;
60/* If !$omp/!$acc occurred in current comment line. */
61static int openmp_flag, openacc_flag;
62static int continue_count, continue_line;
63static locus openmp_locus;
64static locus openacc_locus;
65static locus gcc_attribute_locus;
66
67gfc_source_form gfc_current_form;
68static gfc_linebuf *line_head, *line_tail;
69
70locus gfc_current_locus;
71const char *gfc_source_file;
72static FILE *gfc_src_file;
73static gfc_char_t *gfc_src_preprocessor_lines[2];
74
75static struct gfc_file_change
76{
77 const char *filename;
78 gfc_linebuf *lb;
79 int line;
80} *file_changes;
81static size_t file_changes_cur, file_changes_count;
82static size_t file_changes_allocated;
83
84static gfc_char_t *last_error_char;
85
86/* Functions dealing with our wide characters (gfc_char_t) and
87 sequences of such characters. */
88
89int
90gfc_wide_fits_in_byte (gfc_char_t c)
91{
92 return (c <= UCHAR_MAX(127*2 +1));
93}
94
95static inline int
96wide_is_ascii (gfc_char_t c)
97{
98 return (gfc_wide_fits_in_byte (c) && ((unsigned char) c & ~0x7f) == 0);
99}
100
101int
102gfc_wide_is_printable (gfc_char_t c)
103{
104 return (gfc_wide_fits_in_byte (c) && ISPRINT ((unsigned char) c)(_sch_istable[((unsigned char) c) & 0xff] & (unsigned
short)(_sch_isprint))
);
105}
106
107gfc_char_t
108gfc_wide_tolower (gfc_char_t c)
109{
110 return (wide_is_ascii (c) ? (gfc_char_t) TOLOWER((unsigned char) c)_sch_tolower[((unsigned char) c) & 0xff] : c);
111}
112
113gfc_char_t
114gfc_wide_toupper (gfc_char_t c)
115{
116 return (wide_is_ascii (c) ? (gfc_char_t) TOUPPER((unsigned char) c)_sch_toupper[((unsigned char) c) & 0xff] : c);
117}
118
119int
120gfc_wide_is_digit (gfc_char_t c)
121{
122 return (c >= '0' && c <= '9');
123}
124
125static inline int
126wide_atoi (gfc_char_t *c)
127{
128#define MAX_DIGITS20 20
129 char buf[MAX_DIGITS20+1];
130 int i = 0;
131
132 while (gfc_wide_is_digit(*c) && i < MAX_DIGITS20)
133 buf[i++] = *c++;
134 buf[i] = '\0';
135 return atoi (buf);
136}
137
138size_t
139gfc_wide_strlen (const gfc_char_t *str)
140{
141 size_t i;
142
143 for (i = 0; str[i]; i++)
144 ;
145
146 return i;
147}
148
149gfc_char_t *
150gfc_wide_memset (gfc_char_t *b, gfc_char_t c, size_t len)
151{
152 size_t i;
153
154 for (i = 0; i < len; i++)
155 b[i] = c;
156
157 return b;
158}
159
160static gfc_char_t *
161wide_strcpy (gfc_char_t *dest, const gfc_char_t *src)
162{
163 gfc_char_t *d;
164
165 for (d = dest; (*d = *src) != '\0'; ++src, ++d)
166 ;
167
168 return dest;
169}
170
171static gfc_char_t *
172wide_strchr (const gfc_char_t *s, gfc_char_t c)
173{
174 do {
175 if (*s == c)
176 {
177 return CONST_CAST(gfc_char_t *, s)(const_cast<gfc_char_t *> ((s)));
178 }
179 } while (*s++);
180 return 0;
181}
182
183char *
184gfc_widechar_to_char (const gfc_char_t *s, int length)
185{
186 size_t len, i;
187 char *res;
188
189 if (s == NULL__null)
190 return NULL__null;
191
192 /* Passing a negative length is used to indicate that length should be
193 calculated using gfc_wide_strlen(). */
194 len = (length >= 0 ? (size_t) length : gfc_wide_strlen (s));
195 res = XNEWVEC (char, len + 1)((char *) xmalloc (sizeof (char) * (len + 1)));
196
197 for (i = 0; i < len; i++)
198 {
199 gcc_assert (gfc_wide_fits_in_byte (s[i]))((void)(!(gfc_wide_fits_in_byte (s[i])) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/scanner.c"
, 199, __FUNCTION__), 0 : 0))
;
200 res[i] = (unsigned char) s[i];
201 }
202
203 res[len] = '\0';
204 return res;
205}
206
207gfc_char_t *
208gfc_char_to_widechar (const char *s)
209{
210 size_t len, i;
211 gfc_char_t *res;
212
213 if (s == NULL__null)
214 return NULL__null;
215
216 len = strlen (s);
217 res = gfc_get_wide_string (len + 1)((gfc_char_t *) xcalloc ((len + 1), sizeof (gfc_char_t)));
218
219 for (i = 0; i < len; i++)
220 res[i] = (unsigned char) s[i];
221
222 res[len] = '\0';
223 return res;
224}
225
226static int
227wide_strncmp (const gfc_char_t *s1, const char *s2, size_t n)
228{
229 gfc_char_t c1, c2;
230
231 while (n-- > 0)
232 {
233 c1 = *s1++;
234 c2 = *s2++;
235 if (c1 != c2)
236 return (c1 > c2 ? 1 : -1);
237 if (c1 == '\0')
238 return 0;
239 }
240 return 0;
241}
242
243int
244gfc_wide_strncasecmp (const gfc_char_t *s1, const char *s2, size_t n)
245{
246 gfc_char_t c1, c2;
247
248 while (n-- > 0)
249 {
250 c1 = gfc_wide_tolower (*s1++);
251 c2 = TOLOWER (*s2++)_sch_tolower[(*s2++) & 0xff];
252 if (c1 != c2)
253 return (c1 > c2 ? 1 : -1);
254 if (c1 == '\0')
255 return 0;
256 }
257 return 0;
258}
259
260
261/* Main scanner initialization. */
262
263void
264gfc_scanner_init_1 (void)
265{
266 file_head = NULL__null;
267 line_head = NULL__null;
268 line_tail = NULL__null;
269
270 continue_count = 0;
271 continue_line = 0;
272
273 end_flag = 0;
274 last_error_char = NULL__null;
275}
276
277
278/* Main scanner destructor. */
279
280void
281gfc_scanner_done_1 (void)
282{
283 gfc_linebuf *lb;
284 gfc_file *f;
285
286 while(line_head != NULL__null)
287 {
288 lb = line_head->next;
289 free (line_head);
290 line_head = lb;
291 }
292
293 while(file_head != NULL__null)
294 {
295 f = file_head->next;
296 free (file_head->filename);
297 free (file_head);
298 file_head = f;
299 }
300}
301
302static bool
303gfc_do_check_include_dir (const char *path, bool warn)
304{
305 struct stat st;
306 if (stat (path, &st))
307 {
308 if (errno(*__errno_location ()) != ENOENT2)
309 gfc_warning_now (0, "Include directory %qs: %s",
310 path, xstrerror(errno(*__errno_location ())));
311 else if (warn)
312 gfc_warning_now (OPT_Wmissing_include_dirs,
313 "Nonexistent include directory %qs", path);
314 return false;
315 }
316 else if (!S_ISDIR (st.st_mode)((((st.st_mode)) & 0170000) == (0040000)))
317 {
318 gfc_fatal_error ("%qs is not a directory", path);
319 return false;
320 }
321 return true;
322}
323
324/* In order that -W(no-)missing-include-dirs works, the diagnostic can only be
325 run after processing the commandline. */
326static void
327gfc_do_check_include_dirs (gfc_directorylist **list, bool do_warn)
328{
329 gfc_directorylist *prev, *q, *n;
330 prev = NULL__null;
331 n = *list;
332 while (n)
333 {
334 q = n; n = n->next;
335 if (gfc_do_check_include_dir (q->path, q->warn && do_warn))
336 {
337 prev = q;
338 continue;
339 }
340 if (prev == NULL__null)
341 *list = n;
342 else
343 prev->next = n;
344 free (q->path);
345 free (q);
346 }
347}
348
349void
350gfc_check_include_dirs (bool verbose_missing_dir_warn)
351{
352 /* This is a bit convoluted: If gfc_cpp_enabled () and
353 verbose_missing_dir_warn, the warning is shown by libcpp. Otherwise,
354 it is shown here, still conditional on OPT_Wmissing_include_dirs. */
355 bool warn = !gfc_cpp_enabled () || !verbose_missing_dir_warn;
356 gfc_do_check_include_dirs (&include_dirs, warn);
357 gfc_do_check_include_dirs (&intrinsic_modules_dirs, verbose_missing_dir_warn);
358 if (gfc_option.module_dir && gfc_cpp_enabled ())
359 gfc_do_check_include_dirs (&include_dirs, true);
360}
361
362/* Adds path to the list pointed to by list. */
363
364static void
365add_path_to_list (gfc_directorylist **list, const char *path,
366 bool use_for_modules, bool head, bool warn, bool defer_warn)
367{
368 gfc_directorylist *dir;
369 const char *p;
370 char *q;
371 size_t len;
372 int i;
373
374 p = path;
375 while (*p == ' ' || *p == '\t') /* someone might do "-I include" */
376 if (*p++ == '\0')
377 return;
378
379 /* Strip trailing directory separators from the path, as this
380 will confuse Windows systems. */
381 len = strlen (p);
382 q = (char *) alloca (len + 1)__builtin_alloca(len + 1);
383 memcpy (q, p, len + 1);
384 i = len - 1;
385 while (i >=0 && IS_DIR_SEPARATOR (q[i])(((q[i]) == '/') || (((q[i]) == '\\') && (0))))
386 q[i--] = '\0';
387
388 if (!defer_warn && !gfc_do_check_include_dir (q, warn))
389 return;
390
391 if (head || *list == NULL__null)
392 {
393 dir = XCNEW (gfc_directorylist)((gfc_directorylist *) xcalloc (1, sizeof (gfc_directorylist)
))
;
394 if (!head)
395 *list = dir;
396 }
397 else
398 {
399 dir = *list;
400 while (dir->next)
401 dir = dir->next;
402
403 dir->next = XCNEW (gfc_directorylist)((gfc_directorylist *) xcalloc (1, sizeof (gfc_directorylist)
))
;
404 dir = dir->next;
405 }
406
407 dir->next = head ? *list : NULL__null;
408 if (head)
409 *list = dir;
410 dir->use_for_modules = use_for_modules;
411 dir->warn = warn;
412 dir->path = XCNEWVEC (char, strlen (p) + 2)((char *) xcalloc ((strlen (p) + 2), sizeof (char)));
413 strcpy (dir->path, p);
414 strcat (dir->path, "/"); /* make '/' last character */
415}
416
417/* defer_warn is set to true while parsing the commandline. */
418
419void
420gfc_add_include_path (const char *path, bool use_for_modules, bool file_dir,
421 bool warn, bool defer_warn)
422{
423 add_path_to_list (&include_dirs, path, use_for_modules, file_dir, warn,
424 defer_warn);
425
426 /* For '#include "..."' these directories are automatically searched. */
427 if (!file_dir)
428 gfc_cpp_add_include_path (xstrdup(path), true);
429}
430
431
432void
433gfc_add_intrinsic_modules_path (const char *path)
434{
435 add_path_to_list (&intrinsic_modules_dirs, path, true, false, false, false);
436}
437
438
439/* Release resources allocated for options. */
440
441void
442gfc_release_include_path (void)
443{
444 gfc_directorylist *p;
445
446 while (include_dirs != NULL__null)
447 {
448 p = include_dirs;
449 include_dirs = include_dirs->next;
450 free (p->path);
451 free (p);
452 }
453
454 while (intrinsic_modules_dirs != NULL__null)
455 {
456 p = intrinsic_modules_dirs;
457 intrinsic_modules_dirs = intrinsic_modules_dirs->next;
458 free (p->path);
459 free (p);
460 }
461
462 free (gfc_option.module_dir);
463}
464
465
466static FILE *
467open_included_file (const char *name, gfc_directorylist *list,
468 bool module, bool system)
469{
470 char *fullname;
471 gfc_directorylist *p;
472 FILE *f;
473
474 for (p = list; p; p = p->next)
475 {
476 if (module && !p->use_for_modules)
477 continue;
478
479 fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1)__builtin_alloca(strlen (p->path) + strlen (name) + 1);
480 strcpy (fullname, p->path);
481 strcat (fullname, name);
482
483 f = gfc_open_file (fullname);
484 if (f != NULL__null)
485 {
486 if (gfc_cpp_makedep ())
487 gfc_cpp_add_dep (fullname, system);
488
489 return f;
490 }
491 }
492
493 return NULL__null;
494}
495
496
497/* Opens file for reading, searching through the include directories
498 given if necessary. If the include_cwd argument is true, we try
499 to open the file in the current directory first. */
500
501FILE *
502gfc_open_included_file (const char *name, bool include_cwd, bool module)
503{
504 FILE *f = NULL__null;
505
506 if (IS_ABSOLUTE_PATH (name)(((((name)[0]) == '/') || ((((name)[0]) == '\\') && (
0))) || ((name)[0] && ((name)[1] == ':') && (
0)))
|| include_cwd)
507 {
508 f = gfc_open_file (name);
509 if (f && gfc_cpp_makedep ())
510 gfc_cpp_add_dep (name, false);
511 }
512
513 if (!f)
514 f = open_included_file (name, include_dirs, module, false);
515
516 return f;
517}
518
519
520/* Test to see if we're at the end of the main source file. */
521
522int
523gfc_at_end (void)
524{
525 return end_flag;
526}
527
528
529/* Test to see if we're at the end of the current file. */
530
531int
532gfc_at_eof (void)
533{
534 if (gfc_at_end ())
535 return 1;
536
537 if (line_head == NULL__null)
538 return 1; /* Null file */
539
540 if (gfc_current_locus.lb == NULL__null)
541 return 1;
542
543 return 0;
544}
545
546
547/* Test to see if we're at the beginning of a new line. */
548
549int
550gfc_at_bol (void)
551{
552 if (gfc_at_eof ())
553 return 1;
554
555 return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
556}
557
558
559/* Test to see if we're at the end of a line. */
560
561int
562gfc_at_eol (void)
563{
564 if (gfc_at_eof ())
565 return 1;
566
567 return (*gfc_current_locus.nextc == '\0');
568}
569
570static void
571add_file_change (const char *filename, int line)
572{
573 if (file_changes_count == file_changes_allocated)
574 {
575 if (file_changes_allocated)
576 file_changes_allocated *= 2;
577 else
578 file_changes_allocated = 16;
579 file_changes = XRESIZEVEC (struct gfc_file_change, file_changes,((struct gfc_file_change *) xrealloc ((void *) (file_changes)
, sizeof (struct gfc_file_change) * (file_changes_allocated))
)
580 file_changes_allocated)((struct gfc_file_change *) xrealloc ((void *) (file_changes)
, sizeof (struct gfc_file_change) * (file_changes_allocated))
)
;
581 }
582 file_changes[file_changes_count].filename = filename;
583 file_changes[file_changes_count].lb = NULL__null;
584 file_changes[file_changes_count++].line = line;
585}
586
587static void
588report_file_change (gfc_linebuf *lb)
589{
590 size_t c = file_changes_cur;
591 while (c < file_changes_count
592 && file_changes[c].lb == lb)
593 {
594 if (file_changes[c].filename)
595 (*debug_hooks->start_source_file) (file_changes[c].line,
596 file_changes[c].filename);
597 else
598 (*debug_hooks->end_source_file) (file_changes[c].line);
599 ++c;
600 }
601 file_changes_cur = c;
602}
603
604void
605gfc_start_source_files (void)
606{
607 /* If the debugger wants the name of the main source file,
608 we give it. */
609 if (debug_hooks->start_end_main_source_file)
610 (*debug_hooks->start_source_file) (0, gfc_source_file);
611
612 file_changes_cur = 0;
613 report_file_change (gfc_current_locus.lb);
614}
615
616void
617gfc_end_source_files (void)
618{
619 report_file_change (NULL__null);
620
621 if (debug_hooks->start_end_main_source_file)
622 (*debug_hooks->end_source_file) (0);
623}
624
625/* Advance the current line pointer to the next line. */
626
627void
628gfc_advance_line (void)
629{
630 if (gfc_at_end ())
631 return;
632
633 if (gfc_current_locus.lb == NULL__null)
634 {
635 end_flag = 1;
636 return;
637 }
638
639 if (gfc_current_locus.lb->next
640 && !gfc_current_locus.lb->next->dbg_emitted)
641 {
642 report_file_change (gfc_current_locus.lb->next);
643 gfc_current_locus.lb->next->dbg_emitted = true;
644 }
645
646 gfc_current_locus.lb = gfc_current_locus.lb->next;
647
648 if (gfc_current_locus.lb != NULL__null)
649 gfc_current_locus.nextc = gfc_current_locus.lb->line;
650 else
651 {
652 gfc_current_locus.nextc = NULL__null;
653 end_flag = 1;
654 }
655}
656
657
658/* Get the next character from the input, advancing gfc_current_file's
659 locus. When we hit the end of the line or the end of the file, we
660 start returning a '\n' in order to complete the current statement.
661 No Fortran line conventions are implemented here.
662
663 Requiring explicit advances to the next line prevents the parse
664 pointer from being on the wrong line if the current statement ends
665 prematurely. */
666
667static gfc_char_t
668next_char (void)
669{
670 gfc_char_t c;
671
672 if (gfc_current_locus.nextc == NULL__null)
673 return '\n';
674
675 c = *gfc_current_locus.nextc++;
676 if (c == '\0')
677 {
678 gfc_current_locus.nextc--; /* Remain on this line. */
679 c = '\n';
680 }
681
682 return c;
683}
684
685
686/* Skip a comment. When we come here the parse pointer is positioned
687 immediately after the comment character. If we ever implement
688 compiler directives within comments, here is where we parse the
689 directive. */
690
691static void
692skip_comment_line (void)
693{
694 gfc_char_t c;
695
696 do
697 {
698 c = next_char ();
699 }
700 while (c != '\n');
701
702 gfc_advance_line ();
703}
704
705
706int
707gfc_define_undef_line (void)
708{
709 char *tmp;
710
711 /* All lines beginning with '#' are either #define or #undef. */
712 if (debug_info_levelglobal_options.x_debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_ascii_char () != '#')
713 return 0;
714
715 if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
716 {
717 tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[8], -1);
718 (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
,
719 tmp);
720 free (tmp);
721 }
722
723 if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
724 {
725 tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[7], -1);
726 (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
,
727 tmp);
728 free (tmp);
729 }
730
731 /* Skip the rest of the line. */
732 skip_comment_line ();
733
734 return 1;
735}
736
737
738/* Return true if GCC$ was matched. */
739static bool
740skip_gcc_attribute (locus start)
741{
742 bool r = false;
743 char c;
744 locus old_loc = gfc_current_locus;
745
746 if ((c = next_char ()) == 'g' || c == 'G')
747 if ((c = next_char ()) == 'c' || c == 'C')
748 if ((c = next_char ()) == 'c' || c == 'C')
749 if ((c = next_char ()) == '$')
750 r = true;
751
752 if (r == false)
753 gfc_current_locus = old_loc;
754 else
755 {
756 gcc_attribute_flag = 1;
757 gcc_attribute_locus = old_loc;
758 gfc_current_locus = start;
759 }
760
761 return r;
762}
763
764/* Return true if CC was matched. */
765static bool
766skip_free_oacc_sentinel (locus start, locus old_loc)
767{
768 bool r = false;
769 char c;
770
771 if ((c = next_char ()) == 'c' || c == 'C')
772 if ((c = next_char ()) == 'c' || c == 'C')
773 r = true;
774
775 if (r)
776 {
777 if ((c = next_char ()) == ' ' || c == '\t'
778 || continue_flag)
779 {
780 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')))
781 c = next_char ();
782 if (c != '\n' && c != '!')
783 {
784 openacc_flag = 1;
785 openacc_locus = old_loc;
786 gfc_current_locus = start;
787 }
788 else
789 r = false;
790 }
791 else
792 {
793 gfc_warning_now (0, "!$ACC at %C starts a commented "
794 "line as it neither is followed "
795 "by a space nor is a "
796 "continuation line");
797 r = false;
798 }
799 }
800
801 return r;
802}
803
804/* Return true if MP was matched. */
805static bool
806skip_free_omp_sentinel (locus start, locus old_loc)
807{
808 bool r = false;
809 char c;
810
811 if ((c = next_char ()) == 'm' || c == 'M')
812 if ((c = next_char ()) == 'p' || c == 'P')
813 r = true;
814
815 if (r)
816 {
817 if ((c = next_char ()) == ' ' || c == '\t'
818 || continue_flag)
819 {
820 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')))
821 c = next_char ();
822 if (c != '\n' && c != '!')
823 {
824 openmp_flag = 1;
825 openmp_locus = old_loc;
826 gfc_current_locus = start;
827 }
828 else
829 r = false;
830 }
831 else
832 {
833 gfc_warning_now (0, "!$OMP at %C starts a commented "
834 "line as it neither is followed "
835 "by a space nor is a "
836 "continuation line");
837 r = false;
838 }
839 }
840
841 return r;
842}
843
844/* Comment lines are null lines, lines containing only blanks or lines
845 on which the first nonblank line is a '!'.
846 Return true if !$ openmp or openacc conditional compilation sentinel was
847 seen. */
848
849static bool
850skip_free_comments (void)
851{
852 locus start;
853 gfc_char_t c;
854 int at_bol;
855
856 for (;;)
857 {
858 at_bol = gfc_at_bol ();
859 start = gfc_current_locus;
860 if (gfc_at_eof ())
861 break;
862
863 do
864 c = next_char ();
865 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')));
866
867 if (c == '\n')
868 {
869 gfc_advance_line ();
870 continue;
871 }
872
873 if (c == '!')
874 {
875 /* Keep the !GCC$ line. */
876 if (at_bol && skip_gcc_attribute (start))
877 return false;
878
879 /* If -fopenmp/-fopenacc, we need to handle here 2 things:
880 1) don't treat !$omp/!$acc as comments, but directives
881 2) handle OpenMP/OpenACC conditional compilation, where
882 !$ should be treated as 2 spaces (for initial lines
883 only if followed by space). */
884 if (at_bol)
885 {
886 if ((flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd)
887 && flag_openaccglobal_options.x_flag_openacc)
888 {
889 locus old_loc = gfc_current_locus;
890 if (next_char () == '$')
891 {
892 c = next_char ();
893 if (c == 'o' || c == 'O')
894 {
895 if (skip_free_omp_sentinel (start, old_loc))
896 return false;
897 gfc_current_locus = old_loc;
898 next_char ();
899 c = next_char ();
900 }
901 else if (c == 'a' || c == 'A')
902 {
903 if (skip_free_oacc_sentinel (start, old_loc))
904 return false;
905 gfc_current_locus = old_loc;
906 next_char ();
907 c = next_char ();
908 }
909 if (continue_flag || c == ' ' || c == '\t')
910 {
911 gfc_current_locus = old_loc;
912 next_char ();
913 openmp_flag = openacc_flag = 0;
914 return true;
915 }
916 }
917 gfc_current_locus = old_loc;
918 }
919 else if ((flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd)
920 && !flag_openaccglobal_options.x_flag_openacc)
921 {
922 locus old_loc = gfc_current_locus;
923 if (next_char () == '$')
924 {
925 c = next_char ();
926 if (c == 'o' || c == 'O')
927 {
928 if (skip_free_omp_sentinel (start, old_loc))
929 return false;
930 gfc_current_locus = old_loc;
931 next_char ();
932 c = next_char ();
933 }
934 if (continue_flag || c == ' ' || c == '\t')
935 {
936 gfc_current_locus = old_loc;
937 next_char ();
938 openmp_flag = 0;
939 return true;
940 }
941 }
942 gfc_current_locus = old_loc;
943 }
944 else if (flag_openaccglobal_options.x_flag_openacc
945 && !(flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd))
946 {
947 locus old_loc = gfc_current_locus;
948 if (next_char () == '$')
949 {
950 c = next_char ();
951 if (c == 'a' || c == 'A')
952 {
953 if (skip_free_oacc_sentinel (start, old_loc))
954 return false;
955 gfc_current_locus = old_loc;
956 next_char();
957 c = next_char();
Value stored to 'c' is never read
958 }
959 }
960 gfc_current_locus = old_loc;
961 }
962 }
963 skip_comment_line ();
964 continue;
965 }
966
967 break;
968 }
969
970 if (openmp_flag && at_bol)
971 openmp_flag = 0;
972
973 if (openacc_flag && at_bol)
974 openacc_flag = 0;
975
976 gcc_attribute_flag = 0;
977 gfc_current_locus = start;
978 return false;
979}
980
981/* Return true if MP was matched in fixed form. */
982static bool
983skip_fixed_omp_sentinel (locus *start)
984{
985 gfc_char_t c;
986 if (((c = next_char ()) == 'm' || c == 'M')
987 && ((c = next_char ()) == 'p' || c == 'P'))
988 {
989 c = next_char ();
990 if (c != '\n'
991 && (continue_flag
992 || c == ' ' || c == '\t' || c == '0'))
993 {
994 if (c == ' ' || c == '\t' || c == '0')
995 openacc_flag = 0;
996 do
997 c = next_char ();
998 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')));
999 if (c != '\n' && c != '!')
1000 {
1001 /* Canonicalize to *$omp. */
1002 *start->nextc = '*';
1003 openmp_flag = 1;
1004 gfc_current_locus = *start;
1005 return true;
1006 }
1007 }
1008 }
1009 return false;
1010}
1011
1012/* Return true if CC was matched in fixed form. */
1013static bool
1014skip_fixed_oacc_sentinel (locus *start)
1015{
1016 gfc_char_t c;
1017 if (((c = next_char ()) == 'c' || c == 'C')
1018 && ((c = next_char ()) == 'c' || c == 'C'))
1019 {
1020 c = next_char ();
1021 if (c != '\n'
1022 && (continue_flag
1023 || c == ' ' || c == '\t' || c == '0'))
1024 {
1025 if (c == ' ' || c == '\t' || c == '0')
1026 openmp_flag = 0;
1027 do
1028 c = next_char ();
1029 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')));
1030 if (c != '\n' && c != '!')
1031 {
1032 /* Canonicalize to *$acc. */
1033 *start->nextc = '*';
1034 openacc_flag = 1;
1035 gfc_current_locus = *start;
1036 return true;
1037 }
1038 }
1039 }
1040 return false;
1041}
1042
1043/* Skip comment lines in fixed source mode. We have the same rules as
1044 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
1045 in column 1, and a '!' cannot be in column 6. Also, we deal with
1046 lines with 'd' or 'D' in column 1, if the user requested this. */
1047
1048static void
1049skip_fixed_comments (void)
1050{
1051 locus start;
1052 int col;
1053 gfc_char_t c;
1054
1055 if (! gfc_at_bol ())
1056 {
1057 start = gfc_current_locus;
1058 if (! gfc_at_eof ())
1059 {
1060 do
1061 c = next_char ();
1062 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')));
1063
1064 if (c == '\n')
1065 gfc_advance_line ();
1066 else if (c == '!')
1067 skip_comment_line ();
1068 }
1069
1070 if (! gfc_at_bol ())
1071 {
1072 gfc_current_locus = start;
1073 return;
1074 }
1075 }
1076
1077 for (;;)
1078 {
1079 start = gfc_current_locus;
1080 if (gfc_at_eof ())
1081 break;
1082
1083 c = next_char ();
1084 if (c == '\n')
1085 {
1086 gfc_advance_line ();
1087 continue;
1088 }
1089
1090 if (c == '!' || c == 'c' || c == 'C' || c == '*')
1091 {
1092 if (skip_gcc_attribute (start))
1093 {
1094 /* Canonicalize to *$omp. */
1095 *start.nextc = '*';
1096 return;
1097 }
1098
1099 if (gfc_current_locus.lb != NULL__null
1100 && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
)
1101 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
;
1102
1103 /* If -fopenmp/-fopenacc, we need to handle here 2 things:
1104 1) don't treat !$omp/!$acc|c$omp/c$acc|*$omp / *$acc as comments,
1105 but directives
1106 2) handle OpenMP/OpenACC conditional compilation, where
1107 !$|c$|*$ should be treated as 2 spaces if the characters
1108 in columns 3 to 6 are valid fixed form label columns
1109 characters. */
1110 if ((flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd) && !flag_openaccglobal_options.x_flag_openacc)
1111 {
1112 if (next_char () == '$')
1113 {
1114 c = next_char ();
1115 if (c == 'o' || c == 'O')
1116 {
1117 if (skip_fixed_omp_sentinel (&start))
1118 return;
1119 }
1120 else
1121 goto check_for_digits;
1122 }
1123 gfc_current_locus = start;
1124 }
1125 else if (flag_openaccglobal_options.x_flag_openacc && !(flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd))
1126 {
1127 if (next_char () == '$')
1128 {
1129 c = next_char ();
1130 if (c == 'a' || c == 'A')
1131 {
1132 if (skip_fixed_oacc_sentinel (&start))
1133 return;
1134 }
1135 }
1136 gfc_current_locus = start;
1137 }
1138 else if (flag_openaccglobal_options.x_flag_openacc || flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd)
1139 {
1140 if (next_char () == '$')
1141 {
1142 c = next_char ();
1143 if (c == 'a' || c == 'A')
1144 {
1145 if (skip_fixed_oacc_sentinel (&start))
1146 return;
1147 }
1148 else if (c == 'o' || c == 'O')
1149 {
1150 if (skip_fixed_omp_sentinel (&start))
1151 return;
1152 }
1153 else
1154 goto check_for_digits;
1155 }
1156 gfc_current_locus = start;
1157 }
1158
1159 skip_comment_line ();
1160 continue;
1161
1162 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/scanner.c"
, 1162, __FUNCTION__))
;
1163check_for_digits:
1164 {
1165 /* Required for OpenMP's conditional compilation sentinel. */
1166 int digit_seen = 0;
1167
1168 for (col = 3; col < 6; col++, c = next_char ())
1169 if (c == ' ')
1170 continue;
1171 else if (c == '\t')
1172 {
1173 col = 6;
1174 break;
1175 }
1176 else if (c < '0' || c > '9')
1177 break;
1178 else
1179 digit_seen = 1;
1180
1181 if (col == 6 && c != '\n'
1182 && ((continue_flag && !digit_seen)
1183 || c == ' ' || c == '\t' || c == '0'))
1184 {
1185 gfc_current_locus = start;
1186 start.nextc[0] = ' ';
1187 start.nextc[1] = ' ';
1188 continue;
1189 }
1190 }
1191 skip_comment_line ();
1192 continue;
1193 }
1194
1195 if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
1196 {
1197 if (gfc_option.flag_d_lines == 0)
1198 {
1199 skip_comment_line ();
1200 continue;
1201 }
1202 else
1203 *start.nextc = c = ' ';
1204 }
1205
1206 col = 1;
1207
1208 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')))
1209 {
1210 c = next_char ();
1211 col++;
1212 }
1213
1214 if (c == '\n')
1215 {
1216 gfc_advance_line ();
1217 continue;
1218 }
1219
1220 if (col != 6 && c == '!')
1221 {
1222 if (gfc_current_locus.lb != NULL__null
1223 && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
)
1224 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
;
1225 skip_comment_line ();
1226 continue;
1227 }
1228
1229 break;
1230 }
1231
1232 openmp_flag = 0;
1233 openacc_flag = 0;
1234 gcc_attribute_flag = 0;
1235 gfc_current_locus = start;
1236}
1237
1238
1239/* Skips the current line if it is a comment. */
1240
1241void
1242gfc_skip_comments (void)
1243{
1244 if (gfc_current_form == FORM_FREE)
1245 skip_free_comments ();
1246 else
1247 skip_fixed_comments ();
1248}
1249
1250
1251/* Get the next character from the input, taking continuation lines
1252 and end-of-line comments into account. This implies that comment
1253 lines between continued lines must be eaten here. For higher-level
1254 subroutines, this flattens continued lines into a single logical
1255 line. The in_string flag denotes whether we're inside a character
1256 context or not. */
1257
1258gfc_char_t
1259gfc_next_char_literal (gfc_instring in_string)
1260{
1261 static locus omp_acc_err_loc = {};
1262 locus old_loc;
1263 int i, prev_openmp_flag, prev_openacc_flag;
1264 gfc_char_t c;
1265
1266 continue_flag = 0;
1267 prev_openacc_flag = prev_openmp_flag = 0;
1268
1269restart:
1270 c = next_char ();
1271 if (gfc_at_end ())
1272 {
1273 continue_count = 0;
1274 return c;
1275 }
1276
1277 if (gfc_current_form == FORM_FREE)
1278 {
1279 bool openmp_cond_flag;
1280
1281 if (!in_string && c == '!')
1282 {
1283 if (gcc_attribute_flag
1284 && memcmp (&gfc_current_locus, &gcc_attribute_locus,
1285 sizeof (gfc_current_locus)) == 0)
1286 goto done;
1287
1288 if (openmp_flag
1289 && memcmp (&gfc_current_locus, &openmp_locus,
1290 sizeof (gfc_current_locus)) == 0)
1291 goto done;
1292
1293 if (openacc_flag
1294 && memcmp (&gfc_current_locus, &openacc_locus,
1295 sizeof (gfc_current_locus)) == 0)
1296 goto done;
1297
1298 /* This line can't be continued */
1299 do
1300 {
1301 c = next_char ();
1302 }
1303 while (c != '\n');
1304
1305 /* Avoid truncation warnings for comment ending lines. */
1306 gfc_current_locus.lb->truncated = 0;
1307
1308 goto done;
1309 }
1310
1311 /* Check to see if the continuation line was truncated. */
1312 if (warn_line_truncationglobal_options.x_warn_line_truncation && gfc_current_locus.lb != NULL__null
1313 && gfc_current_locus.lb->truncated)
1314 {
1315 int maxlen = flag_free_line_lengthglobal_options.x_flag_free_line_length;
1316 gfc_char_t *current_nextc = gfc_current_locus.nextc;
1317
1318 gfc_current_locus.lb->truncated = 0;
1319 gfc_current_locus.nextc = gfc_current_locus.lb->line + maxlen;
1320 gfc_warning_now (OPT_Wline_truncation,
1321 "Line truncated at %L", &gfc_current_locus);
1322 gfc_current_locus.nextc = current_nextc;
1323 }
1324
1325 if (c != '&')
1326 goto done;
1327
1328 /* If the next nonblank character is a ! or \n, we've got a
1329 continuation line. */
1330 old_loc = gfc_current_locus;
1331
1332 c = next_char ();
1333 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')))
1334 c = next_char ();
1335
1336 /* Character constants to be continued cannot have commentary
1337 after the '&'. However, there are cases where we may think we
1338 are still in a string and we are looking for a possible
1339 doubled quote and we end up here. See PR64506. */
1340
1341 if (in_string && c != '\n')
1342 {
1343 gfc_current_locus = old_loc;
1344 c = '&';
1345 goto done;
1346 }
1347
1348 if (c != '!' && c != '\n')
1349 {
1350 gfc_current_locus = old_loc;
1351 c = '&';
1352 goto done;
1353 }
1354
1355 if (flag_openmpglobal_options.x_flag_openmp)
1356 prev_openmp_flag = openmp_flag;
1357 if (flag_openaccglobal_options.x_flag_openacc)
1358 prev_openacc_flag = openacc_flag;
1359
1360 /* This can happen if the input file changed or via cpp's #line
1361 without getting reset (e.g. via input_stmt). It also happens
1362 when pre-including files via -fpre-include=. */
1363 if (continue_count == 0
1364 && gfc_current_locus.lb
1365 && continue_line > gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
+ 1)
1366 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
+ 1;
1367
1368 continue_flag = 1;
1369 if (c == '!')
1370 skip_comment_line ();
1371 else
1372 gfc_advance_line ();
1373
1374 if (gfc_at_eof ())
1375 goto not_continuation;
1376
1377 /* We've got a continuation line. If we are on the very next line after
1378 the last continuation, increment the continuation line count and
1379 check whether the limit has been exceeded. */
1380 if (gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
== continue_line + 1)
1381 {
1382 if (++continue_count == gfc_option.max_continue_free)
1383 {
1384 if (gfc_notification_std (GFC_STD_GNU(1<<5)) || pedanticglobal_options.x_pedantic)
1385 gfc_warning (0, "Limit of %d continuations exceeded in "
1386 "statement at %C", gfc_option.max_continue_free);
1387 }
1388 }
1389
1390 /* Now find where it continues. First eat any comment lines. */
1391 openmp_cond_flag = skip_free_comments ();
1392
1393 if (gfc_current_locus.lb != NULL__null
1394 && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
)
1395 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
;
1396
1397 if (flag_openmpglobal_options.x_flag_openmp)
1398 if (prev_openmp_flag != openmp_flag && !openacc_flag)
1399 {
1400 gfc_current_locus = old_loc;
1401 openmp_flag = prev_openmp_flag;
1402 c = '&';
1403 goto done;
1404 }
1405
1406 if (flag_openaccglobal_options.x_flag_openacc)
1407 if (prev_openacc_flag != openacc_flag && !openmp_flag)
1408 {
1409 gfc_current_locus = old_loc;
1410 openacc_flag = prev_openacc_flag;
1411 c = '&';
1412 goto done;
1413 }
1414
1415 /* Now that we have a non-comment line, probe ahead for the
1416 first non-whitespace character. If it is another '&', then
1417 reading starts at the next character, otherwise we must back
1418 up to where the whitespace started and resume from there. */
1419
1420 old_loc = gfc_current_locus;
1421
1422 c = next_char ();
1423 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')))
1424 c = next_char ();
1425
1426 if (openmp_flag && !openacc_flag)
1427 {
1428 for (i = 0; i < 5; i++, c = next_char ())
1429 {
1430 gcc_assert (gfc_wide_tolower (c) == (unsigned char) "!$omp"[i])((void)(!(gfc_wide_tolower (c) == (unsigned char) "!$omp"[i])
? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/scanner.c"
, 1430, __FUNCTION__), 0 : 0))
;
1431 if (i == 4)
1432 old_loc = gfc_current_locus;
1433 }
1434 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')))
1435 c = next_char ();
1436 }
1437 if (openacc_flag && !openmp_flag)
1438 {
1439 for (i = 0; i < 5; i++, c = next_char ())
1440 {
1441 gcc_assert (gfc_wide_tolower (c) == (unsigned char) "!$acc"[i])((void)(!(gfc_wide_tolower (c) == (unsigned char) "!$acc"[i])
? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/scanner.c"
, 1441, __FUNCTION__), 0 : 0))
;
1442 if (i == 4)
1443 old_loc = gfc_current_locus;
1444 }
1445 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')))
1446 c = next_char ();
1447 }
1448
1449 /* In case we have an OpenMP directive continued by OpenACC
1450 sentinel, or vice versa, we get both openmp_flag and
1451 openacc_flag on. */
1452
1453 if (openacc_flag && openmp_flag)
1454 {
1455 int is_openmp = 0;
1456 for (i = 0; i < 5; i++, c = next_char ())
1457 {
1458 if (gfc_wide_tolower (c) != (unsigned char) "!$acc"[i])
1459 is_openmp = 1;
1460 }
1461 if (omp_acc_err_loc.nextc != gfc_current_locus.nextc
1462 || omp_acc_err_loc.lb != gfc_current_locus.lb)
1463 gfc_error_now (is_openmp
1464 ? G_("Wrong OpenACC continuation at %C: ""Wrong OpenACC continuation at %C: " "expected !$ACC, got !$OMP"
1465 "expected !$ACC, got !$OMP")"Wrong OpenACC continuation at %C: " "expected !$ACC, got !$OMP"
1466 : G_("Wrong OpenMP continuation at %C: ""Wrong OpenMP continuation at %C: " "expected !$OMP, got !$ACC"
1467 "expected !$OMP, got !$ACC")"Wrong OpenMP continuation at %C: " "expected !$OMP, got !$ACC");
1468 omp_acc_err_loc = gfc_current_locus;
1469 goto not_continuation;
1470 }
1471
1472 if (c != '&')
1473 {
1474 if (in_string && gfc_current_locus.nextc)
1475 {
1476 gfc_current_locus.nextc--;
1477 if (warn_ampersandglobal_options.x_warn_ampersand && in_string == INSTRING_WARN)
1478 gfc_warning (OPT_Wampersand,
1479 "Missing %<&%> in continued character "
1480 "constant at %C");
1481 }
1482 else if (!in_string && (c == '\'' || c == '"'))
1483 goto done;
1484 /* Both !$omp and !$ -fopenmp continuation lines have & on the
1485 continuation line only optionally. */
1486 else if (openmp_flag || openacc_flag || openmp_cond_flag)
1487 {
1488 if (gfc_current_locus.nextc)
1489 gfc_current_locus.nextc--;
1490 }
1491 else
1492 {
1493 c = ' ';
1494 gfc_current_locus = old_loc;
1495 goto done;
1496 }
1497 }
1498 }
1499 else /* Fixed form. */
1500 {
1501 /* Fixed form continuation. */
1502 if (in_string != INSTRING_WARN && c == '!')
1503 {
1504 /* Skip comment at end of line. */
1505 do
1506 {
1507 c = next_char ();
1508 }
1509 while (c != '\n');
1510
1511 /* Avoid truncation warnings for comment ending lines. */
1512 gfc_current_locus.lb->truncated = 0;
1513 }
1514
1515 if (c != '\n')
1516 goto done;
1517
1518 /* Check to see if the continuation line was truncated. */
1519 if (warn_line_truncationglobal_options.x_warn_line_truncation && gfc_current_locus.lb != NULL__null
1520 && gfc_current_locus.lb->truncated)
1521 {
1522 gfc_current_locus.lb->truncated = 0;
1523 gfc_warning_now (OPT_Wline_truncation,
1524 "Line truncated at %L", &gfc_current_locus);
1525 }
1526
1527 if (flag_openmpglobal_options.x_flag_openmp)
1528 prev_openmp_flag = openmp_flag;
1529 if (flag_openaccglobal_options.x_flag_openacc)
1530 prev_openacc_flag = openacc_flag;
1531
1532 /* This can happen if the input file changed or via cpp's #line
1533 without getting reset (e.g. via input_stmt). It also happens
1534 when pre-including files via -fpre-include=. */
1535 if (continue_count == 0
1536 && gfc_current_locus.lb
1537 && continue_line > gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
+ 1)
1538 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
+ 1;
1539
1540 continue_flag = 1;
1541 old_loc = gfc_current_locus;
1542
1543 gfc_advance_line ();
1544 skip_fixed_comments ();
1545
1546 /* See if this line is a continuation line. */
1547 if (flag_openmpglobal_options.x_flag_openmp && openmp_flag != prev_openmp_flag && !openacc_flag)
1548 {
1549 openmp_flag = prev_openmp_flag;
1550 goto not_continuation;
1551 }
1552 if (flag_openaccglobal_options.x_flag_openacc && openacc_flag != prev_openacc_flag && !openmp_flag)
1553 {
1554 openacc_flag = prev_openacc_flag;
1555 goto not_continuation;
1556 }
1557
1558 /* In case we have an OpenMP directive continued by OpenACC
1559 sentinel, or vice versa, we get both openmp_flag and
1560 openacc_flag on. */
1561 if (openacc_flag && openmp_flag)
1562 {
1563 int is_openmp = 0;
1564 for (i = 0; i < 5; i++)
1565 {
1566 c = next_char ();
1567 if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i])
1568 is_openmp = 1;
1569 }
1570 if (omp_acc_err_loc.nextc != gfc_current_locus.nextc
1571 || omp_acc_err_loc.lb != gfc_current_locus.lb)
1572 gfc_error_now (is_openmp
1573 ? G_("Wrong OpenACC continuation at %C: ""Wrong OpenACC continuation at %C: " "expected !$ACC, got !$OMP"
1574 "expected !$ACC, got !$OMP")"Wrong OpenACC continuation at %C: " "expected !$ACC, got !$OMP"
1575 : G_("Wrong OpenMP continuation at %C: ""Wrong OpenMP continuation at %C: " "expected !$OMP, got !$ACC"
1576 "expected !$OMP, got !$ACC")"Wrong OpenMP continuation at %C: " "expected !$OMP, got !$ACC");
1577 omp_acc_err_loc = gfc_current_locus;
1578 goto not_continuation;
1579 }
1580 else if (!openmp_flag && !openacc_flag)
1581 for (i = 0; i < 5; i++)
1582 {
1583 c = next_char ();
1584 if (c != ' ')
1585 goto not_continuation;
1586 }
1587 else if (openmp_flag)
1588 for (i = 0; i < 5; i++)
1589 {
1590 c = next_char ();
1591 if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
1592 goto not_continuation;
1593 }
1594 else if (openacc_flag)
1595 for (i = 0; i < 5; i++)
1596 {
1597 c = next_char ();
1598 if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i])
1599 goto not_continuation;
1600 }
1601
1602 c = next_char ();
1603 if (c == '0' || c == ' ' || c == '\n')
1604 goto not_continuation;
1605
1606 /* We've got a continuation line. If we are on the very next line after
1607 the last continuation, increment the continuation line count and
1608 check whether the limit has been exceeded. */
1609 if (gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
== continue_line + 1)
1610 {
1611 if (++continue_count == gfc_option.max_continue_fixed)
1612 {
1613 if (gfc_notification_std (GFC_STD_GNU(1<<5)) || pedanticglobal_options.x_pedantic)
1614 gfc_warning (0, "Limit of %d continuations exceeded in "
1615 "statement at %C",
1616 gfc_option.max_continue_fixed);
1617 }
1618 }
1619
1620 if (gfc_current_locus.lb != NULL__null
1621 && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
)
1622 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb)(((expand_location ((gfc_current_locus.lb)->location)).line
))
;
1623 }
1624
1625 /* Ready to read first character of continuation line, which might
1626 be another continuation line! */
1627 goto restart;
1628
1629not_continuation:
1630 c = '\n';
1631 gfc_current_locus = old_loc;
1632 end_flag = 0;
1633
1634done:
1635 if (c == '\n')
1636 continue_count = 0;
1637 continue_flag = 0;
1638 return c;
1639}
1640
1641
1642/* Get the next character of input, folded to lowercase. In fixed
1643 form mode, we also ignore spaces. When matcher subroutines are
1644 parsing character literals, they have to call
1645 gfc_next_char_literal(). */
1646
1647gfc_char_t
1648gfc_next_char (void)
1649{
1650 gfc_char_t c;
1651
1652 do
1653 {
1654 c = gfc_next_char_literal (NONSTRING);
1655 }
1656 while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')));
1657
1658 return gfc_wide_tolower (c);
1659}
1660
1661char
1662gfc_next_ascii_char (void)
1663{
1664 gfc_char_t c = gfc_next_char ();
1665
1666 return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
1667 : (unsigned char) UCHAR_MAX(127*2 +1));
1668}
1669
1670
1671gfc_char_t
1672gfc_peek_char (void)
1673{
1674 locus old_loc;
1675 gfc_char_t c;
1676
1677 old_loc = gfc_current_locus;
1678 c = gfc_next_char ();
1679 gfc_current_locus = old_loc;
1680
1681 return c;
1682}
1683
1684
1685char
1686gfc_peek_ascii_char (void)
1687{
1688 gfc_char_t c = gfc_peek_char ();
1689
1690 return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
1691 : (unsigned char) UCHAR_MAX(127*2 +1));
1692}
1693
1694
1695/* Recover from an error. We try to get past the current statement
1696 and get lined up for the next. The next statement follows a '\n'
1697 or a ';'. We also assume that we are not within a character
1698 constant, and deal with finding a '\'' or '"'. */
1699
1700void
1701gfc_error_recovery (void)
1702{
1703 gfc_char_t c, delim;
1704
1705 if (gfc_at_eof ())
1706 return;
1707
1708 for (;;)
1709 {
1710 c = gfc_next_char ();
1711 if (c == '\n' || c == ';')
1712 break;
1713
1714 if (c != '\'' && c != '"')
1715 {
1716 if (gfc_at_eof ())
1717 break;
1718 continue;
1719 }
1720 delim = c;
1721
1722 for (;;)
1723 {
1724 c = next_char ();
1725
1726 if (c == delim)
1727 break;
1728 if (c == '\n')
1729 return;
1730 if (c == '\\')
1731 {
1732 c = next_char ();
1733 if (c == '\n')
1734 return;
1735 }
1736 }
1737 if (gfc_at_eof ())
1738 break;
1739 }
1740}
1741
1742
1743/* Read ahead until the next character to be read is not whitespace. */
1744
1745void
1746gfc_gobble_whitespace (void)
1747{
1748 static int linenum = 0;
1749 locus old_loc;
1750 gfc_char_t c;
1751
1752 do
1753 {
1754 old_loc = gfc_current_locus;
1755 c = gfc_next_char_literal (NONSTRING);
1756 /* Issue a warning for nonconforming tabs. We keep track of the line
1757 number because the Fortran matchers will often back up and the same
1758 line will be scanned multiple times. */
1759 if (warn_tabsglobal_options.x_warn_tabs && c == '\t')
1760 {
1761 int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location)((expand_location (gfc_current_locus.lb->location)).line);
1762 if (cur_linenum != linenum)
1763 {
1764 linenum = cur_linenum;
1765 gfc_warning_now (OPT_Wtabs, "Nonconforming tab character at %C");
1766 }
1767 }
1768 }
1769 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')));
1770
1771 if (!ISPRINT(c)(_sch_istable[(c) & 0xff] & (unsigned short)(_sch_isprint
))
&& c != '\n' && last_error_char != gfc_current_locus.nextc)
1772 {
1773 char buf[20];
1774 last_error_char = gfc_current_locus.nextc;
1775 snprintf (buf, 20, "%2.2X", c);
1776 gfc_error_now ("Invalid character 0x%s at %C", buf);
1777 }
1778
1779 gfc_current_locus = old_loc;
1780}
1781
1782
1783/* Load a single line into pbuf.
1784
1785 If pbuf points to a NULL pointer, it is allocated.
1786 We truncate lines that are too long, unless we're dealing with
1787 preprocessor lines or if the option -ffixed-line-length-none is set,
1788 in which case we reallocate the buffer to fit the entire line, if
1789 need be.
1790 In fixed mode, we expand a tab that occurs within the statement
1791 label region to expand to spaces that leave the next character in
1792 the source region.
1793
1794 If first_char is not NULL, it's a pointer to a single char value holding
1795 the first character of the line, which has already been read by the
1796 caller. This avoids the use of ungetc().
1797
1798 load_line returns whether the line was truncated.
1799
1800 NOTE: The error machinery isn't available at this point, so we can't
1801 easily report line and column numbers consistent with other
1802 parts of gfortran. */
1803
1804static int
1805load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char)
1806{
1807 int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
1808 int quoted = ' ', comment_ix = -1;
1809 bool seen_comment = false;
1810 bool first_comment = true;
1811 bool trunc_flag = false;
1812 bool seen_printable = false;
1813 bool seen_ampersand = false;
1814 bool found_tab = false;
1815 bool warned_tabs = false;
1816 gfc_char_t *buffer;
1817
1818 /* Determine the maximum allowed line length. */
1819 if (gfc_current_form == FORM_FREE)
1820 maxlen = flag_free_line_lengthglobal_options.x_flag_free_line_length;
1821 else if (gfc_current_form == FORM_FIXED)
1822 maxlen = flag_fixed_line_lengthglobal_options.x_flag_fixed_line_length;
1823 else
1824 maxlen = 72;
1825
1826 if (*pbuf == NULL__null)
1827 {
1828 /* Allocate the line buffer, storing its length into buflen.
1829 Note that if maxlen==0, indicating that arbitrary-length lines
1830 are allowed, the buffer will be reallocated if this length is
1831 insufficient; since 132 characters is the length of a standard
1832 free-form line, we use that as a starting guess. */
1833 if (maxlen > 0)
1834 buflen = maxlen;
1835 else
1836 buflen = 132;
1837
1838 *pbuf = gfc_get_wide_string (buflen + 1)((gfc_char_t *) xcalloc ((buflen + 1), sizeof (gfc_char_t)));
1839 }
1840
1841 i = 0;
1842 buffer = *pbuf;
1843
1844 if (first_char)
1845 c = *first_char;
1846 else
1847 c = getc (input);
1848
1849 /* In order to not truncate preprocessor lines, we have to
1850 remember that this is one. */
1851 preprocessor_flag = (c == '#');
1852
1853 for (;;)
1854 {
1855 if (c == EOF(-1))
1856 break;
1857
1858 if (c == '\n')
1859 {
1860 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1861 if (gfc_current_form == FORM_FREE
1862 && !seen_printable && seen_ampersand)
1863 {
1864 if (pedanticglobal_options.x_pedantic)
1865 gfc_error_now ("%<&%> not allowed by itself in line %d",
1866 current_file->line);
1867 else
1868 gfc_warning_now (0, "%<&%> not allowed by itself in line %d",
1869 current_file->line);
1870 }
1871 break;
1872 }
1873
1874 if (c == '\r' || c == '\0')
1875 goto next_char; /* Gobble characters. */
1876
1877 if (c == '&')
1878 {
1879 if (seen_ampersand)
1880 {
1881 seen_ampersand = false;
1882 seen_printable = true;
1883 }
1884 else
1885 seen_ampersand = true;
1886 }
1887
1888 if ((c != '&' && c != '!' && c != ' ') || (c == '!' && !seen_ampersand))
1889 seen_printable = true;
1890
1891 /* Is this a fixed-form comment? */
1892 if (gfc_current_form == FORM_FIXED && i == 0
1893 && (c == '*' || c == 'c' || c == 'C'
1894 || (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))))
1895 {
1896 seen_comment = true;
1897 comment_ix = i;
1898 }
1899
1900 if (quoted == ' ')
1901 {
1902 if (c == '\'' || c == '"')
1903 quoted = c;
1904 }
1905 else if (c == quoted)
1906 quoted = ' ';
1907
1908 /* Is this a free-form comment? */
1909 if (c == '!' && quoted == ' ')
1910 {
1911 if (seen_comment)
1912 first_comment = false;
1913 seen_comment = true;
1914 comment_ix = i;
1915 }
1916
1917 /* For truncation and tab warnings, set seen_comment to false if one has
1918 either an OpenMP or OpenACC directive - or a !GCC$ attribute. If
1919 OpenMP is enabled, use '!$' as as conditional compilation sentinel
1920 and OpenMP directive ('!$omp'). */
1921 if (seen_comment && first_comment && flag_openmpglobal_options.x_flag_openmp && comment_ix + 1 == i
1922 && c == '$')
1923 first_comment = seen_comment = false;
1924 if (seen_comment && first_comment && comment_ix + 4 == i)
1925 {
1926 if (((*pbuf)[comment_ix+1] == 'g' || (*pbuf)[comment_ix+1] == 'G')
1927 && ((*pbuf)[comment_ix+2] == 'c' || (*pbuf)[comment_ix+2] == 'C')
1928 && ((*pbuf)[comment_ix+3] == 'c' || (*pbuf)[comment_ix+3] == 'C')
1929 && c == '$')
1930 first_comment = seen_comment = false;
1931 if (flag_openaccglobal_options.x_flag_openacc
1932 && (*pbuf)[comment_ix+1] == '$'
1933 && ((*pbuf)[comment_ix+2] == 'a' || (*pbuf)[comment_ix+2] == 'A')
1934 && ((*pbuf)[comment_ix+3] == 'c' || (*pbuf)[comment_ix+3] == 'C')
1935 && (c == 'c' || c == 'C'))
1936 first_comment = seen_comment = false;
1937 }
1938
1939 /* Vendor extension: "<tab>1" marks a continuation line. */
1940 if (found_tab)
1941 {
1942 found_tab = false;
1943 if (c >= '1' && c <= '9')
1944 {
1945 *(buffer-1) = c;
1946 goto next_char;
1947 }
1948 }
1949
1950 if (gfc_current_form == FORM_FIXED && c == '\t' && i < 6)
1951 {
1952 found_tab = true;
1953
1954 if (warn_tabsglobal_options.x_warn_tabs && seen_comment == 0 && !warned_tabs)
1955 {
1956 warned_tabs = true;
1957 gfc_warning_now (OPT_Wtabs,
1958 "Nonconforming tab character in column %d "
1959 "of line %d", i + 1, current_file->line);
1960 }
1961
1962 while (i < 6)
1963 {
1964 *buffer++ = ' ';
1965 i++;
1966 }
1967
1968 goto next_char;
1969 }
1970
1971 *buffer++ = c;
1972 i++;
1973
1974 if (maxlen == 0 || preprocessor_flag)
1975 {
1976 if (i >= buflen)
1977 {
1978 /* Reallocate line buffer to double size to hold the
1979 overlong line. */
1980 buflen = buflen * 2;
1981 *pbuf = XRESIZEVEC (gfc_char_t, *pbuf, (buflen + 1))((gfc_char_t *) xrealloc ((void *) (*pbuf), sizeof (gfc_char_t
) * ((buflen + 1))))
;
1982 buffer = (*pbuf) + i;
1983 }
1984 }
1985 else if (i >= maxlen)
1986 {
1987 bool trunc_warn = true;
1988
1989 /* Enhancement, if the very next non-space character is an ampersand
1990 or comment that we would otherwise warn about, don't mark as
1991 truncated. */
1992
1993 /* Truncate the rest of the line. */
1994 for (;;)
1995 {
1996 c = getc (input);
1997 if (c == '\r' || c == ' ')
1998 continue;
1999
2000 if (c == '\n' || c == EOF(-1))
2001 break;
2002
2003 if (!trunc_warn && c != '!')
2004 trunc_warn = true;
2005
2006 if (trunc_warn && ((gfc_current_form == FORM_FIXED && c == '&')
2007 || c == '!'))
2008 trunc_warn = false;
2009
2010 if (c == '!')
2011 seen_comment = 1;
2012
2013 if (trunc_warn && !seen_comment)
2014 trunc_flag = 1;
2015 }
2016
2017 c = '\n';
2018 continue;
2019 }
2020
2021next_char:
2022 c = getc (input);
2023 }
2024
2025 /* Pad lines to the selected line length in fixed form. */
2026 if (gfc_current_form == FORM_FIXED
2027 && flag_fixed_line_lengthglobal_options.x_flag_fixed_line_length != 0
2028 && flag_pad_sourceglobal_options.x_flag_pad_source
2029 && !preprocessor_flag
2030 && c != EOF(-1))
2031 {
2032 while (i++ < maxlen)
2033 *buffer++ = ' ';
2034 }
2035
2036 *buffer = '\0';
2037 *pbuflen = buflen;
2038
2039 return trunc_flag;
2040}
2041
2042
2043/* Get a gfc_file structure, initialize it and add it to
2044 the file stack. */
2045
2046static gfc_file *
2047get_file (const char *name, enum lc_reason reason)
2048{
2049 gfc_file *f;
2050
2051 f = XCNEW (gfc_file)((gfc_file *) xcalloc (1, sizeof (gfc_file)));
2052
2053 f->filename = xstrdup (name);
2054
2055 f->next = file_head;
2056 file_head = f;
2057
2058 f->up = current_file;
2059 if (current_file != NULL__null)
2060 f->inclusion_line = current_file->line;
2061
2062 linemap_add (line_table, reason, false, f->filename, 1);
2063
2064 return f;
2065}
2066
2067
2068/* Deal with a line from the C preprocessor. The
2069 initial octothorp has already been seen. */
2070
2071static void
2072preprocessor_line (gfc_char_t *c)
2073{
2074 bool flag[5];
2075 int i, line;
2076 gfc_char_t *wide_filename;
2077 gfc_file *f;
2078 int escaped, unescape;
2079 char *filename;
2080
2081 c++;
2082 while (*c == ' ' || *c == '\t')
2083 c++;
2084
2085 if (*c < '0' || *c > '9')
2086 goto bad_cpp_line;
2087
2088 line = wide_atoi (c);
2089
2090 c = wide_strchr (c, ' ');
2091 if (c == NULL__null)
2092 {
2093 /* No file name given. Set new line number. */
2094 current_file->line = line;
2095 return;
2096 }
2097
2098 /* Skip spaces. */
2099 while (*c == ' ' || *c == '\t')
2100 c++;
2101
2102 /* Skip quote. */
2103 if (*c != '"')
2104 goto bad_cpp_line;
2105 ++c;
2106
2107 wide_filename = c;
2108
2109 /* Make filename end at quote. */
2110 unescape = 0;
2111 escaped = false;
2112 while (*c && ! (!escaped && *c == '"'))
2113 {
2114 if (escaped)
2115 escaped = false;
2116 else if (*c == '\\')
2117 {
2118 escaped = true;
2119 unescape++;
2120 }
2121 ++c;
2122 }
2123
2124 if (! *c)
2125 /* Preprocessor line has no closing quote. */
2126 goto bad_cpp_line;
2127
2128 *c++ = '\0';
2129
2130 /* Undo effects of cpp_quote_string. */
2131 if (unescape)
2132 {
2133 gfc_char_t *s = wide_filename;
2134 gfc_char_t *d = gfc_get_wide_string (c - wide_filename - unescape)((gfc_char_t *) xcalloc ((c - wide_filename - unescape), sizeof
(gfc_char_t)))
;
2135
2136 wide_filename = d;
2137 while (*s)
2138 {
2139 if (*s == '\\')
2140 *d++ = *++s;
2141 else
2142 *d++ = *s;
2143 s++;
2144 }
2145 *d = '\0';
2146 }
2147
2148 /* Get flags. */
2149
2150 flag[1] = flag[2] = flag[3] = flag[4] = false;
2151
2152 for (;;)
2153 {
2154 c = wide_strchr (c, ' ');
2155 if (c == NULL__null)
2156 break;
2157
2158 c++;
2159 i = wide_atoi (c);
2160
2161 if (i >= 1 && i <= 4)
2162 flag[i] = true;
2163 }
2164
2165 /* Convert the filename in wide characters into a filename in narrow
2166 characters. */
2167 filename = gfc_widechar_to_char (wide_filename, -1);
2168
2169 /* Interpret flags. */
2170
2171 if (flag[1]) /* Starting new file. */
2172 {
2173 f = get_file (filename, LC_RENAME);
2174 add_file_change (f->filename, f->inclusion_line);
2175 current_file = f;
2176 }
2177
2178 if (flag[2]) /* Ending current file. */
2179 {
2180 if (!current_file->up
2181 || filename_cmp (current_file->up->filename, filename) != 0)
2182 {
2183 linemap_line_start (line_table, current_file->line, 80);
2184 /* ??? One could compute the exact column where the filename
2185 starts and compute the exact location here. */
2186 gfc_warning_now_at (linemap_position_for_column (line_table, 1),
2187 0, "file %qs left but not entered",
2188 filename);
2189 current_file->line++;
2190 if (unescape)
2191 free (wide_filename);
2192 free (filename);
2193 return;
2194 }
2195
2196 add_file_change (NULL__null, line);
2197 current_file = current_file->up;
2198 linemap_add (line_table, LC_RENAME, false, current_file->filename,
2199 current_file->line);
2200 }
2201
2202 /* The name of the file can be a temporary file produced by
2203 cpp. Replace the name if it is different. */
2204
2205 if (filename_cmp (current_file->filename, filename) != 0)
2206 {
2207 /* FIXME: we leak the old filename because a pointer to it may be stored
2208 in the linemap. Alternative could be using GC or updating linemap to
2209 point to the new name, but there is no API for that currently. */
2210 current_file->filename = xstrdup (filename);
2211
2212 /* We need to tell the linemap API that the filename changed. Just
2213 changing current_file is insufficient. */
2214 linemap_add (line_table, LC_RENAME, false, current_file->filename, line);
2215 }
2216
2217 /* Set new line number. */
2218 current_file->line = line;
2219 if (unescape)
2220 free (wide_filename);
2221 free (filename);
2222 return;
2223
2224 bad_cpp_line:
2225 linemap_line_start (line_table, current_file->line, 80);
2226 /* ??? One could compute the exact column where the directive
2227 starts and compute the exact location here. */
2228 gfc_warning_now_at (linemap_position_for_column (line_table, 2), 0,
2229 "Illegal preprocessor directive");
2230 current_file->line++;
2231}
2232
2233
2234static void load_file (const char *, const char *, bool);
2235
2236/* include_line()-- Checks a line buffer to see if it is an include
2237 line. If so, we call load_file() recursively to load the included
2238 file. We never return a syntax error because a statement like
2239 "include = 5" is perfectly legal. We return 0 if no include was
2240 processed, 1 if we matched an include or -1 if include was
2241 partially processed, but will need continuation lines. */
2242
2243static int
2244include_line (gfc_char_t *line)
2245{
2246 gfc_char_t quote, *c, *begin, *stop;
2247 char *filename;
2248 const char *include = "include";
2249 bool allow_continuation = flag_dec_includeglobal_options.x_flag_dec_include;
2250 int i;
2251
2252 c = line;
2253
2254 if (flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd)
2255 {
2256 if (gfc_current_form == FORM_FREE)
2257 {
2258 while (*c == ' ' || *c == '\t')
2259 c++;
2260 if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
2261 c += 3;
2262 }
2263 else
2264 {
2265 if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
2266 && c[1] == '$' && c[2] == ' ')
2267 c += 3;
2268 }
2269 }
2270
2271 if (gfc_current_form == FORM_FREE)
2272 {
2273 while (*c == ' ' || *c == '\t')
2274 c++;
2275 if (gfc_wide_strncasecmp (c, "include", 7))
2276 {
2277 if (!allow_continuation)
2278 return 0;
2279 for (i = 0; i < 7; ++i)
2280 {
2281 gfc_char_t c1 = gfc_wide_tolower (*c);
2282 if (c1 != (unsigned char) include[i])
2283 break;
2284 c++;
2285 }
2286 if (i == 0 || *c != '&')
2287 return 0;
2288 c++;
2289 while (*c == ' ' || *c == '\t')
2290 c++;
2291 if (*c == '\0' || *c == '!')
2292 return -1;
2293 return 0;
2294 }
2295
2296 c += 7;
2297 }
2298 else
2299 {
2300 while (*c == ' ' || *c == '\t')
2301 c++;
2302 if (flag_dec_includeglobal_options.x_flag_dec_include && *c == '0' && c - line == 5)
2303 {
2304 c++;
2305 while (*c == ' ' || *c == '\t')
2306 c++;
2307 }
2308 if (c - line < 6)
2309 allow_continuation = false;
2310 for (i = 0; i < 7; ++i)
2311 {
2312 gfc_char_t c1 = gfc_wide_tolower (*c);
2313 if (c1 != (unsigned char) include[i])
2314 break;
2315 c++;
2316 while (*c == ' ' || *c == '\t')
2317 c++;
2318 }
2319 if (!allow_continuation)
2320 {
2321 if (i != 7)
2322 return 0;
2323 }
2324 else if (i != 7)
2325 {
2326 if (i == 0)
2327 return 0;
2328
2329 /* At the end of line or comment this might be continued. */
2330 if (*c == '\0' || *c == '!')
2331 return -1;
2332
2333 return 0;
2334 }
2335 }
2336
2337 while (*c == ' ' || *c == '\t')
2338 c++;
2339
2340 /* Find filename between quotes. */
2341
2342 quote = *c++;
2343 if (quote != '"' && quote != '\'')
2344 {
2345 if (allow_continuation)
2346 {
2347 if (gfc_current_form == FORM_FREE)
2348 {
2349 if (quote == '&')
2350 {
2351 while (*c == ' ' || *c == '\t')
2352 c++;
2353 if (*c == '\0' || *c == '!')
2354 return -1;
2355 }
2356 }
2357 else if (quote == '\0' || quote == '!')
2358 return -1;
2359 }
2360 return 0;
2361 }
2362
2363 begin = c;
2364
2365 bool cont = false;
2366 while (*c != quote && *c != '\0')
2367 {
2368 if (allow_continuation && gfc_current_form == FORM_FREE)
2369 {
2370 if (*c == '&')
2371 cont = true;
2372 else if (*c != ' ' && *c != '\t')
2373 cont = false;
2374 }
2375 c++;
2376 }
2377
2378 if (*c == '\0')
2379 {
2380 if (allow_continuation
2381 && (cont || gfc_current_form != FORM_FREE))
2382 return -1;
2383 return 0;
2384 }
2385
2386 stop = c++;
2387
2388 while (*c == ' ' || *c == '\t')
2389 c++;
2390
2391 if (*c != '\0' && *c != '!')
2392 return 0;
2393
2394 /* We have an include line at this point. */
2395
2396 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
2397 read by anything else. */
2398
2399 filename = gfc_widechar_to_char (begin, -1);
2400 load_file (filename, NULL__null, false);
2401 free (filename);
2402 return 1;
2403}
2404
2405/* Similarly, but try to parse an INCLUDE statement, using gfc_next_char etc.
2406 APIs. Return 1 if recognized as valid INCLUDE statement and load_file has
2407 been called, 0 if it is not a valid INCLUDE statement and -1 if eof has
2408 been encountered while parsing it. */
2409static int
2410include_stmt (gfc_linebuf *b)
2411{
2412 int ret = 0, i, length;
2413 const char *include = "include";
2414 gfc_char_t c, quote = 0;
2415 locus str_locus;
2416 char *filename;
2417
2418 continue_flag = 0;
2419 end_flag = 0;
2420 gcc_attribute_flag = 0;
2421 openmp_flag = 0;
2422 openacc_flag = 0;
2423 continue_count = 0;
2424 continue_line = 0;
2425 gfc_current_locus.lb = b;
2426 gfc_current_locus.nextc = b->line;
2427
2428 gfc_skip_comments ();
2429 gfc_gobble_whitespace ();
2430
2431 for (i = 0; i < 7; i++)
2432 {
2433 c = gfc_next_char ();
2434 if (c != (unsigned char) include[i])
2435 {
2436 if (gfc_current_form == FORM_FIXED
2437 && i == 0
2438 && c == '0'
2439 && gfc_current_locus.nextc == b->line + 6)
2440 {
2441 gfc_gobble_whitespace ();
2442 i--;
2443 continue;
2444 }
2445 gcc_assert (i != 0)((void)(!(i != 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/scanner.c"
, 2445, __FUNCTION__), 0 : 0))
;
2446 if (c == '\n')
2447 {
2448 gfc_advance_line ();
2449 gfc_skip_comments ();
2450 if (gfc_at_eof ())
2451 ret = -1;
2452 }
2453 goto do_ret;
2454 }
2455 }
2456 gfc_gobble_whitespace ();
2457
2458 c = gfc_next_char ();
2459 if (c == '\'' || c == '"')
2460 quote = c;
2461 else
2462 {
2463 if (c == '\n')
2464 {
2465 gfc_advance_line ();
2466 gfc_skip_comments ();
2467 if (gfc_at_eof ())
2468 ret = -1;
2469 }
2470 goto do_ret;
2471 }
2472
2473 str_locus = gfc_current_locus;
2474 length = 0;
2475 do
2476 {
2477 c = gfc_next_char_literal (INSTRING_NOWARN);
2478 if (c == quote)
2479 break;
2480 if (c == '\n')
2481 {
2482 gfc_advance_line ();
2483 gfc_skip_comments ();
2484 if (gfc_at_eof ())
2485 ret = -1;
2486 goto do_ret;
2487 }
2488 length++;
2489 }
2490 while (1);
2491
2492 gfc_gobble_whitespace ();
2493 c = gfc_next_char ();
2494 if (c != '\n')
2495 goto do_ret;
2496
2497 gfc_current_locus = str_locus;
2498 ret = 1;
2499 filename = XNEWVEC (char, length + 1)((char *) xmalloc (sizeof (char) * (length + 1)));
2500 for (i = 0; i < length; i++)
2501 {
2502 c = gfc_next_char_literal (INSTRING_WARN);
2503 gcc_assert (gfc_wide_fits_in_byte (c))((void)(!(gfc_wide_fits_in_byte (c)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/scanner.c"
, 2503, __FUNCTION__), 0 : 0))
;
2504 filename[i] = (unsigned char) c;
2505 }
2506 filename[length] = '\0';
2507 load_file (filename, NULL__null, false);
2508 free (filename);
2509
2510do_ret:
2511 continue_flag = 0;
2512 end_flag = 0;
2513 gcc_attribute_flag = 0;
2514 openmp_flag = 0;
2515 openacc_flag = 0;
2516 continue_count = 0;
2517 continue_line = 0;
2518 memset (&gfc_current_locus, '\0', sizeof (locus));
2519 memset (&openmp_locus, '\0', sizeof (locus));
2520 memset (&openacc_locus, '\0', sizeof (locus));
2521 memset (&gcc_attribute_locus, '\0', sizeof (locus));
2522 return ret;
2523}
2524
2525
2526
2527/* Load a file into memory by calling load_line until the file ends. */
2528
2529static void
2530load_file (const char *realfilename, const char *displayedname, bool initial)
2531{
2532 gfc_char_t *line;
2533 gfc_linebuf *b, *include_b = NULL__null;
2534 gfc_file *f;
2535 FILE *input;
2536 int len, line_len;
2537 bool first_line;
2538 struct stat st;
2539 int stat_result;
2540 const char *filename;
2541 /* If realfilename and displayedname are different and non-null then
2542 surely realfilename is the preprocessed form of
2543 displayedname. */
2544 bool preprocessed_p = (realfilename && displayedname
2545 && strcmp (realfilename, displayedname));
2546
2547 filename = displayedname ? displayedname : realfilename;
2548
2549 for (f = current_file; f; f = f->up)
2550 if (filename_cmp (filename, f->filename) == 0)
2551 fatal_error (linemap_line_start (line_table, current_file->line, 0),
2552 "File %qs is being included recursively", filename);
2553 if (initial)
2554 {
2555 if (gfc_src_file)
2556 {
2557 input = gfc_src_file;
2558 gfc_src_file = NULL__null;
2559 }
2560 else
2561 input = gfc_open_file (realfilename);
2562
2563 if (input == NULL__null)
2564 gfc_fatal_error ("Cannot open file %qs", filename);
2565 }
2566 else
2567 {
2568 input = gfc_open_included_file (realfilename, false, false);
2569 if (input == NULL__null)
2570 {
2571 /* For -fpre-include file, current_file is NULL. */
2572 if (current_file)
2573 fatal_error (linemap_line_start (line_table, current_file->line, 0),
2574 "Cannot open included file %qs", filename);
2575 else
2576 gfc_fatal_error ("Cannot open pre-included file %qs", filename);
2577 }
2578 stat_result = stat (realfilename, &st);
2579 if (stat_result == 0 && !S_ISREG (st.st_mode)((((st.st_mode)) & 0170000) == (0100000)))
2580 {
2581 fclose (input);
2582 if (current_file)
2583 fatal_error (linemap_line_start (line_table, current_file->line, 0),
2584 "Included file %qs is not a regular file", filename);
2585 else
2586 gfc_fatal_error ("Included file %qs is not a regular file", filename);
2587 }
2588 }
2589
2590 /* Load the file.
2591
2592 A "non-initial" file means a file that is being included. In
2593 that case we are creating an LC_ENTER map.
2594
2595 An "initial" file means a main file; one that is not included.
2596 That file has already got at least one (surely more) line map(s)
2597 created by gfc_init. So the subsequent map created in that case
2598 must have LC_RENAME reason.
2599
2600 This latter case is not true for a preprocessed file. In that
2601 case, although the file is "initial", the line maps created by
2602 gfc_init was used during the preprocessing of the file. Now that
2603 the preprocessing is over and we are being fed the result of that
2604 preprocessing, we need to create a brand new line map for the
2605 preprocessed file, so the reason is going to be LC_ENTER. */
2606
2607 f = get_file (filename, (initial && !preprocessed_p) ? LC_RENAME : LC_ENTER);
2608 if (!initial)
2609 add_file_change (f->filename, f->inclusion_line);
2610 current_file = f;
2611 current_file->line = 1;
2612 line = NULL__null;
2613 line_len = 0;
2614 first_line = true;
2615
2616 if (initial && gfc_src_preprocessor_lines[0])
2617 {
2618 preprocessor_line (gfc_src_preprocessor_lines[0]);
2619 free (gfc_src_preprocessor_lines[0]);
2620 gfc_src_preprocessor_lines[0] = NULL__null;
2621 if (gfc_src_preprocessor_lines[1])
2622 {
2623 preprocessor_line (gfc_src_preprocessor_lines[1]);
2624 free (gfc_src_preprocessor_lines[1]);
2625 gfc_src_preprocessor_lines[1] = NULL__null;
2626 }
2627 }
2628
2629 for (;;)
2630 {
2631 int trunc = load_line (input, &line, &line_len, NULL__null);
2632 int inc_line;
2633
2634 len = gfc_wide_strlen (line);
2635 if (feof (input) && len == 0)
2636 break;
2637
2638 /* If this is the first line of the file, it can contain a byte
2639 order mark (BOM), which we will ignore:
2640 FF FE is UTF-16 little endian,
2641 FE FF is UTF-16 big endian,
2642 EF BB BF is UTF-8. */
2643 if (first_line
2644 && ((line_len >= 2 && line[0] == (unsigned char) '\xFF'
2645 && line[1] == (unsigned char) '\xFE')
2646 || (line_len >= 2 && line[0] == (unsigned char) '\xFE'
2647 && line[1] == (unsigned char) '\xFF')
2648 || (line_len >= 3 && line[0] == (unsigned char) '\xEF'
2649 && line[1] == (unsigned char) '\xBB'
2650 && line[2] == (unsigned char) '\xBF')))
2651 {
2652 int n = line[1] == (unsigned char) '\xBB' ? 3 : 2;
2653 gfc_char_t *new_char = gfc_get_wide_string (line_len)((gfc_char_t *) xcalloc ((line_len), sizeof (gfc_char_t)));
2654
2655 wide_strcpy (new_char, &line[n]);
2656 free (line);
2657 line = new_char;
2658 len -= n;
2659 }
2660
2661 /* There are three things this line can be: a line of Fortran
2662 source, an include line or a C preprocessor directive. */
2663
2664 if (line[0] == '#')
2665 {
2666 /* When -g3 is specified, it's possible that we emit #define
2667 and #undef lines, which we need to pass to the middle-end
2668 so that it can emit correct debug info. */
2669 if (debug_info_levelglobal_options.x_debug_info_level == DINFO_LEVEL_VERBOSE
2670 && (wide_strncmp (line, "#define ", 8) == 0
2671 || wide_strncmp (line, "#undef ", 7) == 0))
2672 ;
2673 else
2674 {
2675 preprocessor_line (line);
2676 continue;
2677 }
2678 }
2679
2680 /* Preprocessed files have preprocessor lines added before the byte
2681 order mark, so first_line is not about the first line of the file
2682 but the first line that's not a preprocessor line. */
2683 first_line = false;
2684
2685 inc_line = include_line (line);
2686 if (inc_line > 0)
2687 {
2688 current_file->line++;
2689 continue;
2690 }
2691
2692 /* Add line. */
2693
2694 b = XCNEWVAR (gfc_linebuf, gfc_linebuf_header_size((gfc_linebuf *) xcalloc (1, ((__builtin_offsetof(gfc_linebuf
, line)) + (len + 1) * sizeof (gfc_char_t))))
2695 + (len + 1) * sizeof (gfc_char_t))((gfc_linebuf *) xcalloc (1, ((__builtin_offsetof(gfc_linebuf
, line)) + (len + 1) * sizeof (gfc_char_t))))
;
2696
2697
2698 b->location
2699 = linemap_line_start (line_table, current_file->line++, len);
2700 /* ??? We add the location for the maximum column possible here,
2701 because otherwise if the next call creates a new line-map, it
2702 will not reserve space for any offset. */
2703 if (len > 0)
2704 linemap_position_for_column (line_table, len);
2705
2706 b->file = current_file;
2707 b->truncated = trunc;
2708 wide_strcpy (b->line, line);
2709
2710 if (line_head == NULL__null)
2711 line_head = b;
2712 else
2713 line_tail->next = b;
2714
2715 line_tail = b;
2716
2717 while (file_changes_cur < file_changes_count)
2718 file_changes[file_changes_cur++].lb = b;
2719
2720 if (flag_dec_includeglobal_options.x_flag_dec_include)
2721 {
2722 if (include_b && b != include_b)
2723 {
2724 int inc_line2 = include_stmt (include_b);
2725 if (inc_line2 == 0)
2726 include_b = NULL__null;
2727 else if (inc_line2 > 0)
2728 {
2729 do
2730 {
2731 if (gfc_current_form == FORM_FIXED)
2732 {
2733 for (gfc_char_t *p = include_b->line; *p; p++)
2734 *p = ' ';
2735 }
2736 else
2737 include_b->line[0] = '\0';
2738 if (include_b == b)
2739 break;
2740 include_b = include_b->next;
2741 }
2742 while (1);
2743 include_b = NULL__null;
2744 }
2745 }
2746 if (inc_line == -1 && !include_b)
2747 include_b = b;
2748 }
2749 }
2750
2751 /* Release the line buffer allocated in load_line. */
2752 free (line);
2753
2754 fclose (input);
2755
2756 if (!initial)
2757 add_file_change (NULL__null, current_file->inclusion_line + 1);
2758 current_file = current_file->up;
2759 linemap_add (line_table, LC_LEAVE, 0, NULL__null, 0);
2760}
2761
2762
2763/* Open a new file and start scanning from that file. Returns true
2764 if everything went OK, false otherwise. If form == FORM_UNKNOWN
2765 it tries to determine the source form from the filename, defaulting
2766 to free form. */
2767
2768void
2769gfc_new_file (void)
2770{
2771 if (flag_pre_includeglobal_options.x_flag_pre_include != NULL__null)
2772 load_file (flag_pre_includeglobal_options.x_flag_pre_include, NULL__null, false);
2773
2774 if (gfc_cpp_enabled ())
2775 {
2776 gfc_cpp_preprocess (gfc_source_file);
2777 if (!gfc_cpp_preprocess_only ())
2778 load_file (gfc_cpp_temporary_file (), gfc_source_file, true);
2779 }
2780 else
2781 load_file (gfc_source_file, NULL__null, true);
2782
2783 gfc_current_locus.lb = line_head;
2784 gfc_current_locus.nextc = (line_head == NULL__null) ? NULL__null : line_head->line;
2785
2786#if 0 /* Debugging aid. */
2787 for (; line_head; line_head = line_head->next)
2788 printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location)((expand_location (line_head->location)).file),
2789 LOCATION_LINE (line_head->location)((expand_location (line_head->location)).line), line_head->line);
2790
2791 exit (SUCCESS_EXIT_CODE0);
2792#endif
2793}
2794
2795static char *
2796unescape_filename (const char *ptr)
2797{
2798 const char *p = ptr, *s;
2799 char *d, *ret;
2800 int escaped, unescape = 0;
2801
2802 /* Make filename end at quote. */
2803 escaped = false;
2804 while (*p && ! (! escaped && *p == '"'))
2805 {
2806 if (escaped)
2807 escaped = false;
2808 else if (*p == '\\')
2809 {
2810 escaped = true;
2811 unescape++;
2812 }
2813 ++p;
2814 }
2815
2816 if (!*p || p[1])
2817 return NULL__null;
2818
2819 /* Undo effects of cpp_quote_string. */
2820 s = ptr;
2821 d = XCNEWVEC (char, p + 1 - ptr - unescape)((char *) xcalloc ((p + 1 - ptr - unescape), sizeof (char)));
2822 ret = d;
2823
2824 while (s != p)
2825 {
2826 if (*s == '\\')
2827 *d++ = *++s;
2828 else
2829 *d++ = *s;
2830 s++;
2831 }
2832 *d = '\0';
2833 return ret;
2834}
2835
2836/* For preprocessed files, if the first tokens are of the form # NUM.
2837 handle the directives so we know the original file name. */
2838
2839const char *
2840gfc_read_orig_filename (const char *filename, const char **canon_source_file)
2841{
2842 int c, len;
2843 char *dirname, *tmp;
2844
2845 gfc_src_file = gfc_open_file (filename);
2846 if (gfc_src_file == NULL__null)
2847 return NULL__null;
2848
2849 c = getc (gfc_src_file);
2850
2851 if (c != '#')
2852 return NULL__null;
2853
2854 len = 0;
2855 load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len, &c);
2856
2857 if (wide_strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
2858 return NULL__null;
2859
2860 tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[0][5], -1);
2861 filename = unescape_filename (tmp);
2862 free (tmp);
2863 if (filename == NULL__null)
2864 return NULL__null;
2865
2866 c = getc (gfc_src_file);
2867
2868 if (c != '#')
2869 return filename;
2870
2871 len = 0;
2872 load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len, &c);
2873
2874 if (wide_strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
2875 return filename;
2876
2877 tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[1][5], -1);
2878 dirname = unescape_filename (tmp);
2879 free (tmp);
2880 if (dirname == NULL__null)
2881 return filename;
2882
2883 len = strlen (dirname);
2884 if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
2885 {
2886 free (dirname);
2887 return filename;
2888 }
2889 dirname[len - 2] = '\0';
2890 set_src_pwd (dirname);
2891
2892 if (! IS_ABSOLUTE_PATH (filename)(((((filename)[0]) == '/') || ((((filename)[0]) == '\\') &&
(0))) || ((filename)[0] && ((filename)[1] == ':') &&
(0)))
)
2893 {
2894 char *p = XCNEWVEC (char, len + strlen (filename))((char *) xcalloc ((len + strlen (filename)), sizeof (char)));
2895
2896 memcpy (p, dirname, len - 2);
2897 p[len - 2] = '/';
2898 strcpy (p + len - 1, filename);
2899 *canon_source_file = p;
2900 }
2901
2902 free (dirname);
2903 return filename;
2904}