Fortran: Diagnose all operands/arguments with constraint violations
04-Nov-2021 Sandra Loosemore <sandra@codesourcery.com> Bernhard Reutner-Fischer <aldot@gcc.gnu.org> PR fortran/101337 gcc/fortran/ChangeLog: * interface.c (gfc_compare_actual_formal): Continue checking all arguments after encountering an error. * intrinsic.c (do_ts29113_check): Likewise. * resolve.c (resolve_operator): Continue resolving on op2 error. gcc/testsuite/ChangeLog: * gfortran.dg/bessel_3.f90: Expect additional diagnostics from multiple bad arguments in the call. * gfortran.dg/pr24823.f: Likewise. * gfortran.dg/pr39937.f: Likewise. * gfortran.dg/pr41011.f: Likewise. * gfortran.dg/pr61318.f90: Likewise. * gfortran.dg/c-interop/c407b-2.f90: Remove xfails. * gfortran.dg/c-interop/c535b-2.f90: Likewise.
This commit is contained in:
parent
f6f704fd10
commit
ee11be7f2d
|
@ -3064,6 +3064,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
gfc_array_spec *fas, *aas;
|
gfc_array_spec *fas, *aas;
|
||||||
bool pointer_dummy, pointer_arg, allocatable_arg;
|
bool pointer_dummy, pointer_arg, allocatable_arg;
|
||||||
|
|
||||||
|
bool ok = true;
|
||||||
|
|
||||||
actual = *ap;
|
actual = *ap;
|
||||||
|
|
||||||
if (actual == NULL && formal == NULL)
|
if (actual == NULL && formal == NULL)
|
||||||
|
@ -3134,7 +3136,6 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
if (where)
|
if (where)
|
||||||
gfc_error ("More actual than formal arguments in procedure "
|
gfc_error ("More actual than formal arguments in procedure "
|
||||||
"call at %L", where);
|
"call at %L", where);
|
||||||
|
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -3192,13 +3193,16 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
else if (where)
|
else if (where)
|
||||||
gfc_error ("Fortran 2008: Null pointer at %L to non-pointer "
|
gfc_error ("Fortran 2008: Null pointer at %L to non-pointer "
|
||||||
"dummy %qs", where, f->sym->name);
|
"dummy %qs", where, f->sym->name);
|
||||||
|
ok = false;
|
||||||
return false;
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (!compare_parameter (f->sym, a->expr, ranks_must_agree,
|
if (!compare_parameter (f->sym, a->expr, ranks_must_agree,
|
||||||
is_elemental, where))
|
is_elemental, where))
|
||||||
return false;
|
{
|
||||||
|
ok = false;
|
||||||
|
goto match;
|
||||||
|
}
|
||||||
|
|
||||||
/* TS 29113, 6.3p2; F2018 15.5.2.4. */
|
/* TS 29113, 6.3p2; F2018 15.5.2.4. */
|
||||||
if (f->sym->ts.type == BT_ASSUMED
|
if (f->sym->ts.type == BT_ASSUMED
|
||||||
|
@ -3217,7 +3221,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
"has type parameters or is of "
|
"has type parameters or is of "
|
||||||
"derived type with type-bound or FINAL procedures",
|
"derived type with type-bound or FINAL procedures",
|
||||||
&a->expr->where);
|
&a->expr->where);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -3249,7 +3254,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
mpz_get_si (a->expr->ts.u.cl->length->value.integer),
|
mpz_get_si (a->expr->ts.u.cl->length->value.integer),
|
||||||
mpz_get_si (f->sym->ts.u.cl->length->value.integer),
|
mpz_get_si (f->sym->ts.u.cl->length->value.integer),
|
||||||
f->sym->name, &a->expr->where);
|
f->sym->name, &a->expr->where);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
if ((f->sym->attr.pointer || f->sym->attr.allocatable)
|
if ((f->sym->attr.pointer || f->sym->attr.allocatable)
|
||||||
|
@ -3261,7 +3267,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
"pointer dummy argument %qs must have a deferred "
|
"pointer dummy argument %qs must have a deferred "
|
||||||
"length type parameter if and only if the dummy has one",
|
"length type parameter if and only if the dummy has one",
|
||||||
&a->expr->where, f->sym->name);
|
&a->expr->where, f->sym->name);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (f->sym->ts.type == BT_CLASS)
|
if (f->sym->ts.type == BT_CLASS)
|
||||||
|
@ -3295,7 +3302,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
"at %L", f->sym->name, actual_size,
|
"at %L", f->sym->name, actual_size,
|
||||||
formal_size, &a->expr->where);
|
formal_size, &a->expr->where);
|
||||||
}
|
}
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
skip_size_check:
|
skip_size_check:
|
||||||
|
@ -3312,7 +3320,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
if (where)
|
if (where)
|
||||||
gfc_error ("Expected a procedure pointer for argument %qs at %L",
|
gfc_error ("Expected a procedure pointer for argument %qs at %L",
|
||||||
f->sym->name, &a->expr->where);
|
f->sym->name, &a->expr->where);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Satisfy F03:12.4.1.3 by ensuring that a procedure actual argument is
|
/* Satisfy F03:12.4.1.3 by ensuring that a procedure actual argument is
|
||||||
|
@ -3328,7 +3337,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
if (where)
|
if (where)
|
||||||
gfc_error ("Expected a procedure for argument %qs at %L",
|
gfc_error ("Expected a procedure for argument %qs at %L",
|
||||||
f->sym->name, &a->expr->where);
|
f->sym->name, &a->expr->where);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Class array variables and expressions store array info in a
|
/* Class array variables and expressions store array info in a
|
||||||
|
@ -3392,7 +3402,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
if (where)
|
if (where)
|
||||||
gfc_error ("Actual argument for %qs cannot be an assumed-size"
|
gfc_error ("Actual argument for %qs cannot be an assumed-size"
|
||||||
" array at %L", f->sym->name, where);
|
" array at %L", f->sym->name, where);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Diagnose F2018 C839 (TS29113 C535c). Here the problem is
|
/* Diagnose F2018 C839 (TS29113 C535c). Here the problem is
|
||||||
|
@ -3421,7 +3432,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
gfc_error ("Actual argument to assumed-rank INTENT(OUT) "
|
gfc_error ("Actual argument to assumed-rank INTENT(OUT) "
|
||||||
"dummy %qs at %L cannot be of unknown size",
|
"dummy %qs at %L cannot be of unknown size",
|
||||||
f->sym->name, where);
|
f->sym->name, where);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (a->expr->expr_type != EXPR_NULL
|
if (a->expr->expr_type != EXPR_NULL
|
||||||
|
@ -3430,7 +3442,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
if (where)
|
if (where)
|
||||||
gfc_error ("Actual argument for %qs must be a pointer at %L",
|
gfc_error ("Actual argument for %qs must be a pointer at %L",
|
||||||
f->sym->name, &a->expr->where);
|
f->sym->name, &a->expr->where);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (a->expr->expr_type != EXPR_NULL
|
if (a->expr->expr_type != EXPR_NULL
|
||||||
|
@ -3440,7 +3453,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
if (where)
|
if (where)
|
||||||
gfc_error ("Fortran 2008: Non-pointer actual argument at %L to "
|
gfc_error ("Fortran 2008: Non-pointer actual argument at %L to "
|
||||||
"pointer dummy %qs", &a->expr->where,f->sym->name);
|
"pointer dummy %qs", &a->expr->where,f->sym->name);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -3451,7 +3465,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
gfc_error ("Coindexed actual argument at %L to pointer "
|
gfc_error ("Coindexed actual argument at %L to pointer "
|
||||||
"dummy %qs",
|
"dummy %qs",
|
||||||
&a->expr->where, f->sym->name);
|
&a->expr->where, f->sym->name);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Fortran 2008, 12.5.2.5 (no constraint). */
|
/* Fortran 2008, 12.5.2.5 (no constraint). */
|
||||||
|
@ -3464,7 +3479,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
gfc_error ("Coindexed actual argument at %L to allocatable "
|
gfc_error ("Coindexed actual argument at %L to allocatable "
|
||||||
"dummy %qs requires INTENT(IN)",
|
"dummy %qs requires INTENT(IN)",
|
||||||
&a->expr->where, f->sym->name);
|
&a->expr->where, f->sym->name);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Fortran 2008, C1237. */
|
/* Fortran 2008, C1237. */
|
||||||
|
@ -3479,7 +3495,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
"%L requires that dummy %qs has neither "
|
"%L requires that dummy %qs has neither "
|
||||||
"ASYNCHRONOUS nor VOLATILE", &a->expr->where,
|
"ASYNCHRONOUS nor VOLATILE", &a->expr->where,
|
||||||
f->sym->name);
|
f->sym->name);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Fortran 2008, 12.5.2.4 (no constraint). */
|
/* Fortran 2008, 12.5.2.4 (no constraint). */
|
||||||
|
@ -3492,7 +3509,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
gfc_error ("Coindexed actual argument at %L with allocatable "
|
gfc_error ("Coindexed actual argument at %L with allocatable "
|
||||||
"ultimate component to dummy %qs requires either VALUE "
|
"ultimate component to dummy %qs requires either VALUE "
|
||||||
"or INTENT(IN)", &a->expr->where, f->sym->name);
|
"or INTENT(IN)", &a->expr->where, f->sym->name);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (f->sym->ts.type == BT_CLASS
|
if (f->sym->ts.type == BT_CLASS
|
||||||
|
@ -3503,7 +3521,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
if (where)
|
if (where)
|
||||||
gfc_error ("Actual CLASS array argument for %qs must be a full "
|
gfc_error ("Actual CLASS array argument for %qs must be a full "
|
||||||
"array at %L", f->sym->name, &a->expr->where);
|
"array at %L", f->sym->name, &a->expr->where);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -3513,7 +3532,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
if (where)
|
if (where)
|
||||||
gfc_error ("Actual argument for %qs must be ALLOCATABLE at %L",
|
gfc_error ("Actual argument for %qs must be ALLOCATABLE at %L",
|
||||||
f->sym->name, &a->expr->where);
|
f->sym->name, &a->expr->where);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Check intent = OUT/INOUT for definable actual argument. */
|
/* Check intent = OUT/INOUT for definable actual argument. */
|
||||||
|
@ -3529,9 +3549,15 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
&& CLASS_DATA (f->sym)->attr.class_pointer)
|
&& CLASS_DATA (f->sym)->attr.class_pointer)
|
||||||
|| (f->sym->ts.type != BT_CLASS && f->sym->attr.pointer))
|
|| (f->sym->ts.type != BT_CLASS && f->sym->attr.pointer))
|
||||||
&& !gfc_check_vardef_context (a->expr, true, false, false, context))
|
&& !gfc_check_vardef_context (a->expr, true, false, false, context))
|
||||||
return false;
|
{
|
||||||
|
ok = false;
|
||||||
|
goto match;
|
||||||
|
}
|
||||||
if (!gfc_check_vardef_context (a->expr, false, false, false, context))
|
if (!gfc_check_vardef_context (a->expr, false, false, false, context))
|
||||||
return false;
|
{
|
||||||
|
ok = false;
|
||||||
|
goto match;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if ((f->sym->attr.intent == INTENT_OUT
|
if ((f->sym->attr.intent == INTENT_OUT
|
||||||
|
@ -3546,7 +3572,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
"INTENT(INOUT), VOLATILE or ASYNCHRONOUS attribute "
|
"INTENT(INOUT), VOLATILE or ASYNCHRONOUS attribute "
|
||||||
"of the dummy argument %qs",
|
"of the dummy argument %qs",
|
||||||
&a->expr->where, f->sym->name);
|
&a->expr->where, f->sym->name);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* C1232 (R1221) For an actual argument which is an array section or
|
/* C1232 (R1221) For an actual argument which is an array section or
|
||||||
|
@ -3564,7 +3591,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
"incompatible with the non-assumed-shape "
|
"incompatible with the non-assumed-shape "
|
||||||
"dummy argument %qs due to VOLATILE attribute",
|
"dummy argument %qs due to VOLATILE attribute",
|
||||||
&a->expr->where,f->sym->name);
|
&a->expr->where,f->sym->name);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Find the last array_ref. */
|
/* Find the last array_ref. */
|
||||||
|
@ -3581,7 +3609,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
"incompatible with the non-assumed-shape "
|
"incompatible with the non-assumed-shape "
|
||||||
"dummy argument %qs due to VOLATILE attribute",
|
"dummy argument %qs due to VOLATILE attribute",
|
||||||
&a->expr->where, f->sym->name);
|
&a->expr->where, f->sym->name);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* C1233 (R1221) For an actual argument which is a pointer array, the
|
/* C1233 (R1221) For an actual argument which is a pointer array, the
|
||||||
|
@ -3601,7 +3630,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
"an assumed-shape or pointer-array dummy "
|
"an assumed-shape or pointer-array dummy "
|
||||||
"argument %qs due to VOLATILE attribute",
|
"argument %qs due to VOLATILE attribute",
|
||||||
&a->expr->where,f->sym->name);
|
&a->expr->where,f->sym->name);
|
||||||
return false;
|
ok = false;
|
||||||
|
goto match;
|
||||||
}
|
}
|
||||||
|
|
||||||
match:
|
match:
|
||||||
|
@ -3611,6 +3641,10 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||||
new_arg[i++] = a;
|
new_arg[i++] = a;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Give up now if we saw any bad argument. */
|
||||||
|
if (!ok)
|
||||||
|
return false;
|
||||||
|
|
||||||
/* Make sure missing actual arguments are optional. */
|
/* Make sure missing actual arguments are optional. */
|
||||||
i = 0;
|
i = 0;
|
||||||
for (f = formal; f; f = f->next, i++)
|
for (f = formal; f; f = f->next, i++)
|
||||||
|
|
|
@ -223,6 +223,7 @@ static bool
|
||||||
do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
|
do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
|
||||||
{
|
{
|
||||||
gfc_actual_arglist *a;
|
gfc_actual_arglist *a;
|
||||||
|
bool ok = true;
|
||||||
|
|
||||||
for (a = arg; a; a = a->next)
|
for (a = arg; a; a = a->next)
|
||||||
{
|
{
|
||||||
|
@ -238,7 +239,7 @@ do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
|
||||||
gfc_error ("Variable with NO_ARG_CHECK attribute at %L is only "
|
gfc_error ("Variable with NO_ARG_CHECK attribute at %L is only "
|
||||||
"permitted as argument to the intrinsic functions "
|
"permitted as argument to the intrinsic functions "
|
||||||
"C_LOC and PRESENT", &a->expr->where);
|
"C_LOC and PRESENT", &a->expr->where);
|
||||||
return false;
|
ok = false;
|
||||||
}
|
}
|
||||||
else if (a->expr->ts.type == BT_ASSUMED
|
else if (a->expr->ts.type == BT_ASSUMED
|
||||||
&& specific->id != GFC_ISYM_LBOUND
|
&& specific->id != GFC_ISYM_LBOUND
|
||||||
|
@ -254,32 +255,32 @@ do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
|
||||||
gfc_error ("Assumed-type argument at %L is not permitted as actual"
|
gfc_error ("Assumed-type argument at %L is not permitted as actual"
|
||||||
" argument to the intrinsic %s", &a->expr->where,
|
" argument to the intrinsic %s", &a->expr->where,
|
||||||
gfc_current_intrinsic);
|
gfc_current_intrinsic);
|
||||||
return false;
|
ok = false;
|
||||||
}
|
}
|
||||||
else if (a->expr->ts.type == BT_ASSUMED && a != arg)
|
else if (a->expr->ts.type == BT_ASSUMED && a != arg)
|
||||||
{
|
{
|
||||||
gfc_error ("Assumed-type argument at %L is only permitted as "
|
gfc_error ("Assumed-type argument at %L is only permitted as "
|
||||||
"first actual argument to the intrinsic %s",
|
"first actual argument to the intrinsic %s",
|
||||||
&a->expr->where, gfc_current_intrinsic);
|
&a->expr->where, gfc_current_intrinsic);
|
||||||
return false;
|
ok = false;
|
||||||
}
|
}
|
||||||
if (a->expr->rank == -1 && !specific->inquiry)
|
else if (a->expr->rank == -1 && !specific->inquiry)
|
||||||
{
|
{
|
||||||
gfc_error ("Assumed-rank argument at %L is only permitted as actual "
|
gfc_error ("Assumed-rank argument at %L is only permitted as actual "
|
||||||
"argument to intrinsic inquiry functions",
|
"argument to intrinsic inquiry functions",
|
||||||
&a->expr->where);
|
&a->expr->where);
|
||||||
return false;
|
ok = false;
|
||||||
}
|
}
|
||||||
if (a->expr->rank == -1 && arg != a)
|
else if (a->expr->rank == -1 && arg != a)
|
||||||
{
|
{
|
||||||
gfc_error ("Assumed-rank argument at %L is only permitted as first "
|
gfc_error ("Assumed-rank argument at %L is only permitted as first "
|
||||||
"actual argument to the intrinsic inquiry function %s",
|
"actual argument to the intrinsic inquiry function %s",
|
||||||
&a->expr->where, gfc_current_intrinsic);
|
&a->expr->where, gfc_current_intrinsic);
|
||||||
return false;
|
ok = false;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return true;
|
return ok;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -4064,7 +4064,7 @@ resolve_operator (gfc_expr *e)
|
||||||
{
|
{
|
||||||
default:
|
default:
|
||||||
if (!gfc_resolve_expr (e->value.op.op2))
|
if (!gfc_resolve_expr (e->value.op.op2))
|
||||||
return false;
|
t = false;
|
||||||
|
|
||||||
/* Fall through. */
|
/* Fall through. */
|
||||||
|
|
||||||
|
@ -4091,6 +4091,9 @@ resolve_operator (gfc_expr *e)
|
||||||
op2 = e->value.op.op2;
|
op2 = e->value.op.op2;
|
||||||
if (op1 == NULL && op2 == NULL)
|
if (op1 == NULL && op2 == NULL)
|
||||||
return false;
|
return false;
|
||||||
|
/* Error out if op2 did not resolve. We already diagnosed op1. */
|
||||||
|
if (t == false)
|
||||||
|
return false;
|
||||||
|
|
||||||
dual_locus_error = false;
|
dual_locus_error = false;
|
||||||
|
|
||||||
|
|
|
@ -9,10 +9,10 @@ print *, SIN (1.0)
|
||||||
print *, BESSEL_J0(1.0) ! { dg-error "has no IMPLICIT type" })
|
print *, BESSEL_J0(1.0) ! { dg-error "has no IMPLICIT type" })
|
||||||
print *, BESSEL_J1(1.0) ! { dg-error "has no IMPLICIT type" }
|
print *, BESSEL_J1(1.0) ! { dg-error "has no IMPLICIT type" }
|
||||||
print *, BESSEL_JN(1,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch" }
|
print *, BESSEL_JN(1,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch" }
|
||||||
print *, BESSEL_JN(1,2,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch" }
|
print *, BESSEL_JN(1,2,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch|More actual than formal" }
|
||||||
|
|
||||||
print *, BESSEL_Y0(1.0) ! { dg-error "has no IMPLICIT type" }
|
print *, BESSEL_Y0(1.0) ! { dg-error "has no IMPLICIT type" }
|
||||||
print *, BESSEL_Y1(1.0) ! { dg-error "has no IMPLICIT type" }
|
print *, BESSEL_Y1(1.0) ! { dg-error "has no IMPLICIT type" }
|
||||||
print *, BESSEL_YN(1,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch" }
|
print *, BESSEL_YN(1,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch" }
|
||||||
print *, BESSEL_YN(1,2,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch" }
|
print *, BESSEL_YN(1,2,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch|More actual than formal" }
|
||||||
end
|
end
|
||||||
|
|
|
@ -78,11 +78,11 @@ subroutine s2 (x, y)
|
||||||
end select
|
end select
|
||||||
|
|
||||||
! relational operations
|
! relational operations
|
||||||
if (x & ! { dg-error "Assumed.type" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
if (x & ! { dg-error "Assumed.type" "pr101337" }
|
||||||
.eq. y) then ! { dg-error "Assumed.type" }
|
.eq. y) then ! { dg-error "Assumed.type" }
|
||||||
return
|
return
|
||||||
end if
|
end if
|
||||||
if (.not. (x & ! { dg-error "Assumed.type" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
if (.not. (x & ! { dg-error "Assumed.type" "pr101337" }
|
||||||
.ne. y)) then ! { dg-error "Assumed.type" }
|
.ne. y)) then ! { dg-error "Assumed.type" }
|
||||||
return
|
return
|
||||||
end if
|
end if
|
||||||
|
@ -99,7 +99,7 @@ subroutine s2 (x, y)
|
||||||
! arithmetic
|
! arithmetic
|
||||||
i = x + 1 ! { dg-error "Assumed.type" }
|
i = x + 1 ! { dg-error "Assumed.type" }
|
||||||
i = -y ! { dg-error "Assumed.type" }
|
i = -y ! { dg-error "Assumed.type" }
|
||||||
i = (x & ! { dg-error "Assumed.type" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
i = (x & ! { dg-error "Assumed.type" "pr101337" }
|
||||||
+ y) ! { dg-error "Assumed.type" }
|
+ y) ! { dg-error "Assumed.type" }
|
||||||
|
|
||||||
! computed go to
|
! computed go to
|
||||||
|
@ -131,19 +131,19 @@ subroutine s3 (x, y)
|
||||||
i = exponent (x) ! { dg-error "Assumed.type" }
|
i = exponent (x) ! { dg-error "Assumed.type" }
|
||||||
|
|
||||||
if (extends_type_of (x, & ! { dg-error "Assumed.type" }
|
if (extends_type_of (x, & ! { dg-error "Assumed.type" }
|
||||||
y)) then ! { dg-error "Assumed.type" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
y)) then ! { dg-error "Assumed.type" "pr101337" }
|
||||||
return
|
return
|
||||||
end if
|
end if
|
||||||
|
|
||||||
if (same_type_as (x, & ! { dg-error "Assumed.type" }
|
if (same_type_as (x, & ! { dg-error "Assumed.type" }
|
||||||
y)) then ! { dg-error "Assumed.type" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
y)) then ! { dg-error "Assumed.type" "pr101337" }
|
||||||
return
|
return
|
||||||
end if
|
end if
|
||||||
|
|
||||||
i = storage_size (x) ! { dg-error "Assumed.type" }
|
i = storage_size (x) ! { dg-error "Assumed.type" }
|
||||||
|
|
||||||
i = iand (x, & ! { dg-error "Assumed.type" }
|
i = iand (x, & ! { dg-error "Assumed.type" }
|
||||||
y) ! { dg-error "Assumed.type" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
y) ! { dg-error "Assumed.type" "pr101337" }
|
||||||
|
|
||||||
i = kind (x) ! { dg-error "Assumed.type" }
|
i = kind (x) ! { dg-error "Assumed.type" }
|
||||||
|
|
||||||
|
|
|
@ -57,18 +57,18 @@ subroutine test_calls (x, y)
|
||||||
! Make sure each invalid argument produces a diagnostic.
|
! Make sure each invalid argument produces a diagnostic.
|
||||||
! scalar dummies
|
! scalar dummies
|
||||||
call f (x, & ! { dg-error "(A|a)ssumed.rank" }
|
call f (x, & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
y) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
y) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
! assumed-rank dummies
|
! assumed-rank dummies
|
||||||
call g (x, y) ! OK
|
call g (x, y) ! OK
|
||||||
! assumed-size dummies
|
! assumed-size dummies
|
||||||
call h (x, & ! { dg-error "(A|a)ssumed.rank" "pr101334" }
|
call h (x, & ! { dg-error "(A|a)ssumed.rank" "pr101334" }
|
||||||
y) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
y) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
! assumed-shape dummies
|
! assumed-shape dummies
|
||||||
call i (x, & ! { dg-error "(A|a)ssumed.rank" }
|
call i (x, & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
y) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
y) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
! fixed-size array dummies
|
! fixed-size array dummies
|
||||||
call j (x, & ! { dg-error "(A|a)ssumed.rank" "pr101334" }
|
call j (x, & ! { dg-error "(A|a)ssumed.rank" "pr101334" }
|
||||||
y) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
y) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
! Check that you can't use an assumed-rank array variable in an array
|
! Check that you can't use an assumed-rank array variable in an array
|
||||||
|
@ -81,7 +81,7 @@ subroutine test_designators (x)
|
||||||
|
|
||||||
call f (x(1), 1) ! { dg-error "(A|a)ssumed.rank" }
|
call f (x(1), 1) ! { dg-error "(A|a)ssumed.rank" }
|
||||||
call g (x(1:3:1), & ! { dg-error "(A|a)ssumed.rank" }
|
call g (x(1:3:1), & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
x) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
x)
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
! Check that you can't use an assumed-rank array variable in elemental
|
! Check that you can't use an assumed-rank array variable in elemental
|
||||||
|
@ -122,7 +122,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
z = x + y ! OK
|
z = x + y ! OK
|
||||||
c & ! { dg-error "(A|a)ssumed.rank" }
|
c & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
+ b ! { dg-error "(A|a)ssumed.rank" }
|
+ b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
z = x + i ! OK
|
z = x + i ! OK
|
||||||
c & ! { dg-error "(A|a)ssumed.rank" }
|
c & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -133,7 +133,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
z = x - y ! OK
|
z = x - y ! OK
|
||||||
c & ! { dg-error "(A|a)ssumed.rank" }
|
c & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
- b ! { dg-error "(A|a)ssumed.rank" }
|
- b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
z = x - i ! OK
|
z = x - i ! OK
|
||||||
c & ! { dg-error "(A|a)ssumed.rank" }
|
c & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -144,7 +144,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
z = x * y ! OK
|
z = x * y ! OK
|
||||||
c & ! { dg-error "(A|a)ssumed.rank" }
|
c & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
* b ! { dg-error "(A|a)ssumed.rank" }
|
* b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
z = x * i ! OK
|
z = x * i ! OK
|
||||||
c & ! { dg-error "(A|a)ssumed.rank" }
|
c & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -155,7 +155,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
z = x / y ! OK
|
z = x / y ! OK
|
||||||
c & ! { dg-error "(A|a)ssumed.rank" }
|
c & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
/ b ! { dg-error "(A|a)ssumed.rank" }
|
/ b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
z = x / i ! OK
|
z = x / i ! OK
|
||||||
c & ! { dg-error "(A|a)ssumed.rank" }
|
c & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -166,7 +166,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
z = x ** y ! OK
|
z = x ** y ! OK
|
||||||
c & ! { dg-error "(A|a)ssumed.rank" }
|
c & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
** b ! { dg-error "(A|a)ssumed.rank" }
|
** b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
z = x ** i ! OK
|
z = x ** i ! OK
|
||||||
c & ! { dg-error "(A|a)ssumed.rank" }
|
c & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -179,7 +179,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
r = x .eq. y ! OK
|
r = x .eq. y ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
.eq. b ! { dg-error "(A|a)ssumed.rank" }
|
.eq. b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = x .eq. i ! OK
|
r = x .eq. i ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -190,7 +190,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
r = x .ne. y ! OK
|
r = x .ne. y ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
.ne. b ! { dg-error "(A|a)ssumed.rank" }
|
.ne. b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = x .ne. i ! OK
|
r = x .ne. i ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -201,7 +201,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
r = x .lt. y ! OK
|
r = x .lt. y ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
.lt. b ! { dg-error "(A|a)ssumed.rank" }
|
.lt. b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = x .lt. i ! OK
|
r = x .lt. i ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -212,7 +212,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
r = x .le. y ! OK
|
r = x .le. y ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
.le. b ! { dg-error "(A|a)ssumed.rank" }
|
.le. b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = x .le. i ! OK
|
r = x .le. i ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -223,7 +223,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
r = x .gt. y ! OK
|
r = x .gt. y ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
.gt. b ! { dg-error "(A|a)ssumed.rank" }
|
.gt. b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = x .gt. i ! OK
|
r = x .gt. i ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -234,7 +234,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
r = x .ge. y ! OK
|
r = x .ge. y ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= a & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
.ge. b ! { dg-error "(A|a)ssumed.rank" }
|
.ge. b ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = x .ge. i ! OK
|
r = x .ge. i ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -253,7 +253,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
r = p .and. q ! OK
|
r = p .and. q ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= l & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= l & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
.and. m ! { dg-error "(A|a)ssumed.rank" }
|
.and. m ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = p .and. j ! OK
|
r = p .and. j ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -264,7 +264,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
r = p .or. q ! OK
|
r = p .or. q ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= l & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= l & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
.or. m ! { dg-error "(A|a)ssumed.rank" }
|
.or. m ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = p .or. j ! OK
|
r = p .or. j ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -275,7 +275,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
r = p .eqv. q ! OK
|
r = p .eqv. q ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= l & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= l & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
.eqv. m ! { dg-error "(A|a)ssumed.rank" }
|
.eqv. m ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = p .eqv. j ! OK
|
r = p .eqv. j ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -286,7 +286,7 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
|
||||||
|
|
||||||
r = p .neqv. q ! OK
|
r = p .neqv. q ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= l & ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
= l & ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
.neqv. m ! { dg-error "(A|a)ssumed.rank" }
|
.neqv. m ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = p .neqv. j ! OK
|
r = p .neqv. j ! OK
|
||||||
n & ! { dg-error "(A|a)ssumed.rank" }
|
n & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -320,7 +320,7 @@ subroutine test_intrinsics (i1, i2, r1, r2, c1, c2, l1, l2, s1, s2)
|
||||||
! trig, hyperbolic, other math functions
|
! trig, hyperbolic, other math functions
|
||||||
r1 & ! { dg-error "(A|a)ssumed.rank" }
|
r1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= atan2 (r1, & ! { dg-error "(A|a)ssumed.rank" }
|
= atan2 (r1, & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r2) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
r2) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
r1 & ! { dg-error "(A|a)ssumed.rank" }
|
r1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= atan (r2) ! { dg-error "(A|a)ssumed.rank" }
|
= atan (r2) ! { dg-error "(A|a)ssumed.rank" }
|
||||||
c1 & ! { dg-error "(A|a)ssumed.rank" }
|
c1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -335,7 +335,7 @@ subroutine test_intrinsics (i1, i2, r1, r2, c1, c2, l1, l2, s1, s2)
|
||||||
! bit operations
|
! bit operations
|
||||||
l1 & ! { dg-error "(A|a)ssumed.rank" }
|
l1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= blt (i1, & ! { dg-error "(A|a)ssumed.rank" }
|
= blt (i1, & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
i2) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
i2) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
l1 & ! { dg-error "(A|a)ssumed.rank" }
|
l1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= btest (i1, 0) ! { dg-error "(A|a)ssumed.rank" }
|
= btest (i1, 0) ! { dg-error "(A|a)ssumed.rank" }
|
||||||
i1 & ! { dg-error "(A|a)ssumed.rank" }
|
i1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -348,7 +348,7 @@ subroutine test_intrinsics (i1, i2, r1, r2, c1, c2, l1, l2, s1, s2)
|
||||||
= char (i1) ! { dg-error "(A|a)ssumed.rank" }
|
= char (i1) ! { dg-error "(A|a)ssumed.rank" }
|
||||||
c1 & ! { dg-error "(A|a)ssumed.rank" }
|
c1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= cmplx (r1, & ! { dg-error "(A|a)ssumed.rank" }
|
= cmplx (r1, & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r2) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
r2) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
i1 & ! { dg-error "(A|a)ssumed.rank" }
|
i1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= floor (r1) ! { dg-error "(A|a)ssumed.rank" }
|
= floor (r1) ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r1 & ! { dg-error "(A|a)ssumed.rank" }
|
r1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -357,16 +357,16 @@ subroutine test_intrinsics (i1, i2, r1, r2, c1, c2, l1, l2, s1, s2)
|
||||||
! reductions
|
! reductions
|
||||||
l = any (l2) ! { dg-error "(A|a)ssumed.rank" }
|
l = any (l2) ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r = dot_product (r1, & ! { dg-error "(A|a)ssumed.rank" }
|
r = dot_product (r1, & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r2) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
r2) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
i = iall (i2, & ! { dg-error "(A|a)ssumed.rank" }
|
i = iall (i2, & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
l2) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
l2) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
|
|
||||||
! string operations
|
! string operations
|
||||||
s1 & ! { dg-error "(A|a)ssumed.rank" }
|
s1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= adjustr (s2) ! { dg-error "(A|a)ssumed.rank" }
|
= adjustr (s2) ! { dg-error "(A|a)ssumed.rank" }
|
||||||
i1 & ! { dg-error "(A|a)ssumed.rank" }
|
i1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= index (c1, & ! { dg-error "(A|a)ssumed.rank" }
|
= index (c1, & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
c2) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
c2) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
|
|
||||||
! misc
|
! misc
|
||||||
i1 & ! { dg-error "(A|a)ssumed.rank" }
|
i1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
@ -374,12 +374,12 @@ subroutine test_intrinsics (i1, i2, r1, r2, c1, c2, l1, l2, s1, s2)
|
||||||
i = findloc (r1, 0.0) ! { dg-error "(A|a)ssumed.rank" }
|
i = findloc (r1, 0.0) ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r1 & ! { dg-error "(A|a)ssumed.rank" }
|
r1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= matmul (r1, & ! { dg-error "(A|a)ssumed.rank" }
|
= matmul (r1, & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
r2) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
r2) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
r1 & ! { dg-error "(A|a)ssumed.rank" }
|
r1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= reshape (r2, [10, 3]) ! { dg-error "(A|a)ssumed.rank" }
|
= reshape (r2, [10, 3]) ! { dg-error "(A|a)ssumed.rank" }
|
||||||
i1 & ! { dg-error "(A|a)ssumed.rank" }
|
i1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= sign (i1, & ! { dg-error "(A|a)ssumed.rank" }
|
= sign (i1, & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
i2) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
i2) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||||
s1 & ! { dg-error "(A|a)ssumed.rank" }
|
s1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||||
= transpose (s2) ! { dg-error "(A|a)ssumed.rank" }
|
= transpose (s2) ! { dg-error "(A|a)ssumed.rank" }
|
||||||
|
|
||||||
|
|
|
@ -61,8 +61,8 @@
|
||||||
IF( ISYM.EQ.0 ) THEN
|
IF( ISYM.EQ.0 ) THEN
|
||||||
END IF
|
END IF
|
||||||
END IF
|
END IF
|
||||||
A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU,
|
A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU, ! { dg-warning "More actual than formal" }
|
||||||
$ DR, IPVTNG, IWORK, SPARSE )
|
$ DR, IPVTNG, IWORK, SPARSE ) ! { dg-warning "Type mismatch" }
|
||||||
END IF
|
END IF
|
||||||
END IF
|
END IF
|
||||||
END IF
|
END IF
|
||||||
|
|
|
@ -20,7 +20,7 @@ C { dg-options "-std=legacy" }
|
||||||
END IF
|
END IF
|
||||||
CALL DLALN2( .FALSE., 2, 2, SMIN, ONE,
|
CALL DLALN2( .FALSE., 2, 2, SMIN, ONE,
|
||||||
$ T( J-1, J-1 ), LDT, ONE, ONE, ! { dg-warning "Type mismatch" }
|
$ T( J-1, J-1 ), LDT, ONE, ONE, ! { dg-warning "Type mismatch" }
|
||||||
$ XNORM, IERR )
|
$ XNORM, IERR ) ! { dg-warning "Type mismatch" }
|
||||||
CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
|
CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
|
||||||
$ WORK( 1+N ), 1 )
|
$ WORK( 1+N ), 1 )
|
||||||
CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1,
|
CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1,
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! { dg-do compile }
|
! { dg-do compile }
|
||||||
! { dg-options "-O3 -std=legacy" }
|
! { dg-options "-O3 -std=legacy" }
|
||||||
CALL UVSET(NX,NY,NZ,HVAR,ZET,NP,DZ,DKM,UM,VM,UG,VG,TM,DCDX, ! { dg-warning "Rank mismatch" }
|
CALL UVSET(NX,NY,NZ,HVAR,ZET,NP,DZ,DKM,UM,VM,UG,VG,TM,DCDX, ! { dg-warning "Rank mismatch|Invalid procedure argument" }
|
||||||
*ITY,ISH,NSMT,F)
|
*ITY,ISH,NSMT,F)
|
||||||
CALL DCTDX(NX,NY,NX1,NFILT,C(MLAG),DCDX(MLAG),HELP,HELPA,
|
CALL DCTDX(NX,NY,NX1,NFILT,C(MLAG),DCDX(MLAG),HELP,HELPA,
|
||||||
* HELP,HELPA,FY,FYC,SAVEY)
|
* HELP,HELPA,FY,FYC,SAVEY)
|
||||||
|
@ -18,6 +18,6 @@
|
||||||
*WORK(*)
|
*WORK(*)
|
||||||
IF(IH.EQ.0) THEN
|
IF(IH.EQ.0) THEN
|
||||||
CALL PADEC(DKM,VM,HVAR,WORK(LWM),WORK(LWG), ! { dg-warning "Rank mismatch" }
|
CALL PADEC(DKM,VM,HVAR,WORK(LWM),WORK(LWG), ! { dg-warning "Rank mismatch" }
|
||||||
* WORK(LF),NZ,WORK(LA),WORK(LB),WORK(LC),ITY)
|
* WORK(LF),NZ,WORK(LA),WORK(LB),WORK(LC),ITY) ! { dg-warning "Type mismatch" }
|
||||||
ENDIF
|
ENDIF
|
||||||
END
|
END
|
||||||
|
|
|
@ -18,5 +18,5 @@ end module gbl_interfaces
|
||||||
program test
|
program test
|
||||||
use gbl_message
|
use gbl_message
|
||||||
use gbl_interfaces
|
use gbl_interfaces
|
||||||
call gagout(seve%e,'Some string') ! { dg-error "Type mismatch in argument" }
|
call gagout(seve%e,'Some string') ! { dg-error "Type mismatch in argument|More actual than formal" }
|
||||||
end program test
|
end program test
|
||||||
|
|
Loading…
Reference in New Issue