#include "gfortran.h"
#include "arith.h" /* For gfc_compare_expr(). */
+/* Types used in equivalence statements. */
+
+typedef enum seq_type
+{
+ SEQ_NONDEFAULT, SEQ_NUMERIC, SEQ_CHARACTER, SEQ_MIXED
+}
+seq_type;
/* Stack to push the current if we descend into a block during
resolution. See resolve_branch() and resolve_code(). */
}
else
{
- /* Otherwise the result will be passed through an union by
+ /* Otherwise the result will be passed through a union by
reference. */
proc->attr.mixed_entry_master = 1;
for (el = ns->entries; el; el = el->next)
{
sym = el->sym->result;
if (sym->attr.dimension)
- gfc_error ("%s result %s can't be an array in FUNCTION %s at %L",
- el == ns->entries ? "FUNCTION" : "ENTRY", sym->name,
- ns->entries->sym->name, &sym->declared_at);
+ {
+ if (el == ns->entries)
+ gfc_error
+ ("FUNCTION result %s can't be an array in FUNCTION %s at %L",
+ sym->name, ns->entries->sym->name, &sym->declared_at);
+ else
+ gfc_error
+ ("ENTRY result %s can't be an array in FUNCTION %s at %L",
+ sym->name, ns->entries->sym->name, &sym->declared_at);
+ }
else if (sym->attr.pointer)
- gfc_error ("%s result %s can't be a POINTER in FUNCTION %s at %L",
- el == ns->entries ? "FUNCTION" : "ENTRY", sym->name,
- ns->entries->sym->name, &sym->declared_at);
+ {
+ if (el == ns->entries)
+ gfc_error
+ ("FUNCTION result %s can't be a POINTER in FUNCTION %s at %L",
+ sym->name, ns->entries->sym->name, &sym->declared_at);
+ else
+ gfc_error
+ ("ENTRY result %s can't be a POINTER in FUNCTION %s at %L",
+ sym->name, ns->entries->sym->name, &sym->declared_at);
+ }
else
{
ts = &sym->ts;
break;
}
if (sym)
- gfc_error ("%s result %s can't be of type %s in FUNCTION %s at %L",
- el == ns->entries ? "FUNCTION" : "ENTRY", sym->name,
- gfc_typename (ts), ns->entries->sym->name,
- &sym->declared_at);
+ {
+ if (el == ns->entries)
+ gfc_error
+ ("FUNCTION result %s can't be of type %s in FUNCTION %s at %L",
+ sym->name, gfc_typename (ts), ns->entries->sym->name,
+ &sym->declared_at);
+ else
+ gfc_error
+ ("ENTRY result %s can't be of type %s in FUNCTION %s at %L",
+ sym->name, gfc_typename (ts), ns->entries->sym->name,
+ &sym->declared_at);
+ }
}
}
}
break;
}
- sprintf (msg, "Operand of unary numeric operator '%s' at %%L is %s",
+ sprintf (msg, _("Operand of unary numeric operator '%s' at %%L is %s"),
gfc_op2string (e->value.op.operator), gfc_typename (&e->ts));
goto bad_op;
}
sprintf (msg,
- "Operands of binary numeric operator '%s' at %%L are %s/%s",
+ _("Operands of binary numeric operator '%s' at %%L are %s/%s"),
gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
goto bad_op;
}
sprintf (msg,
- "Operands of string concatenation operator at %%L are %s/%s",
+ _("Operands of string concatenation operator at %%L are %s/%s"),
gfc_typename (&op1->ts), gfc_typename (&op2->ts));
goto bad_op;
break;
}
- sprintf (msg, "Operands of logical operator '%s' at %%L are %s/%s",
+ sprintf (msg, _("Operands of logical operator '%s' at %%L are %s/%s"),
gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
break;
}
- sprintf (msg, "Operand of .NOT. operator at %%L is %s",
+ sprintf (msg, _("Operand of .NOT. operator at %%L is %s"),
gfc_typename (&op1->ts));
goto bad_op;
case INTRINSIC_LE:
if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX)
{
- strcpy (msg, "COMPLEX quantities cannot be compared at %L");
+ strcpy (msg, _("COMPLEX quantities cannot be compared at %L"));
goto bad_op;
}
break;
}
- sprintf (msg, "Operands of comparison operator '%s' at %%L are %s/%s",
- gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
- gfc_typename (&op2->ts));
+ if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
+ sprintf (msg,
+ _("Logicals at %%L must be compared with %s instead of %s"),
+ e->value.op.operator == INTRINSIC_EQ ? ".EQV." : ".NEQV.",
+ gfc_op2string (e->value.op.operator));
+ else
+ sprintf (msg,
+ _("Operands of comparison operator '%s' at %%L are %s/%s"),
+ gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
+ gfc_typename (&op2->ts));
goto bad_op;
case INTRINSIC_USER:
if (op2 == NULL)
- sprintf (msg, "Operand of user operator '%s' at %%L is %s",
+ sprintf (msg, _("Operand of user operator '%s' at %%L is %s"),
e->value.op.uop->name, gfc_typename (&op1->ts));
else
- sprintf (msg, "Operands of user operator '%s' at %%L are %s/%s",
+ sprintf (msg, _("Operands of user operator '%s' at %%L are %s/%s"),
e->value.op.uop->name, gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
return SUCCESS;
}
+/* Resolve a dim argument to an intrinsic function. */
+
+try
+gfc_resolve_dim_arg (gfc_expr *dim)
+{
+ if (dim == NULL)
+ return SUCCESS;
+
+ if (gfc_resolve_expr (dim) == FAILURE)
+ return FAILURE;
+
+ if (dim->rank != 0)
+ {
+ gfc_error ("Argument dim at %L must be scalar", &dim->where);
+ return FAILURE;
+
+ }
+ if (dim->ts.type != BT_INTEGER)
+ {
+ gfc_error ("Argument dim at %L must be of INTEGER type", &dim->where);
+ return FAILURE;
+ }
+ if (dim->ts.kind != gfc_index_integer_kind)
+ {
+ gfc_typespec ts;
+
+ ts.type = BT_INTEGER;
+ ts.kind = gfc_index_integer_kind;
+
+ gfc_convert_type_warn (dim, &ts, 2, 0);
+ }
+
+ return SUCCESS;
+}
/* Given an expression that contains array references, update those array
references to point to the right array specifications. While this is
INTEGER or (optionally) REAL type. */
static try
-gfc_resolve_iterator_expr (gfc_expr * expr, bool real_ok, const char * name)
+gfc_resolve_iterator_expr (gfc_expr * expr, bool real_ok,
+ const char * name_msgid)
{
if (gfc_resolve_expr (expr) == FAILURE)
return FAILURE;
if (expr->rank != 0)
{
- gfc_error ("%s at %L must be a scalar", name, &expr->where);
+ gfc_error ("%s at %L must be a scalar", _(name_msgid), &expr->where);
return FAILURE;
}
if (!(expr->ts.type == BT_INTEGER
|| (expr->ts.type == BT_REAL && real_ok)))
{
- gfc_error ("%s at %L must be INTEGER%s",
- name,
- &expr->where,
- real_ok ? " or REAL" : "");
+ if (real_ok)
+ gfc_error ("%s at %L must be INTEGER or REAL", _(name_msgid),
+ &expr->where);
+ else
+ gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where);
return FAILURE;
}
return SUCCESS;
}
+/* Given a pointer to a symbol that is a derived type, see if it's
+ inaccessible, i.e. if it's defined in another module and the components are
+ PRIVATE. The search is recursive if necessary. Returns zero if no
+ inaccessible components are found, nonzero otherwise. */
+
+static int
+derived_inaccessible (gfc_symbol *sym)
+{
+ gfc_component *c;
+
+ if (sym->attr.use_assoc && sym->component_access == ACCESS_PRIVATE)
+ return 1;
+
+ for (c = sym->components; c; c = c->next)
+ {
+ if (c->ts.type == BT_DERIVED && derived_inaccessible (c->ts.derived))
+ return 1;
+ }
+
+ return 0;
+}
+
+
/* Resolve the argument of a deallocate expression. The expression must be
a pointer or a full array. */
/* Resolve a transfer statement. This is making sure that:
-- a derived type being transferred has only non-pointer components
- -- a derived type being transferred doesn't have private components
+ -- a derived type being transferred doesn't have private components, unless
+ it's being transferred from the module where the type was defined
-- we're not trying to transfer a whole assumed size array. */
static void
return;
}
- if (ts->derived->component_access == ACCESS_PRIVATE)
+ if (derived_inaccessible (ts->derived))
{
gfc_error ("Data transfer element at %L cannot have "
"PRIVATE components",&code->loc);
case EXEC_BACKSPACE:
case EXEC_ENDFILE:
case EXEC_REWIND:
+ case EXEC_FLUSH:
if (gfc_resolve_filepos (code->ext.filepos) == FAILURE)
break;
int i;
const char *whynot;
gfc_namelist *nl;
+ gfc_symtree * symtree;
+ gfc_symtree * this_symtree;
+ gfc_namespace * ns;
+ gfc_component * c;
+ gfc_formal_arglist * arg;
if (sym->attr.flavor == FL_UNKNOWN)
{
+
+ /* If we find that a flavorless symbol is an interface in one of the
+ parent namespaces, find its symtree in this namespace, free the
+ symbol and set the symtree to point to the interface symbol. */
+ for (ns = gfc_current_ns->parent; ns; ns = ns->parent)
+ {
+ symtree = gfc_find_symtree (ns->sym_root, sym->name);
+ if (symtree && symtree->n.sym->generic)
+ {
+ this_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
+ sym->name);
+ sym->refs--;
+ if (!sym->refs)
+ gfc_free_symbol (sym);
+ symtree->n.sym->refs++;
+ this_symtree->n.sym = symtree->n.sym;
+ return;
+ }
+ }
+
+ /* Otherwise give it a flavor according to such attributes as
+ it has. */
if (sym->attr.external == 0 && sym->attr.intrinsic == 0)
sym->attr.flavor = FL_VARIABLE;
else
|| sym->as->type == AS_ASSUMED_SHAPE)
&& sym->attr.dummy == 0)
{
- gfc_error ("Assumed %s array at %L must be a dummy argument",
- sym->as->type == AS_ASSUMED_SIZE ? "size" : "shape",
- &sym->declared_at);
+ if (sym->as->type == AS_ASSUMED_SIZE)
+ gfc_error ("Assumed size array at %L must be a dummy argument",
+ &sym->declared_at);
+ else
+ gfc_error ("Assumed shape array at %L must be a dummy argument",
+ &sym->declared_at);
return;
}
}
}
+ /* Ensure that derived type components of a public derived type
+ are not of a private type. */
+ if (sym->attr.flavor == FL_DERIVED
+ && gfc_check_access(sym->attr.access, sym->ns->default_access))
+ {
+ for (c = sym->components; c; c = c->next)
+ {
+ if (c->ts.type == BT_DERIVED
+ && !c->ts.derived->attr.use_assoc
+ && !gfc_check_access(c->ts.derived->attr.access,
+ c->ts.derived->ns->default_access))
+ {
+ gfc_error ("The component '%s' is a PRIVATE type and cannot be "
+ "a component of '%s', which is PUBLIC at %L",
+ c->name, sym->name, &sym->declared_at);
+ return;
+ }
+ }
+ }
+
+ /* Ensure that derived type formal arguments of a public procedure
+ are not of a private type. */
+ if (sym->attr.flavor == FL_PROCEDURE
+ && gfc_check_access(sym->attr.access, sym->ns->default_access))
+ {
+ for (arg = sym->formal; arg; arg = arg->next)
+ {
+ if (arg->sym
+ && arg->sym->ts.type == BT_DERIVED
+ && !gfc_check_access(arg->sym->ts.derived->attr.access,
+ arg->sym->ts.derived->ns->default_access))
+ {
+ gfc_error_now ("'%s' is a PRIVATE type and cannot be "
+ "a dummy argument of '%s', which is PUBLIC at %L",
+ arg->sym->name, sym->name, &sym->declared_at);
+ /* Stop this message from recurring. */
+ arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
+ return;
+ }
+ }
+ }
+
/* Constraints on deferred shape variable. */
if (sym->attr.flavor == FL_VARIABLE
|| (sym->attr.flavor == FL_PROCEDURE
/* Can the sybol have an initializer? */
whynot = NULL;
if (sym->attr.allocatable)
- whynot = "Allocatable";
+ whynot = _("Allocatable");
else if (sym->attr.external)
- whynot = "External";
+ whynot = _("External");
else if (sym->attr.dummy)
- whynot = "Dummy";
+ whynot = _("Dummy");
else if (sym->attr.intrinsic)
- whynot = "Intrinsic";
+ whynot = _("Intrinsic");
else if (sym->attr.result)
- whynot = "Function Result";
+ whynot = _("Function Result");
else if (sym->attr.dimension && !sym->attr.pointer)
{
/* Don't allow initialization of automatic arrays. */
|| sym->as->upper[i] == NULL
|| sym->as->upper[i]->expr_type != EXPR_CONSTANT)
{
- whynot = "Automatic array";
+ whynot = _("Automatic array");
break;
}
}
}
/* Assign default initializer. */
- if (sym->ts.type == BT_DERIVED && !(sym->value || whynot))
+ if (sym->ts.type == BT_DERIVED && !(sym->value || whynot)
+ && !sym->attr.pointer)
sym->value = gfc_default_initializer (&sym->ts);
break;
}
+/* Returns the sequence type of a symbol or sequence. */
+
+static seq_type
+sequence_type (gfc_typespec ts)
+{
+ seq_type result;
+ gfc_component *c;
+
+ switch (ts.type)
+ {
+ case BT_DERIVED:
+
+ if (ts.derived->components == NULL)
+ return SEQ_NONDEFAULT;
+
+ result = sequence_type (ts.derived->components->ts);
+ for (c = ts.derived->components->next; c; c = c->next)
+ if (sequence_type (c->ts) != result)
+ return SEQ_MIXED;
+
+ return result;
+
+ case BT_CHARACTER:
+ if (ts.kind != gfc_default_character_kind)
+ return SEQ_NONDEFAULT;
+
+ return SEQ_CHARACTER;
+
+ case BT_INTEGER:
+ if (ts.kind != gfc_default_integer_kind)
+ return SEQ_NONDEFAULT;
+
+ return SEQ_NUMERIC;
+
+ case BT_REAL:
+ if (!(ts.kind == gfc_default_real_kind
+ || ts.kind == gfc_default_double_kind))
+ return SEQ_NONDEFAULT;
+
+ return SEQ_NUMERIC;
+
+ case BT_COMPLEX:
+ if (ts.kind != gfc_default_complex_kind)
+ return SEQ_NONDEFAULT;
+
+ return SEQ_NUMERIC;
+
+ case BT_LOGICAL:
+ if (ts.kind != gfc_default_logical_kind)
+ return SEQ_NONDEFAULT;
+
+ return SEQ_NUMERIC;
+
+ default:
+ return SEQ_NONDEFAULT;
+ }
+}
+
+
/* Resolve derived type EQUIVALENCE object. */
static try
in the structure. */
if (c->pointer)
{
- gfc_error ("Derived type variable '%s' at %L has pointer componet(s) "
+ gfc_error ("Derived type variable '%s' at %L with pointer component(s) "
+ "cannot be an EQUIVALENCE object", sym->name, &e->where);
+ return FAILURE;
+ }
+
+ if (c->initializer)
+ {
+ gfc_error ("Derived type variable '%s' at %L with default initializer "
"cannot be an EQUIVALENCE object", sym->name, &e->where);
return FAILURE;
}
/* Resolve equivalence object.
- An EQUIVALENCE object shall not be a dummy argument, a pointer, an
- allocatable array, an object of nonsequence derived type, an object of
+ An EQUIVALENCE object shall not be a dummy argument, a pointer, a target,
+ an allocatable array, an object of nonsequence derived type, an object of
sequence derived type containing a pointer at any level of component
selection, an automatic object, a function name, an entry name, a result
name, a named constant, a structure component, or a subobject of any of
- the preceding objects. */
+ the preceding objects. A substring shall not have length zero. A
+ derived type shall not have components with default initialization nor
+ shall two objects of an equivalence group be initialized.
+ The simple constraints are done in symbol.c(check_conflict) and the rest
+ are implemented here. */
static void
resolve_equivalence (gfc_equiv *eq)
{
gfc_symbol *sym;
gfc_symbol *derived;
+ gfc_symbol *first_sym;
gfc_expr *e;
gfc_ref *r;
+ locus *last_where = NULL;
+ seq_type eq_type, last_eq_type;
+ gfc_typespec *last_ts;
+ int object;
+ const char *value_name;
+ const char *msg;
+
+ value_name = NULL;
+ last_ts = &eq->expr->symtree->n.sym->ts;
+
+ first_sym = eq->expr->symtree->n.sym;
- for (; eq; eq = eq->eq)
+ for (object = 1; eq; eq = eq->eq, object++)
{
e = eq->expr;
+
+ e->ts = e->symtree->n.sym->ts;
+ /* match_varspec might not know yet if it is seeing
+ array reference or substring reference, as it doesn't
+ know the types. */
+ if (e->ref && e->ref->type == REF_ARRAY)
+ {
+ gfc_ref *ref = e->ref;
+ sym = e->symtree->n.sym;
+
+ if (sym->attr.dimension)
+ {
+ ref->u.ar.as = sym->as;
+ ref = ref->next;
+ }
+
+ /* For substrings, convert REF_ARRAY into REF_SUBSTRING. */
+ if (e->ts.type == BT_CHARACTER
+ && ref
+ && ref->type == REF_ARRAY
+ && ref->u.ar.dimen == 1
+ && ref->u.ar.dimen_type[0] == DIMEN_RANGE
+ && ref->u.ar.stride[0] == NULL)
+ {
+ gfc_expr *start = ref->u.ar.start[0];
+ gfc_expr *end = ref->u.ar.end[0];
+ void *mem = NULL;
+
+ /* Optimize away the (:) reference. */
+ if (start == NULL && end == NULL)
+ {
+ if (e->ref == ref)
+ e->ref = ref->next;
+ else
+ e->ref->next = ref->next;
+ mem = ref;
+ }
+ else
+ {
+ ref->type = REF_SUBSTRING;
+ if (start == NULL)
+ start = gfc_int_expr (1);
+ ref->u.ss.start = start;
+ if (end == NULL && e->ts.cl)
+ end = gfc_copy_expr (e->ts.cl->length);
+ ref->u.ss.end = end;
+ ref->u.ss.length = e->ts.cl;
+ e->ts.cl = NULL;
+ }
+ ref = ref->next;
+ gfc_free (mem);
+ }
+
+ /* Any further ref is an error. */
+ if (ref)
+ {
+ gcc_assert (ref->type == REF_ARRAY);
+ gfc_error ("Syntax error in EQUIVALENCE statement at %L",
+ &ref->u.ar.where);
+ continue;
+ }
+ }
+
if (gfc_resolve_expr (e) == FAILURE)
continue;
sym = e->symtree->n.sym;
-
- /* Shall not be a dummy argument. */
- if (sym->attr.dummy)
- {
- gfc_error ("Dummy argument '%s' at %L cannot be an EQUIVALENCE "
- "object", sym->name, &e->where);
- continue;
- }
- /* Shall not be an allocatable array. */
- if (sym->attr.allocatable)
- {
- gfc_error ("Allocatable array '%s' at %L cannot be an EQUIVALENCE "
- "object", sym->name, &e->where);
- continue;
- }
+ /* An equivalence statement cannot have more than one initialized
+ object. */
+ if (sym->value)
+ {
+ if (value_name != NULL)
+ {
+ gfc_error ("Initialized objects '%s' and '%s' cannot both "
+ "be in the EQUIVALENCE statement at %L",
+ value_name, sym->name, &e->where);
+ continue;
+ }
+ else
+ value_name = sym->name;
+ }
- /* Shall not be a pointer. */
- if (sym->attr.pointer)
+ /* Shall not equivalence common block variables in a PURE procedure. */
+ if (sym->ns->proc_name
+ && sym->ns->proc_name->attr.pure
+ && sym->attr.in_common)
{
- gfc_error ("Pointer '%s' at %L cannot be an EQUIVALENCE object",
- sym->name, &e->where);
- continue;
- }
-
- /* Shall not be a function name, ... */
- if (sym->attr.function || sym->attr.result || sym->attr.entry
- || sym->attr.subroutine)
- {
- gfc_error ("Entity '%s' at %L cannot be an EQUIVALENCE object",
- sym->name, &e->where);
- continue;
+ gfc_error ("Common block member '%s' at %L cannot be an EQUIVALENCE "
+ "object in the pure procedure '%s'",
+ sym->name, &e->where, sym->ns->proc_name->name);
+ break;
}
/* Shall not be a named constant. */
if (derived && resolve_equivalence_derived (derived, sym, e) == FAILURE)
continue;
+ /* Check that the types correspond correctly:
+ Note 5.28:
+ A numeric sequence structure may be equivalenced to another sequence
+ structure, an object of default integer type, default real type, double
+ precision real type, default logical type such that components of the
+ structure ultimately only become associated to objects of the same
+ kind. A character sequence structure may be equivalenced to an object
+ of default character kind or another character sequence structure.
+ Other objects may be equivalenced only to objects of the same type and
+ kind parameters. */
+
+ /* Identical types are unconditionally OK. */
+ if (object == 1 || gfc_compare_types (last_ts, &sym->ts))
+ goto identical_types;
+
+ last_eq_type = sequence_type (*last_ts);
+ eq_type = sequence_type (sym->ts);
+
+ /* Since the pair of objects is not of the same type, mixed or
+ non-default sequences can be rejected. */
+
+ msg = "Sequence %s with mixed components in EQUIVALENCE "
+ "statement at %L with different type objects";
+ if ((object ==2
+ && last_eq_type == SEQ_MIXED
+ && gfc_notify_std (GFC_STD_GNU, msg, first_sym->name,
+ last_where) == FAILURE)
+ || (eq_type == SEQ_MIXED
+ && gfc_notify_std (GFC_STD_GNU, msg,sym->name,
+ &e->where) == FAILURE))
+ continue;
+
+ msg = "Non-default type object or sequence %s in EQUIVALENCE "
+ "statement at %L with objects of different type";
+ if ((object ==2
+ && last_eq_type == SEQ_NONDEFAULT
+ && gfc_notify_std (GFC_STD_GNU, msg, first_sym->name,
+ last_where) == FAILURE)
+ || (eq_type == SEQ_NONDEFAULT
+ && gfc_notify_std (GFC_STD_GNU, msg, sym->name,
+ &e->where) == FAILURE))
+ continue;
+
+ msg ="Non-CHARACTER object '%s' in default CHARACTER "
+ "EQUIVALENCE statement at %L";
+ if (last_eq_type == SEQ_CHARACTER
+ && eq_type != SEQ_CHARACTER
+ && gfc_notify_std (GFC_STD_GNU, msg, sym->name,
+ &e->where) == FAILURE)
+ continue;
+
+ msg ="Non-NUMERIC object '%s' in default NUMERIC "
+ "EQUIVALENCE statement at %L";
+ if (last_eq_type == SEQ_NUMERIC
+ && eq_type != SEQ_NUMERIC
+ && gfc_notify_std (GFC_STD_GNU, msg, sym->name,
+ &e->where) == FAILURE)
+ continue;
+
+ identical_types:
+ last_ts =&sym->ts;
+ last_where = &e->where;
+
if (!e->ref)
continue;
continue;
}
- /* Shall not be a structure component. */
r = e->ref;
while (r)
{
- if (r->type == REF_COMPONENT)
- {
- gfc_error ("Structure component '%s' at %L cannot be an "
- "EQUIVALENCE object",
- r->u.c.component->name, &e->where);
- break;
- }
- r = r->next;
- }
+ /* Shall not be a structure component. */
+ if (r->type == REF_COMPONENT)
+ {
+ gfc_error ("Structure component '%s' at %L cannot be an "
+ "EQUIVALENCE object",
+ r->u.c.component->name, &e->where);
+ break;
+ }
+
+ /* A substring shall not have length zero. */
+ if (r->type == REF_SUBSTRING)
+ {
+ if (compare_bound (r->u.ss.start, r->u.ss.end) == CMP_GT)
+ {
+ gfc_error ("Substring at %L has length zero",
+ &r->u.ss.start->where);
+ break;
+ }
+ }
+ r = r->next;
+ }
}
}
OSDN Git Service
