Hello world,
the attached patch improves the rather hard to read error
messages for argument mismatches. With this patch, this reads
argument_checking_21.f90:7:11:
6 | call foo(1.0) ! { dg-warning "Rank mismatch" }
| 2
7 | call foo(b) ! { dg-warning "Rank mismatch" }
| 1
Fehler: Rank mismatch between actual argument at (1) and actual argument
at (2) (scalar and rank-2)
which I think is fairly clear. It also makes sure that warnings are
always emitted by -fallow-argument-mismatch by removing
-Wargument-mismatch. Finally, for people who do not want to have too
many warnings cluttering up their logs, a type mismatch is only
shown once if it is a warning.
While I was going on about fixing warnings, I also fixed PR 91557 with
the bit in trans-expr.c. This part is trivial, I will backport it
to the other affected branches.
After this, I think we can close PR 91556. Regression-tested. OK for
trunk?
2019-09-13 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/91557
PR fortran/91556
* frontend-passes.c (check_externals_procedure): Reformat argument
list. Use gfc_compare_actual_formal instead of gfc_procedure_use.
* gfortran.h (gfc_symbol): Add flag error.
* interface.c (gfc_compare_interfaces): Reformat.
(argument_rank_mismatch): Add where_formal argument. If it is
present, note that the error is between different calls.
(compare_parameter): Change warnings that previously dependended
on -Wargument-mismatch to unconditional. Issue an error / warning
on type mismatch only once. Pass where_formal to
argument_rank_mismatch for artificial variables.
(compare_actual_formal): Change warnings that previously
dependeded on -Wargument-mismatch to unconditional.
(gfc_check_typebound_override): Likewise.
(gfc_get_formal_from_actual_arglist): Set declared_at for
artificial symbol.
* invoke.texi: Extend description of -fallow-argument-mismatch.
Delete -Wargument-mismatch.
* lang.opt: Change -Wargument-mismatch to do-nothing option.
* resolve.c (resolve_structure_cons): Change warnings that
previously depended on -Wargument-mismatch to unconditional.
* trans-decl.c (generate_local_decl): Do not warn if the symbol is
artificial.
2019-09-13 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/91557
PR fortran/91556
* gfortran.dg/argument_checking_20.f90: New test.
* gfortran.dg/argument_checking_21.f90: New test.
* gfortran.dg/argument_checking_22.f90: New test.
* gfortran.dg/argument_checking_23.f90: New test.
* gfortran.dg/warn_unused_dummy_argument_5.f90: New test.
* gfortran.dg/bessel_3.f90: Add pattern for type mismatch.
* gfortran.dg/g77/20010519-1.f: Adjust dg-warning messages to new
handling.
* gfortran.dg/pr24823.f: Likewise.
* gfortran.dg/pr39937.f: Likewise.
Index: fortran/frontend-passes.c
===================================================================
--- fortran/frontend-passes.c (Revision 275713)
+++ fortran/frontend-passes.c (Arbeitskopie)
@@ -5373,7 +5373,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
/* Common tests for argument checking for both functions and subroutines. */
static int
-check_externals_procedure (gfc_symbol *sym, locus *loc, gfc_actual_arglist *actual)
+check_externals_procedure (gfc_symbol *sym, locus *loc,
+ gfc_actual_arglist *actual)
{
gfc_gsymbol *gsym;
gfc_symbol *def_sym = NULL;
@@ -5396,7 +5397,7 @@ static int
if (def_sym)
{
- gfc_procedure_use (def_sym, &actual, loc);
+ gfc_compare_actual_formal (&actual, def_sym->formal, 0, 0, 0, loc);
return 0;
}
Index: fortran/gfortran.h
===================================================================
--- fortran/gfortran.h (Revision 275713)
+++ fortran/gfortran.h (Arbeitskopie)
@@ -1610,6 +1610,9 @@ typedef struct gfc_symbol
/* Set if this is a module function or subroutine with the
abreviated declaration in a submodule. */
unsigned abr_modproc_decl:1;
+ /* Set if a previous error or warning has occurred and no other
+ should be reported. */
+ unsigned error:1;
int refs;
struct gfc_namespace *ns; /* namespace containing this symbol */
Index: fortran/interface.c
===================================================================
--- fortran/interface.c (Revision 275713)
+++ fortran/interface.c (Arbeitskopie)
@@ -1807,9 +1807,9 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol
if (!compare_rank (f2->sym, f1->sym))
{
if (errmsg != NULL)
- snprintf (errmsg, err_len, "Rank mismatch in argument '%s' "
- "(%i/%i)", f1->sym->name, symbol_rank (f1->sym),
- symbol_rank (f2->sym));
+ snprintf (errmsg, err_len, "Rank mismatch in argument "
+ "'%s' (%i/%i)", f1->sym->name,
+ symbol_rank (f1->sym), symbol_rank (f2->sym));
return false;
}
if ((gfc_option.allow_std & GFC_STD_F2008)
@@ -2189,22 +2189,42 @@ compare_pointer (gfc_symbol *formal, gfc_expr *act
static void
argument_rank_mismatch (const char *name, locus *where,
- int rank1, int rank2)
+ int rank1, int rank2, locus *where_formal)
{
/* TS 29113, C407b. */
- if (rank2 == -1)
- gfc_error ("The assumed-rank array at %L requires that the dummy argument"
- " %qs has assumed-rank", where, name);
- else if (rank1 == 0)
- gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
- "at %L (scalar and rank-%d)", name, where, rank2);
- else if (rank2 == 0)
- gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
- "at %L (rank-%d and scalar)", name, where, rank1);
+ if (where_formal == NULL)
+ {
+ if (rank2 == -1)
+ gfc_error ("The assumed-rank array at %L requires that the dummy "
+ "argument %qs has assumed-rank", where, name);
+ else if (rank1 == 0)
+ gfc_error_opt (0, "Rank mismatch in argument %qs "
+ "at %L (scalar and rank-%d)", name, where, rank2);
+ else if (rank2 == 0)
+ gfc_error_opt (0, "Rank mismatch in argument %qs "
+ "at %L (rank-%d and scalar)", name, where, rank1);
+ else
+ gfc_error_opt (0, "Rank mismatch in argument %qs "
+ "at %L (rank-%d and rank-%d)", name, where, rank1,
+ rank2);
+ }
else
- gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
- "at %L (rank-%d and rank-%d)", name, where, rank1, rank2);
+ {
+ gcc_assert (rank2 != -1);
+ if (rank1 == 0)
+ gfc_error_opt (0, "Rank mismatch between actual argument at %L "
+ "and actual argument at %L (scalar and rank-%d)",
+ where, where_formal, rank2);
+ else if (rank2 == 0)
+ gfc_error_opt (0, "Rank mismatch between actual argument at %L "
+ "and actual argument at %L (rank-%d and scalar)",
+ where, where_formal, rank1);
+ else
+ gfc_error_opt (0, "Rank mismatch between actual argument at %L "
+ "and actual argument at %L (rank-%d and rank-%d", where,
+ where_formal, rank1, rank2);
+ }
}
@@ -2253,8 +2273,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
sizeof(err), NULL, NULL))
{
if (where)
- gfc_error_opt (OPT_Wargument_mismatch,
- "Interface mismatch in dummy procedure %qs at %L:"
+ gfc_error_opt (0, "Interface mismatch in dummy procedure %qs at %L:"
" %s", formal->name, &actual->where, err);
return false;
}
@@ -2281,8 +2300,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
err, sizeof(err), NULL, NULL))
{
if (where)
- gfc_error_opt (OPT_Wargument_mismatch,
- "Interface mismatch in dummy procedure %qs at %L:"
+ gfc_error_opt (0, "Interface mismatch in dummy procedure %qs at %L:"
" %s", formal->name, &actual->where, err);
return false;
}
@@ -2312,10 +2330,24 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
CLASS_DATA (actual)->ts.u.derived)))
{
if (where)
- gfc_error_opt (OPT_Wargument_mismatch,
- "Type mismatch in argument %qs at %L; passed %s to %s",
- formal->name, where, gfc_typename (&actual->ts),
- gfc_typename (&formal->ts));
+ {
+ if (formal->attr.artificial)
+ {
+ if (!flag_allow_argument_mismatch || !formal->error)
+ gfc_error_opt (0, "Type mismatch between actual argument at %L "
+ "and actual argument at %L (%s/%s).",
+ &actual->where,
+ &formal->declared_at,
+ gfc_typename (&actual->ts),
+ gfc_typename (&formal->ts));
+
+ formal->error = 1;
+ }
+ else
+ gfc_error_opt (0, "Type mismatch in argument %qs at %L; passed %s "
+ "to %s", formal->name, where, gfc_typename (&actual->ts),
+ gfc_typename (&formal->ts));
+ }
return false;
}
@@ -2512,8 +2544,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
&& gfc_is_coindexed (actual)))
{
if (where)
- argument_rank_mismatch (formal->name, &actual->where,
- symbol_rank (formal), actual->rank);
+ {
+ locus *where_formal;
+ if (formal->attr.artificial)
+ where_formal = &formal->declared_at;
+ else
+ where_formal = NULL;
+
+ argument_rank_mismatch (formal->name, &actual->where,
+ symbol_rank (formal), actual->rank,
+ where_formal);
+ }
return false;
}
else if (actual->rank != 0 && (is_elemental || formal->attr.dimension))
@@ -2584,8 +2625,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
if (ref == NULL && actual->expr_type != EXPR_NULL)
{
if (where)
- argument_rank_mismatch (formal->name, &actual->where,
- symbol_rank (formal), actual->rank);
+ {
+ locus *where_formal;
+ if (formal->attr.artificial)
+ where_formal = &formal->declared_at;
+ else
+ where_formal = NULL;
+
+ argument_rank_mismatch (formal->name, &actual->where,
+ symbol_rank (formal), actual->rank,
+ where_formal);
+ }
return false;
}
@@ -3062,8 +3112,7 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap
f->sym->ts.u.cl->length->value.integer) != 0))
{
if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
- gfc_warning (OPT_Wargument_mismatch,
- "Character length mismatch (%ld/%ld) between actual "
+ gfc_warning (0, "Character length mismatch (%ld/%ld) between actual "
"argument and pointer or allocatable dummy argument "
"%qs at %L",
mpz_get_si (a->expr->ts.u.cl->length->value.integer),
@@ -3070,8 +3119,7 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap
mpz_get_si (f->sym->ts.u.cl->length->value.integer),
f->sym->name, &a->expr->where);
else if (where)
- gfc_warning (OPT_Wargument_mismatch,
- "Character length mismatch (%ld/%ld) between actual "
+ gfc_warning (0, "Character length mismatch (%ld/%ld) between actual "
"argument and assumed-shape dummy argument %qs "
"at %L",
mpz_get_si (a->expr->ts.u.cl->length->value.integer),
@@ -3102,8 +3150,7 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap
&& f->sym->attr.flavor != FL_PROCEDURE)
{
if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where)
- gfc_warning (OPT_Wargument_mismatch,
- "Character length of actual argument shorter "
+ gfc_warning (0, "Character length of actual argument shorter "
"than of dummy argument %qs (%lu/%lu) at %L",
f->sym->name, actual_size, formal_size,
&a->expr->where);
@@ -3111,8 +3158,7 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap
{
/* Emit a warning for -std=legacy and an error otherwise. */
if (gfc_option.warn_std == 0)
- gfc_warning (OPT_Wargument_mismatch,
- "Actual argument contains too few "
+ gfc_warning (0, "Actual argument contains too few "
"elements for dummy argument %qs (%lu/%lu) "
"at %L", f->sym->name, actual_size,
formal_size, &a->expr->where);
@@ -4706,8 +4752,7 @@ gfc_check_typebound_override (gfc_symtree* proc, g
if (!gfc_check_dummy_characteristics (proc_formal->sym, old_formal->sym,
check_type, err, sizeof(err)))
{
- gfc_error_opt (OPT_Wargument_mismatch,
- "Argument mismatch for the overriding procedure "
+ gfc_error_opt (0, "Argument mismatch for the overriding procedure "
"%qs at %L: %s", proc->name, &where, err);
return false;
}
@@ -5184,6 +5229,7 @@ gfc_get_formal_from_actual_arglist (gfc_symbol *sy
}
}
s->attr.dummy = 1;
+ s->declared_at = a->expr->where;
s->attr.intent = INTENT_UNKNOWN;
(*f)->sym = s;
}
Index: fortran/invoke.texi
===================================================================
--- fortran/invoke.texi (Revision 275713)
+++ fortran/invoke.texi (Arbeitskopie)
@@ -145,7 +145,7 @@ by type. Explanations are in the following sectio
@item Error and Warning Options
@xref{Error and Warning Options,,Options to request or suppress errors
and warnings}.
-@gccoptlist{-Waliasing -Wall -Wampersand -Wargument-mismatch -Warray-bounds @gol
+@gccoptlist{-Waliasing -Wall -Wampersand -Warray-bounds @gol
-Wc-binding-type -Wcharacter-truncation -Wconversion @gol
-Wdo-subscript -Wfunction-elimination -Wimplicit-interface @gol
-Wimplicit-procedure -Wintrinsic-shadow -Wuse-without-only @gol
@@ -236,9 +236,16 @@ intrinsic will be called except when it is explici
Some code contains calls to external procedures whith mismatches
between the calls and the procedure definition, or with mismatches
between different calls. Such code is non-conforming, and will usually
-be flagged with an error. This options degrades the error to a
-warning. This option is implied by @option{-std=legacy}.
+be flagged wi1th an error. This options degrades the error to a
+warning, which can only be disabled by disabling all warnings vial
+@option{-w}. Only a single occurrence per argument is flagged by this
+warning. @option{-fallow-argument-mismatch} is implied by
+@option{-std=legacy}.
+Using this option is @emph{strongly} discouraged. It is possible to
+provide standard-conforming code which allows different types of
+arguments by using an explicit interface and @code{TYPE(*)}.
+
@item -fallow-invalid-boz
@opindex @code{allow-invalid-boz}
A BOZ literal constant can occur in a limited number of contexts in
@@ -907,15 +914,6 @@ character constant, GNU Fortran assumes continuati
non-comment, non-whitespace character after the ampersand that
initiated the continuation.
-@item -Wargument-mismatch
-@opindex @code{Wargument-mismatch}
-@cindex warnings, argument mismatch
-@cindex warnings, parameter mismatch
-@cindex warnings, interface mismatch
-Warn about type, rank, and other mismatches between formal parameters and actual
-arguments to functions and subroutines. These warnings are recommended and
-thus enabled by default.
-
@item -Warray-temporaries
@opindex @code{Warray-temporaries}
@cindex warnings, array temporaries
Index: fortran/lang.opt
===================================================================
--- fortran/lang.opt (Revision 275713)
+++ fortran/lang.opt (Arbeitskopie)
@@ -210,8 +210,8 @@ Fortran Warning Var(warn_array_temporaries)
Warn about creation of array temporaries.
Wargument-mismatch
-Fortran Warning Var(warn_argument_mismatch) Init(1)
-Warn about type and rank mismatches between arguments and parameters.
+Fortran WarnRemoved
+Does nothing. Preserved for backward compatibility.
Wc-binding-type
Fortran Var(warn_c_binding_type) Warning LangEnabledBy(Fortran,Wall)
Index: fortran/resolve.c
===================================================================
--- fortran/resolve.c (Revision 275713)
+++ fortran/resolve.c (Arbeitskopie)
@@ -1429,8 +1429,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1,
err, sizeof (err), NULL, NULL))
{
- gfc_error_opt (OPT_Wargument_mismatch,
- "Interface mismatch for procedure-pointer "
+ gfc_error_opt (0, "Interface mismatch for procedure-pointer "
"component %qs in structure constructor at %L:"
" %s", comp->name, &cons->expr->where, err);
return false;
@@ -2609,8 +2608,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *
if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
reason, sizeof(reason), NULL, NULL))
{
- gfc_error_opt (OPT_Wargument_mismatch,
- "Interface mismatch in global procedure %qs at %L:"
+ gfc_error_opt (0, "Interface mismatch in global procedure %qs at %L:"
" %s", sym->name, &sym->declared_at, reason);
goto done;
}
Index: fortran/trans-decl.c
===================================================================
--- fortran/trans-decl.c (Revision 275713)
+++ fortran/trans-decl.c (Arbeitskopie)
@@ -5881,9 +5881,11 @@ generate_local_decl (gfc_symbol * sym)
}
else if (warn_unused_dummy_argument)
{
- gfc_warning (OPT_Wunused_dummy_argument,
- "Unused dummy argument %qs at %L", sym->name,
- &sym->declared_at);
+ if (!sym->attr.artificial)
+ gfc_warning (OPT_Wunused_dummy_argument,
+ "Unused dummy argument %qs at %L", sym->name,
+ &sym->declared_at);
+
if (sym->backend_decl != NULL_TREE)
TREE_NO_WARNING(sym->backend_decl) = 1;
}
Index: testsuite/gfortran.dg/bessel_3.f90
===================================================================
--- testsuite/gfortran.dg/bessel_3.f90 (Revision 275713)
+++ testsuite/gfortran.dg/bessel_3.f90 (Arbeitskopie)
@@ -8,11 +8,11 @@ IMPLICIT NONE
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" }
+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_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" }
+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" }
end
Index: testsuite/gfortran.dg/g77/20010519-1.f
===================================================================
--- testsuite/gfortran.dg/g77/20010519-1.f (Revision 275713)
+++ testsuite/gfortran.dg/g77/20010519-1.f (Arbeitskopie)
@@ -773,7 +773,7 @@ C
NTR=6
OLDPRN=PRNLEV
PRNLEV=1
- CALL ORTHNM(1,6,NTR,HEAP(TRAROT),NAT3,.FALSE.,TOLER)
+ CALL ORTHNM(1,6,NTR,HEAP(TRAROT),NAT3,.FALSE.,TOLER) ! { dg-warning "Type mismatch" }
PRNLEV=OLDPRN
IF(IUNRMD .LT. 0) THEN
C
@@ -1126,7 +1126,7 @@ C
NFCUT=NFRET
OLDPRN=PRNLEV
PRNLEV=1
- CALL ORTHNM(1,NFRET,NFCUT,DDV,NAT3,LPURG,TOLER) ! { dg-warning "Type mismatch" }
+ CALL ORTHNM(1,NFRET,NFCUT,DDV,NAT3,LPURG,TOLER)
PRNLEV=OLDPRN
NFRET=NFCUT
IF(PRNLEV.GE.2) WRITE(OUTU,568) NFRET
@@ -1174,7 +1174,7 @@ C TO DO-THE-DIAGONALISATIONS
NFSAV=NFCUT1
OLDPRN=PRNLEV
PRNLEV=1
- CALL ORTHNM(1,NFCUT1,NFCUT,DDV,NAT3,LPURG,TOLER) ! { dg-warning "Type mismatch" }
+ CALL ORTHNM(1,NFCUT1,NFCUT,DDV,NAT3,LPURG,TOLER)
PRNLEV=OLDPRN
CALL CPARAY(HEAP(DDVBAS),DDV,NAT3,1,NFCUT,1)
NFRET=NDIM+NFCUT
@@ -1224,7 +1224,7 @@ C
CALL ADZERD(DDV,1,NFCUT1,NAT3,IS1,IS2,IS3,IS4)
OLDPRN=PRNLEV
PRNLEV=1
- CALL ORTHNM(1,NFCUT1,NFCUT,DDV,NAT3,LPURG,TOLER) ! { dg-warning "Type mismatch" }
+ CALL ORTHNM(1,NFCUT1,NFCUT,DDV,NAT3,LPURG,TOLER)
PRNLEV=OLDPRN
CALL CPARAY(HEAP(DDVBAS),DDV,NAT3,1,NFCUT,1)
C
Index: testsuite/gfortran.dg/pr24823.f
===================================================================
--- testsuite/gfortran.dg/pr24823.f (Revision 275713)
+++ testsuite/gfortran.dg/pr24823.f (Arbeitskopie)
@@ -50,9 +50,9 @@
IF( I.LT.1 ) THEN
IF( ISYM.EQ.0 ) THEN
A( J-I+1, I ) = DCONJG( ZLATM2( M, N, I, J, KL,
- $ DR, IPVTNG, IWORK, SPARSE ) )
+ $ DR, IPVTNG, IWORK, SPARSE ) ) ! { dg-warning "Type mismatch" }
ELSE
- A( J-I+1, I ) = ZLATM2( M, N, I, J, KL, KU, ! { dg-warning "Type mismatch" }
+ A( J-I+1, I ) = ZLATM2( M, N, I, J, KL, KU, ! { dg-warning "Type mismatch" }
$ IPVTNG, IWORK, SPARSE )
END IF
END IF
@@ -61,7 +61,7 @@
IF( ISYM.EQ.0 ) THEN
END IF
END IF
- A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU, ! { dg-warning "Type mismatch" }
+ A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU,
$ DR, IPVTNG, IWORK, SPARSE )
END IF
END IF
Index: testsuite/gfortran.dg/pr39937.f
===================================================================
--- testsuite/gfortran.dg/pr39937.f (Revision 275713)
+++ testsuite/gfortran.dg/pr39937.f (Arbeitskopie)
@@ -6,7 +6,7 @@ C { dg-options "-std=legacy" }
$ WORK( * )
DOUBLE PRECISION X( 2, 2 )
CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
- $ ZERO, X, 2, SCALE, XNORM, IERR )
+ $ ZERO, X, 2, SCALE, XNORM, IERR ) ! { dg-warning "Type mismatch" }
CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
DO 90 J = KI - 2, 1, -1
IF( J.GT.JNXT )
@@ -19,8 +19,8 @@ C { dg-options "-std=legacy" }
END IF
END IF
CALL DLALN2( .FALSE., 2, 2, SMIN, ONE,
- $ T( J-1, J-1 ), LDT, ONE, ONE,
- $ XNORM, IERR ) ! { dg-warning "Type mismatch" }
+ $ T( J-1, J-1 ), LDT, ONE, ONE, ! { dg-warning "Type mismatch" }
+ $ XNORM, IERR )
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,
! { dg-do compile }
! { dg-options "-fallow-argument-mismatch" }
! PR 91556 - check that only a single warning iw emitted for type
! mismatch (and that the check is also done in contained procedures).
program main
real :: a
call foo(a) ! { dg-warning "Type mismatch" }
contains
subroutine bar
integer :: b
complex :: c
call foo(b) ! { dg-warning "Type mismatch" }
call foo(c)
end subroutine bar
end program main
! { dg-do compile }
! PR 91556 - check that multiple errors are emitted for type mismatch
! (and that the check is also done in contained procedures).
program main
real :: a
call foo(a) ! { dg-error "Type mismatch" }
contains
subroutine bar
integer :: b
complex :: c
call foo(b) ! { dg-error "Type mismatch" }
call foo(c) ! { dg-error "Type mismatch" }
end subroutine bar
end program main
! { dg-do compile }
! { dg-options "-fallow-argument-mismatch" }
program main
real :: a(10), b(10,10)
! This should be caugt
call foo(1.0) ! { dg-warning "Rank mismatch" }
call foo(b) ! { dg-warning "Rank mismatch" }
! This is OK
call bar(a)
call bar(b)
end program main
! { dg-do compile }
program main
real :: a(10), b(10,10)
! This should be caugt
call foo(1.0) ! { dg-error "Rank mismatch" }
call foo(b) ! { dg-error "Rank mismatch" }
! This is OK
call bar(a)
call bar(b)
end program main
