#include "config.h"
#include "system.h"
#include "gfortran.h"
#include "toplev.h"
typedef struct gfc_directorylist
{
char *path;
struct gfc_directorylist *next;
}
gfc_directorylist;
static gfc_directorylist *include_dirs;
static gfc_file *file_head, *current_file;
static int continue_flag, end_flag, openmp_flag;
static int continue_count, continue_line;
static locus openmp_locus;
gfc_source_form gfc_current_form;
static gfc_linebuf *line_head, *line_tail;
locus gfc_current_locus;
const char *gfc_source_file;
static FILE *gfc_src_file;
static char *gfc_src_preprocessor_lines[2];
extern int pedantic;
void
gfc_scanner_init_1 (void)
{
file_head = NULL;
line_head = NULL;
line_tail = NULL;
continue_count = 0;
continue_line = 0;
end_flag = 0;
}
void
gfc_scanner_done_1 (void)
{
gfc_linebuf *lb;
gfc_file *f;
while(line_head != NULL)
{
lb = line_head->next;
gfc_free(line_head);
line_head = lb;
}
while(file_head != NULL)
{
f = file_head->next;
gfc_free(file_head->filename);
gfc_free(file_head);
file_head = f;
}
}
void
gfc_add_include_path (const char *path)
{
gfc_directorylist *dir;
const char *p;
p = path;
while (*p == ' ' || *p == '\t')
if (*p++ == '\0')
return;
dir = include_dirs;
if (!dir)
{
dir = include_dirs = gfc_getmem (sizeof (gfc_directorylist));
}
else
{
while (dir->next)
dir = dir->next;
dir->next = gfc_getmem (sizeof (gfc_directorylist));
dir = dir->next;
}
dir->next = NULL;
dir->path = gfc_getmem (strlen (p) + 2);
strcpy (dir->path, p);
strcat (dir->path, "/");
}
void
gfc_release_include_path (void)
{
gfc_directorylist *p;
gfc_free (gfc_option.module_dir);
while (include_dirs != NULL)
{
p = include_dirs;
include_dirs = include_dirs->next;
gfc_free (p->path);
gfc_free (p);
}
}
FILE *
gfc_open_included_file (const char *name, const bool include_cwd)
{
char *fullname;
gfc_directorylist *p;
FILE *f;
if (IS_ABSOLUTE_PATH (name))
return gfc_open_file (name);
if (include_cwd)
{
f = gfc_open_file (name);
if (f != NULL)
return f;
}
for (p = include_dirs; p; p = p->next)
{
fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
strcpy (fullname, p->path);
strcat (fullname, name);
f = gfc_open_file (fullname);
if (f != NULL)
return f;
}
return NULL;
}
int
gfc_at_end (void)
{
return end_flag;
}
int
gfc_at_eof (void)
{
if (gfc_at_end ())
return 1;
if (line_head == NULL)
return 1;
if (gfc_current_locus.lb == NULL)
return 1;
return 0;
}
int
gfc_at_bol (void)
{
if (gfc_at_eof ())
return 1;
return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
}
int
gfc_at_eol (void)
{
if (gfc_at_eof ())
return 1;
return (*gfc_current_locus.nextc == '\0');
}
void
gfc_advance_line (void)
{
if (gfc_at_end ())
return;
if (gfc_current_locus.lb == NULL)
{
end_flag = 1;
return;
}
gfc_current_locus.lb = gfc_current_locus.lb->next;
if (gfc_current_locus.lb != NULL)
gfc_current_locus.nextc = gfc_current_locus.lb->line;
else
{
gfc_current_locus.nextc = NULL;
end_flag = 1;
}
}
static int
next_char (void)
{
int c;
if (gfc_current_locus.nextc == NULL)
return '\n';
c = (unsigned char) *gfc_current_locus.nextc++;
if (c == '\0')
{
gfc_current_locus.nextc--;
c = '\n';
}
return c;
}
static void
skip_comment_line (void)
{
char c;
do
{
c = next_char ();
}
while (c != '\n');
gfc_advance_line ();
}
static bool
skip_free_comments (void)
{
locus start;
char c;
int at_bol;
for (;;)
{
at_bol = gfc_at_bol ();
start = gfc_current_locus;
if (gfc_at_eof ())
break;
do
c = next_char ();
while (gfc_is_whitespace (c));
if (c == '\n')
{
gfc_advance_line ();
continue;
}
if (c == '!')
{
if (gfc_option.flag_openmp && at_bol)
{
locus old_loc = gfc_current_locus;
if (next_char () == '$')
{
c = next_char ();
if (c == 'o' || c == 'O')
{
if (((c = next_char ()) == 'm' || c == 'M')
&& ((c = next_char ()) == 'p' || c == 'P')
&& ((c = next_char ()) == ' ' || continue_flag))
{
while (gfc_is_whitespace (c))
c = next_char ();
if (c != '\n' && c != '!')
{
openmp_flag = 1;
openmp_locus = old_loc;
gfc_current_locus = start;
return false;
}
}
gfc_current_locus = old_loc;
next_char ();
c = next_char ();
}
if (continue_flag || c == ' ')
{
gfc_current_locus = old_loc;
next_char ();
openmp_flag = 0;
return true;
}
}
gfc_current_locus = old_loc;
}
skip_comment_line ();
continue;
}
break;
}
if (openmp_flag && at_bol)
openmp_flag = 0;
gfc_current_locus = start;
return false;
}
static void
skip_fixed_comments (void)
{
locus start;
int col;
char c;
if (! gfc_at_bol ())
{
start = gfc_current_locus;
if (! gfc_at_eof ())
{
do
c = next_char ();
while (gfc_is_whitespace (c));
if (c == '\n')
gfc_advance_line ();
else if (c == '!')
skip_comment_line ();
}
if (! gfc_at_bol ())
{
gfc_current_locus = start;
return;
}
}
for (;;)
{
start = gfc_current_locus;
if (gfc_at_eof ())
break;
c = next_char ();
if (c == '\n')
{
gfc_advance_line ();
continue;
}
if (c == '!' || c == 'c' || c == 'C' || c == '*')
{
if (gfc_option.flag_openmp)
{
if (next_char () == '$')
{
c = next_char ();
if (c == 'o' || c == 'O')
{
if (((c = next_char ()) == 'm' || c == 'M')
&& ((c = next_char ()) == 'p' || c == 'P'))
{
c = next_char ();
if (c != '\n'
&& ((openmp_flag && continue_flag)
|| c == ' ' || c == '0'))
{
c = next_char ();
while (gfc_is_whitespace (c))
c = next_char ();
if (c != '\n' && c != '!')
{
*start.nextc = '*';
openmp_flag = 1;
gfc_current_locus = start;
return;
}
}
}
}
else
{
int digit_seen = 0;
for (col = 3; col < 6; col++, c = next_char ())
if (c == ' ')
continue;
else if (c < '0' || c > '9')
break;
else
digit_seen = 1;
if (col == 6 && c != '\n'
&& ((continue_flag && !digit_seen)
|| c == ' ' || c == '0'))
{
gfc_current_locus = start;
start.nextc[0] = ' ';
start.nextc[1] = ' ';
continue;
}
}
}
gfc_current_locus = start;
}
skip_comment_line ();
continue;
}
if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
{
if (gfc_option.flag_d_lines == 0)
{
skip_comment_line ();
continue;
}
else
*start.nextc = c = ' ';
}
col = 1;
while (gfc_is_whitespace (c))
{
c = next_char ();
col++;
}
if (c == '\n')
{
gfc_advance_line ();
continue;
}
if (col != 6 && c == '!')
{
skip_comment_line ();
continue;
}
break;
}
openmp_flag = 0;
gfc_current_locus = start;
}
void
gfc_skip_comments (void)
{
if (gfc_current_form == FORM_FREE)
skip_free_comments ();
else
skip_fixed_comments ();
}
int
gfc_next_char_literal (int in_string)
{
locus old_loc;
int i, c, prev_openmp_flag;
continue_flag = 0;
restart:
c = next_char ();
if (gfc_at_end ())
{
continue_count = 0;
return c;
}
if (gfc_current_form == FORM_FREE)
{
bool openmp_cond_flag;
if (!in_string && c == '!')
{
if (openmp_flag
&& memcmp (&gfc_current_locus, &openmp_locus,
sizeof (gfc_current_locus)) == 0)
goto done;
do
{
c = next_char ();
}
while (c != '\n');
gfc_current_locus.lb->truncated = 0;
goto done;
}
if (c != '&')
goto done;
old_loc = gfc_current_locus;
c = next_char ();
while (gfc_is_whitespace (c))
c = next_char ();
if (in_string && c != '\n')
{
gfc_current_locus = old_loc;
c = '&';
goto done;
}
if (c != '!' && c != '\n')
{
gfc_current_locus = old_loc;
c = '&';
goto done;
}
prev_openmp_flag = openmp_flag;
continue_flag = 1;
if (c == '!')
skip_comment_line ();
else
gfc_advance_line ();
if (gfc_at_eof())
goto not_continuation;
if (gfc_current_locus.lb->linenum == continue_line + 1)
{
if (++continue_count == gfc_option.max_continue_free)
{
if (gfc_notification_std (GFC_STD_GNU)
|| pedantic)
gfc_warning ("Limit of %d continuations exceeded in statement at %C",
gfc_option.max_continue_free);
}
}
continue_line = gfc_current_locus.lb->linenum;
openmp_cond_flag = skip_free_comments ();
if (prev_openmp_flag != openmp_flag)
{
gfc_current_locus = old_loc;
openmp_flag = prev_openmp_flag;
c = '&';
goto done;
}
old_loc = gfc_current_locus;
c = next_char ();
while (gfc_is_whitespace (c))
c = next_char ();
if (openmp_flag)
{
for (i = 0; i < 5; i++, c = next_char ())
{
gcc_assert (TOLOWER (c) == "!$omp"[i]);
if (i == 4)
old_loc = gfc_current_locus;
}
while (gfc_is_whitespace (c))
c = next_char ();
}
if (c != '&')
{
if (in_string)
{
if (gfc_option.warn_ampersand)
gfc_warning_now ("Missing '&' in continued character constant at %C");
gfc_current_locus.nextc--;
}
else if (openmp_flag || openmp_cond_flag)
gfc_current_locus.nextc--;
else
{
c = ' ';
gfc_current_locus = old_loc;
goto done;
}
}
}
else
{
if (!in_string && c == '!')
{
do
{
c = next_char ();
}
while (c != '\n');
gfc_current_locus.lb->truncated = 0;
}
if (c != '\n')
goto done;
prev_openmp_flag = openmp_flag;
continue_flag = 1;
old_loc = gfc_current_locus;
gfc_advance_line ();
skip_fixed_comments ();
if (openmp_flag != prev_openmp_flag)
{
openmp_flag = prev_openmp_flag;
goto not_continuation;
}
if (!openmp_flag)
for (i = 0; i < 5; i++)
{
c = next_char ();
if (c != ' ')
goto not_continuation;
}
else
for (i = 0; i < 5; i++)
{
c = next_char ();
if (TOLOWER (c) != "*$omp"[i])
goto not_continuation;
}
c = next_char ();
if (c == '0' || c == ' ' || c == '\n')
goto not_continuation;
if (gfc_current_locus.lb->linenum == continue_line + 1)
{
if (++continue_count == gfc_option.max_continue_fixed)
{
if (gfc_notification_std (GFC_STD_GNU)
|| pedantic)
gfc_warning ("Limit of %d continuations exceeded in statement at %C",
gfc_option.max_continue_fixed);
}
}
if (continue_line < gfc_current_locus.lb->linenum)
continue_line = gfc_current_locus.lb->linenum;
}
goto restart;
not_continuation:
c = '\n';
gfc_current_locus = old_loc;
done:
if (c == '\n')
continue_count = 0;
continue_flag = 0;
return c;
}
int
gfc_next_char (void)
{
int c;
do
{
c = gfc_next_char_literal (0);
}
while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
return TOLOWER (c);
}
int
gfc_peek_char (void)
{
locus old_loc;
int c;
old_loc = gfc_current_locus;
c = gfc_next_char ();
gfc_current_locus = old_loc;
return c;
}
void
gfc_error_recovery (void)
{
char c, delim;
if (gfc_at_eof ())
return;
for (;;)
{
c = gfc_next_char ();
if (c == '\n' || c == ';')
break;
if (c != '\'' && c != '"')
{
if (gfc_at_eof ())
break;
continue;
}
delim = c;
for (;;)
{
c = next_char ();
if (c == delim)
break;
if (c == '\n')
return;
if (c == '\\')
{
c = next_char ();
if (c == '\n')
return;
}
}
if (gfc_at_eof ())
break;
}
}
void
gfc_gobble_whitespace (void)
{
static int linenum = 0;
locus old_loc;
int c;
do
{
old_loc = gfc_current_locus;
c = gfc_next_char_literal (0);
if (!gfc_option.warn_tabs && c == '\t')
{
#ifdef USE_MAPPED_LOCATION
int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
#else
int cur_linenum = gfc_current_locus.lb->linenum;
#endif
if (cur_linenum != linenum)
{
linenum = cur_linenum;
gfc_warning_now ("Nonconforming tab character at %C");
}
}
}
while (gfc_is_whitespace (c));
gfc_current_locus = old_loc;
}
static int
load_line (FILE * input, char **pbuf, int *pbuflen)
{
static int linenum = 0, current_line = 1;
int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
int trunc_flag = 0, seen_comment = 0;
int seen_printable = 0, seen_ampersand = 0;
char *buffer;
if (gfc_current_form == FORM_FREE)
{
if (gfc_option.free_line_length == -1)
maxlen = GFC_MAX_LINE;
else
maxlen = gfc_option.free_line_length;
}
else if (gfc_current_form == FORM_FIXED)
{
if (gfc_option.fixed_line_length == -1)
maxlen = 72;
else
maxlen = gfc_option.fixed_line_length;
}
else
maxlen = 72;
if (*pbuf == NULL)
{
if (maxlen > 0)
buflen = maxlen;
else
buflen = GFC_MAX_LINE;
*pbuf = gfc_getmem (buflen + 1);
}
i = 0;
buffer = *pbuf;
preprocessor_flag = 0;
c = fgetc (input);
if (c == '#')
preprocessor_flag = 1;
ungetc (c, input);
for (;;)
{
c = fgetc (input);
if (c == EOF)
break;
if (c == '\n')
{
if (gfc_current_form == FORM_FREE
&& !seen_printable && seen_ampersand)
{
if (pedantic)
gfc_error_now
("'&' not allowed by itself in line %d", current_line);
else
gfc_warning_now
("'&' not allowed by itself in line %d", current_line);
}
break;
}
if (c == '\r')
continue;
if (c == '\0')
continue;
if (c == '&')
seen_ampersand = 1;
if ((c != ' ' && c != '&' && c != '!') || (c == '!' && !seen_ampersand))
seen_printable = 1;
if (gfc_current_form == FORM_FREE
&& c == '!' && !seen_printable && seen_ampersand)
{
if (pedantic)
gfc_error_now (
"'&' not allowed by itself with comment in line %d", current_line);
else
gfc_warning_now (
"'&' not allowed by itself with comment in line %d", current_line);
seen_printable = 1;
}
if (gfc_current_form == FORM_FIXED && i == 0
&& (c == '*' || c == 'c' || c == 'd'))
seen_comment = 1;
if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
{
if (!gfc_option.warn_tabs && seen_comment == 0
&& current_line != linenum)
{
linenum = current_line;
gfc_warning_now (
"Nonconforming tab character in column 1 of line %d", linenum);
}
while (i <= 6)
{
*buffer++ = ' ';
i++;
}
continue;
}
*buffer++ = c;
i++;
if (maxlen == 0 || preprocessor_flag)
{
if (i >= buflen)
{
buflen = buflen * 2;
*pbuf = xrealloc (*pbuf, buflen + 1);
buffer = (*pbuf)+i;
}
}
else if (i >= maxlen)
{
for (;;)
{
c = fgetc (input);
if (c == '\n' || c == EOF)
break;
trunc_flag = 1;
}
ungetc ('\n', input);
}
}
if (gfc_current_form == FORM_FIXED
&& gfc_option.fixed_line_length != 0
&& !preprocessor_flag
&& c != EOF)
{
while (i++ < maxlen)
*buffer++ = ' ';
}
*buffer = '\0';
*pbuflen = buflen;
current_line++;
return trunc_flag;
}
static gfc_file *
get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
{
gfc_file *f;
f = gfc_getmem (sizeof (gfc_file));
f->filename = gfc_getmem (strlen (name) + 1);
strcpy (f->filename, name);
f->next = file_head;
file_head = f;
f->included_by = current_file;
if (current_file != NULL)
f->inclusion_line = current_file->line;
#ifdef USE_MAPPED_LOCATION
linemap_add (&line_table, reason, false, f->filename, 1);
#endif
return f;
}
static void
preprocessor_line (char *c)
{
bool flag[5];
int i, line;
char *filename;
gfc_file *f;
int escaped, unescape;
c++;
while (*c == ' ' || *c == '\t')
c++;
if (*c < '0' || *c > '9')
goto bad_cpp_line;
line = atoi (c);
c = strchr (c, ' ');
if (c == NULL)
{
current_file->line = line;
return;
}
while (*c == ' ' || *c == '\t')
c++;
if (*c != '"')
goto bad_cpp_line;
++c;
filename = c;
unescape = 0;
escaped = false;
while (*c && ! (! escaped && *c == '"'))
{
if (escaped)
escaped = false;
else if (*c == '\\')
{
escaped = true;
unescape++;
}
++c;
}
if (! *c)
goto bad_cpp_line;
*c++ = '\0';
if (unescape)
{
char *s = filename;
char *d = gfc_getmem (c - filename - unescape);
filename = d;
while (*s)
{
if (*s == '\\')
*d++ = *++s;
else
*d++ = *s;
s++;
}
*d = '\0';
}
flag[1] = flag[2] = flag[3] = flag[4] = false;
for (;;)
{
c = strchr (c, ' ');
if (c == NULL)
break;
c++;
i = atoi (c);
if (1 <= i && i <= 4)
flag[i] = true;
}
if (flag[1])
{
f = get_file (filename, LC_RENAME);
f->up = current_file;
current_file = f;
}
if (flag[2])
{
if (!current_file->up
|| strcmp (current_file->up->filename, filename) != 0)
{
gfc_warning_now ("%s:%d: file %s left but not entered",
current_file->filename, current_file->line,
filename);
if (unescape)
gfc_free (filename);
return;
}
current_file = current_file->up;
}
if (strcmp (current_file->filename, filename) != 0)
{
gfc_free (current_file->filename);
current_file->filename = gfc_getmem (strlen (filename) + 1);
strcpy (current_file->filename, filename);
}
current_file->line = line;
if (unescape)
gfc_free (filename);
return;
bad_cpp_line:
gfc_warning_now ("%s:%d: Illegal preprocessor directive",
current_file->filename, current_file->line);
current_file->line++;
}
static try load_file (const char *, bool);
static bool
include_line (char *line)
{
char quote, *c, *begin, *stop;
c = line;
if (gfc_option.flag_openmp)
{
if (gfc_current_form == FORM_FREE)
{
while (*c == ' ' || *c == '\t')
c++;
if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
c += 3;
}
else
{
if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
&& c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
c += 3;
}
}
while (*c == ' ' || *c == '\t')
c++;
if (strncasecmp (c, "include", 7))
return false;
c += 7;
while (*c == ' ' || *c == '\t')
c++;
quote = *c++;
if (quote != '"' && quote != '\'')
return false;
begin = c;
while (*c != quote && *c != '\0')
c++;
if (*c == '\0')
return false;
stop = c++;
while (*c == ' ' || *c == '\t')
c++;
if (*c != '\0' && *c != '!')
return false;
*stop = '\0';
load_file (begin, false);
return true;
}
static try
load_file (const char *filename, bool initial)
{
char *line;
gfc_linebuf *b;
gfc_file *f;
FILE *input;
int len, line_len;
for (f = current_file; f; f = f->up)
if (strcmp (filename, f->filename) == 0)
{
gfc_error_now ("File '%s' is being included recursively", filename);
return FAILURE;
}
if (initial)
{
if (gfc_src_file)
{
input = gfc_src_file;
gfc_src_file = NULL;
}
else
input = gfc_open_file (filename);
if (input == NULL)
{
gfc_error_now ("Can't open file '%s'", filename);
return FAILURE;
}
}
else
{
input = gfc_open_included_file (filename, false);
if (input == NULL)
{
gfc_error_now ("Can't open included file '%s'", filename);
return FAILURE;
}
}
f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
f->up = current_file;
current_file = f;
current_file->line = 1;
line = NULL;
line_len = 0;
if (initial && gfc_src_preprocessor_lines[0])
{
preprocessor_line (gfc_src_preprocessor_lines[0]);
gfc_free (gfc_src_preprocessor_lines[0]);
gfc_src_preprocessor_lines[0] = NULL;
if (gfc_src_preprocessor_lines[1])
{
preprocessor_line (gfc_src_preprocessor_lines[1]);
gfc_free (gfc_src_preprocessor_lines[1]);
gfc_src_preprocessor_lines[1] = NULL;
}
}
for (;;)
{
int trunc = load_line (input, &line, &line_len);
len = strlen (line);
if (feof (input) && len == 0)
break;
if (line[0] == '#')
{
preprocessor_line (line);
continue;
}
if (include_line (line))
{
current_file->line++;
continue;
}
b = gfc_getmem (gfc_linebuf_header_size + len + 1);
#ifdef USE_MAPPED_LOCATION
b->location
= linemap_line_start (&line_table, current_file->line++, 120);
#else
b->linenum = current_file->line++;
#endif
b->file = current_file;
b->truncated = trunc;
strcpy (b->line, line);
if (line_head == NULL)
line_head = b;
else
line_tail->next = b;
line_tail = b;
}
gfc_free (line);
fclose (input);
current_file = current_file->up;
#ifdef USE_MAPPED_LOCATION
linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
#endif
return SUCCESS;
}
try
gfc_new_file (void)
{
try result;
result = load_file (gfc_source_file, true);
gfc_current_locus.lb = line_head;
gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
#if 0
for (; line_head; line_head = line_head->next)
gfc_status ("%s:%3d %s\n", line_head->file->filename,
#ifdef USE_MAPPED_LOCATION
LOCATION_LINE (line_head->location),
#else
line_head->linenum,
#endif
line_head->line);
exit (0);
#endif
return result;
}
static char *
unescape_filename (const char *ptr)
{
const char *p = ptr, *s;
char *d, *ret;
int escaped, unescape = 0;
escaped = false;
while (*p && ! (! escaped && *p == '"'))
{
if (escaped)
escaped = false;
else if (*p == '\\')
{
escaped = true;
unescape++;
}
++p;
}
if (! *p || p[1])
return NULL;
s = ptr;
d = gfc_getmem (p + 1 - ptr - unescape);
ret = d;
while (s != p)
{
if (*s == '\\')
*d++ = *++s;
else
*d++ = *s;
s++;
}
*d = '\0';
return ret;
}
const char *
gfc_read_orig_filename (const char *filename, const char **canon_source_file)
{
int c, len;
char *dirname;
gfc_src_file = gfc_open_file (filename);
if (gfc_src_file == NULL)
return NULL;
c = fgetc (gfc_src_file);
ungetc (c, gfc_src_file);
if (c != '#')
return NULL;
len = 0;
load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
return NULL;
filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
if (filename == NULL)
return NULL;
c = fgetc (gfc_src_file);
ungetc (c, gfc_src_file);
if (c != '#')
return filename;
len = 0;
load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
return filename;
dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
if (dirname == NULL)
return filename;
len = strlen (dirname);
if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
{
gfc_free (dirname);
return filename;
}
dirname[len - 2] = '\0';
set_src_pwd (dirname);
if (! IS_ABSOLUTE_PATH (filename))
{
char *p = gfc_getmem (len + strlen (filename));
memcpy (p, dirname, len - 2);
p[len - 2] = '/';
strcpy (p + len - 1, filename);
*canon_source_file = p;
}
gfc_free (dirname);
return filename;
}