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:
Sandra Loosemore
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;
|
||||
bool pointer_dummy, pointer_arg, allocatable_arg;
|
||||
|
||||
bool ok = true;
|
||||
|
||||
actual = *ap;
|
||||
|
||||
if (actual == NULL && formal == NULL)
|
||||
|
|
@ -3134,7 +3136,6 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
|||
if (where)
|
||||
gfc_error ("More actual than formal arguments in procedure "
|
||||
"call at %L", where);
|
||||
|
||||
return false;
|
||||
}
|
||||
|
||||
|
|
@ -3192,13 +3193,16 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
|||
else if (where)
|
||||
gfc_error ("Fortran 2008: Null pointer at %L to non-pointer "
|
||||
"dummy %qs", where, f->sym->name);
|
||||
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
if (!compare_parameter (f->sym, a->expr, ranks_must_agree,
|
||||
is_elemental, where))
|
||||
return false;
|
||||
{
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
/* TS 29113, 6.3p2; F2018 15.5.2.4. */
|
||||
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 "
|
||||
"derived type with type-bound or FINAL procedures",
|
||||
&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 (f->sym->ts.u.cl->length->value.integer),
|
||||
f->sym->name, &a->expr->where);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
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 "
|
||||
"length type parameter if and only if the dummy has one",
|
||||
&a->expr->where, f->sym->name);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
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,
|
||||
formal_size, &a->expr->where);
|
||||
}
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
skip_size_check:
|
||||
|
|
@ -3312,7 +3320,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
|||
if (where)
|
||||
gfc_error ("Expected a procedure pointer for argument %qs at %L",
|
||||
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
|
||||
|
|
@ -3328,7 +3337,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
|||
if (where)
|
||||
gfc_error ("Expected a procedure for argument %qs at %L",
|
||||
f->sym->name, &a->expr->where);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
/* 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)
|
||||
gfc_error ("Actual argument for %qs cannot be an assumed-size"
|
||||
" array at %L", f->sym->name, where);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
/* 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) "
|
||||
"dummy %qs at %L cannot be of unknown size",
|
||||
f->sym->name, where);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
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)
|
||||
gfc_error ("Actual argument for %qs must be a pointer at %L",
|
||||
f->sym->name, &a->expr->where);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
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)
|
||||
gfc_error ("Fortran 2008: Non-pointer actual argument at %L to "
|
||||
"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 "
|
||||
"dummy %qs",
|
||||
&a->expr->where, f->sym->name);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
/* 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 "
|
||||
"dummy %qs requires INTENT(IN)",
|
||||
&a->expr->where, f->sym->name);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
/* 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 "
|
||||
"ASYNCHRONOUS nor VOLATILE", &a->expr->where,
|
||||
f->sym->name);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
/* 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 "
|
||||
"ultimate component to dummy %qs requires either VALUE "
|
||||
"or INTENT(IN)", &a->expr->where, f->sym->name);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
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)
|
||||
gfc_error ("Actual CLASS array argument for %qs must be a full "
|
||||
"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)
|
||||
gfc_error ("Actual argument for %qs must be ALLOCATABLE at %L",
|
||||
f->sym->name, &a->expr->where);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
/* 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)
|
||||
|| (f->sym->ts.type != BT_CLASS && f->sym->attr.pointer))
|
||||
&& !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))
|
||||
return false;
|
||||
{
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
}
|
||||
|
||||
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 "
|
||||
"of the dummy argument %qs",
|
||||
&a->expr->where, f->sym->name);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
/* 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 "
|
||||
"dummy argument %qs due to VOLATILE attribute",
|
||||
&a->expr->where,f->sym->name);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
/* 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 "
|
||||
"dummy argument %qs due to VOLATILE attribute",
|
||||
&a->expr->where, f->sym->name);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
/* 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 "
|
||||
"argument %qs due to VOLATILE attribute",
|
||||
&a->expr->where,f->sym->name);
|
||||
return false;
|
||||
ok = false;
|
||||
goto match;
|
||||
}
|
||||
|
||||
match:
|
||||
|
|
@ -3611,6 +3641,10 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
|||
new_arg[i++] = a;
|
||||
}
|
||||
|
||||
/* Give up now if we saw any bad argument. */
|
||||
if (!ok)
|
||||
return false;
|
||||
|
||||
/* Make sure missing actual arguments are optional. */
|
||||
i = 0;
|
||||
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)
|
||||
{
|
||||
gfc_actual_arglist *a;
|
||||
bool ok = true;
|
||||
|
||||
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 "
|
||||
"permitted as argument to the intrinsic functions "
|
||||
"C_LOC and PRESENT", &a->expr->where);
|
||||
return false;
|
||||
ok = false;
|
||||
}
|
||||
else if (a->expr->ts.type == BT_ASSUMED
|
||||
&& 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"
|
||||
" argument to the intrinsic %s", &a->expr->where,
|
||||
gfc_current_intrinsic);
|
||||
return false;
|
||||
ok = false;
|
||||
}
|
||||
else if (a->expr->ts.type == BT_ASSUMED && a != arg)
|
||||
{
|
||||
gfc_error ("Assumed-type argument at %L is only permitted as "
|
||||
"first actual argument to the intrinsic %s",
|
||||
&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 "
|
||||
"argument to intrinsic inquiry functions",
|
||||
&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 "
|
||||
"actual argument to the intrinsic inquiry function %s",
|
||||
&a->expr->where, gfc_current_intrinsic);
|
||||
return false;
|
||||
ok = false;
|
||||
}
|
||||
}
|
||||
|
||||
return true;
|
||||
return ok;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -4064,7 +4064,7 @@ resolve_operator (gfc_expr *e)
|
|||
{
|
||||
default:
|
||||
if (!gfc_resolve_expr (e->value.op.op2))
|
||||
return false;
|
||||
t = false;
|
||||
|
||||
/* Fall through. */
|
||||
|
||||
|
|
@ -4091,6 +4091,9 @@ resolve_operator (gfc_expr *e)
|
|||
op2 = e->value.op.op2;
|
||||
if (op1 == NULL && op2 == NULL)
|
||||
return false;
|
||||
/* Error out if op2 did not resolve. We already diagnosed op1. */
|
||||
if (t == false)
|
||||
return 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_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,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_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,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
|
||||
|
|
|
|||
|
|
@ -78,11 +78,11 @@ subroutine s2 (x, y)
|
|||
end select
|
||||
|
||||
! 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" }
|
||||
return
|
||||
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" }
|
||||
return
|
||||
end if
|
||||
|
|
@ -99,7 +99,7 @@ subroutine s2 (x, y)
|
|||
! arithmetic
|
||||
i = x + 1 ! { 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" }
|
||||
|
||||
! computed go to
|
||||
|
|
@ -131,19 +131,19 @@ subroutine s3 (x, y)
|
|||
i = exponent (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
|
||||
end if
|
||||
|
||||
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
|
||||
end if
|
||||
|
||||
i = storage_size (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" }
|
||||
|
||||
|
|
|
|||
|
|
@ -57,18 +57,18 @@ subroutine test_calls (x, y)
|
|||
! Make sure each invalid argument produces a diagnostic.
|
||||
! scalar dummies
|
||||
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
|
||||
call g (x, y) ! OK
|
||||
! assumed-size dummies
|
||||
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
|
||||
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
|
||||
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
|
||||
|
||||
! 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 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
|
||||
|
||||
! 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
|
||||
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" }
|
||||
z = x + i ! OK
|
||||
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
|
||||
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" }
|
||||
z = x - i ! OK
|
||||
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
|
||||
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" }
|
||||
z = x * i ! OK
|
||||
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
|
||||
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" }
|
||||
z = x / i ! OK
|
||||
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
|
||||
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" }
|
||||
z = x ** i ! OK
|
||||
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
|
||||
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" }
|
||||
r = x .eq. i ! OK
|
||||
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
|
||||
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" }
|
||||
r = x .ne. i ! OK
|
||||
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
|
||||
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" }
|
||||
r = x .lt. i ! OK
|
||||
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
|
||||
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" }
|
||||
r = x .le. i ! OK
|
||||
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
|
||||
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" }
|
||||
r = x .gt. i ! OK
|
||||
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
|
||||
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" }
|
||||
r = x .ge. i ! OK
|
||||
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
|
||||
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" }
|
||||
r = p .and. j ! OK
|
||||
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
|
||||
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" }
|
||||
r = p .or. j ! OK
|
||||
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
|
||||
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" }
|
||||
r = p .eqv. j ! OK
|
||||
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
|
||||
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" }
|
||||
r = p .neqv. j ! OK
|
||||
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
|
||||
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" }
|
||||
= atan (r2) ! { 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
|
||||
l1 & ! { 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" }
|
||||
= btest (i1, 0) ! { 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" }
|
||||
c1 & ! { 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" }
|
||||
= floor (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
|
||||
l = any (l2) ! { 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" }
|
||||
l2) ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
|
||||
l2) ! { dg-error "(A|a)ssumed.rank" "pr101337" }
|
||||
|
||||
! string operations
|
||||
s1 & ! { dg-error "(A|a)ssumed.rank" }
|
||||
= adjustr (s2) ! { dg-error "(A|a)ssumed.rank" }
|
||||
i1 & ! { 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
|
||||
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" }
|
||||
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" }
|
||||
= reshape (r2, [10, 3]) ! { dg-error "(A|a)ssumed.rank" }
|
||||
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" }
|
||||
= transpose (s2) ! { dg-error "(A|a)ssumed.rank" }
|
||||
|
||||
|
|
|
|||
|
|
@ -61,8 +61,8 @@
|
|||
IF( ISYM.EQ.0 ) THEN
|
||||
END IF
|
||||
END IF
|
||||
A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU,
|
||||
$ DR, IPVTNG, IWORK, SPARSE )
|
||||
A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU, ! { dg-warning "More actual than formal" }
|
||||
$ DR, IPVTNG, IWORK, SPARSE ) ! { dg-warning "Type mismatch" }
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@ C { dg-options "-std=legacy" }
|
|||
END IF
|
||||
CALL DLALN2( .FALSE., 2, 2, SMIN, ONE,
|
||||
$ 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,
|
||||
$ WORK( 1+N ), 1 )
|
||||
CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1,
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! { dg-do compile }
|
||||
! { 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)
|
||||
CALL DCTDX(NX,NY,NX1,NFILT,C(MLAG),DCDX(MLAG),HELP,HELPA,
|
||||
* HELP,HELPA,FY,FYC,SAVEY)
|
||||
|
|
@ -18,6 +18,6 @@
|
|||
*WORK(*)
|
||||
IF(IH.EQ.0) THEN
|
||||
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
|
||||
END
|
||||
|
|
|
|||
|
|
@ -18,5 +18,5 @@ end module gbl_interfaces
|
|||
program test
|
||||
use gbl_message
|
||||
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue