/* Pass manager for Fortran front end.
- Copyright (C) 2010-2018 Free Software Foundation, Inc.
+ Copyright (C) 2010-2020 Free Software Foundation, Inc.
Contributed by Thomas König.
This file is part of GCC.
static gfc_expr* check_conjg_transpose_variable (gfc_expr *, bool *,
bool *);
static int call_external_blas (gfc_code **, int *, void *);
-static bool has_dimen_vector_ref (gfc_expr *);
static int matmul_temp_args (gfc_code **, int *,void *data);
static int index_interchange (gfc_code **, int*, void *);
-
static bool is_fe_temp (gfc_expr *e);
#ifdef CHECKING_P
static bool in_omp_workshare;
+/* Keep track of whether we are within an OMP atomic. */
+
+static bool in_omp_atomic;
+
/* Keep track of whether we are within a WHERE statement. */
static bool in_where;
return gfc_copy_expr(length);
}
- /* Return length of substring, if constant. */
+ /* See if there is a substring. If it has a constant length, return
+ that and NULL otherwise. */
for (ref = e->ref; ref; ref = ref->next)
{
- if (ref->type == REF_SUBSTRING
- && gfc_dep_difference (ref->u.ss.end, ref->u.ss.start, &value))
+ if (ref->type == REF_SUBSTRING)
{
- res = gfc_get_constant_expr (BT_INTEGER, gfc_charlen_int_kind,
- &e->where);
+ if (gfc_dep_difference (ref->u.ss.end, ref->u.ss.start, &value))
+ {
+ res = gfc_get_constant_expr (BT_INTEGER, gfc_charlen_int_kind,
+ &e->where);
- mpz_add_ui (res->value.integer, value, 1);
- mpz_clear (value);
- return res;
+ mpz_add_ui (res->value.integer, value, 1);
+ mpz_clear (value);
+ return res;
+ }
+ else
+ return NULL;
}
}
/* Return length of char symbol, if constant. */
-
if (e->symtree && e->symtree->n.sym->ts.u.cl
&& e->symtree->n.sym->ts.u.cl->length
&& e->symtree->n.sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
gfc_expr *newvar;
gfc_expr **ei, **ej;
- /* Don't do this optimization within OMP workshare or ASSOC lists. */
+ /* Don't do this optimization within OMP workshare/atomic or ASSOC lists. */
- if (in_omp_workshare || in_assoc_list)
+ if (in_omp_workshare || in_omp_atomic || in_assoc_list)
{
*walk_subtrees = 0;
return 0;
iterator_level = 0;
in_assoc_list = false;
in_omp_workshare = false;
+ in_omp_atomic = false;
if (flag_frontend_optimize)
{
if (iterator_level > 0)
return false;
+ /* WHERE also doesn't work. */
+ if (in_where > 0)
+ return false;
+
op1 = e->value.op.op1;
op2 = e->value.op.op2;
return true;
}
-/* Change (-1)**k into 1-ishift(iand(k,1),1) and
- 2**k into ishift(1,k) */
-
-static bool
-optimize_power (gfc_expr *e)
-{
- gfc_expr *op1, *op2;
- gfc_expr *iand, *ishft;
-
- if (e->ts.type != BT_INTEGER)
- return false;
-
- op1 = e->value.op.op1;
-
- if (op1 == NULL || op1->expr_type != EXPR_CONSTANT)
- return false;
-
- if (mpz_cmp_si (op1->value.integer, -1L) == 0)
- {
- gfc_free_expr (op1);
-
- op2 = e->value.op.op2;
-
- if (op2 == NULL)
- return false;
-
- iand = gfc_build_intrinsic_call (current_ns, GFC_ISYM_IAND,
- "_internal_iand", e->where, 2, op2,
- gfc_get_int_expr (e->ts.kind,
- &e->where, 1));
-
- ishft = gfc_build_intrinsic_call (current_ns, GFC_ISYM_ISHFT,
- "_internal_ishft", e->where, 2, iand,
- gfc_get_int_expr (e->ts.kind,
- &e->where, 1));
-
- e->value.op.op = INTRINSIC_MINUS;
- e->value.op.op1 = gfc_get_int_expr (e->ts.kind, &e->where, 1);
- e->value.op.op2 = ishft;
- return true;
- }
- else if (mpz_cmp_si (op1->value.integer, 2L) == 0)
- {
- gfc_free_expr (op1);
-
- op2 = e->value.op.op2;
- if (op2 == NULL)
- return false;
-
- ishft = gfc_build_intrinsic_call (current_ns, GFC_ISYM_ISHFT,
- "_internal_ishft", e->where, 2,
- gfc_get_int_expr (e->ts.kind,
- &e->where, 1),
- op2);
- *e = *ishft;
- return true;
- }
-
- else if (mpz_cmp_si (op1->value.integer, 1L) == 0)
- {
- op2 = e->value.op.op2;
- if (op2 == NULL)
- return false;
-
- gfc_free_expr (op1);
- gfc_free_expr (op2);
-
- e->expr_type = EXPR_CONSTANT;
- e->value.op.op1 = NULL;
- e->value.op.op2 = NULL;
- mpz_init_set_si (e->value.integer, 1);
- /* Typespec and location are still OK. */
- return true;
- }
-
- return false;
-}
-
/* Recursive optimization of operators. */
static bool
case INTRINSIC_DIVIDE:
return combine_array_constructor (e) || changed;
- case INTRINSIC_POWER:
- return optimize_power (e);
-
default:
break;
}
data.sym = sym;
mpz_init_set (data.val, val);
gfc_expr_walker (&n, callback_insert_index, (void *) &data);
+
+ /* Suppress errors here - we could get errors here such as an
+ out of bounds access for arrays, see PR 90563. */
+ gfc_push_suppress_errors ();
gfc_simplify_expr (n, 0);
+ gfc_pop_suppress_errors ();
if (n->expr_type == EXPR_CONSTANT)
{
if (in_assoc_list)
return 0;
+ /* We already warned about this. */
+ if (v->do_not_warn)
+ return 0;
+
+ v->do_not_warn = 1;
+
for (ref = v->ref; ref; ref = ref->next)
{
if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT)
bool have_do_start, have_do_end;
bool error_not_proven;
int warn;
+ int sgn;
dl = lp->c;
if (dl == NULL)
Do not warn in this case. */
if (dl->ext.iterator->step->expr_type == EXPR_CONSTANT)
- mpz_init_set (do_step, dl->ext.iterator->step->value.integer);
+ {
+ sgn = mpz_cmp_ui (dl->ext.iterator->step->value.integer, 0);
+ /* This can happen, but then the error has been
+ reported previously. */
+ if (sgn == 0)
+ continue;
+
+ mpz_init_set (do_step, dl->ext.iterator->step->value.integer);
+ }
+
else
continue;
else
have_do_start = false;
-
if (dl->ext.iterator->end->expr_type == EXPR_CONSTANT)
{
have_do_end = true;
if (!have_do_start && !have_do_end)
return 0;
+ /* No warning inside a zero-trip loop. */
+ if (have_do_start && have_do_end)
+ {
+ int cmp;
+
+ cmp = mpz_cmp (do_end, do_start);
+ if ((sgn > 0 && cmp < 0) || (sgn < 0 && cmp > 0))
+ break;
+ }
+
/* May have to correct the end value if the step does not equal
one. */
if (have_do_start && have_do_end && mpz_cmp_ui (do_step, 1) != 0)
doloop_warn (gfc_namespace *ns)
{
gfc_code_walker (&ns->code, doloop_code, do_function, NULL);
+
+ for (ns = ns->contained; ns; ns = ns->sibling)
+ {
+ if (ns->code == NULL || ns->code->op != EXEC_BLOCK)
+ doloop_warn (ns);
+ }
}
/* This selction deals with inlining calls to MATMUL. */
return 0;
if (forall_level > 0 || iterator_level > 0 || in_omp_workshare
- || in_where || in_assoc_list)
+ || in_omp_atomic || in_where || in_assoc_list)
return 0;
/* Check if this is already in the form c = matmul(a,b). */
return 0;
if (forall_level > 0 || iterator_level > 0 || in_omp_workshare
- || in_where)
+ || in_omp_atomic || in_where)
return 0;
/* This has some duplication with inline_matmul_assign. This
{
if (matrix_a->expr_type == EXPR_VARIABLE
&& (gfc_check_dependency (matrix_a, expr1, true)
- || has_dimen_vector_ref (matrix_a)))
+ || gfc_has_dimen_vector_ref (matrix_a)))
a_tmp = true;
}
else
{
if (matrix_b->expr_type == EXPR_VARIABLE
&& (gfc_check_dependency (matrix_b, expr1, true)
- || has_dimen_vector_ref (matrix_b)))
+ || gfc_has_dimen_vector_ref (matrix_b)))
b_tmp = true;
}
else
/* Helper function to check for a dimen vector as subscript. */
-static bool
-has_dimen_vector_ref (gfc_expr *e)
+bool
+gfc_has_dimen_vector_ref (gfc_expr *e)
{
gfc_array_ref *ar;
int i;
/* Macros for unified error messages. */
-#define B_ERROR(n) _("Incorrect extent in argument B in MATMUL intrinsic in " \
- "dimension " #n ": is %ld, should be %ld")
+#define B_ERROR_1 _("Incorrect extent in argument B in MATMUL intrinsic in " \
+ "dimension 1: is %ld, should be %ld")
+
+#define C_ERROR_1 _("Array bound mismatch for dimension 1 of array " \
+ "(%ld/%ld)")
-#define C_ERROR(n) _("Array bound mismatch for dimension " #n " of array " \
- "(%ld/%ld)")
+#define C_ERROR_2 _("Array bound mismatch for dimension 2 of array " \
+ "(%ld/%ld)")
/* Inline assignments of the form c = matmul(a,b).
/* For now don't do anything in OpenMP workshare, it confuses
its translation, which expects only the allowed statements in there.
We should figure out how to parallelize this eventually. */
- if (in_omp_workshare)
+ if (in_omp_workshare || in_omp_atomic)
return 0;
expr1 = co->expr1;
if (matrix_b == NULL)
return 0;
- if (has_dimen_vector_ref (expr1) || has_dimen_vector_ref (matrix_a)
- || has_dimen_vector_ref (matrix_b))
+ if (gfc_has_dimen_vector_ref (expr1) || gfc_has_dimen_vector_ref (matrix_a)
+ || gfc_has_dimen_vector_ref (matrix_b))
return 0;
/* We do not handle data dependencies yet. */
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
- test = runtime_error_ne (b1, a2, B_ERROR(1));
+ test = runtime_error_ne (b1, a2, B_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
{
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
- test = runtime_error_ne (c1, a1, C_ERROR(1));
+ test = runtime_error_ne (c1, a1, C_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
}
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
- test = runtime_error_ne (b1, a1, B_ERROR(1));
+ test = runtime_error_ne (b1, a1, B_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
{
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
- test = runtime_error_ne (c1, b2, C_ERROR(1));
+ test = runtime_error_ne (c1, b2, C_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
}
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
- test = runtime_error_ne (b1, a2, B_ERROR(1));
+ test = runtime_error_ne (b1, a2, B_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
{
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
- test = runtime_error_ne (c1, a1, C_ERROR(1));
+ test = runtime_error_ne (c1, a1, C_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
- test = runtime_error_ne (c2, b2, C_ERROR(2));
+ test = runtime_error_ne (c2, b2, C_ERROR_2);
*next_code_point = test;
next_code_point = &test->next;
}
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
/* matrix_b is transposed, hence dimension 1 for the error message. */
- test = runtime_error_ne (b2, a2, B_ERROR(1));
+ test = runtime_error_ne (b2, a2, B_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
{
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
- test = runtime_error_ne (c1, a1, C_ERROR(1));
+ test = runtime_error_ne (c1, a1, C_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
- test = runtime_error_ne (c2, b1, C_ERROR(2));
+ test = runtime_error_ne (c2, b1, C_ERROR_2);
*next_code_point = test;
next_code_point = &test->next;
}
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
- test = runtime_error_ne (b1, a1, B_ERROR(1));
+ test = runtime_error_ne (b1, a1, B_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
{
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
- test = runtime_error_ne (c1, a2, C_ERROR(1));
+ test = runtime_error_ne (c1, a2, C_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
- test = runtime_error_ne (c2, b2, C_ERROR(2));
+ test = runtime_error_ne (c2, b2, C_ERROR_2);
*next_code_point = test;
next_code_point = &test->next;
}
/* For now don't do anything in OpenMP workshare, it confuses
its translation, which expects only the allowed statements in there. */
- if (in_omp_workshare)
+ if (in_omp_workshare || in_omp_atomic)
return 0;
expr1 = co->expr1;
case A2B2:
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
- test = runtime_error_ne (b1, a2, B_ERROR(1));
+ test = runtime_error_ne (b1, a2, B_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
{
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
- test = runtime_error_ne (c1, a1, C_ERROR(1));
+ test = runtime_error_ne (c1, a1, C_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
- test = runtime_error_ne (c2, b2, C_ERROR(2));
+ test = runtime_error_ne (c2, b2, C_ERROR_2);
*next_code_point = test;
next_code_point = &test->next;
}
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
/* matrix_b is transposed, hence dimension 1 for the error message. */
- test = runtime_error_ne (b2, a2, B_ERROR(1));
+ test = runtime_error_ne (b2, a2, B_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
{
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
- test = runtime_error_ne (c1, a1, C_ERROR(1));
+ test = runtime_error_ne (c1, a1, C_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
- test = runtime_error_ne (c2, b1, C_ERROR(2));
+ test = runtime_error_ne (c2, b1, C_ERROR_2);
*next_code_point = test;
next_code_point = &test->next;
}
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
- test = runtime_error_ne (b1, a1, B_ERROR(1));
+ test = runtime_error_ne (b1, a1, B_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
{
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
- test = runtime_error_ne (c1, a2, C_ERROR(1));
+ test = runtime_error_ne (c1, a2, C_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
- test = runtime_error_ne (c2, b2, C_ERROR(2));
+ test = runtime_error_ne (c2, b2, C_ERROR_2);
*next_code_point = test;
next_code_point = &test->next;
}
case A2TB2T:
b2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 2);
a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1);
- test = runtime_error_ne (b2, a1, B_ERROR(1));
+ test = runtime_error_ne (b2, a1, B_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
{
c1 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 1);
a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2);
- test = runtime_error_ne (c1, a2, C_ERROR(1));
+ test = runtime_error_ne (c1, a2, C_ERROR_1);
*next_code_point = test;
next_code_point = &test->next;
c2 = get_array_inq_function (GFC_ISYM_SIZE, expr1, 2);
b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1);
- test = runtime_error_ne (c2, b1, C_ERROR(2));
+ test = runtime_error_ne (c2, b1, C_ERROR_2);
*next_code_point = test;
next_code_point = &test->next;
}
call->symtree->n.sym->attr.procedure = 1;
call->symtree->n.sym->attr.flavor = FL_PROCEDURE;
call->resolved_sym = call->symtree->n.sym;
+ gfc_commit_symbol (call->resolved_sym);
/* Argument TRANSA. */
next = gfc_get_actual_arglist ();
break;
case REF_COMPONENT:
+ case REF_INQUIRY:
break;
}
}
gfc_code *co;
gfc_association_list *alist;
bool saved_in_omp_workshare;
+ bool saved_in_omp_atomic;
bool saved_in_where;
/* There might be statement insertions before the current code,
co = *c;
saved_in_omp_workshare = in_omp_workshare;
+ saved_in_omp_atomic = in_omp_atomic;
saved_in_where = in_where;
switch (co->op)
WALK_SUBEXPR (co->ext.dt->extra_comma);
break;
+ case EXEC_OMP_ATOMIC:
+ in_omp_atomic = true;
+ break;
+
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
select_level --;
in_omp_workshare = saved_in_omp_workshare;
+ in_omp_atomic = saved_in_omp_atomic;
in_where = saved_in_where;
}
}
return 0;
}
+
+/* As a post-resolution step, check that all global symbols which are
+ not declared in the source file match in their call signatures.
+ We do this by looping over the code (and expressions). The first call
+ we happen to find is assumed to be canonical. */
+
+
+/* Common tests for argument checking for both functions and subroutines. */
+
+static int
+check_externals_procedure (gfc_symbol *sym, locus *loc,
+ gfc_actual_arglist *actual)
+{
+ gfc_gsymbol *gsym;
+ gfc_symbol *def_sym = NULL;
+
+ if (sym == NULL || sym->attr.is_bind_c)
+ return 0;
+
+ if (sym->attr.proc != PROC_EXTERNAL && sym->attr.proc != PROC_UNKNOWN)
+ return 0;
+
+ if (sym->attr.if_source == IFSRC_IFBODY || sym->attr.if_source == IFSRC_DECL)
+ return 0;
+
+ gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name);
+ if (gsym == NULL)
+ return 0;
+
+ if (gsym->ns)
+ gfc_find_symbol (sym->name, gsym->ns, 0, &def_sym);
+
+ if (def_sym)
+ {
+ gfc_compare_actual_formal (&actual, def_sym->formal, 0, 0, 0, loc);
+ return 0;
+ }
+
+ /* First time we have seen this procedure called. Let's create an
+ "interface" from the call and put it into a new namespace. */
+ gfc_namespace *save_ns;
+ gfc_symbol *new_sym;
+
+ gsym->where = *loc;
+ save_ns = gfc_current_ns;
+ gsym->ns = gfc_get_namespace (gfc_current_ns, 0);
+ gsym->ns->proc_name = sym;
+
+ gfc_get_symbol (sym->name, gsym->ns, &new_sym);
+ gcc_assert (new_sym);
+ new_sym->attr = sym->attr;
+ new_sym->attr.if_source = IFSRC_DECL;
+ gfc_current_ns = gsym->ns;
+
+ gfc_get_formal_from_actual_arglist (new_sym, actual);
+ gfc_current_ns = save_ns;
+
+ return 0;
+
+}
+
+/* Callback for calls of external routines. */
+
+static int
+check_externals_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_code *co = *c;
+ gfc_symbol *sym;
+ locus *loc;
+ gfc_actual_arglist *actual;
+
+ if (co->op != EXEC_CALL)
+ return 0;
+
+ sym = co->resolved_sym;
+ loc = &co->loc;
+ actual = co->ext.actual;
+
+ return check_externals_procedure (sym, loc, actual);
+
+}
+
+/* Callback for external functions. */
+
+static int
+check_externals_expr (gfc_expr **ep, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_expr *e = *ep;
+ gfc_symbol *sym;
+ locus *loc;
+ gfc_actual_arglist *actual;
+
+ if (e->expr_type != EXPR_FUNCTION)
+ return 0;
+
+ sym = e->value.function.esym;
+ if (sym == NULL)
+ return 0;
+
+ loc = &e->where;
+ actual = e->value.function.actual;
+
+ return check_externals_procedure (sym, loc, actual);
+}
+
+/* Called routine. */
+
+void
+gfc_check_externals (gfc_namespace *ns)
+{
+
+ gfc_clear_error ();
+
+ /* Turn errors into warnings if the user indicated this. */
+
+ if (!pedantic && flag_allow_argument_mismatch)
+ gfc_errors_to_warnings (true);
+
+ gfc_code_walker (&ns->code, check_externals_code, check_externals_expr, NULL);
+
+ for (ns = ns->contained; ns; ns = ns->sibling)
+ {
+ if (ns->code == NULL || ns->code->op != EXEC_BLOCK)
+ gfc_check_externals (ns);
+ }
+
+ gfc_errors_to_warnings (false);
+}
projects / thirdparty / gcc.git / blobdiff