Replace enum gfc_try with bool type.
2013-04-11 Janne Blomqvist <jb@gcc.gnu.org> * gfortran.h: Remove enum gfc_try, replace gfc_try with bool type. * arith.c: Replace gfc_try with bool type. * array.c: Likewise. * check.c: Likewise. * class.c: Likewise. * cpp.c: Likewise. * cpp.h: Likewise. * data.c: Likewise. * data.h: Likewise. * decl.c: Likewise. * error.c: Likewise. * expr.c: Likewise. * f95-lang.c: Likewise. * interface.c: Likewise. * intrinsic.c: Likewise. * intrinsic.h: Likewise. * io.c: Likewise. * match.c: Likewise. * match.h: Likewise. * module.c: Likewise. * openmp.c: Likewise. * parse.c: Likewise. * parse.h: Likewise. * primary.c: Likewise. * resolve.c: Likewise. * scanner.c: Likewise. * simplify.c: Likewise. * symbol.c: Likewise. * trans-intrinsic.c: Likewise. * trans-openmp.c: Likewise. * trans-stmt.c: Likewise. * trans-types.c: Likewise. From-SVN: r197682
This commit is contained in:
parent
0ea8a6f9c7
commit
524af0d6c7
|
@ -1,3 +1,38 @@
|
|||
2013-04-11 Janne Blomqvist <jb@gcc.gnu.org>
|
||||
|
||||
* gfortran.h: Remove enum gfc_try, replace gfc_try with bool type.
|
||||
* arith.c: Replace gfc_try with bool type.
|
||||
* array.c: Likewise.
|
||||
* check.c: Likewise.
|
||||
* class.c: Likewise.
|
||||
* cpp.c: Likewise.
|
||||
* cpp.h: Likewise.
|
||||
* data.c: Likewise.
|
||||
* data.h: Likewise.
|
||||
* decl.c: Likewise.
|
||||
* error.c: Likewise.
|
||||
* expr.c: Likewise.
|
||||
* f95-lang.c: Likewise.
|
||||
* interface.c: Likewise.
|
||||
* intrinsic.c: Likewise.
|
||||
* intrinsic.h: Likewise.
|
||||
* io.c: Likewise.
|
||||
* match.c: Likewise.
|
||||
* match.h: Likewise.
|
||||
* module.c: Likewise.
|
||||
* openmp.c: Likewise.
|
||||
* parse.c: Likewise.
|
||||
* parse.h: Likewise.
|
||||
* primary.c: Likewise.
|
||||
* resolve.c: Likewise.
|
||||
* scanner.c: Likewise.
|
||||
* simplify.c: Likewise.
|
||||
* symbol.c: Likewise.
|
||||
* trans-intrinsic.c: Likewise.
|
||||
* trans-openmp.c: Likewise.
|
||||
* trans-stmt.c: Likewise.
|
||||
* trans-types.c: Likewise.
|
||||
|
||||
2013-04-09 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
* gfortran.texi (KIND Type Parameters,
|
||||
|
|
|
@ -901,9 +901,9 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
|
||||
if (gfc_init_expr_flag)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "Noninteger "
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "Noninteger "
|
||||
"exponent in an initialization "
|
||||
"expression at %L", &op2->where) == FAILURE)
|
||||
"expression at %L", &op2->where))
|
||||
{
|
||||
gfc_free_expr (result);
|
||||
return ARITH_PROHIBIT;
|
||||
|
@ -926,9 +926,9 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
{
|
||||
if (gfc_init_expr_flag)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "Noninteger "
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "Noninteger "
|
||||
"exponent in an initialization "
|
||||
"expression at %L", &op2->where) == FAILURE)
|
||||
"expression at %L", &op2->where))
|
||||
{
|
||||
gfc_free_expr (result);
|
||||
return ARITH_PROHIBIT;
|
||||
|
@ -1347,8 +1347,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
|
|||
gfc_expr *r;
|
||||
arith rc = ARITH_OK;
|
||||
|
||||
if (gfc_check_conformance (op1, op2,
|
||||
"elemental binary operation") != SUCCESS)
|
||||
if (!gfc_check_conformance (op1, op2, "elemental binary operation"))
|
||||
return ARITH_INCOMMENSURATE;
|
||||
|
||||
head = gfc_constructor_copy (op1->value.constructor);
|
||||
|
|
File diff suppressed because it is too large
Load Diff
3685
gcc/fortran/check.c
3685
gcc/fortran/check.c
File diff suppressed because it is too large
Load Diff
|
@ -543,7 +543,7 @@ gfc_intrinsic_hash_value (gfc_typespec *ts)
|
|||
which contains the declared type as '_data' component, plus a pointer
|
||||
component '_vptr' which determines the dynamic type. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
|
||||
gfc_array_spec **as, bool delayed_vtab)
|
||||
{
|
||||
|
@ -560,19 +560,19 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
|
|||
{
|
||||
gfc_error ("Assumed size polymorphic objects or components, such "
|
||||
"as that at %C, have not yet been implemented");
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (attr->class_ok)
|
||||
/* Class container has already been built. */
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
attr->class_ok = attr->dummy || attr->pointer || attr->allocatable
|
||||
|| attr->select_type_temporary || attr->associate_var;
|
||||
|
||||
if (!attr->class_ok)
|
||||
/* We can not build the class container yet. */
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
/* Determine the name of the encapsulating type. */
|
||||
rank = !(*as) || (*as)->rank == -1 ? GFC_MAX_DIMENSIONS : (*as)->rank;
|
||||
|
@ -614,13 +614,13 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
|
|||
if (!ts->u.derived->attr.unlimited_polymorphic)
|
||||
fclass->attr.abstract = ts->u.derived->attr.abstract;
|
||||
fclass->f2k_derived = gfc_get_namespace (NULL, 0);
|
||||
if (gfc_add_flavor (&fclass->attr, FL_DERIVED,
|
||||
NULL, &gfc_current_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_add_flavor (&fclass->attr, FL_DERIVED, NULL,
|
||||
&gfc_current_locus))
|
||||
return false;
|
||||
|
||||
/* Add component '_data'. */
|
||||
if (gfc_add_component (fclass, "_data", &c) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_add_component (fclass, "_data", &c))
|
||||
return false;
|
||||
c->ts = *ts;
|
||||
c->ts.type = BT_DERIVED;
|
||||
c->attr.access = ACCESS_PRIVATE;
|
||||
|
@ -636,8 +636,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
|
|||
c->initializer = NULL;
|
||||
|
||||
/* Add component '_vptr'. */
|
||||
if (gfc_add_component (fclass, "_vptr", &c) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_add_component (fclass, "_vptr", &c))
|
||||
return false;
|
||||
c->ts.type = BT_DERIVED;
|
||||
if (delayed_vtab
|
||||
|| (ts->u.derived->f2k_derived
|
||||
|
@ -661,7 +661,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
|
|||
{
|
||||
gfc_error ("Maximum extension level reached with type '%s' at %L",
|
||||
ts->u.derived->name, &ts->u.derived->declared_at);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
fclass->attr.extension = ts->u.derived->attr.extension + 1;
|
||||
|
@ -672,7 +672,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
|
|||
ts->u.derived = fclass;
|
||||
attr->allocatable = attr->pointer = attr->dimension = attr->codimension = 0;
|
||||
(*as) = NULL;
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -692,7 +692,7 @@ add_proc_comp (gfc_symbol *vtype, const char *name, gfc_typebound_proc *tb)
|
|||
if (c == NULL)
|
||||
{
|
||||
/* Add procedure component. */
|
||||
if (gfc_add_component (vtype, name, &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, name, &c))
|
||||
return;
|
||||
|
||||
if (!c->tb)
|
||||
|
@ -1724,7 +1724,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
|
|||
DO idx = 1, rank
|
||||
strides(idx) = _F._stride (array, dim=idx)
|
||||
sizes(idx) = sizes(i-1) * size(array, dim=idx, kind=index_kind)
|
||||
if (strides(idx) /= sizes(i-1)) is_contiguous = .false.
|
||||
if (strides (idx) /= sizes(i-1)) is_contiguous = .false.
|
||||
END DO. */
|
||||
|
||||
/* Create loop. */
|
||||
|
@ -1811,7 +1811,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
|
|||
block->expr2->value.op.op2->ts.kind = gfc_index_integer_kind;
|
||||
block->expr2->ts = idx->ts;
|
||||
|
||||
/* if (strides(idx) /= sizes(idx-1)) is_contiguous = .false. */
|
||||
/* if (strides (idx) /= sizes(idx-1)) is_contiguous = .false. */
|
||||
block->next = XCNEW (gfc_code);
|
||||
block = block->next;
|
||||
block->loc = gfc_current_locus;
|
||||
|
@ -2202,8 +2202,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
|
|||
{
|
||||
gfc_get_symbol (name, ns, &vtab);
|
||||
vtab->ts.type = BT_DERIVED;
|
||||
if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL,
|
||||
&gfc_current_locus) == FAILURE)
|
||||
if (!gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL,
|
||||
&gfc_current_locus))
|
||||
goto cleanup;
|
||||
vtab->attr.target = 1;
|
||||
vtab->attr.save = SAVE_IMPLICIT;
|
||||
|
@ -2219,15 +2219,15 @@ gfc_find_derived_vtab (gfc_symbol *derived)
|
|||
gfc_symbol *parent = NULL, *parent_vtab = NULL;
|
||||
|
||||
gfc_get_symbol (name, ns, &vtype);
|
||||
if (gfc_add_flavor (&vtype->attr, FL_DERIVED,
|
||||
NULL, &gfc_current_locus) == FAILURE)
|
||||
if (!gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL,
|
||||
&gfc_current_locus))
|
||||
goto cleanup;
|
||||
vtype->attr.access = ACCESS_PUBLIC;
|
||||
vtype->attr.vtype = 1;
|
||||
gfc_set_sym_referenced (vtype);
|
||||
|
||||
/* Add component '_hash'. */
|
||||
if (gfc_add_component (vtype, "_hash", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_hash", &c))
|
||||
goto cleanup;
|
||||
c->ts.type = BT_INTEGER;
|
||||
c->ts.kind = 4;
|
||||
|
@ -2236,7 +2236,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
|
|||
NULL, derived->hash_value);
|
||||
|
||||
/* Add component '_size'. */
|
||||
if (gfc_add_component (vtype, "_size", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_size", &c))
|
||||
goto cleanup;
|
||||
c->ts.type = BT_INTEGER;
|
||||
c->ts.kind = 4;
|
||||
|
@ -2249,7 +2249,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
|
|||
NULL, 0);
|
||||
|
||||
/* Add component _extends. */
|
||||
if (gfc_add_component (vtype, "_extends", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_extends", &c))
|
||||
goto cleanup;
|
||||
c->attr.pointer = 1;
|
||||
c->attr.access = ACCESS_PRIVATE;
|
||||
|
@ -2286,7 +2286,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
|
|||
}
|
||||
|
||||
/* Add component _def_init. */
|
||||
if (gfc_add_component (vtype, "_def_init", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_def_init", &c))
|
||||
goto cleanup;
|
||||
c->attr.pointer = 1;
|
||||
c->attr.artificial = 1;
|
||||
|
@ -2315,7 +2315,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
|
|||
}
|
||||
|
||||
/* Add component _copy. */
|
||||
if (gfc_add_component (vtype, "_copy", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_copy", &c))
|
||||
goto cleanup;
|
||||
c->attr.proc_pointer = 1;
|
||||
c->attr.access = ACCESS_PRIVATE;
|
||||
|
@ -2385,7 +2385,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
|
|||
/* FIXME: Enable ABI-breaking "_final" generation. */
|
||||
if (0)
|
||||
{
|
||||
if (gfc_add_component (vtype, "_final", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_final", &c))
|
||||
goto cleanup;
|
||||
c->attr.proc_pointer = 1;
|
||||
c->attr.access = ACCESS_PRIVATE;
|
||||
|
@ -2528,8 +2528,8 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
|
|||
{
|
||||
gfc_get_symbol (name, ns, &vtab);
|
||||
vtab->ts.type = BT_DERIVED;
|
||||
if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL,
|
||||
&gfc_current_locus) == FAILURE)
|
||||
if (!gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL,
|
||||
&gfc_current_locus))
|
||||
goto cleanup;
|
||||
vtab->attr.target = 1;
|
||||
vtab->attr.save = SAVE_IMPLICIT;
|
||||
|
@ -2547,15 +2547,15 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
|
|||
gfc_namespace *contained;
|
||||
|
||||
gfc_get_symbol (name, ns, &vtype);
|
||||
if (gfc_add_flavor (&vtype->attr, FL_DERIVED,
|
||||
NULL, &gfc_current_locus) == FAILURE)
|
||||
if (!gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL,
|
||||
&gfc_current_locus))
|
||||
goto cleanup;
|
||||
vtype->attr.access = ACCESS_PUBLIC;
|
||||
vtype->attr.vtype = 1;
|
||||
gfc_set_sym_referenced (vtype);
|
||||
|
||||
/* Add component '_hash'. */
|
||||
if (gfc_add_component (vtype, "_hash", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_hash", &c))
|
||||
goto cleanup;
|
||||
c->ts.type = BT_INTEGER;
|
||||
c->ts.kind = 4;
|
||||
|
@ -2565,7 +2565,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
|
|||
NULL, hash);
|
||||
|
||||
/* Add component '_size'. */
|
||||
if (gfc_add_component (vtype, "_size", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_size", &c))
|
||||
goto cleanup;
|
||||
c->ts.type = BT_INTEGER;
|
||||
c->ts.kind = 4;
|
||||
|
@ -2578,7 +2578,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
|
|||
NULL, ts->kind);
|
||||
|
||||
/* Add component _extends. */
|
||||
if (gfc_add_component (vtype, "_extends", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_extends", &c))
|
||||
goto cleanup;
|
||||
c->attr.pointer = 1;
|
||||
c->attr.access = ACCESS_PRIVATE;
|
||||
|
@ -2586,7 +2586,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
|
|||
c->initializer = gfc_get_null_expr (NULL);
|
||||
|
||||
/* Add component _def_init. */
|
||||
if (gfc_add_component (vtype, "_def_init", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_def_init", &c))
|
||||
goto cleanup;
|
||||
c->attr.pointer = 1;
|
||||
c->attr.access = ACCESS_PRIVATE;
|
||||
|
@ -2594,7 +2594,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
|
|||
c->initializer = gfc_get_null_expr (NULL);
|
||||
|
||||
/* Add component _copy. */
|
||||
if (gfc_add_component (vtype, "_copy", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_copy", &c))
|
||||
goto cleanup;
|
||||
c->attr.proc_pointer = 1;
|
||||
c->attr.access = ACCESS_PRIVATE;
|
||||
|
@ -2666,7 +2666,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
|
|||
c->ts.interface = copy;
|
||||
|
||||
/* Add component _final. */
|
||||
if (gfc_add_component (vtype, "_final", &c) == FAILURE)
|
||||
if (!gfc_add_component (vtype, "_final", &c))
|
||||
goto cleanup;
|
||||
c->attr.proc_pointer = 1;
|
||||
c->attr.access = ACCESS_PRIVATE;
|
||||
|
@ -2709,7 +2709,7 @@ cleanup:
|
|||
type-bound user operator. */
|
||||
|
||||
static gfc_symtree*
|
||||
find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t,
|
||||
find_typebound_proc_uop (gfc_symbol* derived, bool* t,
|
||||
const char* name, bool noaccess, bool uop,
|
||||
locus* where)
|
||||
{
|
||||
|
@ -2718,7 +2718,7 @@ find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t,
|
|||
|
||||
/* Set default to failure. */
|
||||
if (t)
|
||||
*t = FAILURE;
|
||||
*t = false;
|
||||
|
||||
if (derived->f2k_derived)
|
||||
/* Set correct symbol-root. */
|
||||
|
@ -2733,7 +2733,7 @@ find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t,
|
|||
{
|
||||
/* We found one. */
|
||||
if (t)
|
||||
*t = SUCCESS;
|
||||
*t = true;
|
||||
|
||||
if (!noaccess && derived->attr.use_assoc
|
||||
&& res->n.tb->access == ACCESS_PRIVATE)
|
||||
|
@ -2742,7 +2742,7 @@ find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t,
|
|||
gfc_error ("'%s' of '%s' is PRIVATE at %L",
|
||||
name, derived->name, where);
|
||||
if (t)
|
||||
*t = FAILURE;
|
||||
*t = false;
|
||||
}
|
||||
|
||||
return res;
|
||||
|
@ -2768,14 +2768,14 @@ find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t,
|
|||
(looking recursively through the super-types). */
|
||||
|
||||
gfc_symtree*
|
||||
gfc_find_typebound_proc (gfc_symbol* derived, gfc_try* t,
|
||||
gfc_find_typebound_proc (gfc_symbol* derived, bool* t,
|
||||
const char* name, bool noaccess, locus* where)
|
||||
{
|
||||
return find_typebound_proc_uop (derived, t, name, noaccess, false, where);
|
||||
}
|
||||
|
||||
gfc_symtree*
|
||||
gfc_find_typebound_user_op (gfc_symbol* derived, gfc_try* t,
|
||||
gfc_find_typebound_user_op (gfc_symbol* derived, bool* t,
|
||||
const char* name, bool noaccess, locus* where)
|
||||
{
|
||||
return find_typebound_proc_uop (derived, t, name, noaccess, true, where);
|
||||
|
@ -2786,7 +2786,7 @@ gfc_find_typebound_user_op (gfc_symbol* derived, gfc_try* t,
|
|||
super-type hierarchy. */
|
||||
|
||||
gfc_typebound_proc*
|
||||
gfc_find_typebound_intrinsic_op (gfc_symbol* derived, gfc_try* t,
|
||||
gfc_find_typebound_intrinsic_op (gfc_symbol* derived, bool* t,
|
||||
gfc_intrinsic_op op, bool noaccess,
|
||||
locus* where)
|
||||
{
|
||||
|
@ -2794,7 +2794,7 @@ gfc_find_typebound_intrinsic_op (gfc_symbol* derived, gfc_try* t,
|
|||
|
||||
/* Set default to failure. */
|
||||
if (t)
|
||||
*t = FAILURE;
|
||||
*t = false;
|
||||
|
||||
/* Try to find it in the current type's namespace. */
|
||||
if (derived->f2k_derived)
|
||||
|
@ -2807,7 +2807,7 @@ gfc_find_typebound_intrinsic_op (gfc_symbol* derived, gfc_try* t,
|
|||
{
|
||||
/* We found one. */
|
||||
if (t)
|
||||
*t = SUCCESS;
|
||||
*t = true;
|
||||
|
||||
if (!noaccess && derived->attr.use_assoc
|
||||
&& res->access == ACCESS_PRIVATE)
|
||||
|
@ -2816,7 +2816,7 @@ gfc_find_typebound_intrinsic_op (gfc_symbol* derived, gfc_try* t,
|
|||
gfc_error ("'%s' of '%s' is PRIVATE at %L",
|
||||
gfc_op2string (op), derived->name, where);
|
||||
if (t)
|
||||
*t = FAILURE;
|
||||
*t = false;
|
||||
}
|
||||
|
||||
return res;
|
||||
|
|
|
@ -609,11 +609,11 @@ gfc_cpp_init (void)
|
|||
pp_dir_change (cpp_in, get_src_pwd ());
|
||||
}
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_cpp_preprocess (const char *source_file)
|
||||
{
|
||||
if (!gfc_cpp_enabled ())
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
cpp_change_file (cpp_in, LC_RENAME, source_file);
|
||||
|
||||
|
@ -636,7 +636,7 @@ gfc_cpp_preprocess (const char *source_file)
|
|||
|| (gfc_cpp_preprocess_only () && gfc_cpp_option.output_filename))
|
||||
fclose (print.outf);
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
void
|
||||
|
|
|
@ -43,7 +43,7 @@ int gfc_cpp_handle_option(size_t scode, const char *arg, int value);
|
|||
|
||||
void gfc_cpp_post_options (void);
|
||||
|
||||
gfc_try gfc_cpp_preprocess (const char *source_file);
|
||||
bool gfc_cpp_preprocess (const char *source_file);
|
||||
|
||||
void gfc_cpp_done (void);
|
||||
|
||||
|
|
|
@ -129,8 +129,8 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts,
|
|||
start_expr = gfc_copy_expr (ref->u.ss.start);
|
||||
end_expr = gfc_copy_expr (ref->u.ss.end);
|
||||
|
||||
if ((gfc_simplify_expr (start_expr, 1) == FAILURE)
|
||||
|| (gfc_simplify_expr (end_expr, 1)) == FAILURE)
|
||||
if ((!gfc_simplify_expr(start_expr, 1))
|
||||
|| !(gfc_simplify_expr(end_expr, 1)))
|
||||
{
|
||||
gfc_error ("failure to simplify substring reference in DATA "
|
||||
"statement at %L", &ref->u.ss.start->where);
|
||||
|
@ -196,7 +196,7 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts,
|
|||
consecutive values in LVALUE the same value in RVALUE. In that case,
|
||||
LVALUE must refer to a full array, not an array section. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
|
||||
mpz_t *repeat)
|
||||
{
|
||||
|
@ -283,7 +283,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
|
|||
&& ref->next == NULL);
|
||||
mpz_init_set (end, offset);
|
||||
mpz_add (end, end, *repeat);
|
||||
if (spec_size (ref->u.ar.as, &size) == SUCCESS)
|
||||
if (spec_size (ref->u.ar.as, &size))
|
||||
{
|
||||
if (mpz_cmp (end, size) > 0)
|
||||
{
|
||||
|
@ -319,8 +319,8 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
|
|||
? con->expr : rvalue;
|
||||
if (gfc_notify_std (GFC_STD_GNU,
|
||||
"re-initialization of '%s' at %L",
|
||||
symbol->name, &exprd->where) == FAILURE)
|
||||
return FAILURE;
|
||||
symbol->name, &exprd->where) == false)
|
||||
return false;
|
||||
}
|
||||
|
||||
while (con != NULL)
|
||||
|
@ -372,7 +372,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
|
|||
else
|
||||
{
|
||||
mpz_t size;
|
||||
if (spec_size (ref->u.ar.as, &size) == SUCCESS)
|
||||
if (spec_size (ref->u.ar.as, &size))
|
||||
{
|
||||
if (mpz_cmp (offset, size) >= 0)
|
||||
{
|
||||
|
@ -468,7 +468,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
|
|||
if (ref || last_ts->type == BT_CHARACTER)
|
||||
{
|
||||
if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
|
||||
return FAILURE;
|
||||
return false;
|
||||
expr = create_character_initializer (init, last_ts, ref, rvalue);
|
||||
}
|
||||
else
|
||||
|
@ -485,8 +485,8 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
|
|||
? init : rvalue;
|
||||
if (gfc_notify_std (GFC_STD_GNU,
|
||||
"re-initialization of '%s' at %L",
|
||||
symbol->name, &expr->where) == FAILURE)
|
||||
return FAILURE;
|
||||
symbol->name, &expr->where) == false)
|
||||
return false;
|
||||
}
|
||||
|
||||
expr = gfc_copy_expr (rvalue);
|
||||
|
@ -499,13 +499,13 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
|
|||
else
|
||||
last_con->expr = expr;
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
abort:
|
||||
if (!init)
|
||||
gfc_free_expr (expr);
|
||||
mpz_clear (offset);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -19,5 +19,5 @@ along with GCC; see the file COPYING3. If not see
|
|||
|
||||
void gfc_formalize_init_value (gfc_symbol *);
|
||||
void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
|
||||
gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t, mpz_t *);
|
||||
bool gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t, mpz_t *);
|
||||
void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -756,7 +756,7 @@ gfc_dep_difference (gfc_expr *e1, gfc_expr *e2, mpz_t *result)
|
|||
}
|
||||
}
|
||||
|
||||
if (gfc_dep_compare_expr(e1, e2) == 0)
|
||||
if (gfc_dep_compare_expr (e1, e2) == 0)
|
||||
{
|
||||
/* Case 18: X - X = 0. */
|
||||
mpz_set_si (*result, 0);
|
||||
|
@ -1548,7 +1548,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
|
|||
#define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
|
||||
&& (a)->ts.type == BT_INTEGER)
|
||||
|
||||
if (IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride)
|
||||
if (IS_CONSTANT_INTEGER (l_stride) && IS_CONSTANT_INTEGER (r_stride)
|
||||
&& gfc_dep_difference (l_start, r_start, &tmp))
|
||||
{
|
||||
mpz_t gcd;
|
||||
|
|
|
@ -806,10 +806,10 @@ gfc_notification_std (int std)
|
|||
|
||||
/* Possibly issue a warning/error about use of a nonstandard (or deleted)
|
||||
feature. An error/warning will be issued if the currently selected
|
||||
standard does not contain the requested bits. Return FAILURE if
|
||||
standard does not contain the requested bits. Return false if
|
||||
an error is generated. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_notify_std (int std, const char *gmsgid, ...)
|
||||
{
|
||||
va_list argp;
|
||||
|
@ -819,10 +819,10 @@ gfc_notify_std (int std, const char *gmsgid, ...)
|
|||
|
||||
warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
|
||||
if ((gfc_option.allow_std & std) != 0 && !warning)
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
if (suppress_errors)
|
||||
return warning ? SUCCESS : FAILURE;
|
||||
return warning ? true : false;
|
||||
|
||||
cur_error_buffer = warning ? &warning_buffer : &error_buffer;
|
||||
cur_error_buffer->flag = 1;
|
||||
|
@ -883,7 +883,7 @@ gfc_notify_std (int std, const char *gmsgid, ...)
|
|||
cur_error_buffer->flag = 0;
|
||||
}
|
||||
|
||||
return (warning && !warnings_are_errors) ? SUCCESS : FAILURE;
|
||||
return (warning && !warnings_are_errors) ? true : false;
|
||||
}
|
||||
|
||||
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -221,7 +221,7 @@ gfc_init (void)
|
|||
|
||||
gfc_init_1 ();
|
||||
|
||||
if (gfc_new_file () != SUCCESS)
|
||||
if (!gfc_new_file ())
|
||||
fatal_error ("can't open input file: %s", gfc_source_file);
|
||||
|
||||
return true;
|
||||
|
|
|
@ -588,7 +588,7 @@ cfe_expr_0 (gfc_expr **e, int *walk_subtrees,
|
|||
newvar = NULL;
|
||||
for (j=0; j<i; j++)
|
||||
{
|
||||
if (gfc_dep_compare_functions(*(expr_array[i]),
|
||||
if (gfc_dep_compare_functions (*(expr_array[i]),
|
||||
*(expr_array[j]), true) == 0)
|
||||
{
|
||||
if (newvar == NULL)
|
||||
|
@ -936,7 +936,7 @@ optimize_assignment (gfc_code * c)
|
|||
remove_trim (rhs);
|
||||
|
||||
/* Replace a = ' ' by a = '' to optimize away a memcpy. */
|
||||
if (is_empty_string(rhs))
|
||||
if (is_empty_string (rhs))
|
||||
rhs->value.character.length = 0;
|
||||
}
|
||||
|
||||
|
|
|
@ -95,14 +95,6 @@ typedef enum
|
|||
{ M_READ, M_WRITE, M_PRINT, M_INQUIRE }
|
||||
io_kind;
|
||||
|
||||
/* The author remains confused to this day about the convention of
|
||||
returning '0' for 'SUCCESS'... or was it the other way around? The
|
||||
following enum makes things much more readable. We also start
|
||||
values off at one instead of zero. */
|
||||
|
||||
typedef enum
|
||||
{ SUCCESS = 1, FAILURE }
|
||||
gfc_try;
|
||||
|
||||
/* These are flags for identifying whether we are reading a character literal
|
||||
between quotes or normal source code. */
|
||||
|
@ -1626,16 +1618,16 @@ gfc_intrinsic_arg;
|
|||
|
||||
typedef union
|
||||
{
|
||||
gfc_try (*f0)(void);
|
||||
gfc_try (*f1)(struct gfc_expr *);
|
||||
gfc_try (*f1m)(gfc_actual_arglist *);
|
||||
gfc_try (*f2)(struct gfc_expr *, struct gfc_expr *);
|
||||
gfc_try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
|
||||
gfc_try (*f3ml)(gfc_actual_arglist *);
|
||||
gfc_try (*f3red)(gfc_actual_arglist *);
|
||||
gfc_try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
|
||||
bool (*f0)(void);
|
||||
bool (*f1)(struct gfc_expr *);
|
||||
bool (*f1m)(gfc_actual_arglist *);
|
||||
bool (*f2)(struct gfc_expr *, struct gfc_expr *);
|
||||
bool (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
|
||||
bool (*f3ml)(gfc_actual_arglist *);
|
||||
bool (*f3red)(gfc_actual_arglist *);
|
||||
bool (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
|
||||
struct gfc_expr *);
|
||||
gfc_try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
|
||||
bool (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
|
||||
struct gfc_expr *, struct gfc_expr *);
|
||||
}
|
||||
gfc_check_f;
|
||||
|
@ -2432,7 +2424,7 @@ gfc_char_t gfc_peek_char (void);
|
|||
char gfc_peek_ascii_char (void);
|
||||
void gfc_error_recovery (void);
|
||||
void gfc_gobble_whitespace (void);
|
||||
gfc_try gfc_new_file (void);
|
||||
bool gfc_new_file (void);
|
||||
const char * gfc_read_orig_filename (const char *, const char **);
|
||||
|
||||
extern gfc_source_form gfc_current_form;
|
||||
|
@ -2505,7 +2497,7 @@ int gfc_error_check (void);
|
|||
int gfc_error_flag_test (void);
|
||||
|
||||
notification gfc_notification_std (int);
|
||||
gfc_try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
|
||||
bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
|
||||
|
||||
/* A general purpose syntax error. */
|
||||
#define gfc_syntax_error(ST) \
|
||||
|
@ -2525,7 +2517,7 @@ arith gfc_check_integer_range (mpz_t p, int kind);
|
|||
bool gfc_check_character_range (gfc_char_t, int);
|
||||
|
||||
/* trans-types.c */
|
||||
gfc_try gfc_check_any_c_kind (gfc_typespec *);
|
||||
bool gfc_check_any_c_kind (gfc_typespec *);
|
||||
int gfc_validate_kind (bt, int, bool);
|
||||
int gfc_get_int_kind_from_width_isofortranenv (int size);
|
||||
int gfc_get_real_kind_from_width_isofortranenv (int size);
|
||||
|
@ -2548,72 +2540,72 @@ extern int gfc_character_storage_size;
|
|||
|
||||
/* symbol.c */
|
||||
void gfc_clear_new_implicit (void);
|
||||
gfc_try gfc_add_new_implicit_range (int, int);
|
||||
gfc_try gfc_merge_new_implicit (gfc_typespec *);
|
||||
bool gfc_add_new_implicit_range (int, int);
|
||||
bool gfc_merge_new_implicit (gfc_typespec *);
|
||||
void gfc_set_implicit_none (void);
|
||||
void gfc_check_function_type (gfc_namespace *);
|
||||
bool gfc_is_intrinsic_typename (const char *);
|
||||
|
||||
gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *);
|
||||
gfc_try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
|
||||
bool gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
|
||||
|
||||
void gfc_set_sym_referenced (gfc_symbol *);
|
||||
|
||||
gfc_try gfc_add_attribute (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *);
|
||||
gfc_try gfc_add_allocatable (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_codimension (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_contiguous (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_dimension (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_external (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_intrinsic (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_optional (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_pointer (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_cray_pointer (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_cray_pointee (symbol_attribute *, locus *);
|
||||
bool gfc_add_attribute (symbol_attribute *, locus *);
|
||||
bool gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *);
|
||||
bool gfc_add_allocatable (symbol_attribute *, locus *);
|
||||
bool gfc_add_codimension (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_contiguous (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_dimension (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_external (symbol_attribute *, locus *);
|
||||
bool gfc_add_intrinsic (symbol_attribute *, locus *);
|
||||
bool gfc_add_optional (symbol_attribute *, locus *);
|
||||
bool gfc_add_pointer (symbol_attribute *, locus *);
|
||||
bool gfc_add_cray_pointer (symbol_attribute *, locus *);
|
||||
bool gfc_add_cray_pointee (symbol_attribute *, locus *);
|
||||
match gfc_mod_pointee_as (gfc_array_spec *);
|
||||
gfc_try gfc_add_protected (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_result (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
|
||||
gfc_try gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_saved_common (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_target (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_dummy (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_generic (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_common (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_in_common (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_data (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_sequence (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_elemental (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_pure (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_recursive (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_function (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_asynchronous (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
|
||||
gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where);
|
||||
bool gfc_add_protected (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_result (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
|
||||
bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_saved_common (symbol_attribute *, locus *);
|
||||
bool gfc_add_target (symbol_attribute *, locus *);
|
||||
bool gfc_add_dummy (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_generic (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_common (symbol_attribute *, locus *);
|
||||
bool gfc_add_in_common (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_data (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_sequence (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_elemental (symbol_attribute *, locus *);
|
||||
bool gfc_add_pure (symbol_attribute *, locus *);
|
||||
bool gfc_add_recursive (symbol_attribute *, locus *);
|
||||
bool gfc_add_function (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_subroutine (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_volatile (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_asynchronous (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
|
||||
bool gfc_add_abstract (symbol_attribute* attr, locus* where);
|
||||
|
||||
gfc_try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
|
||||
gfc_try gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
|
||||
gfc_try gfc_add_extension (symbol_attribute *, locus *);
|
||||
gfc_try gfc_add_value (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
|
||||
gfc_try gfc_add_entry (symbol_attribute *, const char *, locus *);
|
||||
gfc_try gfc_add_procedure (symbol_attribute *, procedure_type,
|
||||
bool gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
|
||||
bool gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
|
||||
bool gfc_add_extension (symbol_attribute *, locus *);
|
||||
bool gfc_add_value (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
|
||||
bool gfc_add_entry (symbol_attribute *, const char *, locus *);
|
||||
bool gfc_add_procedure (symbol_attribute *, procedure_type,
|
||||
const char *, locus *);
|
||||
gfc_try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
|
||||
gfc_try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
|
||||
bool gfc_add_intent (symbol_attribute *, sym_intent, locus *);
|
||||
bool gfc_add_explicit_interface (gfc_symbol *, ifsrc,
|
||||
gfc_formal_arglist *, locus *);
|
||||
gfc_try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
|
||||
bool gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
|
||||
|
||||
void gfc_clear_attr (symbol_attribute *);
|
||||
gfc_try gfc_missing_attr (symbol_attribute *, locus *);
|
||||
gfc_try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
|
||||
bool gfc_missing_attr (symbol_attribute *, locus *);
|
||||
bool gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
|
||||
|
||||
gfc_try gfc_add_component (gfc_symbol *, const char *, gfc_component **);
|
||||
bool gfc_add_component (gfc_symbol *, const char *, gfc_component **);
|
||||
gfc_symbol *gfc_use_derived (gfc_symbol *);
|
||||
gfc_symtree *gfc_use_derived_tree (gfc_symtree *);
|
||||
gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool);
|
||||
|
@ -2621,7 +2613,7 @@ gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool);
|
|||
gfc_st_label *gfc_get_st_label (int);
|
||||
void gfc_free_st_label (gfc_st_label *);
|
||||
void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
|
||||
gfc_try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
|
||||
bool gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
|
||||
|
||||
gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
|
||||
gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
|
||||
|
@ -2637,11 +2629,11 @@ gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
|
|||
int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
|
||||
int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
|
||||
int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
|
||||
gfc_try gfc_verify_c_interop (gfc_typespec *);
|
||||
gfc_try gfc_verify_c_interop_param (gfc_symbol *);
|
||||
gfc_try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
|
||||
gfc_try verify_bind_c_derived_type (gfc_symbol *);
|
||||
gfc_try verify_com_block_vars_c_interop (gfc_common_head *);
|
||||
bool gfc_verify_c_interop (gfc_typespec *);
|
||||
bool gfc_verify_c_interop_param (gfc_symbol *);
|
||||
bool verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
|
||||
bool verify_bind_c_derived_type (gfc_symbol *);
|
||||
bool verify_com_block_vars_c_interop (gfc_common_head *);
|
||||
gfc_symtree *generate_isocbinding_symbol (const char *, iso_c_binding_symbol,
|
||||
const char *, gfc_symtree *, bool);
|
||||
int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
|
||||
|
@ -2683,7 +2675,7 @@ void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *);
|
|||
|
||||
void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */
|
||||
|
||||
gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
|
||||
bool gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
|
||||
gfc_namespace* gfc_find_proc_namespace (gfc_namespace*);
|
||||
|
||||
bool gfc_is_associate_pointer (gfc_symbol*);
|
||||
|
@ -2704,9 +2696,9 @@ void gfc_intrinsic_done_1 (void);
|
|||
|
||||
char gfc_type_letter (bt);
|
||||
gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
|
||||
gfc_try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
|
||||
gfc_try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
|
||||
gfc_try gfc_convert_chartype (gfc_expr *, gfc_typespec *);
|
||||
bool gfc_convert_type (gfc_expr *, gfc_typespec *, int);
|
||||
bool gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
|
||||
bool gfc_convert_chartype (gfc_expr *, gfc_typespec *);
|
||||
int gfc_generic_intrinsic (const char *);
|
||||
int gfc_specific_intrinsic (const char *);
|
||||
bool gfc_is_intrinsic (gfc_symbol*, int, locus);
|
||||
|
@ -2723,7 +2715,7 @@ match gfc_intrinsic_func_interface (gfc_expr *, int);
|
|||
match gfc_intrinsic_sub_interface (gfc_code *, int);
|
||||
|
||||
void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool);
|
||||
gfc_try gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
|
||||
bool gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
|
||||
bool, locus);
|
||||
|
||||
/* match.c -- FIXME */
|
||||
|
@ -2755,13 +2747,13 @@ gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
|
|||
const char *gfc_extract_int (gfc_expr *, int *);
|
||||
bool is_subref_array (gfc_expr *);
|
||||
bool gfc_is_simply_contiguous (gfc_expr *, bool);
|
||||
gfc_try gfc_check_init_expr (gfc_expr *);
|
||||
bool gfc_check_init_expr (gfc_expr *);
|
||||
|
||||
gfc_expr *gfc_build_conversion (gfc_expr *);
|
||||
void gfc_free_ref_list (gfc_ref *);
|
||||
void gfc_type_convert_binary (gfc_expr *, int);
|
||||
int gfc_is_constant_expr (gfc_expr *);
|
||||
gfc_try gfc_simplify_expr (gfc_expr *, int);
|
||||
bool gfc_simplify_expr (gfc_expr *, int);
|
||||
int gfc_has_vector_index (gfc_expr *);
|
||||
|
||||
gfc_expr *gfc_get_expr (void);
|
||||
|
@ -2784,15 +2776,15 @@ mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
|
|||
gfc_expr *gfc_copy_expr (gfc_expr *);
|
||||
gfc_ref* gfc_copy_ref (gfc_ref*);
|
||||
|
||||
gfc_try gfc_specification_expr (gfc_expr *);
|
||||
bool gfc_specification_expr (gfc_expr *);
|
||||
|
||||
int gfc_numeric_ts (gfc_typespec *);
|
||||
int gfc_kind_max (gfc_expr *, gfc_expr *);
|
||||
|
||||
gfc_try gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
|
||||
gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int);
|
||||
gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *);
|
||||
bool gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
|
||||
bool gfc_check_assign (gfc_expr *, gfc_expr *, int);
|
||||
bool gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *);
|
||||
|
||||
bool gfc_has_default_initializer (gfc_symbol *);
|
||||
gfc_expr *gfc_default_initializer (gfc_typespec *);
|
||||
|
@ -2806,7 +2798,7 @@ bool gfc_traverse_expr (gfc_expr *, gfc_symbol *,
|
|||
bool (*)(gfc_expr *, gfc_symbol *, int*),
|
||||
int);
|
||||
void gfc_expr_set_symbols_referenced (gfc_expr *);
|
||||
gfc_try gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool);
|
||||
bool gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool);
|
||||
|
||||
gfc_component * gfc_get_proc_ptr_comp (gfc_expr *);
|
||||
bool gfc_is_proc_ptr_comp (gfc_expr *);
|
||||
|
@ -2820,7 +2812,7 @@ bool gfc_has_ultimate_pointer (gfc_expr *);
|
|||
|
||||
gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
|
||||
locus, unsigned, ...);
|
||||
gfc_try gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
|
||||
bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
|
||||
|
||||
|
||||
/* st.c */
|
||||
|
@ -2834,23 +2826,23 @@ void gfc_free_statements (gfc_code *);
|
|||
void gfc_free_association_list (gfc_association_list *);
|
||||
|
||||
/* resolve.c */
|
||||
gfc_try gfc_resolve_expr (gfc_expr *);
|
||||
bool gfc_resolve_expr (gfc_expr *);
|
||||
void gfc_resolve (gfc_namespace *);
|
||||
void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
|
||||
int gfc_impure_variable (gfc_symbol *);
|
||||
int gfc_pure (gfc_symbol *);
|
||||
int gfc_implicit_pure (gfc_symbol *);
|
||||
int gfc_elemental (gfc_symbol *);
|
||||
gfc_try gfc_resolve_iterator (gfc_iterator *, bool, bool);
|
||||
gfc_try find_forall_index (gfc_expr *, gfc_symbol *, int);
|
||||
gfc_try gfc_resolve_index (gfc_expr *, int);
|
||||
gfc_try gfc_resolve_dim_arg (gfc_expr *);
|
||||
bool gfc_resolve_iterator (gfc_iterator *, bool, bool);
|
||||
bool find_forall_index (gfc_expr *, gfc_symbol *, int);
|
||||
bool gfc_resolve_index (gfc_expr *, int);
|
||||
bool gfc_resolve_dim_arg (gfc_expr *);
|
||||
int gfc_is_formal_arg (void);
|
||||
void gfc_resolve_substring_charlen (gfc_expr *);
|
||||
match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *);
|
||||
gfc_expr *gfc_expr_to_initialize (gfc_expr *);
|
||||
bool gfc_type_is_extensible (gfc_symbol *);
|
||||
gfc_try gfc_resolve_intrinsic (gfc_symbol *, locus *);
|
||||
bool gfc_resolve_intrinsic (gfc_symbol *, locus *);
|
||||
|
||||
|
||||
/* array.c */
|
||||
|
@ -2859,31 +2851,31 @@ gfc_iterator *gfc_copy_iterator (gfc_iterator *);
|
|||
void gfc_free_array_spec (gfc_array_spec *);
|
||||
gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
|
||||
|
||||
gfc_try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
|
||||
bool gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
|
||||
gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
|
||||
gfc_try gfc_resolve_array_spec (gfc_array_spec *, int);
|
||||
bool gfc_resolve_array_spec (gfc_array_spec *, int);
|
||||
|
||||
int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
|
||||
|
||||
void gfc_simplify_iterator_var (gfc_expr *);
|
||||
gfc_try gfc_expand_constructor (gfc_expr *, bool);
|
||||
bool gfc_expand_constructor (gfc_expr *, bool);
|
||||
int gfc_constant_ac (gfc_expr *);
|
||||
int gfc_expanded_ac (gfc_expr *);
|
||||
gfc_try gfc_resolve_character_array_constructor (gfc_expr *);
|
||||
gfc_try gfc_resolve_array_constructor (gfc_expr *);
|
||||
gfc_try gfc_check_constructor_type (gfc_expr *);
|
||||
gfc_try gfc_check_iter_variable (gfc_expr *);
|
||||
gfc_try gfc_check_constructor (gfc_expr *, gfc_try (*)(gfc_expr *));
|
||||
gfc_try gfc_array_size (gfc_expr *, mpz_t *);
|
||||
gfc_try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
|
||||
gfc_try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
|
||||
bool gfc_resolve_character_array_constructor (gfc_expr *);
|
||||
bool gfc_resolve_array_constructor (gfc_expr *);
|
||||
bool gfc_check_constructor_type (gfc_expr *);
|
||||
bool gfc_check_iter_variable (gfc_expr *);
|
||||
bool gfc_check_constructor (gfc_expr *, bool (*)(gfc_expr *));
|
||||
bool gfc_array_size (gfc_expr *, mpz_t *);
|
||||
bool gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
|
||||
bool gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
|
||||
gfc_array_ref *gfc_find_array_ref (gfc_expr *);
|
||||
tree gfc_conv_array_initializer (tree type, gfc_expr *);
|
||||
gfc_try spec_size (gfc_array_spec *, mpz_t *);
|
||||
gfc_try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
|
||||
bool spec_size (gfc_array_spec *, mpz_t *);
|
||||
bool spec_dimen_size (gfc_array_spec *, int, mpz_t *);
|
||||
int gfc_is_compile_time_shape (gfc_array_spec *);
|
||||
|
||||
gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *);
|
||||
bool gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *);
|
||||
|
||||
|
||||
/* interface.c -- FIXME: some of these should be in symbol.c */
|
||||
|
@ -2893,15 +2885,15 @@ int gfc_compare_types (gfc_typespec *, gfc_typespec *);
|
|||
int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
|
||||
char *, int, const char *, const char *);
|
||||
void gfc_check_interfaces (gfc_namespace *);
|
||||
gfc_try gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
|
||||
bool gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
|
||||
void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *);
|
||||
gfc_symbol *gfc_search_interface (gfc_interface *, int,
|
||||
gfc_actual_arglist **);
|
||||
match gfc_extend_expr (gfc_expr *);
|
||||
void gfc_free_formal_arglist (gfc_formal_arglist *);
|
||||
gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *);
|
||||
gfc_try gfc_check_new_interface (gfc_interface *, gfc_symbol *, locus);
|
||||
gfc_try gfc_add_interface (gfc_symbol *);
|
||||
bool gfc_extend_assign (gfc_code *, gfc_namespace *);
|
||||
bool gfc_check_new_interface (gfc_interface *, gfc_symbol *, locus);
|
||||
bool gfc_add_interface (gfc_symbol *);
|
||||
gfc_interface *gfc_current_interface_head (void);
|
||||
void gfc_set_current_interface_head (gfc_interface *);
|
||||
gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
|
||||
|
@ -2909,23 +2901,23 @@ bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
|
|||
bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
|
||||
int gfc_has_vector_subscript (gfc_expr*);
|
||||
gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
|
||||
gfc_try gfc_check_typebound_override (gfc_symtree*, gfc_symtree*);
|
||||
bool gfc_check_typebound_override (gfc_symtree*, gfc_symtree*);
|
||||
|
||||
/* io.c */
|
||||
extern gfc_st_label format_asterisk;
|
||||
|
||||
void gfc_free_open (gfc_open *);
|
||||
gfc_try gfc_resolve_open (gfc_open *);
|
||||
bool gfc_resolve_open (gfc_open *);
|
||||
void gfc_free_close (gfc_close *);
|
||||
gfc_try gfc_resolve_close (gfc_close *);
|
||||
bool gfc_resolve_close (gfc_close *);
|
||||
void gfc_free_filepos (gfc_filepos *);
|
||||
gfc_try gfc_resolve_filepos (gfc_filepos *);
|
||||
bool gfc_resolve_filepos (gfc_filepos *);
|
||||
void gfc_free_inquire (gfc_inquire *);
|
||||
gfc_try gfc_resolve_inquire (gfc_inquire *);
|
||||
bool gfc_resolve_inquire (gfc_inquire *);
|
||||
void gfc_free_dt (gfc_dt *);
|
||||
gfc_try gfc_resolve_dt (gfc_dt *, locus *);
|
||||
bool gfc_resolve_dt (gfc_dt *, locus *);
|
||||
void gfc_free_wait (gfc_wait *);
|
||||
gfc_try gfc_resolve_wait (gfc_wait *);
|
||||
bool gfc_resolve_wait (gfc_wait *);
|
||||
|
||||
/* module.c */
|
||||
void gfc_module_init_2 (void);
|
||||
|
@ -2941,7 +2933,7 @@ match gfc_match_rvalue (gfc_expr **);
|
|||
match gfc_match_varspec (gfc_expr*, int, bool, bool);
|
||||
int gfc_check_digit (char, int);
|
||||
bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
|
||||
gfc_try gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *,
|
||||
bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *,
|
||||
gfc_expr **,
|
||||
gfc_actual_arglist **, bool);
|
||||
|
||||
|
@ -2962,7 +2954,7 @@ void gfc_delete_bbt (void *, void *, compare_fn);
|
|||
void gfc_dump_parse_tree (gfc_namespace *, FILE *);
|
||||
|
||||
/* parse.c */
|
||||
gfc_try gfc_parse_file (void);
|
||||
bool gfc_parse_file (void);
|
||||
void gfc_global_used (gfc_gsymbol *, locus *);
|
||||
gfc_namespace* gfc_build_block_ns (gfc_namespace *);
|
||||
|
||||
|
@ -2972,8 +2964,8 @@ int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
|
|||
bool gfc_dep_difference (gfc_expr *, gfc_expr *, mpz_t *);
|
||||
|
||||
/* check.c */
|
||||
gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
|
||||
gfc_try gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*,
|
||||
bool gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
|
||||
bool gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*,
|
||||
size_t*, size_t*, size_t*);
|
||||
|
||||
/* class.c */
|
||||
|
@ -2991,15 +2983,15 @@ bool gfc_is_class_scalar_expr (gfc_expr *);
|
|||
bool gfc_is_class_container_ref (gfc_expr *e);
|
||||
gfc_expr *gfc_class_null_initializer (gfc_typespec *, gfc_expr *);
|
||||
unsigned int gfc_hash_value (gfc_symbol *);
|
||||
gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
|
||||
bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
|
||||
gfc_array_spec **, bool);
|
||||
gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
|
||||
gfc_symbol *gfc_find_intrinsic_vtab (gfc_typespec *);
|
||||
gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*,
|
||||
gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, bool*,
|
||||
const char*, bool, locus*);
|
||||
gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*,
|
||||
gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, bool*,
|
||||
const char*, bool, locus*);
|
||||
gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*,
|
||||
gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, bool*,
|
||||
gfc_intrinsic_op, bool,
|
||||
locus*);
|
||||
gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
|
||||
|
|
|
@ -213,7 +213,7 @@ gfc_match_interface (void)
|
|||
return MATCH_ERROR;
|
||||
|
||||
if (!sym->attr.generic
|
||||
&& gfc_add_generic (&sym->attr, sym->name, NULL) == FAILURE)
|
||||
&& !gfc_add_generic (&sym->attr, sym->name, NULL))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (sym->attr.dummy)
|
||||
|
@ -251,8 +251,7 @@ gfc_match_abstract_interface (void)
|
|||
{
|
||||
match m;
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F2003, "ABSTRACT INTERFACE at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "ABSTRACT INTERFACE at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
m = gfc_match_eos ();
|
||||
|
@ -326,23 +325,23 @@ gfc_match_end_interface (void)
|
|||
|
||||
/* The following if-statements are used to enforce C1202
|
||||
from F2003. */
|
||||
if ((strcmp(s1, "==") == 0 && strcmp(s2, ".eq.") == 0)
|
||||
|| (strcmp(s1, ".eq.") == 0 && strcmp(s2, "==") == 0))
|
||||
if ((strcmp(s1, "==") == 0 && strcmp (s2, ".eq.") == 0)
|
||||
|| (strcmp(s1, ".eq.") == 0 && strcmp (s2, "==") == 0))
|
||||
break;
|
||||
if ((strcmp(s1, "/=") == 0 && strcmp(s2, ".ne.") == 0)
|
||||
|| (strcmp(s1, ".ne.") == 0 && strcmp(s2, "/=") == 0))
|
||||
if ((strcmp(s1, "/=") == 0 && strcmp (s2, ".ne.") == 0)
|
||||
|| (strcmp(s1, ".ne.") == 0 && strcmp (s2, "/=") == 0))
|
||||
break;
|
||||
if ((strcmp(s1, "<=") == 0 && strcmp(s2, ".le.") == 0)
|
||||
|| (strcmp(s1, ".le.") == 0 && strcmp(s2, "<=") == 0))
|
||||
if ((strcmp(s1, "<=") == 0 && strcmp (s2, ".le.") == 0)
|
||||
|| (strcmp(s1, ".le.") == 0 && strcmp (s2, "<=") == 0))
|
||||
break;
|
||||
if ((strcmp(s1, "<") == 0 && strcmp(s2, ".lt.") == 0)
|
||||
|| (strcmp(s1, ".lt.") == 0 && strcmp(s2, "<") == 0))
|
||||
if ((strcmp(s1, "<") == 0 && strcmp (s2, ".lt.") == 0)
|
||||
|| (strcmp(s1, ".lt.") == 0 && strcmp (s2, "<") == 0))
|
||||
break;
|
||||
if ((strcmp(s1, ">=") == 0 && strcmp(s2, ".ge.") == 0)
|
||||
|| (strcmp(s1, ".ge.") == 0 && strcmp(s2, ">=") == 0))
|
||||
if ((strcmp(s1, ">=") == 0 && strcmp (s2, ".ge.") == 0)
|
||||
|| (strcmp(s1, ".ge.") == 0 && strcmp (s2, ">=") == 0))
|
||||
break;
|
||||
if ((strcmp(s1, ">") == 0 && strcmp(s2, ".gt.") == 0)
|
||||
|| (strcmp(s1, ".gt.") == 0 && strcmp(s2, ">") == 0))
|
||||
if ((strcmp(s1, ">") == 0 && strcmp (s2, ".gt.") == 0)
|
||||
|| (strcmp(s1, ".gt.") == 0 && strcmp (s2, ">") == 0))
|
||||
break;
|
||||
|
||||
m = MATCH_ERROR;
|
||||
|
@ -1019,19 +1018,19 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2,
|
|||
/* Check if the characteristics of two dummy arguments match,
|
||||
cf. F08:12.3.2. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
||||
bool type_must_agree, char *errmsg, int err_len)
|
||||
{
|
||||
if (s1 == NULL || s2 == NULL)
|
||||
return s1 == s2 ? SUCCESS : FAILURE;
|
||||
return s1 == s2 ? true : false;
|
||||
|
||||
/* Check type and rank. */
|
||||
if (type_must_agree && !compare_type_rank (s2, s1))
|
||||
{
|
||||
snprintf (errmsg, err_len, "Type/rank mismatch in argument '%s'",
|
||||
s1->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check INTENT. */
|
||||
|
@ -1039,7 +1038,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "INTENT mismatch in argument '%s'",
|
||||
s1->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check OPTIONAL attribute. */
|
||||
|
@ -1047,7 +1046,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "OPTIONAL mismatch in argument '%s'",
|
||||
s1->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check ALLOCATABLE attribute. */
|
||||
|
@ -1055,7 +1054,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "ALLOCATABLE mismatch in argument '%s'",
|
||||
s1->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check POINTER attribute. */
|
||||
|
@ -1063,7 +1062,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "POINTER mismatch in argument '%s'",
|
||||
s1->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check TARGET attribute. */
|
||||
|
@ -1071,7 +1070,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "TARGET mismatch in argument '%s'",
|
||||
s1->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* FIXME: Do more comprehensive testing of attributes, like e.g.
|
||||
|
@ -1086,7 +1085,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "Interface mismatch in dummy procedure "
|
||||
"'%s': %s", s1->name, err);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -1104,7 +1103,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
case -3:
|
||||
snprintf (errmsg, err_len, "Character length mismatch "
|
||||
"in argument '%s'", s1->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
case -2:
|
||||
/* FIXME: Implement a warning for this case.
|
||||
|
@ -1132,7 +1131,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "Shape mismatch in argument '%s'",
|
||||
s1->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (s1->as->type == AS_EXPLICIT)
|
||||
|
@ -1152,7 +1151,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
case -3:
|
||||
snprintf (errmsg, err_len, "Shape mismatch in dimension %i of "
|
||||
"argument '%s'", i + 1, s1->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
case -2:
|
||||
/* FIXME: Implement a warning for this case.
|
||||
|
@ -1172,14 +1171,14 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
/* Check if the characteristics of two function results match,
|
||||
cf. F08:12.3.3. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
||||
char *errmsg, int err_len)
|
||||
{
|
||||
|
@ -1189,13 +1188,13 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
r2 = s2->result ? s2->result : s2;
|
||||
|
||||
if (r1->ts.type == BT_UNKNOWN)
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
/* Check type and rank. */
|
||||
if (!compare_type_rank (r1, r2))
|
||||
{
|
||||
snprintf (errmsg, err_len, "Type/rank mismatch in function result");
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check ALLOCATABLE attribute. */
|
||||
|
@ -1203,7 +1202,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "ALLOCATABLE attribute mismatch in "
|
||||
"function result");
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check POINTER attribute. */
|
||||
|
@ -1211,7 +1210,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "POINTER attribute mismatch in "
|
||||
"function result");
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check CONTIGUOUS attribute. */
|
||||
|
@ -1219,7 +1218,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "CONTIGUOUS attribute mismatch in "
|
||||
"function result");
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check PROCEDURE POINTER attribute. */
|
||||
|
@ -1227,7 +1226,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "PROCEDURE POINTER mismatch in "
|
||||
"function result");
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check string length. */
|
||||
|
@ -1237,7 +1236,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
{
|
||||
snprintf (errmsg, err_len, "Character length mismatch "
|
||||
"in function result");
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (r1->ts.u.cl->length)
|
||||
|
@ -1251,7 +1250,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
case -3:
|
||||
snprintf (errmsg, err_len, "Character length mismatch "
|
||||
"in function result");
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
case -2:
|
||||
/* FIXME: Implement a warning for this case.
|
||||
|
@ -1279,7 +1278,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
if (r1->as->type != r2->as->type)
|
||||
{
|
||||
snprintf (errmsg, err_len, "Shape mismatch in function result");
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (r1->as->type == AS_EXPLICIT)
|
||||
|
@ -1299,7 +1298,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
case -3:
|
||||
snprintf (errmsg, err_len, "Shape mismatch in dimension %i of "
|
||||
"function result", i + 1);
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
case -2:
|
||||
/* FIXME: Implement a warning for this case.
|
||||
|
@ -1318,7 +1317,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
|
|||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -1362,8 +1361,7 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
|
|||
if (s1->attr.function && s2->attr.function)
|
||||
{
|
||||
/* If both are functions, check result characteristics. */
|
||||
if (check_result_characteristics (s1, s2, errmsg, err_len)
|
||||
== FAILURE)
|
||||
if (!check_result_characteristics (s1, s2, errmsg, err_len))
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
@ -1423,8 +1421,8 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
|
|||
if (strict_flag)
|
||||
{
|
||||
/* Check all characteristics. */
|
||||
if (check_dummy_characteristics (f1->sym, f2->sym,
|
||||
true, errmsg, err_len) == FAILURE)
|
||||
if (!check_dummy_characteristics (f1->sym, f2->sym, true,
|
||||
errmsg, err_len))
|
||||
return 0;
|
||||
}
|
||||
else if (!compare_type_rank (f2->sym, f1->sym))
|
||||
|
@ -1491,9 +1489,9 @@ check_interface0 (gfc_interface *p, const char *interface_name)
|
|||
|
||||
/* F2003, C1207. F2008, C1207. */
|
||||
if (p->sym->attr.proc == PROC_INTERNAL
|
||||
&& gfc_notify_std (GFC_STD_F2008, "Internal procedure "
|
||||
"'%s' in %s at %L", p->sym->name, interface_name,
|
||||
&p->sym->declared_at) == FAILURE)
|
||||
&& !gfc_notify_std (GFC_STD_F2008, "Internal procedure "
|
||||
"'%s' in %s at %L", p->sym->name,
|
||||
interface_name, &p->sym->declared_at))
|
||||
return 1;
|
||||
}
|
||||
p = psave;
|
||||
|
@ -1879,7 +1877,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
|
|||
gfc_add_function (&act_sym->attr, act_sym->name,
|
||||
&act_sym->declared_at);
|
||||
if (act_sym->ts.type == BT_UNKNOWN
|
||||
&& gfc_set_default_type (act_sym, 1, act_sym->ns) == FAILURE)
|
||||
&& !gfc_set_default_type (act_sym, 1, act_sym->ns))
|
||||
return 0;
|
||||
}
|
||||
else if (formal->attr.subroutine && !act_sym->attr.subroutine)
|
||||
|
@ -2478,7 +2476,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
|||
|
||||
/* Make sure that intrinsic vtables exist for calls to unlimited
|
||||
polymorphic formal arguments. */
|
||||
if (UNLIMITED_POLY(f->sym)
|
||||
if (UNLIMITED_POLY (f->sym)
|
||||
&& a->expr->ts.type != BT_DERIVED
|
||||
&& a->expr->ts.type != BT_CLASS)
|
||||
gfc_find_intrinsic_vtab (&a->expr->ts);
|
||||
|
@ -2528,7 +2526,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
|||
gfc_error ("Actual argument at %L to assumed-type dummy is of "
|
||||
"derived type with type-bound or FINAL procedures",
|
||||
&a->expr->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -2741,11 +2739,9 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
|||
if (((f->sym->ts.type == BT_CLASS && f->sym->attr.class_ok
|
||||
&& CLASS_DATA (f->sym)->attr.class_pointer)
|
||||
|| (f->sym->ts.type != BT_CLASS && f->sym->attr.pointer))
|
||||
&& gfc_check_vardef_context (a->expr, true, false, false, context)
|
||||
== FAILURE)
|
||||
&& !gfc_check_vardef_context (a->expr, true, false, false, context))
|
||||
return 0;
|
||||
if (gfc_check_vardef_context (a->expr, false, false, false, context)
|
||||
== FAILURE)
|
||||
if (!gfc_check_vardef_context (a->expr, false, false, false, context))
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
@ -2919,9 +2915,9 @@ pair_cmp (const void *p1, const void *p2)
|
|||
|
||||
/* Given two expressions from some actual arguments, test whether they
|
||||
refer to the same expression. The analysis is conservative.
|
||||
Returning FAILURE will produce no warning. */
|
||||
Returning false will produce no warning. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
compare_actual_expr (gfc_expr *e1, gfc_expr *e2)
|
||||
{
|
||||
const gfc_ref *r1, *r2;
|
||||
|
@ -2930,39 +2926,39 @@ compare_actual_expr (gfc_expr *e1, gfc_expr *e2)
|
|||
|| e1->expr_type != EXPR_VARIABLE
|
||||
|| e2->expr_type != EXPR_VARIABLE
|
||||
|| e1->symtree->n.sym != e2->symtree->n.sym)
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
/* TODO: improve comparison, see expr.c:show_ref(). */
|
||||
for (r1 = e1->ref, r2 = e2->ref; r1 && r2; r1 = r1->next, r2 = r2->next)
|
||||
{
|
||||
if (r1->type != r2->type)
|
||||
return FAILURE;
|
||||
return false;
|
||||
switch (r1->type)
|
||||
{
|
||||
case REF_ARRAY:
|
||||
if (r1->u.ar.type != r2->u.ar.type)
|
||||
return FAILURE;
|
||||
return false;
|
||||
/* TODO: At the moment, consider only full arrays;
|
||||
we could do better. */
|
||||
if (r1->u.ar.type != AR_FULL || r2->u.ar.type != AR_FULL)
|
||||
return FAILURE;
|
||||
return false;
|
||||
break;
|
||||
|
||||
case REF_COMPONENT:
|
||||
if (r1->u.c.component != r2->u.c.component)
|
||||
return FAILURE;
|
||||
return false;
|
||||
break;
|
||||
|
||||
case REF_SUBSTRING:
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
default:
|
||||
gfc_internal_error ("compare_actual_expr(): Bad component code");
|
||||
}
|
||||
}
|
||||
if (!r1 && !r2)
|
||||
return SUCCESS;
|
||||
return FAILURE;
|
||||
return true;
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
|
@ -2970,7 +2966,7 @@ compare_actual_expr (gfc_expr *e1, gfc_expr *e2)
|
|||
another, check that identical actual arguments aren't not
|
||||
associated with some incompatible INTENTs. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
||||
{
|
||||
sym_intent f1_intent, f2_intent;
|
||||
|
@ -2978,7 +2974,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
|||
gfc_actual_arglist *a1;
|
||||
size_t n, i, j;
|
||||
argpair *p;
|
||||
gfc_try t = SUCCESS;
|
||||
bool t = true;
|
||||
|
||||
n = 0;
|
||||
for (f1 = f, a1 = a;; f1 = f1->next, a1 = a1->next)
|
||||
|
@ -3015,7 +3011,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
|||
gfc_internal_error ("check_some_aliasing(): corrupted data");
|
||||
|
||||
/* Are the expression the same? */
|
||||
if (compare_actual_expr (p[i].a->expr, p[j].a->expr) == FAILURE)
|
||||
if (!compare_actual_expr (p[i].a->expr, p[j].a->expr))
|
||||
break;
|
||||
f2_intent = p[j].f->sym->attr.intent;
|
||||
if ((f1_intent == INTENT_IN && f2_intent == INTENT_OUT)
|
||||
|
@ -3026,7 +3022,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
|||
gfc_intent_string (f1_intent), p[i].f->sym->name,
|
||||
gfc_intent_string (f2_intent), p[j].f->sym->name,
|
||||
&p[i].a->expr->where);
|
||||
t = FAILURE;
|
||||
t = false;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -3039,7 +3035,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
|||
another, check that they are compatible in the sense that intents
|
||||
are not mismatched. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
||||
{
|
||||
sym_intent f_intent;
|
||||
|
@ -3065,7 +3061,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
|||
gfc_error ("Procedure argument at %L is local to a PURE "
|
||||
"procedure and has the POINTER attribute",
|
||||
&a->expr->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -3077,7 +3073,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
|||
gfc_error ("Coindexed actual argument at %L in PURE procedure "
|
||||
"is passed to an INTENT(%s) argument",
|
||||
&a->expr->where, gfc_intent_string (f_intent));
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if ((f->sym->ts.type == BT_CLASS && f->sym->attr.class_ok
|
||||
|
@ -3087,7 +3083,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
|||
gfc_error ("Coindexed actual argument at %L in PURE procedure "
|
||||
"is passed to a POINTER dummy argument",
|
||||
&a->expr->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -3098,11 +3094,11 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
|||
gfc_error ("Coindexed polymorphic actual argument at %L is passed "
|
||||
"polymorphic dummy argument '%s'",
|
||||
&a->expr->where, f->sym->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -3110,7 +3106,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
|
|||
well, the actual argument list will also end up being properly
|
||||
sorted. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
|
||||
{
|
||||
gfc_formal_arglist *dummy_args;
|
||||
|
@ -3139,7 +3135,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
|
|||
gfc_error("The pointer object '%s' at %L must have an explicit "
|
||||
"function interface or be declared as array",
|
||||
sym->name, where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (sym->attr.allocatable && !sym->attr.external)
|
||||
|
@ -3147,14 +3143,14 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
|
|||
gfc_error("The allocatable object '%s' at %L must have an explicit "
|
||||
"function interface or be declared as array",
|
||||
sym->name, where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (sym->attr.allocatable)
|
||||
{
|
||||
gfc_error("Allocatable function '%s' at %L must have an explicit "
|
||||
"function interface", sym->name, where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
for (a = *ap; a; a = a->next)
|
||||
|
@ -3194,7 +3190,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
|
|||
&& a->expr->ts.type == BT_UNKNOWN)
|
||||
{
|
||||
gfc_error ("MOLD argument to NULL required at %L", &a->expr->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* TS 29113, C407b. */
|
||||
|
@ -3203,25 +3199,25 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
|
|||
{
|
||||
gfc_error ("Assumed-rank argument requires an explicit interface "
|
||||
"at %L", &a->expr->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
dummy_args = gfc_sym_get_dummy_args (sym);
|
||||
|
||||
if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental, where))
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
if (check_intents (dummy_args, *ap) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!check_intents (dummy_args, *ap))
|
||||
return false;
|
||||
|
||||
if (gfc_option.warn_aliasing)
|
||||
check_some_aliasing (dummy_args, *ap);
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -3427,7 +3423,7 @@ matching_typebound_op (gfc_expr** tb_base,
|
|||
{
|
||||
gfc_typebound_proc* tb;
|
||||
gfc_symbol* derived;
|
||||
gfc_try result;
|
||||
bool result;
|
||||
|
||||
while (base->expr->expr_type == EXPR_OP
|
||||
&& base->expr->value.op.op == INTRINSIC_PARENTHESES)
|
||||
|
@ -3462,7 +3458,7 @@ matching_typebound_op (gfc_expr** tb_base,
|
|||
|
||||
/* This means we hit a PRIVATE operator which is use-associated and
|
||||
should thus not be seen. */
|
||||
if (result == FAILURE)
|
||||
if (!result)
|
||||
tb = NULL;
|
||||
|
||||
/* Look through the super-type hierarchy for a matching specific
|
||||
|
@ -3653,13 +3649,13 @@ gfc_extend_expr (gfc_expr *e)
|
|||
a call to it and succeed. */
|
||||
if (tbo)
|
||||
{
|
||||
gfc_try result;
|
||||
bool result;
|
||||
|
||||
gcc_assert (tb_base);
|
||||
build_compcall_for_operator (e, actual, tb_base, tbo, gname);
|
||||
|
||||
result = gfc_resolve_expr (e);
|
||||
if (result == FAILURE)
|
||||
if (!result)
|
||||
return MATCH_ERROR;
|
||||
|
||||
return MATCH_YES;
|
||||
|
@ -3681,7 +3677,7 @@ gfc_extend_expr (gfc_expr *e)
|
|||
e->value.function.name = NULL;
|
||||
e->user_operator = 1;
|
||||
|
||||
if (gfc_resolve_expr (e) == FAILURE)
|
||||
if (!gfc_resolve_expr (e))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return MATCH_YES;
|
||||
|
@ -3690,10 +3686,10 @@ gfc_extend_expr (gfc_expr *e)
|
|||
|
||||
/* Tries to replace an assignment code node with a subroutine call to
|
||||
the subroutine associated with the assignment operator. Return
|
||||
SUCCESS if the node was replaced. On FAILURE, no error is
|
||||
true if the node was replaced. On false, no error is
|
||||
generated. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
|
||||
{
|
||||
gfc_actual_arglist *actual;
|
||||
|
@ -3711,7 +3707,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
|
|||
&& (rhs->rank == 0 || rhs->rank == lhs->rank)
|
||||
&& (lhs->ts.type == rhs->ts.type
|
||||
|| (gfc_numeric_ts (&lhs->ts) && gfc_numeric_ts (&rhs->ts))))
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
actual = gfc_get_actual_arglist ();
|
||||
actual->expr = lhs;
|
||||
|
@ -3753,12 +3749,12 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
|
|||
|
||||
/* c is resolved from the caller, so no need to do it here. */
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
free (actual->next);
|
||||
free (actual);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Replace the assignment with the call. */
|
||||
|
@ -3768,7 +3764,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
|
|||
c->expr2 = NULL;
|
||||
c->ext.actual = actual;
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -3776,7 +3772,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
|
|||
the given interface list. Ambiguity isn't checked yet since module
|
||||
procedures can be present without interfaces. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_check_new_interface (gfc_interface *base, gfc_symbol *new_sym, locus loc)
|
||||
{
|
||||
gfc_interface *ip;
|
||||
|
@ -3787,17 +3783,17 @@ gfc_check_new_interface (gfc_interface *base, gfc_symbol *new_sym, locus loc)
|
|||
{
|
||||
gfc_error ("Entity '%s' at %L is already present in the interface",
|
||||
new_sym->name, &loc);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
/* Add a symbol to the current interface. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_add_interface (gfc_symbol *new_sym)
|
||||
{
|
||||
gfc_interface **head, *intr;
|
||||
|
@ -3808,7 +3804,7 @@ gfc_add_interface (gfc_symbol *new_sym)
|
|||
{
|
||||
case INTERFACE_NAMELESS:
|
||||
case INTERFACE_ABSTRACT:
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
case INTERFACE_INTRINSIC_OP:
|
||||
for (ns = current_interface.ns; ns; ns = ns->parent)
|
||||
|
@ -3816,62 +3812,62 @@ gfc_add_interface (gfc_symbol *new_sym)
|
|||
{
|
||||
case INTRINSIC_EQ:
|
||||
case INTRINSIC_EQ_OS:
|
||||
if (gfc_check_new_interface (ns->op[INTRINSIC_EQ], new_sym,
|
||||
gfc_current_locus) == FAILURE
|
||||
|| gfc_check_new_interface (ns->op[INTRINSIC_EQ_OS], new_sym,
|
||||
gfc_current_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_new_interface (ns->op[INTRINSIC_EQ], new_sym,
|
||||
gfc_current_locus)
|
||||
|| !gfc_check_new_interface (ns->op[INTRINSIC_EQ_OS],
|
||||
new_sym, gfc_current_locus))
|
||||
return false;
|
||||
break;
|
||||
|
||||
case INTRINSIC_NE:
|
||||
case INTRINSIC_NE_OS:
|
||||
if (gfc_check_new_interface (ns->op[INTRINSIC_NE], new_sym,
|
||||
gfc_current_locus) == FAILURE
|
||||
|| gfc_check_new_interface (ns->op[INTRINSIC_NE_OS], new_sym,
|
||||
gfc_current_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_new_interface (ns->op[INTRINSIC_NE], new_sym,
|
||||
gfc_current_locus)
|
||||
|| !gfc_check_new_interface (ns->op[INTRINSIC_NE_OS],
|
||||
new_sym, gfc_current_locus))
|
||||
return false;
|
||||
break;
|
||||
|
||||
case INTRINSIC_GT:
|
||||
case INTRINSIC_GT_OS:
|
||||
if (gfc_check_new_interface (ns->op[INTRINSIC_GT], new_sym,
|
||||
gfc_current_locus) == FAILURE
|
||||
|| gfc_check_new_interface (ns->op[INTRINSIC_GT_OS], new_sym,
|
||||
gfc_current_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_new_interface (ns->op[INTRINSIC_GT],
|
||||
new_sym, gfc_current_locus)
|
||||
|| !gfc_check_new_interface (ns->op[INTRINSIC_GT_OS],
|
||||
new_sym, gfc_current_locus))
|
||||
return false;
|
||||
break;
|
||||
|
||||
case INTRINSIC_GE:
|
||||
case INTRINSIC_GE_OS:
|
||||
if (gfc_check_new_interface (ns->op[INTRINSIC_GE], new_sym,
|
||||
gfc_current_locus) == FAILURE
|
||||
|| gfc_check_new_interface (ns->op[INTRINSIC_GE_OS], new_sym,
|
||||
gfc_current_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_new_interface (ns->op[INTRINSIC_GE],
|
||||
new_sym, gfc_current_locus)
|
||||
|| !gfc_check_new_interface (ns->op[INTRINSIC_GE_OS],
|
||||
new_sym, gfc_current_locus))
|
||||
return false;
|
||||
break;
|
||||
|
||||
case INTRINSIC_LT:
|
||||
case INTRINSIC_LT_OS:
|
||||
if (gfc_check_new_interface (ns->op[INTRINSIC_LT], new_sym,
|
||||
gfc_current_locus) == FAILURE
|
||||
|| gfc_check_new_interface (ns->op[INTRINSIC_LT_OS], new_sym,
|
||||
gfc_current_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_new_interface (ns->op[INTRINSIC_LT],
|
||||
new_sym, gfc_current_locus)
|
||||
|| !gfc_check_new_interface (ns->op[INTRINSIC_LT_OS],
|
||||
new_sym, gfc_current_locus))
|
||||
return false;
|
||||
break;
|
||||
|
||||
case INTRINSIC_LE:
|
||||
case INTRINSIC_LE_OS:
|
||||
if (gfc_check_new_interface (ns->op[INTRINSIC_LE], new_sym,
|
||||
gfc_current_locus) == FAILURE
|
||||
|| gfc_check_new_interface (ns->op[INTRINSIC_LE_OS], new_sym,
|
||||
gfc_current_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_new_interface (ns->op[INTRINSIC_LE],
|
||||
new_sym, gfc_current_locus)
|
||||
|| !gfc_check_new_interface (ns->op[INTRINSIC_LE_OS],
|
||||
new_sym, gfc_current_locus))
|
||||
return false;
|
||||
break;
|
||||
|
||||
default:
|
||||
if (gfc_check_new_interface (ns->op[current_interface.op], new_sym,
|
||||
gfc_current_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_new_interface (ns->op[current_interface.op],
|
||||
new_sym, gfc_current_locus))
|
||||
return false;
|
||||
}
|
||||
|
||||
head = ¤t_interface.ns->op[current_interface.op];
|
||||
|
@ -3884,18 +3880,18 @@ gfc_add_interface (gfc_symbol *new_sym)
|
|||
if (sym == NULL)
|
||||
continue;
|
||||
|
||||
if (gfc_check_new_interface (sym->generic, new_sym, gfc_current_locus)
|
||||
== FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_new_interface (sym->generic,
|
||||
new_sym, gfc_current_locus))
|
||||
return false;
|
||||
}
|
||||
|
||||
head = ¤t_interface.sym->generic;
|
||||
break;
|
||||
|
||||
case INTERFACE_USER_OP:
|
||||
if (gfc_check_new_interface (current_interface.uop->op, new_sym,
|
||||
gfc_current_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_new_interface (current_interface.uop->op,
|
||||
new_sym, gfc_current_locus))
|
||||
return false;
|
||||
|
||||
head = ¤t_interface.uop->op;
|
||||
break;
|
||||
|
@ -3911,7 +3907,7 @@ gfc_add_interface (gfc_symbol *new_sym)
|
|||
intr->next = *head;
|
||||
*head = intr;
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -3980,7 +3976,7 @@ gfc_free_formal_arglist (gfc_formal_arglist *p)
|
|||
/* Check that it is ok for the type-bound procedure 'proc' to override the
|
||||
procedure 'old', cf. F08:4.5.7.3. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
||||
{
|
||||
locus where;
|
||||
|
@ -3998,7 +3994,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("Can't overwrite GENERIC '%s' at %L",
|
||||
old->name, &proc->n.tb->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
where = proc->n.tb->where;
|
||||
|
@ -4010,7 +4006,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("'%s' at %L overrides a procedure binding declared"
|
||||
" NON_OVERRIDABLE", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* It's an error to override a non-DEFERRED procedure with a DEFERRED one. */
|
||||
|
@ -4018,7 +4014,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
|
||||
" non-DEFERRED binding", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If the overridden binding is PURE, the overriding must be, too. */
|
||||
|
@ -4026,7 +4022,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE",
|
||||
proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If the overridden binding is ELEMENTAL, the overriding must be, too. If it
|
||||
|
@ -4035,13 +4031,13 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be"
|
||||
" ELEMENTAL", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
if (!old_target->attr.elemental && proc_target->attr.elemental)
|
||||
{
|
||||
gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not"
|
||||
" be ELEMENTAL, either", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If the overridden binding is a SUBROUTINE, the overriding must also be a
|
||||
|
@ -4050,7 +4046,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a"
|
||||
" SUBROUTINE", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If the overridden binding is a FUNCTION, the overriding must also be a
|
||||
|
@ -4061,15 +4057,15 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("'%s' at %L overrides a FUNCTION and must also be a"
|
||||
" FUNCTION", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (check_result_characteristics (proc_target, old_target,
|
||||
err, sizeof(err)) == FAILURE)
|
||||
if (!check_result_characteristics (proc_target, old_target, err,
|
||||
sizeof(err)))
|
||||
{
|
||||
gfc_error ("Result mismatch for the overriding procedure "
|
||||
"'%s' at %L: %s", proc->name, &where, err);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -4080,7 +4076,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be"
|
||||
" PRIVATE", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Compare the formal argument lists of both procedures. This is also abused
|
||||
|
@ -4112,16 +4108,16 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
" to match the corresponding argument of the overridden"
|
||||
" procedure", proc_formal->sym->name, proc->name, &where,
|
||||
old_formal->sym->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
check_type = proc_pass_arg != argpos && old_pass_arg != argpos;
|
||||
if (check_dummy_characteristics (proc_formal->sym, old_formal->sym,
|
||||
check_type, err, sizeof(err)) == FAILURE)
|
||||
if (!check_dummy_characteristics (proc_formal->sym, old_formal->sym,
|
||||
check_type, err, sizeof(err)))
|
||||
{
|
||||
gfc_error ("Argument mismatch for the overriding procedure "
|
||||
"'%s' at %L: %s", proc->name, &where, err);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
++argpos;
|
||||
|
@ -4130,7 +4126,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("'%s' at %L must have the same number of formal arguments as"
|
||||
" the overridden procedure", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If the overridden binding is NOPASS, the overriding one must also be
|
||||
|
@ -4139,7 +4135,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("'%s' at %L overrides a NOPASS binding and must also be"
|
||||
" NOPASS", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If the overridden binding is PASS(x), the overriding one must also be
|
||||
|
@ -4150,7 +4146,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
{
|
||||
gfc_error ("'%s' at %L overrides a binding with PASS and must also be"
|
||||
" PASS", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (proc_pass_arg != old_pass_arg)
|
||||
|
@ -4158,9 +4154,9 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
|||
gfc_error ("Passed-object dummy argument of '%s' at %L must be at"
|
||||
" the same position as the passed-object dummy argument of"
|
||||
" the overridden procedure", proc->name, &where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
|
|
@ -178,7 +178,7 @@ find_char_conv (gfc_typespec *from, gfc_typespec *to)
|
|||
and call the proper check function rather than forcing each
|
||||
function to manipulate the argument list. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
|
||||
{
|
||||
gfc_expr *a1, *a2, *a3, *a4, *a5;
|
||||
|
@ -343,7 +343,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
|
|||
static void
|
||||
add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
|
||||
int kind, int standard,
|
||||
gfc_try (*check) (void),
|
||||
bool (*check) (void),
|
||||
gfc_expr *(*simplify) (void),
|
||||
void (*resolve) (gfc_expr *))
|
||||
{
|
||||
|
@ -386,7 +386,7 @@ add_sym_0s (const char *name, gfc_isym_id id, int standard,
|
|||
static void
|
||||
add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
|
||||
int kind, int standard,
|
||||
gfc_try (*check) (gfc_expr *),
|
||||
bool (*check) (gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *),
|
||||
void (*resolve) (gfc_expr *, gfc_expr *),
|
||||
const char *a1, bt type1, int kind1, int optional1)
|
||||
|
@ -411,7 +411,7 @@ add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty
|
|||
static void
|
||||
add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl,
|
||||
int actual_ok, bt type, int kind, int standard,
|
||||
gfc_try (*check) (gfc_expr *),
|
||||
bool (*check) (gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *),
|
||||
void (*resolve) (gfc_expr *, gfc_expr *),
|
||||
const char *a1, bt type1, int kind1, int optional1,
|
||||
|
@ -436,7 +436,7 @@ add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl,
|
|||
|
||||
static void
|
||||
add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
|
||||
int standard, gfc_try (*check) (gfc_expr *),
|
||||
int standard, bool (*check) (gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_code *),
|
||||
const char *a1, bt type1, int kind1, int optional1,
|
||||
sym_intent intent1)
|
||||
|
@ -461,7 +461,7 @@ add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
|
|||
static void
|
||||
add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
|
||||
int kind, int standard,
|
||||
gfc_try (*check) (gfc_actual_arglist *),
|
||||
bool (*check) (gfc_actual_arglist *),
|
||||
gfc_expr *(*simplify) (gfc_expr *),
|
||||
void (*resolve) (gfc_expr *, gfc_actual_arglist *),
|
||||
const char *a1, bt type1, int kind1, int optional1,
|
||||
|
@ -488,7 +488,7 @@ add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt t
|
|||
static void
|
||||
add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
|
||||
int kind, int standard,
|
||||
gfc_try (*check) (gfc_expr *, gfc_expr *),
|
||||
bool (*check) (gfc_expr *, gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
|
||||
void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
const char *a1, bt type1, int kind1, int optional1,
|
||||
|
@ -515,7 +515,7 @@ add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty
|
|||
static void
|
||||
add_sym_2_intent (const char *name, gfc_isym_id id, enum klass cl,
|
||||
int actual_ok, bt type, int kind, int standard,
|
||||
gfc_try (*check) (gfc_expr *, gfc_expr *),
|
||||
bool (*check) (gfc_expr *, gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
|
||||
void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
const char *a1, bt type1, int kind1, int optional1,
|
||||
|
@ -543,7 +543,7 @@ add_sym_2_intent (const char *name, gfc_isym_id id, enum klass cl,
|
|||
static void
|
||||
add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type,
|
||||
int kind, int standard,
|
||||
gfc_try (*check) (gfc_expr *, gfc_expr *),
|
||||
bool (*check) (gfc_expr *, gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
|
||||
void (*resolve) (gfc_code *),
|
||||
const char *a1, bt type1, int kind1, int optional1,
|
||||
|
@ -571,7 +571,7 @@ add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type,
|
|||
static void
|
||||
add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
|
||||
int kind, int standard,
|
||||
gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
const char *a1, bt type1, int kind1, int optional1,
|
||||
|
@ -600,7 +600,7 @@ add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty
|
|||
static void
|
||||
add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
|
||||
int kind, int standard,
|
||||
gfc_try (*check) (gfc_actual_arglist *),
|
||||
bool (*check) (gfc_actual_arglist *),
|
||||
gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
const char *a1, bt type1, int kind1, int optional1,
|
||||
|
@ -629,7 +629,7 @@ add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt
|
|||
static void
|
||||
add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
|
||||
int kind, int standard,
|
||||
gfc_try (*check) (gfc_actual_arglist *),
|
||||
bool (*check) (gfc_actual_arglist *),
|
||||
gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
const char *a1, bt type1, int kind1, int optional1,
|
||||
|
@ -658,7 +658,7 @@ add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt
|
|||
static void
|
||||
add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type,
|
||||
int kind, int standard,
|
||||
gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
void (*resolve) (gfc_code *),
|
||||
const char *a1, bt type1, int kind1, int optional1,
|
||||
|
@ -688,7 +688,7 @@ add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type,
|
|||
static void
|
||||
add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
|
||||
int kind, int standard,
|
||||
gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
|
||||
gfc_expr *),
|
||||
void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
|
||||
|
@ -721,7 +721,7 @@ add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty
|
|||
static void
|
||||
add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
|
||||
int standard,
|
||||
gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
|
||||
gfc_expr *),
|
||||
void (*resolve) (gfc_code *),
|
||||
|
@ -754,7 +754,7 @@ add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
|
|||
static void
|
||||
add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
|
||||
int standard,
|
||||
gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
|
||||
bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
|
||||
gfc_expr *),
|
||||
gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
|
||||
gfc_expr *, gfc_expr *),
|
||||
|
@ -981,7 +981,7 @@ gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
|
|||
return false;
|
||||
|
||||
/* See if this intrinsic is allowed in the current standard. */
|
||||
if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE)
|
||||
if (!gfc_check_intrinsic_standard (isym, &symstd, false, loc))
|
||||
{
|
||||
if (sym->attr.proc == PROC_UNKNOWN
|
||||
&& gfc_option.warn_intrinsics_std)
|
||||
|
@ -3574,9 +3574,9 @@ remove_nullargs (gfc_actual_arglist **ap)
|
|||
with the format arglist. Arguments that are not present are given
|
||||
a blank gfc_actual_arglist structure. If something is obviously
|
||||
wrong (say, a missing required argument) we abort sorting and
|
||||
return FAILURE. */
|
||||
return false. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
sort_actual (const char *name, gfc_actual_arglist **ap,
|
||||
gfc_intrinsic_arg *formal, locus *where)
|
||||
{
|
||||
|
@ -3593,7 +3593,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap,
|
|||
a = actual;
|
||||
|
||||
if (f == NULL && a == NULL) /* No arguments */
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
for (;;)
|
||||
{ /* Put the nonkeyword arguments in a 1:1 correspondence */
|
||||
|
@ -3615,7 +3615,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap,
|
|||
goto do_sort;
|
||||
|
||||
gfc_error ("Too many arguments in call to '%s' at %L", name, where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
keywords:
|
||||
/* Associate the remaining actual arguments, all of which have
|
||||
|
@ -3634,14 +3634,14 @@ keywords:
|
|||
else
|
||||
gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
|
||||
a->name, name, where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (f->actual != NULL)
|
||||
{
|
||||
gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
|
||||
f->name, name, where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
f->actual = a;
|
||||
|
@ -3655,7 +3655,7 @@ optional:
|
|||
{
|
||||
gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
|
||||
f->name, name, where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -3669,7 +3669,7 @@ do_sort:
|
|||
if (f->actual && f->actual->label != NULL && f->ts.type)
|
||||
{
|
||||
gfc_error ("ALTERNATE RETURN not permitted at %L", where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (f->actual == NULL)
|
||||
|
@ -3689,7 +3689,7 @@ do_sort:
|
|||
}
|
||||
actual->next = NULL; /* End the sorted argument list. */
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -3697,7 +3697,7 @@ do_sort:
|
|||
list. The lists are checked for agreement of type. We don't check
|
||||
for arrayness here. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
|
||||
int error_flag)
|
||||
{
|
||||
|
@ -3730,7 +3730,7 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
|
|||
gfc_current_intrinsic, &actual->expr->where,
|
||||
gfc_typename (&formal->ts),
|
||||
gfc_typename (&actual->expr->ts));
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If the formal argument is INTENT([IN]OUT), check for definability. */
|
||||
|
@ -3741,13 +3741,12 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
|
|||
: NULL);
|
||||
|
||||
/* No pointer arguments for intrinsics. */
|
||||
if (gfc_check_vardef_context (actual->expr, false, false, false,
|
||||
context) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_vardef_context (actual->expr, false, false, false, context))
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -3838,11 +3837,11 @@ resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
|
|||
|
||||
/* Given an intrinsic symbol node and an expression node, call the
|
||||
simplification function (if there is one), perhaps replacing the
|
||||
expression with something simpler. We return FAILURE on an error
|
||||
of the simplification, SUCCESS if the simplification worked, even
|
||||
expression with something simpler. We return false on an error
|
||||
of the simplification, true if the simplification worked, even
|
||||
if nothing has changed in the expression itself. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
|
||||
{
|
||||
gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
|
||||
|
@ -3926,7 +3925,7 @@ do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
|
|||
|
||||
finish:
|
||||
if (result == &gfc_bad_expr)
|
||||
return FAILURE;
|
||||
return false;
|
||||
|
||||
if (result == NULL)
|
||||
resolve_intrinsic (specific, e); /* Must call at run-time */
|
||||
|
@ -3936,12 +3935,12 @@ finish:
|
|||
gfc_replace_expr (e, result);
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
/* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
|
||||
error messages. This subroutine returns FAILURE if a subroutine
|
||||
error messages. This subroutine returns false if a subroutine
|
||||
has more than MAX_INTRINSIC_ARGS, in which case the actual argument
|
||||
list cannot match any intrinsic. */
|
||||
|
||||
|
@ -3965,14 +3964,14 @@ init_arglist (gfc_intrinsic_sym *isym)
|
|||
|
||||
/* Given a pointer to an intrinsic symbol and an expression consisting
|
||||
of a function call, see if the function call is consistent with the
|
||||
intrinsic's formal argument list. Return SUCCESS if the expression
|
||||
and intrinsic match, FAILURE otherwise. */
|
||||
intrinsic's formal argument list. Return true if the expression
|
||||
and intrinsic match, false otherwise. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
|
||||
{
|
||||
gfc_actual_arglist *arg, **ap;
|
||||
gfc_try t;
|
||||
bool t;
|
||||
|
||||
ap = &expr->value.function.actual;
|
||||
|
||||
|
@ -3985,9 +3984,8 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
|
|||
|| specific->check.f1m == gfc_check_min_max_double)
|
||||
return (*specific->check.f1m) (*ap);
|
||||
|
||||
if (sort_actual (specific->name, ap, specific->formal,
|
||||
&expr->where) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!sort_actual (specific->name, ap, specific->formal, &expr->where))
|
||||
return false;
|
||||
|
||||
if (specific->check.f3ml == gfc_check_minloc_maxloc)
|
||||
/* This is special because we might have to reorder the argument list. */
|
||||
|
@ -4008,7 +4006,7 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
|
|||
if (specific->check.f1 == NULL)
|
||||
{
|
||||
t = check_arglist (ap, specific, error_flag);
|
||||
if (t == SUCCESS)
|
||||
if (t)
|
||||
expr->ts = specific->ts;
|
||||
}
|
||||
else
|
||||
|
@ -4016,7 +4014,7 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
|
|||
}
|
||||
|
||||
/* Check conformance of elemental intrinsics. */
|
||||
if (t == SUCCESS && specific->elemental)
|
||||
if (t && specific->elemental)
|
||||
{
|
||||
int n = 0;
|
||||
gfc_expr *first_expr;
|
||||
|
@ -4027,16 +4025,16 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
|
|||
first_expr = arg->expr;
|
||||
|
||||
for ( ; arg && arg->expr; arg = arg->next, n++)
|
||||
if (gfc_check_conformance (first_expr, arg->expr,
|
||||
if (!gfc_check_conformance (first_expr, arg->expr,
|
||||
"arguments '%s' and '%s' for "
|
||||
"intrinsic '%s'",
|
||||
gfc_current_intrinsic_arg[0]->name,
|
||||
gfc_current_intrinsic_arg[n]->name,
|
||||
gfc_current_intrinsic) == FAILURE)
|
||||
return FAILURE;
|
||||
gfc_current_intrinsic))
|
||||
return false;
|
||||
}
|
||||
|
||||
if (t == FAILURE)
|
||||
if (!t)
|
||||
remove_nullargs (ap);
|
||||
|
||||
return t;
|
||||
|
@ -4049,9 +4047,9 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
|
|||
textual representation of the symbols standard status (like
|
||||
"new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
|
||||
can be used to construct a detailed warning/error message in case of
|
||||
a FAILURE. */
|
||||
a false. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
|
||||
const char** symstd, bool silent, locus where)
|
||||
{
|
||||
|
@ -4059,7 +4057,7 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
|
|||
|
||||
/* For -fall-intrinsics, just succeed. */
|
||||
if (gfc_option.flag_all_intrinsics)
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
/* Find the symbol's standard message for later usage. */
|
||||
switch (isym->standard)
|
||||
|
@ -4113,17 +4111,17 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
|
|||
gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
|
||||
isym->name, _(symstd_msg), &where);
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
/* If allowing the symbol's standard, succeed, too. */
|
||||
if (gfc_option.allow_std & isym->standard)
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
/* Otherwise, fail. */
|
||||
if (symstd)
|
||||
*symstd = _(symstd_msg);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
|
@ -4149,7 +4147,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
|
|||
int flag;
|
||||
|
||||
if (expr->value.function.isym != NULL)
|
||||
return (do_simplify (expr->value.function.isym, expr) == FAILURE)
|
||||
return (!do_simplify(expr->value.function.isym, expr))
|
||||
? MATCH_ERROR : MATCH_YES;
|
||||
|
||||
if (!error_flag)
|
||||
|
@ -4181,9 +4179,8 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
|
|||
if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
|
||||
|| isym->id == GFC_ISYM_CMPLX)
|
||||
&& gfc_init_expr_flag
|
||||
&& gfc_notify_std (GFC_STD_F2003, "Function '%s' "
|
||||
"as initialization expression at %L", name,
|
||||
&expr->where) == FAILURE)
|
||||
&& !gfc_notify_std (GFC_STD_F2003, "Function '%s' as initialization "
|
||||
"expression at %L", name, &expr->where))
|
||||
{
|
||||
if (!error_flag)
|
||||
gfc_pop_suppress_errors ();
|
||||
|
@ -4197,7 +4194,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
|
|||
{
|
||||
init_arglist (isym);
|
||||
|
||||
if (isym->check.f1m (expr->value.function.actual) == SUCCESS)
|
||||
if (isym->check.f1m(expr->value.function.actual))
|
||||
goto got_specific;
|
||||
|
||||
if (!error_flag)
|
||||
|
@ -4218,7 +4215,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
|
|||
{
|
||||
if (specific == isym)
|
||||
continue;
|
||||
if (check_specific (specific, expr, 0) == SUCCESS)
|
||||
if (check_specific (specific, expr, 0))
|
||||
{
|
||||
gfc_pop_suppress_errors ();
|
||||
goto got_specific;
|
||||
|
@ -4228,7 +4225,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
|
|||
|
||||
gfc_pop_suppress_errors ();
|
||||
|
||||
if (check_specific (isym, expr, error_flag) == FAILURE)
|
||||
if (!check_specific (isym, expr, error_flag))
|
||||
{
|
||||
if (!error_flag)
|
||||
gfc_pop_suppress_errors ();
|
||||
|
@ -4244,7 +4241,7 @@ got_specific:
|
|||
if (!error_flag)
|
||||
gfc_pop_suppress_errors ();
|
||||
|
||||
if (do_simplify (specific, expr) == FAILURE)
|
||||
if (!do_simplify (specific, expr))
|
||||
return MATCH_ERROR;
|
||||
|
||||
/* F95, 7.1.6.1, Initialization expressions
|
||||
|
@ -4257,9 +4254,9 @@ got_specific:
|
|||
where each argument is an initialization expression */
|
||||
|
||||
if (gfc_init_expr_flag && isym->elemental && flag
|
||||
&& gfc_notify_std (GFC_STD_F2003, "Elemental function "
|
||||
"as initialization expression with non-integer/non-"
|
||||
"character arguments at %L", &expr->where) == FAILURE)
|
||||
&& !gfc_notify_std (GFC_STD_F2003, "Elemental function as "
|
||||
"initialization expression with non-integer/non-"
|
||||
"character arguments at %L", &expr->where))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return MATCH_YES;
|
||||
|
@ -4295,17 +4292,17 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
|
|||
|
||||
init_arglist (isym);
|
||||
|
||||
if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
|
||||
if (!sort_actual (name, &c->ext.actual, isym->formal, &c->loc))
|
||||
goto fail;
|
||||
|
||||
if (isym->check.f1 != NULL)
|
||||
{
|
||||
if (do_check (isym, c->ext.actual) == FAILURE)
|
||||
if (!do_check (isym, c->ext.actual))
|
||||
goto fail;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
|
||||
if (!check_arglist (&c->ext.actual, isym, 1))
|
||||
goto fail;
|
||||
}
|
||||
|
||||
|
@ -4343,7 +4340,7 @@ fail:
|
|||
|
||||
/* Call gfc_convert_type() with warning enabled. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
|
||||
{
|
||||
return gfc_convert_type_warn (expr, ts, eflag, 1);
|
||||
|
@ -4360,7 +4357,7 @@ gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
|
|||
|
||||
'wflag' controls the warning related to conversion. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
|
||||
{
|
||||
gfc_intrinsic_sym *sym;
|
||||
|
@ -4381,7 +4378,7 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
|
|||
{
|
||||
/* Sometimes the RHS acquire the type. */
|
||||
expr->ts = *ts;
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
if (expr->ts.type == BT_UNKNOWN)
|
||||
|
@ -4389,7 +4386,7 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
|
|||
|
||||
if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
|
||||
&& gfc_compare_types (&expr->ts, ts))
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
sym = find_conv (&expr->ts, ts);
|
||||
if (sym == NULL)
|
||||
|
@ -4499,22 +4496,22 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
|
|||
expr->ts = *ts;
|
||||
|
||||
if (gfc_is_constant_expr (expr->value.function.actual->expr)
|
||||
&& do_simplify (sym, expr) == FAILURE)
|
||||
&& !do_simplify (sym, expr))
|
||||
{
|
||||
|
||||
if (eflag == 2)
|
||||
goto bad;
|
||||
return FAILURE; /* Error already generated in do_simplify() */
|
||||
return false; /* Error already generated in do_simplify() */
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
bad:
|
||||
if (eflag == 1)
|
||||
{
|
||||
gfc_error ("Can't convert %s to %s at %L",
|
||||
gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
gfc_internal_error ("Can't convert %s to %s at %L",
|
||||
|
@ -4524,7 +4521,7 @@ bad:
|
|||
}
|
||||
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
|
||||
{
|
||||
gfc_intrinsic_sym *sym;
|
||||
|
@ -4568,13 +4565,13 @@ gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
|
|||
expr->ts = *ts;
|
||||
|
||||
if (gfc_is_constant_expr (expr->value.function.actual->expr)
|
||||
&& do_simplify (sym, expr) == FAILURE)
|
||||
&& !do_simplify (sym, expr))
|
||||
{
|
||||
/* Error already generated in do_simplify() */
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -4600,8 +4597,8 @@ gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
|
|||
|
||||
/* If no intrinsic was found with this name or it's not included in the
|
||||
selected standard, everything's fine. */
|
||||
if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
|
||||
sym->declared_at) == FAILURE)
|
||||
if (!isym || !gfc_check_intrinsic_standard (isym, NULL, true,
|
||||
sym->declared_at))
|
||||
return;
|
||||
|
||||
/* Emit the warning. */
|
||||
|
|
|
@ -25,195 +25,195 @@ extern gfc_expr gfc_bad_expr;
|
|||
|
||||
|
||||
/* Check functions. */
|
||||
gfc_try gfc_check_a_ikind (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_a_xkind (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_a_p (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_x_yd (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_a_ikind (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_a_xkind (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_a_p (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_x_yd (gfc_expr *, gfc_expr *);
|
||||
|
||||
gfc_try gfc_check_abs (gfc_expr *);
|
||||
gfc_try gfc_check_access_func (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_achar (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_all_any (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_allocated (gfc_expr *);
|
||||
gfc_try gfc_check_associated (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_atan_2 (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_atan2 (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_atomic_def (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_atomic_ref (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_besn (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_bge_bgt_ble_blt (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_bitfcn (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_char (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_chdir (gfc_expr *);
|
||||
gfc_try gfc_check_chmod (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_complex (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ctime (gfc_expr *);
|
||||
gfc_try gfc_check_datan2 (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_dcmplx (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_dble (gfc_expr *);
|
||||
gfc_try gfc_check_digits (gfc_expr *);
|
||||
gfc_try gfc_check_dot_product (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_dprod (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_dshift (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_dtime_etime (gfc_expr *);
|
||||
gfc_try gfc_check_fgetputc (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_fgetput (gfc_expr *);
|
||||
gfc_try gfc_check_float (gfc_expr *);
|
||||
gfc_try gfc_check_fstat (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ftell (gfc_expr *);
|
||||
gfc_try gfc_check_fn_c (gfc_expr *);
|
||||
gfc_try gfc_check_fn_d (gfc_expr *);
|
||||
gfc_try gfc_check_fn_r (gfc_expr *);
|
||||
gfc_try gfc_check_fn_rc (gfc_expr *);
|
||||
gfc_try gfc_check_fn_rc2008 (gfc_expr *);
|
||||
gfc_try gfc_check_fnum (gfc_expr *);
|
||||
gfc_try gfc_check_hostnm (gfc_expr *);
|
||||
gfc_try gfc_check_huge (gfc_expr *);
|
||||
gfc_try gfc_check_hypot (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_i (gfc_expr *);
|
||||
gfc_try gfc_check_iand (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_and (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ichar_iachar (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_idnint (gfc_expr *);
|
||||
gfc_try gfc_check_ieor (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_int (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_intconv (gfc_expr *);
|
||||
gfc_try gfc_check_ior (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_irand (gfc_expr *);
|
||||
gfc_try gfc_check_isatty (gfc_expr *);
|
||||
gfc_try gfc_check_isnan (gfc_expr *);
|
||||
gfc_try gfc_check_ishft (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_kill (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_kind (gfc_expr *);
|
||||
gfc_try gfc_check_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_lcobound (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_len_lentrim (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_link (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_lge_lgt_lle_llt (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_loc (gfc_expr *);
|
||||
gfc_try gfc_check_logical (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_min_max (gfc_actual_arglist *);
|
||||
gfc_try gfc_check_min_max_integer (gfc_actual_arglist *);
|
||||
gfc_try gfc_check_min_max_real (gfc_actual_arglist *);
|
||||
gfc_try gfc_check_min_max_double (gfc_actual_arglist *);
|
||||
gfc_try gfc_check_malloc (gfc_expr *);
|
||||
gfc_try gfc_check_mask (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_matmul (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_minloc_maxloc (gfc_actual_arglist *);
|
||||
gfc_try gfc_check_minval_maxval (gfc_actual_arglist *);
|
||||
gfc_try gfc_check_nearest (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_new_line (gfc_expr *);
|
||||
gfc_try gfc_check_norm2 (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_null (gfc_expr *);
|
||||
gfc_try gfc_check_pack (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_parity (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_precision (gfc_expr *);
|
||||
gfc_try gfc_check_present (gfc_expr *);
|
||||
gfc_try gfc_check_product_sum (gfc_actual_arglist *);
|
||||
gfc_try gfc_check_radix (gfc_expr *);
|
||||
gfc_try gfc_check_rand (gfc_expr *);
|
||||
gfc_try gfc_check_range (gfc_expr *);
|
||||
gfc_try gfc_check_rank (gfc_expr *);
|
||||
gfc_try gfc_check_real (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_rename (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_repeat (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_same_type_as (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_scale (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_second_sub (gfc_expr *);
|
||||
gfc_try gfc_check_secnds (gfc_expr *);
|
||||
gfc_try gfc_check_selected_char_kind (gfc_expr *);
|
||||
gfc_try gfc_check_selected_int_kind (gfc_expr *);
|
||||
gfc_try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_set_exponent (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_shape (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_shift (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_size (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_sign (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_signal (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_sizeof (gfc_expr *);
|
||||
gfc_try gfc_check_c_associated (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_c_f_pointer (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_c_f_procpointer (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_c_funloc (gfc_expr *);
|
||||
gfc_try gfc_check_c_loc (gfc_expr *);
|
||||
gfc_try gfc_check_c_sizeof (gfc_expr *);
|
||||
gfc_try gfc_check_sngl (gfc_expr *);
|
||||
gfc_try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_srand (gfc_expr *);
|
||||
gfc_try gfc_check_stat (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_storage_size (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_symlnk (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_transf_bit_intrins (gfc_actual_arglist *);
|
||||
gfc_try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_transpose (gfc_expr *);
|
||||
gfc_try gfc_check_trim (gfc_expr *);
|
||||
gfc_try gfc_check_ttynam (gfc_expr *);
|
||||
gfc_try gfc_check_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ucobound (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_umask (gfc_expr *);
|
||||
gfc_try gfc_check_unlink (gfc_expr *);
|
||||
gfc_try gfc_check_unpack (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_x (gfc_expr *);
|
||||
bool gfc_check_abs (gfc_expr *);
|
||||
bool gfc_check_access_func (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_achar (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_all_any (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_allocated (gfc_expr *);
|
||||
bool gfc_check_associated (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_atan_2 (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_atan2 (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_atomic_def (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_atomic_ref (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_besn (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_bge_bgt_ble_blt (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_bitfcn (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_char (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_chdir (gfc_expr *);
|
||||
bool gfc_check_chmod (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_complex (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_ctime (gfc_expr *);
|
||||
bool gfc_check_datan2 (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_dcmplx (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_dble (gfc_expr *);
|
||||
bool gfc_check_digits (gfc_expr *);
|
||||
bool gfc_check_dot_product (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_dprod (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_dshift (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_dtime_etime (gfc_expr *);
|
||||
bool gfc_check_fgetputc (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_fgetput (gfc_expr *);
|
||||
bool gfc_check_float (gfc_expr *);
|
||||
bool gfc_check_fstat (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_ftell (gfc_expr *);
|
||||
bool gfc_check_fn_c (gfc_expr *);
|
||||
bool gfc_check_fn_d (gfc_expr *);
|
||||
bool gfc_check_fn_r (gfc_expr *);
|
||||
bool gfc_check_fn_rc (gfc_expr *);
|
||||
bool gfc_check_fn_rc2008 (gfc_expr *);
|
||||
bool gfc_check_fnum (gfc_expr *);
|
||||
bool gfc_check_hostnm (gfc_expr *);
|
||||
bool gfc_check_huge (gfc_expr *);
|
||||
bool gfc_check_hypot (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_i (gfc_expr *);
|
||||
bool gfc_check_iand (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_and (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_ichar_iachar (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_idnint (gfc_expr *);
|
||||
bool gfc_check_ieor (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_int (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_intconv (gfc_expr *);
|
||||
bool gfc_check_ior (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_irand (gfc_expr *);
|
||||
bool gfc_check_isatty (gfc_expr *);
|
||||
bool gfc_check_isnan (gfc_expr *);
|
||||
bool gfc_check_ishft (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_kill (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_kind (gfc_expr *);
|
||||
bool gfc_check_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_lcobound (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_len_lentrim (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_link (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_lge_lgt_lle_llt (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_loc (gfc_expr *);
|
||||
bool gfc_check_logical (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_min_max (gfc_actual_arglist *);
|
||||
bool gfc_check_min_max_integer (gfc_actual_arglist *);
|
||||
bool gfc_check_min_max_real (gfc_actual_arglist *);
|
||||
bool gfc_check_min_max_double (gfc_actual_arglist *);
|
||||
bool gfc_check_malloc (gfc_expr *);
|
||||
bool gfc_check_mask (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_matmul (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_minloc_maxloc (gfc_actual_arglist *);
|
||||
bool gfc_check_minval_maxval (gfc_actual_arglist *);
|
||||
bool gfc_check_nearest (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_new_line (gfc_expr *);
|
||||
bool gfc_check_norm2 (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_null (gfc_expr *);
|
||||
bool gfc_check_pack (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_parity (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_precision (gfc_expr *);
|
||||
bool gfc_check_present (gfc_expr *);
|
||||
bool gfc_check_product_sum (gfc_actual_arglist *);
|
||||
bool gfc_check_radix (gfc_expr *);
|
||||
bool gfc_check_rand (gfc_expr *);
|
||||
bool gfc_check_range (gfc_expr *);
|
||||
bool gfc_check_rank (gfc_expr *);
|
||||
bool gfc_check_real (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_rename (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_repeat (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_same_type_as (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_scale (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_second_sub (gfc_expr *);
|
||||
bool gfc_check_secnds (gfc_expr *);
|
||||
bool gfc_check_selected_char_kind (gfc_expr *);
|
||||
bool gfc_check_selected_int_kind (gfc_expr *);
|
||||
bool gfc_check_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_set_exponent (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_shape (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_shift (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_size (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_sign (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_signal (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_sizeof (gfc_expr *);
|
||||
bool gfc_check_c_associated (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_c_f_pointer (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_c_f_procpointer (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_c_funloc (gfc_expr *);
|
||||
bool gfc_check_c_loc (gfc_expr *);
|
||||
bool gfc_check_c_sizeof (gfc_expr *);
|
||||
bool gfc_check_sngl (gfc_expr *);
|
||||
bool gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_srand (gfc_expr *);
|
||||
bool gfc_check_stat (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_storage_size (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_symlnk (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_transf_bit_intrins (gfc_actual_arglist *);
|
||||
bool gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_transpose (gfc_expr *);
|
||||
bool gfc_check_trim (gfc_expr *);
|
||||
bool gfc_check_ttynam (gfc_expr *);
|
||||
bool gfc_check_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_ucobound (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_umask (gfc_expr *);
|
||||
bool gfc_check_unlink (gfc_expr *);
|
||||
bool gfc_check_unpack (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_x (gfc_expr *);
|
||||
|
||||
|
||||
/* Intrinsic subroutines. */
|
||||
gfc_try gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_chdir_sub (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_chmod_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_cpu_time (gfc_expr *);
|
||||
gfc_try gfc_check_ctime_sub (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_exit (gfc_expr *);
|
||||
gfc_try gfc_check_fdate_sub (gfc_expr *);
|
||||
gfc_try gfc_check_flush (gfc_expr *);
|
||||
gfc_try gfc_check_free (gfc_expr *);
|
||||
gfc_try gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_gerror (gfc_expr *);
|
||||
gfc_try gfc_check_getarg (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_getlog (gfc_expr *);
|
||||
gfc_try gfc_check_move_alloc (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
|
||||
bool gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_chdir_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_chmod_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_cpu_time (gfc_expr *);
|
||||
bool gfc_check_ctime_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_exit (gfc_expr *);
|
||||
bool gfc_check_fdate_sub (gfc_expr *);
|
||||
bool gfc_check_flush (gfc_expr *);
|
||||
bool gfc_check_free (gfc_expr *);
|
||||
bool gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_gerror (gfc_expr *);
|
||||
bool gfc_check_getarg (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_getlog (gfc_expr *);
|
||||
bool gfc_check_move_alloc (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
|
||||
gfc_expr *);
|
||||
gfc_try gfc_check_random_number (gfc_expr *);
|
||||
gfc_try gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_fgetputc_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_fgetput_sub (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_fseek_sub (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ftell_sub (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_hostnm_sub (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_image_index (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_itime_idate (gfc_expr *);
|
||||
gfc_try gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ltime_gmtime (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_perror (gfc_expr *);
|
||||
gfc_try gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_signal_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_sleep_sub (gfc_expr *);
|
||||
gfc_try gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_system_sub (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_this_image (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ttynam_sub (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_umask_sub (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_unlink_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_random_number (gfc_expr *);
|
||||
bool gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_fgetputc_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_fgetput_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_fseek_sub (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_ftell_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_getcwd_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_hostnm_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_image_index (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_itime_idate (gfc_expr *);
|
||||
bool gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_ltime_gmtime (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_perror (gfc_expr *);
|
||||
bool gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_signal_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_sleep_sub (gfc_expr *);
|
||||
bool gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_system_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_this_image (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_ttynam_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_umask_sub (gfc_expr *, gfc_expr *);
|
||||
bool gfc_check_unlink_sub (gfc_expr *, gfc_expr *);
|
||||
|
||||
|
||||
/* Simplification functions. */
|
||||
|
|
317
gcc/fortran/io.c
317
gcc/fortran/io.c
|
@ -100,7 +100,7 @@ static const io_tag
|
|||
|
||||
static gfc_dt *current_dt;
|
||||
|
||||
#define RESOLVE_TAG(x, y) if (resolve_tag(x, y) == FAILURE) return FAILURE;
|
||||
#define RESOLVE_TAG(x, y) if (!resolve_tag (x, y)) return false;
|
||||
|
||||
|
||||
/**************** Fortran 95 FORMAT parser *****************/
|
||||
|
@ -452,15 +452,15 @@ format_lex (void)
|
|||
c = next_char_not_space (&error);
|
||||
if (c == 'P')
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "DP format "
|
||||
"specifier not allowed at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "DP format "
|
||||
"specifier not allowed at %C"))
|
||||
return FMT_ERROR;
|
||||
token = FMT_DP;
|
||||
}
|
||||
else if (c == 'C')
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "DC format "
|
||||
"specifier not allowed at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "DC format "
|
||||
"specifier not allowed at %C"))
|
||||
return FMT_ERROR;
|
||||
token = FMT_DC;
|
||||
}
|
||||
|
@ -545,7 +545,7 @@ token_to_string (format_token t)
|
|||
by itself, and we are checking it for validity. The dual origin
|
||||
means that the warning message is a little less than great. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
check_format (bool is_input)
|
||||
{
|
||||
const char *posint_required = _("Positive width required");
|
||||
|
@ -559,13 +559,13 @@ check_format (bool is_input)
|
|||
format_token t, u;
|
||||
int level;
|
||||
int repeat;
|
||||
gfc_try rv;
|
||||
bool rv;
|
||||
|
||||
use_last_char = 0;
|
||||
saved_token = FMT_NONE;
|
||||
level = 0;
|
||||
repeat = 0;
|
||||
rv = SUCCESS;
|
||||
rv = true;
|
||||
format_string_pos = 0;
|
||||
|
||||
t = format_lex ();
|
||||
|
@ -648,10 +648,9 @@ format_item_1:
|
|||
/* X requires a prior number if we're being pedantic. */
|
||||
if (mode != MODE_FORMAT)
|
||||
format_locus.nextc += format_string_pos;
|
||||
if (gfc_notify_std (GFC_STD_GNU, "X descriptor "
|
||||
"requires leading space count at %L", &format_locus)
|
||||
== FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_GNU, "X descriptor requires leading "
|
||||
"space count at %L", &format_locus))
|
||||
return false;
|
||||
goto between_desc;
|
||||
|
||||
case FMT_SIGN:
|
||||
|
@ -678,9 +677,8 @@ format_item_1:
|
|||
if (t == FMT_ERROR)
|
||||
goto fail;
|
||||
|
||||
if (gfc_notify_std (GFC_STD_GNU, "$ descriptor at %L",
|
||||
&format_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_GNU, "$ descriptor at %L", &format_locus))
|
||||
return false;
|
||||
if (t != FMT_RPAREN || level > 0)
|
||||
{
|
||||
gfc_warning ("$ should be the last specifier in format at %L",
|
||||
|
@ -825,9 +823,9 @@ data_desc:
|
|||
error = zero_width;
|
||||
goto syntax;
|
||||
}
|
||||
if (gfc_notify_std (GFC_STD_F2008, "'G0' in "
|
||||
"format at %L", &format_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "'G0' in format at %L",
|
||||
&format_locus))
|
||||
return false;
|
||||
u = format_lex ();
|
||||
if (u != FMT_PERIOD)
|
||||
{
|
||||
|
@ -1058,9 +1056,8 @@ between_desc:
|
|||
default:
|
||||
if (mode != MODE_FORMAT)
|
||||
format_locus.nextc += format_string_pos - 1;
|
||||
if (gfc_notify_std (GFC_STD_GNU, "Missing comma at %L",
|
||||
&format_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_GNU, "Missing comma at %L", &format_locus))
|
||||
return false;
|
||||
/* If we do not actually return a failure, we need to unwind this
|
||||
before the next round. */
|
||||
if (mode != MODE_FORMAT)
|
||||
|
@ -1121,9 +1118,8 @@ extension_optional_comma:
|
|||
default:
|
||||
if (mode != MODE_FORMAT)
|
||||
format_locus.nextc += format_string_pos;
|
||||
if (gfc_notify_std (GFC_STD_GNU, "Missing comma at %L",
|
||||
&format_locus) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_GNU, "Missing comma at %L", &format_locus))
|
||||
return false;
|
||||
/* If we do not actually return a failure, we need to unwind this
|
||||
before the next round. */
|
||||
if (mode != MODE_FORMAT)
|
||||
|
@ -1142,7 +1138,7 @@ syntax:
|
|||
else
|
||||
gfc_error ("%s in format string at %L", error, &format_locus);
|
||||
fail:
|
||||
rv = FAILURE;
|
||||
rv = false;
|
||||
|
||||
finished:
|
||||
return rv;
|
||||
|
@ -1152,13 +1148,13 @@ finished:
|
|||
/* Given an expression node that is a constant string, see if it looks
|
||||
like a format string. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
check_format_string (gfc_expr *e, bool is_input)
|
||||
{
|
||||
gfc_try rv;
|
||||
bool rv;
|
||||
int i;
|
||||
if (!e || e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT)
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
mode = MODE_STRING;
|
||||
format_string = e->value.character.string;
|
||||
|
@ -1172,7 +1168,7 @@ check_format_string (gfc_expr *e, bool is_input)
|
|||
string, like '(A10,I3)F5'
|
||||
start at the end and move back to the last character processed,
|
||||
spaces are OK */
|
||||
if (rv == SUCCESS && e->value.character.length > format_string_pos)
|
||||
if (rv && e->value.character.length > format_string_pos)
|
||||
for (i=e->value.character.length-1;i>format_string_pos-1;i--)
|
||||
if (e->value.character.string[i] != ' ')
|
||||
{
|
||||
|
@ -1215,7 +1211,7 @@ gfc_match_format (void)
|
|||
|
||||
start = gfc_current_locus;
|
||||
|
||||
if (check_format (false) == FAILURE)
|
||||
if (!check_format (false))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (gfc_match_eos () != MATCH_YES)
|
||||
|
@ -1366,7 +1362,7 @@ match_ltag (const io_tag *tag, gfc_st_label ** label)
|
|||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_reference_st_label (*label, ST_LABEL_TARGET) == FAILURE)
|
||||
if (!gfc_reference_st_label (*label, ST_LABEL_TARGET))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return m;
|
||||
|
@ -1375,7 +1371,7 @@ match_ltag (const io_tag *tag, gfc_st_label ** label)
|
|||
|
||||
/* Resolution of the FORMAT tag, to be called from resolve_tag. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
resolve_tag_format (const gfc_expr *e)
|
||||
{
|
||||
if (e->expr_type == EXPR_CONSTANT
|
||||
|
@ -1384,7 +1380,7 @@ resolve_tag_format (const gfc_expr *e)
|
|||
{
|
||||
gfc_error ("Constant expression in FORMAT tag at %L must be "
|
||||
"of type default CHARACTER", &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If e's rank is zero and e is not an element of an array, it should be
|
||||
|
@ -1402,75 +1398,74 @@ resolve_tag_format (const gfc_expr *e)
|
|||
{
|
||||
gfc_error ("FORMAT tag at %L must be of type default-kind CHARACTER "
|
||||
"or of INTEGER", &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F95_DEL, "ASSIGNED "
|
||||
"variable in FORMAT tag at %L", &e->where)
|
||||
== FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_F95_DEL, "ASSIGNED variable in "
|
||||
"FORMAT tag at %L", &e->where))
|
||||
return false;
|
||||
if (e->symtree->n.sym->attr.assign != 1)
|
||||
{
|
||||
gfc_error ("Variable '%s' at %L has not been assigned a "
|
||||
"format label", e->symtree->n.sym->name, &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
else if (e->ts.type == BT_INTEGER)
|
||||
{
|
||||
gfc_error ("Scalar '%s' in FORMAT tag at %L is not an ASSIGNED "
|
||||
"variable", gfc_basic_typename (e->ts.type), &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
/* If rank is nonzero and type is not character, we allow it under GFC_STD_LEGACY.
|
||||
It may be assigned an Hollerith constant. */
|
||||
if (e->ts.type != BT_CHARACTER)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_LEGACY, "Non-character "
|
||||
"in FORMAT tag at %L", &e->where) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_LEGACY, "Non-character in FORMAT tag "
|
||||
"at %L", &e->where))
|
||||
return false;
|
||||
|
||||
if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SHAPE)
|
||||
{
|
||||
gfc_error ("Non-character assumed shape array element in FORMAT"
|
||||
" tag at %L", &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SIZE)
|
||||
{
|
||||
gfc_error ("Non-character assumed size array element in FORMAT"
|
||||
" tag at %L", &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (e->rank == 0 && e->symtree->n.sym->attr.pointer)
|
||||
{
|
||||
gfc_error ("Non-character pointer array element in FORMAT tag at %L",
|
||||
&e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
/* Do expression resolution and type-checking on an expression tag. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
resolve_tag (const io_tag *tag, gfc_expr *e)
|
||||
{
|
||||
if (e == NULL)
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
if (gfc_resolve_expr (e) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_resolve_expr (e))
|
||||
return false;
|
||||
|
||||
if (tag == &tag_format)
|
||||
return resolve_tag_format (e);
|
||||
|
@ -1479,51 +1474,48 @@ resolve_tag (const io_tag *tag, gfc_expr *e)
|
|||
{
|
||||
gfc_error ("%s tag at %L must be of type %s", tag->name,
|
||||
&e->where, gfc_basic_typename (tag->type));
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (e->ts.type == BT_CHARACTER && e->ts.kind != gfc_default_character_kind)
|
||||
{
|
||||
gfc_error ("%s tag at %L must be a character string of default kind",
|
||||
tag->name, &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (e->rank != 0)
|
||||
{
|
||||
gfc_error ("%s tag at %L must be scalar", tag->name, &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (tag == &tag_iomsg)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "IOMSG tag at %L",
|
||||
&e->where) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "IOMSG tag at %L", &e->where))
|
||||
return false;
|
||||
}
|
||||
|
||||
if ((tag == &tag_iostat || tag == &tag_size || tag == &tag_iolength)
|
||||
&& e->ts.kind != gfc_default_integer_kind)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "Fortran 95 requires default "
|
||||
"INTEGER in %s tag at %L", tag->name, &e->where)
|
||||
== FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "Fortran 95 requires default "
|
||||
"INTEGER in %s tag at %L", tag->name, &e->where))
|
||||
return false;
|
||||
}
|
||||
|
||||
if (tag == &tag_exist && e->ts.kind != gfc_default_logical_kind)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2008, "Nondefault LOGICAL "
|
||||
"in %s tag at %L", tag->name, &e->where)
|
||||
== FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "Nondefault LOGICAL "
|
||||
"in %s tag at %L", tag->name, &e->where))
|
||||
return false;
|
||||
}
|
||||
|
||||
if (tag == &tag_newunit)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2008, "NEWUNIT specifier"
|
||||
" at %L", &e->where) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "NEWUNIT specifier at %L",
|
||||
&e->where))
|
||||
return false;
|
||||
}
|
||||
|
||||
/* NEWUNIT, IOSTAT, SIZE and IOMSG are variable definition contexts. */
|
||||
|
@ -1533,18 +1525,17 @@ resolve_tag (const io_tag *tag, gfc_expr *e)
|
|||
char context[64];
|
||||
|
||||
sprintf (context, _("%s tag"), tag->name);
|
||||
if (gfc_check_vardef_context (e, false, false, false, context) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_check_vardef_context (e, false, false, false, context))
|
||||
return false;
|
||||
}
|
||||
|
||||
if (tag == &tag_convert)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_GNU, "CONVERT tag at %L",
|
||||
&e->where) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_GNU, "CONVERT tag at %L", &e->where))
|
||||
return false;
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -1657,7 +1648,7 @@ gfc_free_open (gfc_open *open)
|
|||
|
||||
/* Resolve everything in a gfc_open structure. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_resolve_open (gfc_open *open)
|
||||
{
|
||||
|
||||
|
@ -1682,10 +1673,10 @@ gfc_resolve_open (gfc_open *open)
|
|||
RESOLVE_TAG (&tag_convert, open->convert);
|
||||
RESOLVE_TAG (&tag_newunit, open->newunit);
|
||||
|
||||
if (gfc_reference_st_label (open->err, ST_LABEL_TARGET) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_reference_st_label (open->err, ST_LABEL_TARGET))
|
||||
return false;
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -1895,8 +1886,8 @@ gfc_match_open (void)
|
|||
/* Checks on the ASYNCHRONOUS specifier. */
|
||||
if (open->asynchronous)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
goto cleanup;
|
||||
|
||||
if (open->asynchronous->expr_type == EXPR_CONSTANT)
|
||||
|
@ -1913,8 +1904,8 @@ gfc_match_open (void)
|
|||
/* Checks on the BLANK specifier. */
|
||||
if (open->blank)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "BLANK= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "BLANK= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
goto cleanup;
|
||||
|
||||
if (open->blank->expr_type == EXPR_CONSTANT)
|
||||
|
@ -1931,8 +1922,8 @@ gfc_match_open (void)
|
|||
/* Checks on the DECIMAL specifier. */
|
||||
if (open->decimal)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
goto cleanup;
|
||||
|
||||
if (open->decimal->expr_type == EXPR_CONSTANT)
|
||||
|
@ -1963,8 +1954,8 @@ gfc_match_open (void)
|
|||
/* Checks on the ENCODING specifier. */
|
||||
if (open->encoding)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "ENCODING= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "ENCODING= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
goto cleanup;
|
||||
|
||||
if (open->encoding->expr_type == EXPR_CONSTANT)
|
||||
|
@ -2014,8 +2005,8 @@ gfc_match_open (void)
|
|||
/* Checks on the ROUND specifier. */
|
||||
if (open->round)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "ROUND= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "ROUND= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
goto cleanup;
|
||||
|
||||
if (open->round->expr_type == EXPR_CONSTANT)
|
||||
|
@ -2034,8 +2025,8 @@ gfc_match_open (void)
|
|||
/* Checks on the SIGN specifier. */
|
||||
if (open->sign)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "SIGN= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
goto cleanup;
|
||||
|
||||
if (open->sign->expr_type == EXPR_CONSTANT)
|
||||
|
@ -2282,7 +2273,7 @@ cleanup:
|
|||
|
||||
/* Resolve everything in a gfc_close structure. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_resolve_close (gfc_close *close)
|
||||
{
|
||||
RESOLVE_TAG (&tag_unit, close->unit);
|
||||
|
@ -2290,8 +2281,8 @@ gfc_resolve_close (gfc_close *close)
|
|||
RESOLVE_TAG (&tag_iostat, close->iostat);
|
||||
RESOLVE_TAG (&tag_status, close->status);
|
||||
|
||||
if (gfc_reference_st_label (close->err, ST_LABEL_TARGET) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_reference_st_label (close->err, ST_LABEL_TARGET))
|
||||
return false;
|
||||
|
||||
if (close->unit == NULL)
|
||||
{
|
||||
|
@ -2308,7 +2299,7 @@ gfc_resolve_close (gfc_close *close)
|
|||
loc = close->err->where;
|
||||
|
||||
gfc_error ("CLOSE statement at %L requires a UNIT number", &loc);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (close->unit->expr_type == EXPR_CONSTANT
|
||||
|
@ -2319,7 +2310,7 @@ gfc_resolve_close (gfc_close *close)
|
|||
&close->unit->where);
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -2435,14 +2426,14 @@ cleanup:
|
|||
}
|
||||
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_resolve_filepos (gfc_filepos *fp)
|
||||
{
|
||||
RESOLVE_TAG (&tag_unit, fp->unit);
|
||||
RESOLVE_TAG (&tag_iostat, fp->iostat);
|
||||
RESOLVE_TAG (&tag_iomsg, fp->iomsg);
|
||||
if (gfc_reference_st_label (fp->err, ST_LABEL_TARGET) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_reference_st_label (fp->err, ST_LABEL_TARGET))
|
||||
return false;
|
||||
|
||||
if (fp->unit->expr_type == EXPR_CONSTANT
|
||||
&& fp->unit->ts.type == BT_INTEGER
|
||||
|
@ -2452,7 +2443,7 @@ gfc_resolve_filepos (gfc_filepos *fp)
|
|||
&fp->unit->where);
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -2480,8 +2471,7 @@ gfc_match_rewind (void)
|
|||
match
|
||||
gfc_match_flush (void)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "FLUSH statement at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "FLUSH statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return match_filepos (ST_FLUSH, EXEC_FLUSH);
|
||||
|
@ -2583,7 +2573,7 @@ match_dt_format (gfc_dt *dt)
|
|||
goto conflict;
|
||||
}
|
||||
|
||||
if (gfc_reference_st_label (label, ST_LABEL_FORMAT) == FAILURE)
|
||||
if (!gfc_reference_st_label (label, ST_LABEL_FORMAT))
|
||||
return MATCH_ERROR;
|
||||
|
||||
dt->format_label = label;
|
||||
|
@ -2785,7 +2775,7 @@ gfc_free_dt (gfc_dt *dt)
|
|||
|
||||
/* Resolve everything in a gfc_dt structure. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_resolve_dt (gfc_dt *dt, locus *loc)
|
||||
{
|
||||
gfc_expr *e;
|
||||
|
@ -2815,10 +2805,10 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
|
|||
if (e == NULL)
|
||||
{
|
||||
gfc_error ("UNIT not specified at %L", loc);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (gfc_resolve_expr (e) == SUCCESS
|
||||
if (gfc_resolve_expr (e)
|
||||
&& (e->ts.type != BT_INTEGER
|
||||
&& (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE)))
|
||||
{
|
||||
|
@ -2828,7 +2818,7 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
|
|||
{
|
||||
gfc_error ("UNIT specification at %L must be an INTEGER expression "
|
||||
"or a CHARACTER variable", &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
else
|
||||
{
|
||||
|
@ -2850,7 +2840,7 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
|
|||
{
|
||||
gfc_error ("Invalid form of WRITE statement at %L, UNIT required",
|
||||
&dt->extra_comma->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -2860,21 +2850,21 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
|
|||
if (gfc_has_vector_index (e))
|
||||
{
|
||||
gfc_error ("Internal unit with vector subscript at %L", &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If we are writing, make sure the internal unit can be changed. */
|
||||
gcc_assert (k != M_PRINT);
|
||||
if (k == M_WRITE
|
||||
&& gfc_check_vardef_context (e, false, false, false,
|
||||
_("internal unit in WRITE")) == FAILURE)
|
||||
return FAILURE;
|
||||
&& !gfc_check_vardef_context (e, false, false, false,
|
||||
_("internal unit in WRITE")))
|
||||
return false;
|
||||
}
|
||||
|
||||
if (e->rank && e->ts.type != BT_CHARACTER)
|
||||
{
|
||||
gfc_error ("External IO UNIT cannot be an array at %L", &e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (e->expr_type == EXPR_CONSTANT && e->ts.type == BT_INTEGER
|
||||
|
@ -2882,7 +2872,7 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
|
|||
{
|
||||
gfc_error ("UNIT number in statement at %L must be non-negative",
|
||||
&e->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
/* If we are reading and have a namelist, check that all namelist symbols
|
||||
|
@ -2893,61 +2883,61 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
|
|||
for (n = dt->namelist->namelist; n; n = n->next)
|
||||
{
|
||||
gfc_expr* e;
|
||||
gfc_try t;
|
||||
bool t;
|
||||
|
||||
e = gfc_get_variable_expr (gfc_find_sym_in_symtree (n->sym));
|
||||
t = gfc_check_vardef_context (e, false, false, false, NULL);
|
||||
gfc_free_expr (e);
|
||||
|
||||
if (t == FAILURE)
|
||||
if (!t)
|
||||
{
|
||||
gfc_error ("NAMELIST '%s' in READ statement at %L contains"
|
||||
" the symbol '%s' which may not appear in a"
|
||||
" variable definition context",
|
||||
dt->namelist->name, loc, n->sym->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (dt->extra_comma
|
||||
&& gfc_notify_std (GFC_STD_GNU, "Comma before i/o "
|
||||
"item list at %L", &dt->extra_comma->where) == FAILURE)
|
||||
return FAILURE;
|
||||
&& !gfc_notify_std (GFC_STD_GNU, "Comma before i/o item list at %L",
|
||||
&dt->extra_comma->where))
|
||||
return false;
|
||||
|
||||
if (dt->err)
|
||||
{
|
||||
if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_reference_st_label (dt->err, ST_LABEL_TARGET))
|
||||
return false;
|
||||
if (dt->err->defined == ST_LABEL_UNKNOWN)
|
||||
{
|
||||
gfc_error ("ERR tag label %d at %L not defined",
|
||||
dt->err->value, &dt->err_where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
if (dt->end)
|
||||
{
|
||||
if (gfc_reference_st_label (dt->end, ST_LABEL_TARGET) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_reference_st_label (dt->end, ST_LABEL_TARGET))
|
||||
return false;
|
||||
if (dt->end->defined == ST_LABEL_UNKNOWN)
|
||||
{
|
||||
gfc_error ("END tag label %d at %L not defined",
|
||||
dt->end->value, &dt->end_where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
if (dt->eor)
|
||||
{
|
||||
if (gfc_reference_st_label (dt->eor, ST_LABEL_TARGET) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_reference_st_label (dt->eor, ST_LABEL_TARGET))
|
||||
return false;
|
||||
if (dt->eor->defined == ST_LABEL_UNKNOWN)
|
||||
{
|
||||
gfc_error ("EOR tag label %d at %L not defined",
|
||||
dt->eor->value, &dt->eor_where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -2957,10 +2947,10 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
|
|||
{
|
||||
gfc_error ("FORMAT label %d at %L not defined", dt->format_label->value,
|
||||
&dt->format_label->where);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -3257,9 +3247,8 @@ if (condition) \
|
|||
|
||||
if (dt->namelist != NULL)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "Internal file "
|
||||
"at %L with namelist", &expr->where)
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "Internal file at %L with "
|
||||
"namelist", &expr->where))
|
||||
m = MATCH_ERROR;
|
||||
}
|
||||
|
||||
|
@ -3313,7 +3302,7 @@ if (condition) \
|
|||
{
|
||||
static const char * asynchronous[] = { "YES", "NO", NULL };
|
||||
|
||||
if (gfc_reduce_init_expr (dt->asynchronous) != SUCCESS)
|
||||
if (!gfc_reduce_init_expr (dt->asynchronous))
|
||||
{
|
||||
gfc_error ("ASYNCHRONOUS= specifier at %L must be an initialization "
|
||||
"expression", &dt->asynchronous->where);
|
||||
|
@ -3341,8 +3330,8 @@ if (condition) \
|
|||
|
||||
if (dt->decimal)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (dt->decimal->expr_type == EXPR_CONSTANT)
|
||||
|
@ -3362,8 +3351,8 @@ if (condition) \
|
|||
|
||||
if (dt->blank)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "BLANK= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "BLANK= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (dt->blank->expr_type == EXPR_CONSTANT)
|
||||
|
@ -3383,8 +3372,8 @@ if (condition) \
|
|||
|
||||
if (dt->pad)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "PAD= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "PAD= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (dt->pad->expr_type == EXPR_CONSTANT)
|
||||
|
@ -3404,8 +3393,8 @@ if (condition) \
|
|||
|
||||
if (dt->round)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "ROUND= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "ROUND= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (dt->round->expr_type == EXPR_CONSTANT)
|
||||
|
@ -3425,7 +3414,7 @@ if (condition) \
|
|||
{
|
||||
/* When implemented, change the following to use gfc_notify_std F2003.
|
||||
if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
"not allowed in Fortran 95") == false)
|
||||
return MATCH_ERROR; */
|
||||
if (dt->sign->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
|
@ -3449,8 +3438,8 @@ if (condition) \
|
|||
|
||||
if (dt->delim)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "DELIM= at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "DELIM= at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (dt->delim->expr_type == EXPR_CONSTANT)
|
||||
|
@ -3557,8 +3546,8 @@ if (condition) \
|
|||
}
|
||||
|
||||
expr = dt->format_expr;
|
||||
if (gfc_simplify_expr (expr, 0) == FAILURE
|
||||
|| check_format_string (expr, k == M_READ) == FAILURE)
|
||||
if (!gfc_simplify_expr (expr, 0)
|
||||
|| !check_format_string (expr, k == M_READ))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return m;
|
||||
|
@ -3598,8 +3587,8 @@ match_io (io_kind k)
|
|||
gfc_find_symbol (name, NULL, 1, &sym);
|
||||
if (sym && sym->attr.flavor == FL_NAMELIST)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at "
|
||||
"%C is an extension") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_GNU, "PRINT namelist at "
|
||||
"%C is an extension"))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
goto cleanup;
|
||||
|
@ -4048,7 +4037,7 @@ cleanup:
|
|||
|
||||
/* Resolve everything in a gfc_inquire structure. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_resolve_inquire (gfc_inquire *inquire)
|
||||
{
|
||||
RESOLVE_TAG (&tag_unit, inquire->unit);
|
||||
|
@ -4064,8 +4053,8 @@ gfc_resolve_inquire (gfc_inquire *inquire)
|
|||
char context[64]; \
|
||||
sprintf (context, _("%s tag with INQUIRE"), (tag)->name); \
|
||||
if (gfc_check_vardef_context ((expr), false, false, false, \
|
||||
context) == FAILURE) \
|
||||
return FAILURE; \
|
||||
context) == false) \
|
||||
return false; \
|
||||
}
|
||||
INQUIRE_RESOLVE_TAG (&tag_iomsg, inquire->iomsg);
|
||||
INQUIRE_RESOLVE_TAG (&tag_iostat, inquire->iostat);
|
||||
|
@ -4104,10 +4093,10 @@ gfc_resolve_inquire (gfc_inquire *inquire)
|
|||
INQUIRE_RESOLVE_TAG (&tag_s_iqstream, inquire->iqstream);
|
||||
#undef INQUIRE_RESOLVE_TAG
|
||||
|
||||
if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_reference_st_label (inquire->err, ST_LABEL_TARGET))
|
||||
return false;
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -4125,7 +4114,7 @@ gfc_free_wait (gfc_wait *wait)
|
|||
}
|
||||
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_resolve_wait (gfc_wait *wait)
|
||||
{
|
||||
RESOLVE_TAG (&tag_unit, wait->unit);
|
||||
|
@ -4133,13 +4122,13 @@ gfc_resolve_wait (gfc_wait *wait)
|
|||
RESOLVE_TAG (&tag_iostat, wait->iostat);
|
||||
RESOLVE_TAG (&tag_id, wait->id);
|
||||
|
||||
if (gfc_reference_st_label (wait->err, ST_LABEL_TARGET) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_reference_st_label (wait->err, ST_LABEL_TARGET))
|
||||
return false;
|
||||
|
||||
if (gfc_reference_st_label (wait->end, ST_LABEL_TARGET) == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_reference_st_label (wait->end, ST_LABEL_TARGET))
|
||||
return false;
|
||||
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
/* Match an element of a WAIT statement. */
|
||||
|
@ -4202,8 +4191,8 @@ gfc_match_wait (void)
|
|||
goto syntax;
|
||||
}
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F2003, "WAIT at %C "
|
||||
"not allowed in Fortran 95") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "WAIT at %C "
|
||||
"not allowed in Fortran 95"))
|
||||
goto cleanup;
|
||||
|
||||
if (gfc_pure (NULL))
|
||||
|
|
|
@ -505,8 +505,8 @@ gfc_match_label (void)
|
|||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_add_flavor (&gfc_new_block->attr, FL_LABEL,
|
||||
gfc_new_block->name, NULL) == FAILURE)
|
||||
if (!gfc_add_flavor (&gfc_new_block->attr, FL_LABEL,
|
||||
gfc_new_block->name, NULL))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return MATCH_YES;
|
||||
|
@ -531,7 +531,7 @@ gfc_match_name (char *buffer)
|
|||
c = gfc_next_ascii_char ();
|
||||
if (!(ISALPHA (c) || (c == '_' && gfc_option.flag_allow_leading_underscore)))
|
||||
{
|
||||
if (gfc_error_flag_test() == 0 && c != '(')
|
||||
if (gfc_error_flag_test () == 0 && c != '(')
|
||||
gfc_error ("Invalid character in name at %C");
|
||||
gfc_current_locus = old_loc;
|
||||
return MATCH_NO;
|
||||
|
@ -1268,7 +1268,7 @@ gfc_match_program (void)
|
|||
if (m == MATCH_ERROR)
|
||||
return m;
|
||||
|
||||
if (gfc_add_flavor (&sym->attr, FL_PROGRAM, sym->name, NULL) == FAILURE)
|
||||
if (!gfc_add_flavor (&sym->attr, FL_PROGRAM, sym->name, NULL))
|
||||
return MATCH_ERROR;
|
||||
|
||||
gfc_new_block = sym;
|
||||
|
@ -1383,16 +1383,15 @@ match_arithmetic_if (void)
|
|||
if (m != MATCH_YES)
|
||||
return m;
|
||||
|
||||
if (gfc_reference_st_label (l1, ST_LABEL_TARGET) == FAILURE
|
||||
|| gfc_reference_st_label (l2, ST_LABEL_TARGET) == FAILURE
|
||||
|| gfc_reference_st_label (l3, ST_LABEL_TARGET) == FAILURE)
|
||||
if (!gfc_reference_st_label (l1, ST_LABEL_TARGET)
|
||||
|| !gfc_reference_st_label (l2, ST_LABEL_TARGET)
|
||||
|| !gfc_reference_st_label (l3, ST_LABEL_TARGET))
|
||||
{
|
||||
gfc_free_expr (expr);
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF "
|
||||
"statement at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
new_st.op = EXEC_ARITHMETIC_IF;
|
||||
|
@ -1464,16 +1463,15 @@ gfc_match_if (gfc_statement *if_type)
|
|||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_reference_st_label (l1, ST_LABEL_TARGET) == FAILURE
|
||||
|| gfc_reference_st_label (l2, ST_LABEL_TARGET) == FAILURE
|
||||
|| gfc_reference_st_label (l3, ST_LABEL_TARGET) == FAILURE)
|
||||
if (!gfc_reference_st_label (l1, ST_LABEL_TARGET)
|
||||
|| !gfc_reference_st_label (l2, ST_LABEL_TARGET)
|
||||
|| !gfc_reference_st_label (l3, ST_LABEL_TARGET))
|
||||
{
|
||||
gfc_free_expr (expr);
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF "
|
||||
"statement at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
new_st.op = EXEC_ARITHMETIC_IF;
|
||||
|
@ -1539,7 +1537,7 @@ gfc_match_if (gfc_statement *if_type)
|
|||
restore between tries. */
|
||||
|
||||
#define match(string, subr, statement) \
|
||||
if (gfc_match(string) == MATCH_YES) { m = subr(); goto got_match; }
|
||||
if (gfc_match (string) == MATCH_YES) { m = subr(); goto got_match; }
|
||||
|
||||
gfc_clear_error ();
|
||||
|
||||
|
@ -1746,7 +1744,7 @@ gfc_match_critical (void)
|
|||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS)
|
||||
if (gfc_find_state (COMP_DO_CONCURRENT))
|
||||
{
|
||||
gfc_error ("Image control statement CRITICAL at %C in DO CONCURRENT "
|
||||
"block");
|
||||
|
@ -1756,8 +1754,7 @@ gfc_match_critical (void)
|
|||
if (gfc_implicit_pure (NULL))
|
||||
gfc_current_ns->proc_name->attr.implicit_pure = 0;
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F2008, "CRITICAL statement at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "CRITICAL statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (gfc_option.coarray == GFC_FCOARRAY_NONE)
|
||||
|
@ -1766,7 +1763,7 @@ gfc_match_critical (void)
|
|||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
|
||||
if (gfc_find_state (COMP_CRITICAL))
|
||||
{
|
||||
gfc_error ("Nested CRITICAL block at %C");
|
||||
return MATCH_ERROR;
|
||||
|
@ -1775,7 +1772,7 @@ gfc_match_critical (void)
|
|||
new_st.op = EXEC_CRITICAL;
|
||||
|
||||
if (label != NULL
|
||||
&& gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
|
||||
&& !gfc_reference_st_label (label, ST_LABEL_TARGET))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return MATCH_YES;
|
||||
|
@ -2380,8 +2377,7 @@ gfc_match_do (void)
|
|||
gfc_forall_iterator *head;
|
||||
gfc_expr *mask;
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F2008, "DO CONCURRENT "
|
||||
"construct at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "DO CONCURRENT construct at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
|
||||
|
@ -2398,7 +2394,7 @@ gfc_match_do (void)
|
|||
goto concurr_cleanup;
|
||||
|
||||
if (label != NULL
|
||||
&& gfc_reference_st_label (label, ST_LABEL_DO_TARGET) == FAILURE)
|
||||
&& !gfc_reference_st_label (label, ST_LABEL_DO_TARGET))
|
||||
goto concurr_cleanup;
|
||||
|
||||
new_st.label1 = label;
|
||||
|
@ -2452,7 +2448,7 @@ concurr_cleanup:
|
|||
|
||||
done:
|
||||
if (label != NULL
|
||||
&& gfc_reference_st_label (label, ST_LABEL_DO_TARGET) == FAILURE)
|
||||
&& !gfc_reference_st_label (label, ST_LABEL_DO_TARGET))
|
||||
goto cleanup;
|
||||
|
||||
new_st.label1 = label;
|
||||
|
@ -2579,8 +2575,8 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
|
|||
return MATCH_ERROR;
|
||||
}
|
||||
gcc_assert (op == EXEC_EXIT);
|
||||
if (gfc_notify_std (GFC_STD_F2008, "EXIT statement with no"
|
||||
" do-construct-name at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "EXIT statement with no"
|
||||
" do-construct-name at %C"))
|
||||
return MATCH_ERROR;
|
||||
break;
|
||||
|
||||
|
@ -2686,12 +2682,12 @@ gfc_match_stopcode (gfc_statement st)
|
|||
if (gfc_implicit_pure (NULL))
|
||||
gfc_current_ns->proc_name->attr.implicit_pure = 0;
|
||||
|
||||
if (st == ST_STOP && gfc_find_state (COMP_CRITICAL) == SUCCESS)
|
||||
if (st == ST_STOP && gfc_find_state (COMP_CRITICAL))
|
||||
{
|
||||
gfc_error ("Image control statement STOP at %C in CRITICAL block");
|
||||
goto cleanup;
|
||||
}
|
||||
if (st == ST_STOP && gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS)
|
||||
if (st == ST_STOP && gfc_find_state (COMP_DO_CONCURRENT))
|
||||
{
|
||||
gfc_error ("Image control statement STOP at %C in DO CONCURRENT block");
|
||||
goto cleanup;
|
||||
|
@ -2770,9 +2766,7 @@ gfc_match_pause (void)
|
|||
m = gfc_match_stopcode (ST_PAUSE);
|
||||
if (m == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F95_DEL, "PAUSE statement"
|
||||
" at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F95_DEL, "PAUSE statement at %C"))
|
||||
m = MATCH_ERROR;
|
||||
}
|
||||
return m;
|
||||
|
@ -2793,8 +2787,7 @@ gfc_match_stop (void)
|
|||
match
|
||||
gfc_match_error_stop (void)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2008, "ERROR STOP statement at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "ERROR STOP statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return gfc_match_stopcode (ST_ERROR_STOP);
|
||||
|
@ -2833,14 +2826,14 @@ lock_unlock_statement (gfc_statement st)
|
|||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
|
||||
if (gfc_find_state (COMP_CRITICAL))
|
||||
{
|
||||
gfc_error ("Image control statement %s at %C in CRITICAL block",
|
||||
st == ST_LOCK ? "LOCK" : "UNLOCK");
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS)
|
||||
if (gfc_find_state (COMP_DO_CONCURRENT))
|
||||
{
|
||||
gfc_error ("Image control statement %s at %C in DO CONCURRENT block",
|
||||
st == ST_LOCK ? "LOCK" : "UNLOCK");
|
||||
|
@ -2979,8 +2972,7 @@ cleanup:
|
|||
match
|
||||
gfc_match_lock (void)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2008, "LOCK statement at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "LOCK statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return lock_unlock_statement (ST_LOCK);
|
||||
|
@ -2990,8 +2982,7 @@ gfc_match_lock (void)
|
|||
match
|
||||
gfc_match_unlock (void)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2008, "UNLOCK statement at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "UNLOCK statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return lock_unlock_statement (ST_UNLOCK);
|
||||
|
@ -3023,8 +3014,7 @@ sync_statement (gfc_statement st)
|
|||
if (gfc_implicit_pure (NULL))
|
||||
gfc_current_ns->proc_name->attr.implicit_pure = 0;
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F2008, "SYNC statement at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "SYNC statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (gfc_option.coarray == GFC_FCOARRAY_NONE)
|
||||
|
@ -3033,13 +3023,13 @@ sync_statement (gfc_statement st)
|
|||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
|
||||
if (gfc_find_state (COMP_CRITICAL))
|
||||
{
|
||||
gfc_error ("Image control statement SYNC at %C in CRITICAL block");
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS)
|
||||
if (gfc_find_state (COMP_DO_CONCURRENT))
|
||||
{
|
||||
gfc_error ("Image control statement SYNC at %C in DO CONCURRENT block");
|
||||
return MATCH_ERROR;
|
||||
|
@ -3217,13 +3207,11 @@ gfc_match_assign (void)
|
|||
|
||||
if (gfc_match (" %l", &label) == MATCH_YES)
|
||||
{
|
||||
if (gfc_reference_st_label (label, ST_LABEL_UNKNOWN) == FAILURE)
|
||||
if (!gfc_reference_st_label (label, ST_LABEL_UNKNOWN))
|
||||
return MATCH_ERROR;
|
||||
if (gfc_match (" to %v%t", &expr) == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F95_DEL, "ASSIGN "
|
||||
"statement at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F95_DEL, "ASSIGN statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
expr->symtree->n.sym->attr.assign = 1;
|
||||
|
@ -3255,7 +3243,7 @@ gfc_match_goto (void)
|
|||
|
||||
if (gfc_match (" %l%t", &label) == MATCH_YES)
|
||||
{
|
||||
if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
|
||||
if (!gfc_reference_st_label (label, ST_LABEL_TARGET))
|
||||
return MATCH_ERROR;
|
||||
|
||||
new_st.op = EXEC_GOTO;
|
||||
|
@ -3267,9 +3255,7 @@ gfc_match_goto (void)
|
|||
|
||||
if (gfc_match_variable (&expr, 0) == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F95_DEL, "Assigned GOTO "
|
||||
"statement at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F95_DEL, "Assigned GOTO statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
new_st.op = EXEC_GOTO;
|
||||
|
@ -3293,7 +3279,7 @@ gfc_match_goto (void)
|
|||
if (m != MATCH_YES)
|
||||
goto syntax;
|
||||
|
||||
if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
|
||||
if (!gfc_reference_st_label (label, ST_LABEL_TARGET))
|
||||
goto cleanup;
|
||||
|
||||
if (head == NULL)
|
||||
|
@ -3338,7 +3324,7 @@ gfc_match_goto (void)
|
|||
if (m != MATCH_YES)
|
||||
goto syntax;
|
||||
|
||||
if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
|
||||
if (!gfc_reference_st_label (label, ST_LABEL_TARGET))
|
||||
goto cleanup;
|
||||
|
||||
if (head == NULL)
|
||||
|
@ -3377,8 +3363,7 @@ gfc_match_goto (void)
|
|||
if (gfc_match (" %e%t", &expr) != MATCH_YES)
|
||||
goto syntax;
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F95_OBS, "Computed GOTO "
|
||||
"at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F95_OBS, "Computed GOTO at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
/* At this point, a computed GOTO has been fully matched and an
|
||||
|
@ -3460,8 +3445,8 @@ gfc_match_allocate (void)
|
|||
{
|
||||
if (gfc_match (" :: ") == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "typespec in "
|
||||
"ALLOCATE at %L", &old_locus) == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "typespec in ALLOCATE at %L",
|
||||
&old_locus))
|
||||
goto cleanup;
|
||||
|
||||
if (ts.deferred)
|
||||
|
@ -3516,8 +3501,8 @@ gfc_match_allocate (void)
|
|||
deferred_locus = tail->expr->where;
|
||||
}
|
||||
|
||||
if (gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS
|
||||
|| gfc_find_state (COMP_CRITICAL) == SUCCESS)
|
||||
if (gfc_find_state (COMP_DO_CONCURRENT)
|
||||
|| gfc_find_state (COMP_CRITICAL))
|
||||
{
|
||||
gfc_ref *ref;
|
||||
bool coarray = tail->expr->symtree->n.sym->attr.codimension;
|
||||
|
@ -3525,12 +3510,12 @@ gfc_match_allocate (void)
|
|||
if (ref->type == REF_COMPONENT)
|
||||
coarray = ref->u.c.component->attr.codimension;
|
||||
|
||||
if (coarray && gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS)
|
||||
if (coarray && gfc_find_state (COMP_DO_CONCURRENT))
|
||||
{
|
||||
gfc_error ("ALLOCATE of coarray at %C in DO CONCURRENT block");
|
||||
goto cleanup;
|
||||
}
|
||||
if (coarray && gfc_find_state (COMP_CRITICAL) == SUCCESS)
|
||||
if (coarray && gfc_find_state (COMP_CRITICAL))
|
||||
{
|
||||
gfc_error ("ALLOCATE of coarray at %C in CRITICAL block");
|
||||
goto cleanup;
|
||||
|
@ -3625,8 +3610,7 @@ alloc_opt_list:
|
|||
goto cleanup;
|
||||
if (m == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "ERRMSG tag at %L",
|
||||
&tmp->where) == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "ERRMSG tag at %L", &tmp->where))
|
||||
goto cleanup;
|
||||
|
||||
/* Enforce C630. */
|
||||
|
@ -3649,8 +3633,7 @@ alloc_opt_list:
|
|||
goto cleanup;
|
||||
if (m == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "SOURCE tag at %L",
|
||||
&tmp->where) == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "SOURCE tag at %L", &tmp->where))
|
||||
goto cleanup;
|
||||
|
||||
/* Enforce C630. */
|
||||
|
@ -3669,9 +3652,9 @@ alloc_opt_list:
|
|||
}
|
||||
|
||||
if (head->next
|
||||
&& gfc_notify_std (GFC_STD_F2008, "SOURCE tag at %L"
|
||||
&& !gfc_notify_std (GFC_STD_F2008, "SOURCE tag at %L"
|
||||
" with more than a single allocate object",
|
||||
&tmp->where) == FAILURE)
|
||||
&tmp->where))
|
||||
goto cleanup;
|
||||
|
||||
source = tmp;
|
||||
|
@ -3687,8 +3670,7 @@ alloc_opt_list:
|
|||
goto cleanup;
|
||||
if (m == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2008, "MOLD tag at %L",
|
||||
&tmp->where) == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2008, "MOLD tag at %L", &tmp->where))
|
||||
goto cleanup;
|
||||
|
||||
/* Check F08:C636. */
|
||||
|
@ -3900,14 +3882,14 @@ gfc_match_deallocate (void)
|
|||
gfc_current_ns->proc_name->attr.implicit_pure = 0;
|
||||
|
||||
if (gfc_is_coarray (tail->expr)
|
||||
&& gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS)
|
||||
&& gfc_find_state (COMP_DO_CONCURRENT))
|
||||
{
|
||||
gfc_error ("DEALLOCATE of coarray at %C in DO CONCURRENT block");
|
||||
goto cleanup;
|
||||
}
|
||||
|
||||
if (gfc_is_coarray (tail->expr)
|
||||
&& gfc_find_state (COMP_CRITICAL) == SUCCESS)
|
||||
&& gfc_find_state (COMP_CRITICAL))
|
||||
{
|
||||
gfc_error ("DEALLOCATE of coarray at %C in CRITICAL block");
|
||||
goto cleanup;
|
||||
|
@ -3962,8 +3944,7 @@ dealloc_opt_list:
|
|||
goto cleanup;
|
||||
if (m == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "ERRMSG at %L",
|
||||
&tmp->where) == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "ERRMSG at %L", &tmp->where))
|
||||
goto cleanup;
|
||||
|
||||
if (saw_errmsg)
|
||||
|
@ -4018,13 +3999,13 @@ gfc_match_return (void)
|
|||
|
||||
e = NULL;
|
||||
|
||||
if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
|
||||
if (gfc_find_state (COMP_CRITICAL))
|
||||
{
|
||||
gfc_error ("Image control statement RETURN at %C in CRITICAL block");
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_find_state (COMP_DO_CONCURRENT) == SUCCESS)
|
||||
if (gfc_find_state (COMP_DO_CONCURRENT))
|
||||
{
|
||||
gfc_error ("Image control statement RETURN at %C in DO CONCURRENT block");
|
||||
return MATCH_ERROR;
|
||||
|
@ -4033,7 +4014,7 @@ gfc_match_return (void)
|
|||
if (gfc_match_eos () == MATCH_YES)
|
||||
goto done;
|
||||
|
||||
if (gfc_find_state (COMP_SUBROUTINE) == FAILURE)
|
||||
if (!gfc_find_state (COMP_SUBROUTINE))
|
||||
{
|
||||
gfc_error ("Alternate RETURN statement at %C is only allowed within "
|
||||
"a SUBROUTINE");
|
||||
|
@ -4066,8 +4047,8 @@ cleanup:
|
|||
done:
|
||||
gfc_enclosing_unit (&s);
|
||||
if (s == COMP_PROGRAM
|
||||
&& gfc_notify_std (GFC_STD_GNU, "RETURN statement in "
|
||||
"main program at %C") == FAILURE)
|
||||
&& !gfc_notify_std (GFC_STD_GNU, "RETURN statement in "
|
||||
"main program at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
new_st.op = EXEC_RETURN;
|
||||
|
@ -4178,7 +4159,7 @@ gfc_match_call (void)
|
|||
}
|
||||
|
||||
/* ...and then to try to make the symbol into a subroutine. */
|
||||
if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
|
||||
if (!gfc_add_subroutine (&sym->attr, sym->name, NULL))
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
|
@ -4231,7 +4212,7 @@ gfc_match_call (void)
|
|||
if (a->expr != NULL)
|
||||
continue;
|
||||
|
||||
if (gfc_reference_st_label (a->label, ST_LABEL_TARGET) == FAILURE)
|
||||
if (!gfc_reference_st_label (a->label, ST_LABEL_TARGET))
|
||||
continue;
|
||||
|
||||
i++;
|
||||
|
@ -4450,14 +4431,13 @@ gfc_match_common (void)
|
|||
if (((sym->value != NULL && sym->value->expr_type != EXPR_NULL)
|
||||
|| sym->attr.data) && gfc_current_state () != COMP_BLOCK_DATA)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_GNU, "Initialized symbol '%s' at %C "
|
||||
"can only be COMMON in "
|
||||
"BLOCK DATA", sym->name)
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_GNU, "Initialized symbol '%s' at "
|
||||
"%C can only be COMMON in BLOCK DATA",
|
||||
sym->name))
|
||||
goto cleanup;
|
||||
}
|
||||
|
||||
if (gfc_add_in_common (&sym->attr, sym->name, NULL) == FAILURE)
|
||||
if (!gfc_add_in_common (&sym->attr, sym->name, NULL))
|
||||
goto cleanup;
|
||||
|
||||
if (tail != NULL)
|
||||
|
@ -4482,7 +4462,7 @@ gfc_match_common (void)
|
|||
goto cleanup;
|
||||
}
|
||||
|
||||
if (gfc_add_dimension (&sym->attr, sym->name, NULL) == FAILURE)
|
||||
if (!gfc_add_dimension (&sym->attr, sym->name, NULL))
|
||||
goto cleanup;
|
||||
|
||||
if (sym->attr.pointer)
|
||||
|
@ -4584,7 +4564,7 @@ gfc_match_block_data (void)
|
|||
if (gfc_get_symbol (name, NULL, &sym))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (gfc_add_flavor (&sym->attr, FL_BLOCK_DATA, sym->name, NULL) == FAILURE)
|
||||
if (!gfc_add_flavor (&sym->attr, FL_BLOCK_DATA, sym->name, NULL))
|
||||
return MATCH_ERROR;
|
||||
|
||||
gfc_new_block = sym;
|
||||
|
@ -4635,15 +4615,14 @@ gfc_match_namelist (void)
|
|||
|
||||
if (group_name->attr.flavor == FL_NAMELIST
|
||||
&& group_name->attr.use_assoc
|
||||
&& gfc_notify_std (GFC_STD_GNU, "Namelist group name '%s' "
|
||||
&& !gfc_notify_std (GFC_STD_GNU, "Namelist group name '%s' "
|
||||
"at %C already is USE associated and can"
|
||||
"not be respecified.", group_name->name)
|
||||
== FAILURE)
|
||||
"not be respecified.", group_name->name))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (group_name->attr.flavor != FL_NAMELIST
|
||||
&& gfc_add_flavor (&group_name->attr, FL_NAMELIST,
|
||||
group_name->name, NULL) == FAILURE)
|
||||
&& !gfc_add_flavor (&group_name->attr, FL_NAMELIST,
|
||||
group_name->name, NULL))
|
||||
return MATCH_ERROR;
|
||||
|
||||
for (;;)
|
||||
|
@ -4655,7 +4634,7 @@ gfc_match_namelist (void)
|
|||
goto error;
|
||||
|
||||
if (sym->attr.in_namelist == 0
|
||||
&& gfc_add_in_namelist (&sym->attr, sym->name, NULL) == FAILURE)
|
||||
&& !gfc_add_in_namelist (&sym->attr, sym->name, NULL))
|
||||
goto error;
|
||||
|
||||
/* Use gfc_error_check here, rather than goto error, so that
|
||||
|
@ -4721,8 +4700,8 @@ gfc_match_module (void)
|
|||
if (m != MATCH_YES)
|
||||
return m;
|
||||
|
||||
if (gfc_add_flavor (&gfc_new_block->attr, FL_MODULE,
|
||||
gfc_new_block->name, NULL) == FAILURE)
|
||||
if (!gfc_add_flavor (&gfc_new_block->attr, FL_MODULE,
|
||||
gfc_new_block->name, NULL))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return MATCH_YES;
|
||||
|
@ -4811,7 +4790,7 @@ gfc_match_equivalence (void)
|
|||
|
||||
sym = set->expr->symtree->n.sym;
|
||||
|
||||
if (gfc_add_in_equivalence (&sym->attr, sym->name, NULL) == FAILURE)
|
||||
if (!gfc_add_in_equivalence (&sym->attr, sym->name, NULL))
|
||||
goto cleanup;
|
||||
|
||||
if (sym->attr.in_common)
|
||||
|
@ -4958,8 +4937,7 @@ gfc_match_st_function (void)
|
|||
|
||||
gfc_push_error (&old_error);
|
||||
|
||||
if (gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION,
|
||||
sym->name, NULL) == FAILURE)
|
||||
if (!gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION, sym->name, NULL))
|
||||
goto undo_error;
|
||||
|
||||
if (gfc_match_formal_arglist (sym, 1, 0) != MATCH_YES)
|
||||
|
@ -4981,8 +4959,7 @@ gfc_match_st_function (void)
|
|||
|
||||
sym->value = expr;
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F95_OBS,
|
||||
"Statement function at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F95_OBS, "Statement function at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
return MATCH_YES;
|
||||
|
|
|
@ -195,9 +195,9 @@ match gfc_match_volatile (void);
|
|||
/* Fortran 2003 c interop.
|
||||
TODO: some of these should be moved to another file rather than decl.c */
|
||||
void set_com_block_bind_c (gfc_common_head *, int);
|
||||
gfc_try set_verify_bind_c_sym (gfc_symbol *, int);
|
||||
gfc_try set_verify_bind_c_com_block (gfc_common_head *, int);
|
||||
gfc_try get_bind_c_idents (void);
|
||||
bool set_verify_bind_c_sym (gfc_symbol *, int);
|
||||
bool set_verify_bind_c_com_block (gfc_common_head *, int);
|
||||
bool get_bind_c_idents (void);
|
||||
match gfc_match_bind_c_stmt (void);
|
||||
match gfc_match_suffix (gfc_symbol *, gfc_symbol **);
|
||||
match gfc_match_bind_c (gfc_symbol *, bool);
|
||||
|
@ -213,7 +213,7 @@ match gfc_match_literal_constant (gfc_expr **, int);
|
|||
/* expr.c -- FIXME: this one should be eliminated by moving the
|
||||
matcher to matchexp.c and a call to a new function in expr.c that
|
||||
only makes sure the init expr. is valid. */
|
||||
gfc_try gfc_reduce_init_expr (gfc_expr *expr);
|
||||
bool gfc_reduce_init_expr (gfc_expr *expr);
|
||||
match gfc_match_init_expr (gfc_expr **);
|
||||
|
||||
/* array.c. */
|
||||
|
|
|
@ -555,8 +555,8 @@ gfc_match_use (void)
|
|||
{
|
||||
if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "module "
|
||||
"nature in USE statement at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "module "
|
||||
"nature in USE statement at %C"))
|
||||
goto cleanup;
|
||||
|
||||
if (strcmp (module_nature, "intrinsic") == 0)
|
||||
|
@ -590,8 +590,7 @@ gfc_match_use (void)
|
|||
{
|
||||
m = gfc_match (" ::");
|
||||
if (m == MATCH_YES &&
|
||||
gfc_notify_std (GFC_STD_F2003,
|
||||
"\"USE :: module\" at %C") == FAILURE)
|
||||
!gfc_notify_std(GFC_STD_F2003, "\"USE :: module\" at %C"))
|
||||
goto cleanup;
|
||||
|
||||
if (m != MATCH_YES)
|
||||
|
@ -658,9 +657,8 @@ gfc_match_use (void)
|
|||
m = gfc_match (" =>");
|
||||
|
||||
if (type == INTERFACE_USER_OP && m == MATCH_YES
|
||||
&& (gfc_notify_std (GFC_STD_F2003, "Renaming "
|
||||
"operators in USE statements at %C")
|
||||
== FAILURE))
|
||||
&& (!gfc_notify_std(GFC_STD_F2003, "Renaming "
|
||||
"operators in USE statements at %C")))
|
||||
goto cleanup;
|
||||
|
||||
if (type == INTERFACE_USER_OP)
|
||||
|
@ -4089,7 +4087,7 @@ load_generic_interfaces (void)
|
|||
if (st && !sym->attr.generic
|
||||
&& !st->ambiguous
|
||||
&& sym->module
|
||||
&& strcmp(module, sym->module))
|
||||
&& strcmp (module, sym->module))
|
||||
{
|
||||
ambiguous_set = true;
|
||||
st->ambiguous = 1;
|
||||
|
@ -6096,10 +6094,9 @@ use_iso_fortran_env_module (void)
|
|||
found = true;
|
||||
u->found = 1;
|
||||
|
||||
if (gfc_notify_std (symbol[i].standard, "The symbol '%s', "
|
||||
if (!gfc_notify_std (symbol[i].standard, "The symbol '%s', "
|
||||
"referenced at %L, is not in the selected "
|
||||
"standard", symbol[i].name,
|
||||
&u->where) == FAILURE)
|
||||
"standard", symbol[i].name, &u->where))
|
||||
continue;
|
||||
|
||||
if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
|
||||
|
@ -6265,7 +6262,7 @@ gfc_use_module (gfc_use_list *module)
|
|||
{
|
||||
if (strcmp (module_name, "iso_fortran_env") == 0
|
||||
&& gfc_notify_std (GFC_STD_F2003, "ISO_FORTRAN_ENV "
|
||||
"intrinsic module at %C") != FAILURE)
|
||||
"intrinsic module at %C"))
|
||||
{
|
||||
use_iso_fortran_env_module ();
|
||||
free_rename (module->rename);
|
||||
|
@ -6276,8 +6273,7 @@ gfc_use_module (gfc_use_list *module)
|
|||
}
|
||||
|
||||
if (strcmp (module_name, "iso_c_binding") == 0
|
||||
&& gfc_notify_std (GFC_STD_F2003,
|
||||
"ISO_C_BINDING module at %C") != FAILURE)
|
||||
&& gfc_notify_std (GFC_STD_F2003, "ISO_C_BINDING module at %C"))
|
||||
{
|
||||
import_iso_c_binding_module();
|
||||
free_rename (module->rename);
|
||||
|
|
|
@ -316,9 +316,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
|
|||
&& ! sym->attr.intrinsic
|
||||
&& ! sym->attr.use_assoc
|
||||
&& ((sym->attr.flavor == FL_UNKNOWN
|
||||
&& gfc_add_flavor (&sym->attr, FL_PROCEDURE,
|
||||
sym->name, NULL) == FAILURE)
|
||||
|| gfc_add_intrinsic (&sym->attr, NULL) == FAILURE))
|
||||
&& !gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL))
|
||||
|| !gfc_add_intrinsic (&sym->attr, NULL)))
|
||||
{
|
||||
gfc_free_omp_clauses (c);
|
||||
return MATCH_ERROR;
|
||||
|
@ -573,8 +572,7 @@ gfc_match_omp_threadprivate (void)
|
|||
if (sym->attr.in_common)
|
||||
gfc_error_now ("Threadprivate variable at %C is an element of "
|
||||
"a COMMON block");
|
||||
else if (gfc_add_threadprivate (&sym->attr, sym->name,
|
||||
&sym->declared_at) == FAILURE)
|
||||
else if (!gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at))
|
||||
goto cleanup;
|
||||
goto next_item;
|
||||
case MATCH_NO:
|
||||
|
@ -597,8 +595,7 @@ gfc_match_omp_threadprivate (void)
|
|||
}
|
||||
st->n.common->threadprivate = 1;
|
||||
for (sym = st->n.common->head; sym; sym = sym->common_next)
|
||||
if (gfc_add_threadprivate (&sym->attr, sym->name,
|
||||
&sym->declared_at) == FAILURE)
|
||||
if (!gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at))
|
||||
goto cleanup;
|
||||
|
||||
next_item:
|
||||
|
@ -814,7 +811,7 @@ resolve_omp_clauses (gfc_code *code)
|
|||
if (omp_clauses->if_expr)
|
||||
{
|
||||
gfc_expr *expr = omp_clauses->if_expr;
|
||||
if (gfc_resolve_expr (expr) == FAILURE
|
||||
if (!gfc_resolve_expr (expr)
|
||||
|| expr->ts.type != BT_LOGICAL || expr->rank != 0)
|
||||
gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
|
||||
&expr->where);
|
||||
|
@ -822,7 +819,7 @@ resolve_omp_clauses (gfc_code *code)
|
|||
if (omp_clauses->final_expr)
|
||||
{
|
||||
gfc_expr *expr = omp_clauses->final_expr;
|
||||
if (gfc_resolve_expr (expr) == FAILURE
|
||||
if (!gfc_resolve_expr (expr)
|
||||
|| expr->ts.type != BT_LOGICAL || expr->rank != 0)
|
||||
gfc_error ("FINAL clause at %L requires a scalar LOGICAL expression",
|
||||
&expr->where);
|
||||
|
@ -830,7 +827,7 @@ resolve_omp_clauses (gfc_code *code)
|
|||
if (omp_clauses->num_threads)
|
||||
{
|
||||
gfc_expr *expr = omp_clauses->num_threads;
|
||||
if (gfc_resolve_expr (expr) == FAILURE
|
||||
if (!gfc_resolve_expr (expr)
|
||||
|| expr->ts.type != BT_INTEGER || expr->rank != 0)
|
||||
gfc_error ("NUM_THREADS clause at %L requires a scalar "
|
||||
"INTEGER expression", &expr->where);
|
||||
|
@ -838,7 +835,7 @@ resolve_omp_clauses (gfc_code *code)
|
|||
if (omp_clauses->chunk_size)
|
||||
{
|
||||
gfc_expr *expr = omp_clauses->chunk_size;
|
||||
if (gfc_resolve_expr (expr) == FAILURE
|
||||
if (!gfc_resolve_expr (expr)
|
||||
|| expr->ts.type != BT_INTEGER || expr->rank != 0)
|
||||
gfc_error ("SCHEDULE clause's chunk_size at %L requires "
|
||||
"a scalar INTEGER expression", &expr->where);
|
||||
|
|
|
@ -100,7 +100,7 @@ use_modules (void)
|
|||
|
||||
#define match(keyword, subr, st) \
|
||||
do { \
|
||||
if (match_word(keyword, subr, &old_locus) == MATCH_YES) \
|
||||
if (match_word (keyword, subr, &old_locus) == MATCH_YES) \
|
||||
return st; \
|
||||
else \
|
||||
undo_new_statement (); \
|
||||
|
@ -1068,7 +1068,7 @@ pop_state (void)
|
|||
|
||||
/* Try to find the given state in the state stack. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_find_state (gfc_compile_state state)
|
||||
{
|
||||
gfc_state_data *p;
|
||||
|
@ -1077,7 +1077,7 @@ gfc_find_state (gfc_compile_state state)
|
|||
if (p->state == state)
|
||||
break;
|
||||
|
||||
return (p == NULL) ? FAILURE : SUCCESS;
|
||||
return (p == NULL) ? false : true;
|
||||
}
|
||||
|
||||
|
||||
|
@ -1763,7 +1763,7 @@ unexpected_statement (gfc_statement st)
|
|||
/* Given the next statement seen by the matcher, make sure that it is
|
||||
in proper order with the last. This subroutine is initialized by
|
||||
calling it with an argument of ST_NONE. If there is a problem, we
|
||||
issue an error and return FAILURE. Otherwise we return SUCCESS.
|
||||
issue an error and return false. Otherwise we return true.
|
||||
|
||||
Individual parsers need to verify that the statements seen are
|
||||
valid before calling here, i.e., ENTRY statements are not allowed in
|
||||
|
@ -1815,7 +1815,7 @@ typedef struct
|
|||
}
|
||||
st_state;
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
verify_st_order (st_state *p, gfc_statement st, bool silent)
|
||||
{
|
||||
|
||||
|
@ -1897,7 +1897,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent)
|
|||
/* All is well, record the statement in case we need it next time. */
|
||||
p->where = gfc_current_locus;
|
||||
p->last_statement = st;
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
order:
|
||||
if (!silent)
|
||||
|
@ -1905,7 +1905,7 @@ order:
|
|||
gfc_ascii_statement (st),
|
||||
gfc_ascii_statement (p->last_statement), &p->where);
|
||||
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
|
@ -1977,8 +1977,7 @@ parse_derived_contains (void)
|
|||
goto error;
|
||||
|
||||
case ST_PROCEDURE:
|
||||
if (gfc_notify_std (GFC_STD_F2003, "Type-bound"
|
||||
" procedure at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "Type-bound procedure at %C"))
|
||||
goto error;
|
||||
|
||||
accept_statement (ST_PROCEDURE);
|
||||
|
@ -1986,8 +1985,7 @@ parse_derived_contains (void)
|
|||
break;
|
||||
|
||||
case ST_GENERIC:
|
||||
if (gfc_notify_std (GFC_STD_F2003, "GENERIC binding"
|
||||
" at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "GENERIC binding at %C"))
|
||||
goto error;
|
||||
|
||||
accept_statement (ST_GENERIC);
|
||||
|
@ -1995,9 +1993,8 @@ parse_derived_contains (void)
|
|||
break;
|
||||
|
||||
case ST_FINAL:
|
||||
if (gfc_notify_std (GFC_STD_F2003,
|
||||
"FINAL procedure declaration"
|
||||
" at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "FINAL procedure declaration"
|
||||
" at %C"))
|
||||
goto error;
|
||||
|
||||
accept_statement (ST_FINAL);
|
||||
|
@ -2008,16 +2005,15 @@ parse_derived_contains (void)
|
|||
to_finish = true;
|
||||
|
||||
if (!seen_comps
|
||||
&& (gfc_notify_std (GFC_STD_F2008, "Derived type "
|
||||
"definition at %C with empty CONTAINS "
|
||||
"section") == FAILURE))
|
||||
&& (!gfc_notify_std(GFC_STD_F2008, "Derived type definition "
|
||||
"at %C with empty CONTAINS section")))
|
||||
goto error;
|
||||
|
||||
/* ST_END_TYPE is accepted by parse_derived after return. */
|
||||
break;
|
||||
|
||||
case ST_PRIVATE:
|
||||
if (gfc_find_state (COMP_MODULE) == FAILURE)
|
||||
if (!gfc_find_state (COMP_MODULE))
|
||||
{
|
||||
gfc_error ("PRIVATE statement in TYPE at %C must be inside "
|
||||
"a MODULE");
|
||||
|
@ -2120,7 +2116,7 @@ endType:
|
|||
break;
|
||||
|
||||
case ST_PRIVATE:
|
||||
if (gfc_find_state (COMP_MODULE) == FAILURE)
|
||||
if (!gfc_find_state (COMP_MODULE))
|
||||
{
|
||||
gfc_error ("PRIVATE statement in TYPE at %C must be inside "
|
||||
"a MODULE");
|
||||
|
@ -2395,8 +2391,8 @@ loop:
|
|||
gfc_new_block->attr.pointer = 0;
|
||||
gfc_new_block->attr.proc_pointer = 1;
|
||||
}
|
||||
if (gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
|
||||
gfc_new_block->formal, NULL) == FAILURE)
|
||||
if (!gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
|
||||
gfc_new_block->formal, NULL))
|
||||
{
|
||||
reject_statement ();
|
||||
gfc_free_namespace (gfc_current_ns);
|
||||
|
@ -2642,7 +2638,7 @@ loop:
|
|||
verify_st_order (&dummyss, ST_NONE, false);
|
||||
verify_st_order (&dummyss, st, false);
|
||||
|
||||
if (verify_st_order (&dummyss, ST_IMPLICIT, true) == FAILURE)
|
||||
if (!verify_st_order (&dummyss, ST_IMPLICIT, true))
|
||||
verify_now = true;
|
||||
}
|
||||
|
||||
|
@ -2683,7 +2679,7 @@ loop:
|
|||
case ST_DERIVED_DECL:
|
||||
case_decl:
|
||||
declSt:
|
||||
if (verify_st_order (&ss, st, false) == FAILURE)
|
||||
if (!verify_st_order (&ss, st, false))
|
||||
{
|
||||
reject_statement ();
|
||||
st = next_statement ();
|
||||
|
@ -3313,14 +3309,14 @@ gfc_build_block_ns (gfc_namespace *parent_ns)
|
|||
my_ns->proc_name = gfc_new_block;
|
||||
else
|
||||
{
|
||||
gfc_try t;
|
||||
bool t;
|
||||
char buffer[20]; /* Enough to hold "block@2147483648\n". */
|
||||
|
||||
snprintf(buffer, sizeof(buffer), "block@%d", numblock++);
|
||||
gfc_get_symbol (buffer, my_ns, &my_ns->proc_name);
|
||||
t = gfc_add_flavor (&my_ns->proc_name->attr, FL_LABEL,
|
||||
my_ns->proc_name->name, NULL);
|
||||
gcc_assert (t == SUCCESS);
|
||||
gcc_assert (t);
|
||||
gfc_commit_symbol (my_ns->proc_name);
|
||||
}
|
||||
|
||||
|
@ -4026,9 +4022,9 @@ parse_contained (int module)
|
|||
"ambiguous", gfc_new_block->name);
|
||||
else
|
||||
{
|
||||
if (gfc_add_procedure (&sym->attr, PROC_INTERNAL, sym->name,
|
||||
&gfc_new_block->declared_at) ==
|
||||
SUCCESS)
|
||||
if (gfc_add_procedure (&sym->attr, PROC_INTERNAL,
|
||||
sym->name,
|
||||
&gfc_new_block->declared_at))
|
||||
{
|
||||
if (st == ST_FUNCTION)
|
||||
gfc_add_function (&sym->attr, sym->name,
|
||||
|
@ -4174,7 +4170,7 @@ contains:
|
|||
if (p->state == COMP_CONTAINS)
|
||||
n++;
|
||||
|
||||
if (gfc_find_state (COMP_MODULE) == SUCCESS)
|
||||
if (gfc_find_state (COMP_MODULE) == true)
|
||||
n--;
|
||||
|
||||
if (n > 0)
|
||||
|
@ -4492,7 +4488,7 @@ translate_all_program_units (gfc_namespace *gfc_global_ns_list,
|
|||
|
||||
/* Top level parser. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_parse_file (void)
|
||||
{
|
||||
int seen_program, errors_before, errors;
|
||||
|
@ -4516,7 +4512,7 @@ gfc_parse_file (void)
|
|||
gfc_statement_label = NULL;
|
||||
|
||||
if (setjmp (eof_buf))
|
||||
return FAILURE; /* Come here on unexpected EOF */
|
||||
return false; /* Come here on unexpected EOF */
|
||||
|
||||
/* Prepare the global namespace that will contain the
|
||||
program units. */
|
||||
|
@ -4663,7 +4659,7 @@ prog_units:
|
|||
translate_all_program_units (gfc_global_ns_list, seen_program);
|
||||
|
||||
gfc_end_source_files ();
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
duplicate_main:
|
||||
/* If we see a duplicate main program, shut down. If the second
|
||||
|
@ -4672,5 +4668,5 @@ duplicate_main:
|
|||
gfc_error ("Two main PROGRAMs at %L and %C", &prog_locus);
|
||||
reject_statement ();
|
||||
gfc_done_2 ();
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
|
|
@ -60,7 +60,7 @@ extern gfc_state_data *gfc_state_stack;
|
|||
#define gfc_current_state() (gfc_state_stack->state)
|
||||
|
||||
int gfc_check_do_variable (gfc_symtree *);
|
||||
gfc_try gfc_find_state (gfc_compile_state);
|
||||
bool gfc_find_state (gfc_compile_state);
|
||||
gfc_state_data *gfc_enclosing_unit (gfc_compile_state *);
|
||||
const char *gfc_ascii_statement (gfc_statement);
|
||||
match gfc_match_enum (void);
|
||||
|
|
|
@ -267,8 +267,7 @@ match_hollerith_constant (gfc_expr **result)
|
|||
if (match_integer_constant (&e, 0) == MATCH_YES
|
||||
&& gfc_match_char ('h') == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_LEGACY, "Hollerith constant "
|
||||
"at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_LEGACY, "Hollerith constant at %C"))
|
||||
goto cleanup;
|
||||
|
||||
msg = gfc_extract_int (e, &num);
|
||||
|
@ -391,9 +390,8 @@ match_boz_constant (gfc_expr **result)
|
|||
goto backup;
|
||||
|
||||
if (x_hex
|
||||
&& (gfc_notify_std (GFC_STD_GNU, "Hexadecimal "
|
||||
"constant at %C uses non-standard syntax")
|
||||
== FAILURE))
|
||||
&& (!gfc_notify_std(GFC_STD_GNU, "Hexadecimal "
|
||||
"constant at %C uses non-standard syntax")))
|
||||
return MATCH_ERROR;
|
||||
|
||||
old_loc = gfc_current_locus;
|
||||
|
@ -430,9 +428,8 @@ match_boz_constant (gfc_expr **result)
|
|||
goto backup;
|
||||
}
|
||||
|
||||
if (gfc_notify_std (GFC_STD_GNU, "BOZ constant "
|
||||
"at %C uses non-standard postfix syntax")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_GNU, "BOZ constant "
|
||||
"at %C uses non-standard postfix syntax"))
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
|
@ -467,9 +464,8 @@ match_boz_constant (gfc_expr **result)
|
|||
}
|
||||
|
||||
if (!gfc_in_match_data ()
|
||||
&& (gfc_notify_std (GFC_STD_F2003, "BOZ used outside a DATA "
|
||||
"statement at %C")
|
||||
== FAILURE))
|
||||
&& (!gfc_notify_std(GFC_STD_F2003, "BOZ used outside a DATA "
|
||||
"statement at %C")))
|
||||
return MATCH_ERROR;
|
||||
|
||||
*result = e;
|
||||
|
@ -558,8 +554,8 @@ match_real_constant (gfc_expr **result, int signflag)
|
|||
|
||||
if (c == 'q')
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_GNU, "exponent-letter 'q' in "
|
||||
"real-literal-constant at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_GNU, "exponent-letter 'q' in "
|
||||
"real-literal-constant at %C"))
|
||||
return MATCH_ERROR;
|
||||
else if (gfc_option.warn_real_q_constant)
|
||||
gfc_warning("Extension: exponent-letter 'q' in real-literal-constant "
|
||||
|
@ -1217,8 +1213,8 @@ match_sym_complex_part (gfc_expr **result)
|
|||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F2003, "PARAMETER symbol in "
|
||||
"complex constant at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "PARAMETER symbol in "
|
||||
"complex constant at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
switch (sym->value->ts.type)
|
||||
|
@ -1506,8 +1502,8 @@ match_actual_arg (gfc_expr **result)
|
|||
|
||||
if (sym->attr.in_common && !sym->attr.proc_pointer)
|
||||
{
|
||||
if (gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name,
|
||||
&sym->declared_at) == FAILURE)
|
||||
if (!gfc_add_flavor (&sym->attr, FL_VARIABLE,
|
||||
sym->name, &sym->declared_at))
|
||||
return MATCH_ERROR;
|
||||
break;
|
||||
}
|
||||
|
@ -1646,8 +1642,7 @@ match_arg_list_function (gfc_actual_arglist *result)
|
|||
}
|
||||
}
|
||||
|
||||
if (gfc_notify_std (GFC_STD_GNU, "argument list "
|
||||
"function at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_GNU, "argument list function at %C"))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
goto cleanup;
|
||||
|
@ -1719,8 +1714,8 @@ gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist **argp)
|
|||
if (m != MATCH_YES)
|
||||
goto cleanup;
|
||||
|
||||
if (gfc_notify_std (GFC_STD_F95_OBS, "Alternate-return argument "
|
||||
"at %C") == FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F95_OBS, "Alternate-return argument "
|
||||
"at %C"))
|
||||
goto cleanup;
|
||||
|
||||
tail->label = label;
|
||||
|
@ -1936,7 +1931,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
|
|||
|
||||
for (;;)
|
||||
{
|
||||
gfc_try t;
|
||||
bool t;
|
||||
gfc_symtree *tbp;
|
||||
|
||||
m = gfc_match_name (name);
|
||||
|
@ -1954,7 +1949,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
|
|||
{
|
||||
gfc_symbol* tbp_sym;
|
||||
|
||||
if (t == FAILURE)
|
||||
if (!t)
|
||||
return MATCH_ERROR;
|
||||
|
||||
gcc_assert (!tail || !tail->next);
|
||||
|
@ -2311,7 +2306,7 @@ gfc_free_structure_ctor_component (gfc_structure_ctor_component *comp)
|
|||
the order required; this also checks along the way that each and every
|
||||
component actually has an initializer and handles default initializers
|
||||
for components without explicit value given. */
|
||||
static gfc_try
|
||||
static bool
|
||||
build_actual_constructor (gfc_structure_ctor_component **comp_head,
|
||||
gfc_constructor_base *ctor_head, gfc_symbol *sym)
|
||||
{
|
||||
|
@ -2341,11 +2336,12 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
|
|||
&gfc_current_locus);
|
||||
value->ts = comp->ts;
|
||||
|
||||
if (build_actual_constructor (comp_head, &value->value.constructor,
|
||||
comp->ts.u.derived) == FAILURE)
|
||||
if (!build_actual_constructor (comp_head,
|
||||
&value->value.constructor,
|
||||
comp->ts.u.derived))
|
||||
{
|
||||
gfc_free_expr (value);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
gfc_constructor_append_expr (ctor_head, value, NULL);
|
||||
|
@ -2358,17 +2354,16 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
|
|||
{
|
||||
if (comp->initializer)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "Structure"
|
||||
" constructor with missing optional arguments"
|
||||
" at %C") == FAILURE)
|
||||
return FAILURE;
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "Structure constructor "
|
||||
"with missing optional arguments at %C"))
|
||||
return false;
|
||||
value = gfc_copy_expr (comp->initializer);
|
||||
}
|
||||
else
|
||||
{
|
||||
gfc_error ("No initializer for component '%s' given in the"
|
||||
" structure constructor at %C!", comp->name);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
else
|
||||
|
@ -2386,11 +2381,11 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
|
|||
gfc_free_structure_ctor_component (comp_iter);
|
||||
}
|
||||
}
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **cexpr,
|
||||
gfc_actual_arglist **arglist,
|
||||
bool parent)
|
||||
|
@ -2434,9 +2429,8 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
|
|||
}
|
||||
if (actual->name)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "Structure"
|
||||
" constructor with named arguments at %C")
|
||||
== FAILURE)
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "Structure"
|
||||
" constructor with named arguments at %C"))
|
||||
goto cleanup;
|
||||
|
||||
comp_tail->name = xstrdup (actual->name);
|
||||
|
@ -2519,7 +2513,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
|
|||
||
|
||||
comp_tail->val->ts.u.derived != this_comp->ts.u.derived))
|
||||
{
|
||||
gfc_try m;
|
||||
bool m;
|
||||
gfc_actual_arglist *arg_null = NULL;
|
||||
|
||||
actual->expr = comp_tail->val;
|
||||
|
@ -2529,7 +2523,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
|
|||
comp->ts.u.derived, &comp_tail->val,
|
||||
comp->ts.u.derived->attr.zero_comp
|
||||
? &arg_null : &actual, true);
|
||||
if (m == FAILURE)
|
||||
if (!m)
|
||||
goto cleanup;
|
||||
|
||||
if (comp->ts.u.derived->attr.zero_comp)
|
||||
|
@ -2547,7 +2541,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
|
|||
actual = actual->next;
|
||||
}
|
||||
|
||||
if (build_actual_constructor (&comp_head, &ctor_head, sym) == FAILURE)
|
||||
if (!build_actual_constructor (&comp_head, &ctor_head, sym))
|
||||
goto cleanup;
|
||||
|
||||
/* No component should be left, as this should have caused an error in the
|
||||
|
@ -2585,7 +2579,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
|
|||
gfc_current_locus = old_locus;
|
||||
if (parent)
|
||||
*arglist = actual;
|
||||
return SUCCESS;
|
||||
return true;
|
||||
|
||||
cleanup:
|
||||
gfc_current_locus = old_locus;
|
||||
|
@ -2598,7 +2592,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
|
|||
}
|
||||
gfc_constructor_free (ctor_head);
|
||||
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
|
@ -2627,8 +2621,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
|
|||
return m;
|
||||
}
|
||||
|
||||
if (gfc_convert_to_structure_constructor (e, sym, NULL, NULL, false)
|
||||
!= SUCCESS)
|
||||
if (!gfc_convert_to_structure_constructor (e, sym, NULL, NULL, false))
|
||||
{
|
||||
gfc_free_expr (e);
|
||||
return MATCH_ERROR;
|
||||
|
@ -2664,7 +2657,7 @@ check_for_implicit_index (gfc_symtree **st, gfc_symbol **sym)
|
|||
/* Procedure pointer as function result: Replace the function symbol by the
|
||||
auto-generated hidden result variable named "ppr@". */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
replace_hidden_procptr_result (gfc_symbol **sym, gfc_symtree **st)
|
||||
{
|
||||
/* Check for procedure pointer result variable. */
|
||||
|
@ -2679,9 +2672,9 @@ replace_hidden_procptr_result (gfc_symbol **sym, gfc_symtree **st)
|
|||
(*sym)->result->attr.referenced = (*sym)->attr.referenced;
|
||||
*sym = (*sym)->result;
|
||||
*st = gfc_find_symtree ((*sym)->ns->sym_root, (*sym)->name);
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
|
@ -2708,7 +2701,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
if (m != MATCH_YES)
|
||||
return m;
|
||||
|
||||
if (gfc_find_state (COMP_INTERFACE) == SUCCESS
|
||||
if (gfc_find_state (COMP_INTERFACE)
|
||||
&& !gfc_current_ns->has_import_set)
|
||||
i = gfc_get_sym_tree (name, NULL, &symtree, false);
|
||||
else
|
||||
|
@ -2854,8 +2847,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
m = gfc_match_varspec (e, 0, false, true);
|
||||
if (!e->ref && sym->attr.flavor == FL_UNKNOWN
|
||||
&& sym->ts.type == BT_UNKNOWN
|
||||
&& gfc_add_flavor (&sym->attr, FL_PROCEDURE,
|
||||
sym->name, NULL) == FAILURE)
|
||||
&& !gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
break;
|
||||
|
@ -2930,7 +2922,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
e->rank = sym->as->rank;
|
||||
|
||||
if (!sym->attr.function
|
||||
&& gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
|
||||
&& !gfc_add_function (&sym->attr, sym->name, NULL))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
break;
|
||||
|
@ -2977,8 +2969,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
|
||||
if (sym->attr.dimension || sym->attr.codimension)
|
||||
{
|
||||
if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
|
||||
sym->name, NULL) == FAILURE)
|
||||
if (!gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, NULL))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
break;
|
||||
|
@ -2995,8 +2986,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
&& (CLASS_DATA (sym)->attr.dimension
|
||||
|| CLASS_DATA (sym)->attr.codimension))
|
||||
{
|
||||
if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
|
||||
sym->name, NULL) == FAILURE)
|
||||
if (!gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, NULL))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
break;
|
||||
|
@ -3021,8 +3011,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
e->symtree = symtree;
|
||||
e->expr_type = EXPR_VARIABLE;
|
||||
|
||||
if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
|
||||
sym->name, NULL) == FAILURE)
|
||||
if (!gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, NULL))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
break;
|
||||
|
@ -3069,15 +3058,15 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
e->expr_type = EXPR_VARIABLE;
|
||||
|
||||
if (sym->attr.flavor != FL_VARIABLE
|
||||
&& gfc_add_flavor (&sym->attr, FL_VARIABLE,
|
||||
sym->name, NULL) == FAILURE)
|
||||
&& !gfc_add_flavor (&sym->attr, FL_VARIABLE,
|
||||
sym->name, NULL))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
break;
|
||||
}
|
||||
|
||||
if (sym->ts.type == BT_UNKNOWN
|
||||
&& gfc_set_default_type (sym, 1, NULL) == FAILURE)
|
||||
&& !gfc_set_default_type (sym, 1, NULL))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
break;
|
||||
|
@ -3098,7 +3087,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
e->expr_type = EXPR_FUNCTION;
|
||||
|
||||
if (!sym->attr.function
|
||||
&& gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
|
||||
&& !gfc_add_function (&sym->attr, sym->name, NULL))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
break;
|
||||
|
@ -3233,7 +3222,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
|
|||
flavor = FL_VARIABLE;
|
||||
|
||||
if (flavor != FL_UNKNOWN
|
||||
&& gfc_add_flavor (&sym->attr, flavor, sym->name, NULL) == FAILURE)
|
||||
&& !gfc_add_flavor (&sym->attr, flavor, sym->name, NULL))
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
break;
|
||||
|
@ -3269,7 +3258,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
|
|||
}
|
||||
|
||||
if (sym->attr.proc_pointer
|
||||
|| replace_hidden_procptr_result (&sym, &st) == SUCCESS)
|
||||
|| replace_hidden_procptr_result (&sym, &st))
|
||||
break;
|
||||
|
||||
/* Fall through to error */
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -326,7 +326,7 @@ add_path_to_list (gfc_directorylist **list, const char *path,
|
|||
q = (char *) alloca (len + 1);
|
||||
memcpy (q, p, len + 1);
|
||||
i = len - 1;
|
||||
while (i >=0 && IS_DIR_SEPARATOR(q[i]))
|
||||
while (i >=0 && IS_DIR_SEPARATOR (q[i]))
|
||||
q[i--] = '\0';
|
||||
|
||||
if (stat (q, &st))
|
||||
|
@ -1123,7 +1123,7 @@ restart:
|
|||
else
|
||||
gfc_advance_line ();
|
||||
|
||||
if (gfc_at_eof())
|
||||
if (gfc_at_eof ())
|
||||
goto not_continuation;
|
||||
|
||||
/* We've got a continuation line. If we are on the very next line after
|
||||
|
@ -1831,7 +1831,7 @@ preprocessor_line (gfc_char_t *c)
|
|||
}
|
||||
|
||||
|
||||
static gfc_try load_file (const char *, const char *, bool);
|
||||
static bool load_file (const char *, const char *, bool);
|
||||
|
||||
/* include_line()-- Checks a line buffer to see if it is an include
|
||||
line. If so, we call load_file() recursively to load the included
|
||||
|
@ -1902,7 +1902,7 @@ include_line (gfc_char_t *line)
|
|||
read by anything else. */
|
||||
|
||||
filename = gfc_widechar_to_char (begin, -1);
|
||||
if (load_file (filename, NULL, false) == FAILURE)
|
||||
if (!load_file (filename, NULL, false))
|
||||
exit (FATAL_EXIT_CODE);
|
||||
|
||||
free (filename);
|
||||
|
@ -1912,7 +1912,7 @@ include_line (gfc_char_t *line)
|
|||
|
||||
/* Load a file into memory by calling load_line until the file ends. */
|
||||
|
||||
static gfc_try
|
||||
static bool
|
||||
load_file (const char *realfilename, const char *displayedname, bool initial)
|
||||
{
|
||||
gfc_char_t *line;
|
||||
|
@ -1936,7 +1936,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
|
|||
fprintf (stderr, "%s:%d: Error: File '%s' is being included "
|
||||
"recursively\n", current_file->filename, current_file->line,
|
||||
filename);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (initial)
|
||||
|
@ -1951,7 +1951,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
|
|||
if (input == NULL)
|
||||
{
|
||||
gfc_error_now ("Can't open file '%s'", filename);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
else
|
||||
|
@ -1961,7 +1961,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
|
|||
{
|
||||
fprintf (stderr, "%s:%d: Error: Can't open included file '%s'\n",
|
||||
current_file->filename, current_file->line, filename);
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -2096,19 +2096,19 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
|
|||
add_file_change (NULL, current_file->inclusion_line + 1);
|
||||
current_file = current_file->up;
|
||||
linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
/* Open a new file and start scanning from that file. Returns SUCCESS
|
||||
if everything went OK, FAILURE otherwise. If form == FORM_UNKNOWN
|
||||
/* Open a new file and start scanning from that file. Returns true
|
||||
if everything went OK, false otherwise. If form == FORM_UNKNOWN
|
||||
it tries to determine the source form from the filename, defaulting
|
||||
to free form. */
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_new_file (void)
|
||||
{
|
||||
gfc_try result;
|
||||
bool result;
|
||||
|
||||
if (gfc_cpp_enabled ())
|
||||
{
|
||||
|
|
|
@ -3263,7 +3263,7 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
|
|||
gcc_assert (array->expr_type == EXPR_VARIABLE);
|
||||
gcc_assert (as);
|
||||
|
||||
if (gfc_resolve_array_spec (as, 0) == FAILURE)
|
||||
if (!gfc_resolve_array_spec (as, 0))
|
||||
return NULL;
|
||||
|
||||
/* The last dimension of an assumed-size array is special. */
|
||||
|
@ -3313,8 +3313,7 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
|
|||
{
|
||||
if (upper)
|
||||
{
|
||||
if (gfc_ref_dimen_size (&ref->u.ar, d-1, &result->value.integer, NULL)
|
||||
!= SUCCESS)
|
||||
if (!gfc_ref_dimen_size (&ref->u.ar, d - 1, &result->value.integer, NULL))
|
||||
goto returnNull;
|
||||
}
|
||||
else
|
||||
|
@ -4078,7 +4077,7 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign)
|
|||
case BT_CHARACTER:
|
||||
#define LENGTH(x) ((x)->value.character.length)
|
||||
#define STRING(x) ((x)->value.character.string)
|
||||
if (LENGTH(extremum) < LENGTH(arg))
|
||||
if (LENGTH (extremum) < LENGTH(arg))
|
||||
{
|
||||
gfc_char_t *tmp = STRING(extremum);
|
||||
|
||||
|
@ -4629,10 +4628,10 @@ gfc_simplify_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
|
|||
gfc_expr *result;
|
||||
gfc_constructor *array_ctor, *mask_ctor, *vector_ctor;
|
||||
|
||||
if (!is_constant_array_expr(array)
|
||||
|| !is_constant_array_expr(vector)
|
||||
if (!is_constant_array_expr (array)
|
||||
|| !is_constant_array_expr (vector)
|
||||
|| (!gfc_is_constant_expr (mask)
|
||||
&& !is_constant_array_expr(mask)))
|
||||
&& !is_constant_array_expr (mask)))
|
||||
return NULL;
|
||||
|
||||
result = gfc_get_array_expr (array->ts.type, array->ts.kind, &array->where);
|
||||
|
@ -5506,7 +5505,7 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
|
|||
gfc_expr *result, *e, *f;
|
||||
gfc_array_ref *ar;
|
||||
int n;
|
||||
gfc_try t;
|
||||
bool t;
|
||||
int k = get_kind (BT_INTEGER, kind, "SHAPE", gfc_default_integer_kind);
|
||||
|
||||
if (source->rank == -1)
|
||||
|
@ -5524,7 +5523,7 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
|
|||
}
|
||||
else if (source->shape)
|
||||
{
|
||||
t = SUCCESS;
|
||||
t = true;
|
||||
for (n = 0; n < source->rank; n++)
|
||||
{
|
||||
mpz_init (shape[n]);
|
||||
|
@ -5532,13 +5531,13 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
|
|||
}
|
||||
}
|
||||
else
|
||||
t = FAILURE;
|
||||
t = false;
|
||||
|
||||
for (n = 0; n < source->rank; n++)
|
||||
{
|
||||
e = gfc_get_constant_expr (BT_INTEGER, k, &source->where);
|
||||
|
||||
if (t == SUCCESS)
|
||||
if (t)
|
||||
{
|
||||
mpz_set (e->value.integer, shape[n]);
|
||||
mpz_clear (shape[n]);
|
||||
|
@ -5631,7 +5630,7 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
|
|||
|
||||
if (dim == NULL)
|
||||
{
|
||||
if (gfc_array_size (array, &size) == FAILURE)
|
||||
if (!gfc_array_size (array, &size))
|
||||
return NULL;
|
||||
}
|
||||
else
|
||||
|
@ -5640,7 +5639,7 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
|
|||
return NULL;
|
||||
|
||||
d = mpz_get_ui (dim->value.integer) - 1;
|
||||
if (gfc_array_dimen_size (array, d, &size) == FAILURE)
|
||||
if (!gfc_array_dimen_size (array, d, &size))
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
@ -5668,7 +5667,7 @@ gfc_simplify_sizeof (gfc_expr *x)
|
|||
return NULL;
|
||||
|
||||
if (x->rank && x->expr_type != EXPR_ARRAY
|
||||
&& gfc_array_size (x, &array_size) == FAILURE)
|
||||
&& !gfc_array_size (x, &array_size))
|
||||
return NULL;
|
||||
|
||||
result = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind,
|
||||
|
@ -5897,7 +5896,7 @@ gfc_simplify_spread (gfc_expr *source, gfc_expr *dim_expr, gfc_expr *ncopies_exp
|
|||
constructor. */
|
||||
if (source->expr_type == EXPR_ARRAY)
|
||||
{
|
||||
if (gfc_array_size (source, &size) == FAILURE)
|
||||
if (!gfc_array_size (source, &size))
|
||||
gfc_internal_error ("Failure getting length of a constant array.");
|
||||
}
|
||||
else
|
||||
|
@ -6123,13 +6122,13 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
|
|||
|| !gfc_is_constant_expr (size))
|
||||
return NULL;
|
||||
|
||||
if (gfc_calculate_transfer_sizes (source, mold, size, &source_size,
|
||||
&result_size, &result_length) == FAILURE)
|
||||
if (!gfc_calculate_transfer_sizes (source, mold, size, &source_size,
|
||||
&result_size, &result_length))
|
||||
return NULL;
|
||||
|
||||
/* Calculate the size of the source. */
|
||||
if (source->expr_type == EXPR_ARRAY
|
||||
&& gfc_array_size (source, &tmp) == FAILURE)
|
||||
&& !gfc_array_size (source, &tmp))
|
||||
gfc_internal_error ("Failure getting length of a constant array.");
|
||||
|
||||
/* Create an empty new expression with the appropriate characteristics. */
|
||||
|
@ -6395,7 +6394,7 @@ gfc_simplify_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
|
|||
if (!is_constant_array_expr (vector)
|
||||
|| !is_constant_array_expr (mask)
|
||||
|| (!gfc_is_constant_expr (field)
|
||||
&& !is_constant_array_expr(field)))
|
||||
&& !is_constant_array_expr (field)))
|
||||
return NULL;
|
||||
|
||||
result = gfc_get_array_expr (vector->ts.type, vector->ts.kind,
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -7582,7 +7582,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
|
|||
comp = fold_build3_loc (input_location, COMPONENT_REF,
|
||||
TREE_TYPE (tmp), comp, tmp, NULL_TREE);
|
||||
|
||||
if (GFC_DESCRIPTOR_TYPE_P(TREE_TYPE (comp)))
|
||||
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
|
||||
tmp = gfc_trans_dealloc_allocated (comp,
|
||||
CLASS_DATA (c)->attr.codimension);
|
||||
else
|
||||
|
@ -7647,7 +7647,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
|
|||
tmp = CLASS_DATA (c)->backend_decl;
|
||||
comp = fold_build3_loc (input_location, COMPONENT_REF,
|
||||
TREE_TYPE (tmp), comp, tmp, NULL_TREE);
|
||||
if (GFC_DESCRIPTOR_TYPE_P(TREE_TYPE (comp)))
|
||||
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
|
||||
gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node);
|
||||
else
|
||||
{
|
||||
|
|
|
@ -2192,9 +2192,9 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr)
|
|||
minmax (a1, a2, a3, ...)
|
||||
{
|
||||
mvar = a1;
|
||||
if (a2 .op. mvar || isnan(mvar))
|
||||
if (a2 .op. mvar || isnan (mvar))
|
||||
mvar = a2;
|
||||
if (a3 .op. mvar || isnan(mvar))
|
||||
if (a3 .op. mvar || isnan (mvar))
|
||||
mvar = a3;
|
||||
...
|
||||
return mvar
|
||||
|
@ -2749,7 +2749,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
|
|||
|
||||
if (norm2)
|
||||
{
|
||||
/* if (x(i) != 0.0)
|
||||
/* if (x (i) != 0.0)
|
||||
{
|
||||
absX = abs(x(i))
|
||||
if (absX > scale)
|
||||
|
@ -3104,7 +3104,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
else
|
||||
{
|
||||
mpz_t asize;
|
||||
if (gfc_array_size (arrayexpr, &asize) == SUCCESS)
|
||||
if (gfc_array_size (arrayexpr, &asize))
|
||||
{
|
||||
nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
|
||||
mpz_clear (asize);
|
||||
|
@ -3594,7 +3594,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
else
|
||||
{
|
||||
mpz_t asize;
|
||||
if (gfc_array_size (arrayexpr, &asize) == SUCCESS)
|
||||
if (gfc_array_size (arrayexpr, &asize))
|
||||
{
|
||||
nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
|
||||
mpz_clear (asize);
|
||||
|
|
|
@ -500,7 +500,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
|
|||
tree decl, backend_decl, stmt, type, outer_decl;
|
||||
locus old_loc = gfc_current_locus;
|
||||
const char *iname;
|
||||
gfc_try t;
|
||||
bool t;
|
||||
|
||||
decl = OMP_CLAUSE_DECL (c);
|
||||
gfc_current_locus = where;
|
||||
|
@ -562,7 +562,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
|
|||
ref->u.ar.type = AR_FULL;
|
||||
ref->u.ar.dimen = 0;
|
||||
t = gfc_resolve_expr (e1);
|
||||
gcc_assert (t == SUCCESS);
|
||||
gcc_assert (t);
|
||||
|
||||
e2 = gfc_get_expr ();
|
||||
e2->expr_type = EXPR_VARIABLE;
|
||||
|
@ -570,12 +570,12 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
|
|||
e2->symtree = symtree2;
|
||||
e2->ts = sym->ts;
|
||||
t = gfc_resolve_expr (e2);
|
||||
gcc_assert (t == SUCCESS);
|
||||
gcc_assert (t);
|
||||
|
||||
e3 = gfc_copy_expr (e1);
|
||||
e3->symtree = symtree3;
|
||||
t = gfc_resolve_expr (e3);
|
||||
gcc_assert (t == SUCCESS);
|
||||
gcc_assert (t);
|
||||
|
||||
iname = NULL;
|
||||
switch (OMP_CLAUSE_REDUCTION_CODE (c))
|
||||
|
@ -647,7 +647,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
|
|||
e1 = gfc_copy_expr (e1);
|
||||
e3 = gfc_copy_expr (e3);
|
||||
t = gfc_resolve_expr (e4);
|
||||
gcc_assert (t == SUCCESS);
|
||||
gcc_assert (t);
|
||||
|
||||
/* Create the init statement list. */
|
||||
pushlevel ();
|
||||
|
|
|
@ -2661,7 +2661,7 @@ check_forall_dependencies (gfc_code *c, stmtblock_t *pre, stmtblock_t *post)
|
|||
return need_temp;
|
||||
|
||||
new_symtree = NULL;
|
||||
if (find_forall_index (c->expr1, lsym, 2) == SUCCESS)
|
||||
if (find_forall_index (c->expr1, lsym, 2))
|
||||
{
|
||||
forall_make_variable_temp (c, pre, post);
|
||||
need_temp = 0;
|
||||
|
@ -4757,21 +4757,21 @@ gfc_trans_where (gfc_code * code)
|
|||
are the same. In short, this is VERY conservative and this
|
||||
is needed because the two loops, required by the standard
|
||||
are coalesced in gfc_trans_where_3. */
|
||||
if (!gfc_check_dependency(cblock->next->expr1,
|
||||
if (!gfc_check_dependency (cblock->next->expr1,
|
||||
cblock->expr1, 0)
|
||||
&& !gfc_check_dependency(eblock->next->expr1,
|
||||
&& !gfc_check_dependency (eblock->next->expr1,
|
||||
cblock->expr1, 0)
|
||||
&& !gfc_check_dependency(cblock->next->expr1,
|
||||
&& !gfc_check_dependency (cblock->next->expr1,
|
||||
eblock->next->expr2, 1)
|
||||
&& !gfc_check_dependency(eblock->next->expr1,
|
||||
&& !gfc_check_dependency (eblock->next->expr1,
|
||||
cblock->next->expr2, 1)
|
||||
&& !gfc_check_dependency(cblock->next->expr1,
|
||||
&& !gfc_check_dependency (cblock->next->expr1,
|
||||
cblock->next->expr2, 1)
|
||||
&& !gfc_check_dependency(eblock->next->expr1,
|
||||
&& !gfc_check_dependency (eblock->next->expr1,
|
||||
eblock->next->expr2, 1)
|
||||
&& !gfc_check_dependency(cblock->next->expr1,
|
||||
&& !gfc_check_dependency (cblock->next->expr1,
|
||||
eblock->next->expr1, 0)
|
||||
&& !gfc_check_dependency(eblock->next->expr1,
|
||||
&& !gfc_check_dependency (eblock->next->expr1,
|
||||
cblock->next->expr1, 0))
|
||||
return gfc_trans_where_3 (cblock, eblock);
|
||||
}
|
||||
|
|
|
@ -132,7 +132,7 @@ int gfc_numeric_storage_size;
|
|||
int gfc_character_storage_size;
|
||||
|
||||
|
||||
gfc_try
|
||||
bool
|
||||
gfc_check_any_c_kind (gfc_typespec *ts)
|
||||
{
|
||||
int i;
|
||||
|
@ -144,10 +144,10 @@ gfc_check_any_c_kind (gfc_typespec *ts)
|
|||
Fortran kind being used exists in at least some form for C. */
|
||||
if (c_interop_kinds_table[i].f90_type == ts->type &&
|
||||
c_interop_kinds_table[i].value == ts->kind)
|
||||
return SUCCESS;
|
||||
return true;
|
||||
}
|
||||
|
||||
return FAILURE;
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue