diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 683d66bbf913b17fadb79b670006a76f736883ee..9c2cc465e7fd78143fc09d2777d777dda685280c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2008-01-13 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/34665
+ * resolve.c (resolve_actual_arglist): For expressions,
+ also check for assume-sized arrays.
+ * interface.c (compare_parameter): Move F2003 character checks
+ here, print error messages here, reject elements of
+ assumed-shape array as argument to dummy arrays.
+ (compare_actual_formal): Update for the changes above.
+
2008-01-13 Tobias Burnus <burnus@net-b.de>
PR fortran/34763
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 8088fc65432162cbc9e29aeaa037e7909a95577a..9057ef932855b828d1d86ef4539d045a0bca4fdf 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1420,9 +1420,10 @@ compare_pointer (gfc_symbol *formal, gfc_expr *actual)
static int
compare_parameter (gfc_symbol *formal, gfc_expr *actual,
- int ranks_must_agree, int is_elemental)
+ int ranks_must_agree, int is_elemental, locus *where)
{
gfc_ref *ref;
+ bool rank_check;
/* If the formal arg has type BT_VOID, it's to one of the iso_c_binding
procs c_f_pointer or c_f_procpointer, and we need to accept most
@@ -1439,51 +1440,119 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
if (actual->ts.type == BT_PROCEDURE)
{
if (formal->attr.flavor != FL_PROCEDURE)
- return 0;
+ goto proc_fail;
if (formal->attr.function
&& !compare_type_rank (formal, actual->symtree->n.sym))
- return 0;
+ goto proc_fail;
if (formal->attr.if_source == IFSRC_UNKNOWN
|| actual->symtree->n.sym->attr.external)
return 1; /* Assume match. */
if (actual->symtree->n.sym->attr.intrinsic)
- return compare_intr_interfaces (formal, actual->symtree->n.sym);
- else
- return compare_interfaces (formal, actual->symtree->n.sym, 0);
+ {
+ if (!compare_intr_interfaces (formal, actual->symtree->n.sym))
+ goto proc_fail;
+ }
+ else if (!compare_interfaces (formal, actual->symtree->n.sym, 0))
+ goto proc_fail;
+
+ return 1;
+
+ proc_fail:
+ if (where)
+ gfc_error ("Type/rank mismatch in argument '%s' at %L",
+ formal->name, &actual->where);
+ return 0;
}
if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
&& !gfc_compare_types (&formal->ts, &actual->ts))
- return 0;
+ {
+ if (where && actual->ts.type == BT_DERIVED
+ && formal->ts.type == BT_DERIVED)
+ gfc_error ("Type mismatch in argument '%s' at %L; passed type(%s) to "
+ "type(%s)", formal->name, &actual->where,
+ actual->ts.derived->name, formal->ts.derived->name);
+ else if (where)
+ gfc_error ("Type mismatch in argument '%s' at %L; passed %s to %s",
+ formal->name, &actual->where,
+ actual->ts.type == BT_DERIVED ? "derived type"
+ : gfc_basic_typename (actual->ts.type),
+ formal->ts.type == BT_DERIVED ? "derived type"
+ : gfc_basic_typename (formal->ts.type));
+ return 0;
+ }
if (symbol_rank (formal) == actual->rank)
return 1;
- /* At this point the ranks didn't agree. */
- if (ranks_must_agree || formal->attr.pointer)
- return 0;
-
- if (actual->rank != 0)
- return is_elemental || formal->attr.dimension;
-
- /* At this point, we are considering a scalar passed to an array.
- This is legal if the scalar is an array element of the right sort. */
- if (formal->as->type == AS_ASSUMED_SHAPE)
- return 0;
+ rank_check = where != NULL && !is_elemental && formal->as
+ && (formal->as->type == AS_ASSUMED_SHAPE
+ || formal->as->type == AS_DEFERRED);
- for (ref = actual->ref; ref; ref = ref->next)
- if (ref->type == REF_SUBSTRING)
+ if (rank_check || ranks_must_agree || formal->attr.pointer
+ || (actual->rank != 0 && !(is_elemental || formal->attr.dimension))
+ || (actual->rank == 0 && formal->as->type == AS_ASSUMED_SHAPE))
+ {
+ if (where)
+ gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)",
+ formal->name, &actual->where, symbol_rank (formal),
+ actual->rank);
return 0;
+ }
+ else if (actual->rank != 0 && (is_elemental || formal->attr.dimension))
+ return 1;
+
+ /* At this point, we are considering a scalar passed to an array. This
+ is valid (cf. F95 12.4.1.1; F2003 12.4.1.2),
+ - if the actual argument is (a substring of) an element of a
+ non-assumed-shape/non-pointer array;
+ - (F2003) if the actual argument is of type character. */
for (ref = actual->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT)
break;
- if (ref == NULL)
- return 0; /* Not an array element. */
+ /* Not an array element. */
+ if (formal->ts.type == BT_CHARACTER
+ && (ref == NULL
+ || (actual->expr_type == EXPR_VARIABLE
+ && (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
+ || actual->symtree->n.sym->as->type == AS_DEFERRED))))
+ {
+ if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0)
+ {
+ gfc_error ("Fortran 2003: Scalar CHARACTER actual argument with "
+ "array dummy argument '%s' at %L",
+ formal->name, &actual->where);
+ return 0;
+ }
+ else if ((gfc_option.allow_std & GFC_STD_F2003) == 0)
+ return 0;
+ else
+ return 1;
+ }
+ else if (ref == NULL)
+ {
+ if (where)
+ gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)",
+ formal->name, &actual->where, symbol_rank (formal),
+ actual->rank);
+ return 0;
+ }
+
+ if (actual->expr_type == EXPR_VARIABLE
+ && actual->symtree->n.sym->as
+ && (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
+ || actual->symtree->n.sym->as->type == AS_DEFERRED))
+ {
+ if (where)
+ gfc_error ("Element of assumed-shaped array passed to dummy "
+ "argument '%s' at %L", formal->name, &actual->where);
+ return 0;
+ }
return 1;
}
@@ -1708,7 +1777,6 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
gfc_actual_arglist **new, *a, *actual, temp;
gfc_formal_arglist *f;
int i, n, na;
- bool rank_check;
unsigned long actual_size, formal_size;
actual = *ap;
@@ -1788,34 +1856,10 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
"call at %L", where);
return 0;
}
-
- rank_check = where != NULL && !is_elemental && f->sym->as
- && (f->sym->as->type == AS_ASSUMED_SHAPE
- || f->sym->as->type == AS_DEFERRED);
-
- if (f->sym->ts.type == BT_CHARACTER && a->expr->ts.type == BT_CHARACTER
- && a->expr->rank == 0 && !ranks_must_agree
- && f->sym->as && f->sym->as->type != AS_ASSUMED_SHAPE)
- {
- if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0)
- {
- gfc_error ("Fortran 2003: Scalar CHARACTER actual argument "
- "with array dummy argument '%s' at %L",
- f->sym->name, &a->expr->where);
- return 0;
- }
- else if ((gfc_option.allow_std & GFC_STD_F2003) == 0)
- return 0;
-
- }
- else if (!compare_parameter (f->sym, a->expr,
- ranks_must_agree || rank_check, is_elemental))
- {
- if (where)
- gfc_error ("Type/rank mismatch in argument '%s' at %L",
- f->sym->name, &a->expr->where);
- return 0;
- }
+
+ if (!compare_parameter (f->sym, a->expr, ranks_must_agree,
+ is_elemental, where))
+ return 0;
if (a->expr->ts.type == BT_CHARACTER
&& a->expr->ts.cl && a->expr->ts.cl->length
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0f96cd6eb75c56c9e89870c5e5eedec5af4409cd..0c4946e67bd5bbf470ec65cb4b9ed71f4a6acb43 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1013,6 +1013,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype)
gfc_symbol *sym;
gfc_symtree *parent_st;
gfc_expr *e;
+ int save_need_full_assumed_size;
for (; arg; arg = arg->next)
{
@@ -1041,8 +1042,12 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype)
if (e->ts.type != BT_PROCEDURE)
{
+ save_need_full_assumed_size = need_full_assumed_size;
+ if (e->expr_type != FL_VARIABLE)
+ need_full_assumed_size = 0;
if (gfc_resolve_expr (e) != SUCCESS)
return FAILURE;
+ need_full_assumed_size = save_need_full_assumed_size;
goto argument_list;
}
@@ -1181,8 +1186,12 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype)
primary.c (match_actual_arg). If above code determines that it
is a variable instead, it needs to be resolved as it was not
done at the beginning of this function. */
+ save_need_full_assumed_size = need_full_assumed_size;
+ if (e->expr_type != FL_VARIABLE)
+ need_full_assumed_size = 0;
if (gfc_resolve_expr (e) != SUCCESS)
return FAILURE;
+ need_full_assumed_size = save_need_full_assumed_size;
argument_list:
/* Check argument list functions %VAL, %LOC and %REF. There is
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 09b233e064403a9cfccf95d1122f1db54dc7ec74..180d9559063c3046132aa67fd815d0b230ee91e5 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,18 @@
+2008-01-13 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/34665
+ * gfortran.dg/argument_checking_11.f90: New.
+ * gfortran.dg/argument_checking_12.f90: New.
+ * gfortran.dg/used_dummy_types_4.f90: Update dg-error.
+ * gfortran.dg/c_assoc_2.f03: Update dg-error.
+ * gfortran.dg/argument_checking_3.f90: Ditto.
+ * gfortran.dg/pointer_intent_2.f90: Ditto.
+ * gfortran.dg/import2.f90: Ditto.
+ * gfortran.dg/assumed_shape_ranks_1.f90: Ditto.
+ * gfortran.dg/implicit_actual.f90: Ditto.
+ * gfortran.dg/used_dummy_types_3.f90: Ditto.
+ * gfortran.dg/derived_comp_array_ref_6.f90: Ditto.
+
2008-01-13 Tobias Burnus <burnus@net-b.de>
PR fortran/34763
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_11.f90 b/gcc/testsuite/gfortran.dg/argument_checking_11.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7c70c37ee47b0de1de2205ee8c51c8664f155cb7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_11.f90
@@ -0,0 +1,285 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -fmax-errors=100" }
+!
+! PR fortran/34665
+!
+! Test argument checking
+!
+! TODO: Check also expressions, e.g. "(a(1))" instead of "a(1)
+! for strings; check also "string" and [ "string" ]
+!
+implicit none
+CONTAINS
+SUBROUTINE test1(a,b,c,d,e)
+ integer, dimension(:) :: a
+ integer, pointer, dimension(:) :: b
+ integer, dimension(*) :: c
+ integer, dimension(5) :: d
+ integer :: e
+
+ call as_size(a)
+ call as_size(b)
+ call as_size(c)
+ call as_size(d)
+ call as_size(e) ! { dg-error "Rank mismatch" }
+ call as_size(1) ! { dg-error "Rank mismatch" }
+ call as_size( (/ 1 /) )
+ call as_size( (a) )
+ call as_size( (b) )
+ call as_size( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call as_size( (d) )
+ call as_size( (e) ) ! { dg-error "Rank mismatch" }
+ call as_size(a(1)) ! { dg-error "Element of assumed-shaped" }
+ call as_size(b(1)) ! { dg-error "Element of assumed-shaped" }
+ call as_size(c(1))
+ call as_size(d(1))
+ call as_size( (a(1)) ) ! { dg-error "Rank mismatch" }
+ call as_size( (b(1)) ) ! { dg-error "Rank mismatch" }
+ call as_size( (c(1)) ) ! { dg-error "Rank mismatch" }
+ call as_size( (d(1)) ) ! { dg-error "Rank mismatch" }
+ call as_size(a(1:2))
+ call as_size(b(1:2))
+ call as_size(c(1:2))
+ call as_size(d(1:2))
+ call as_size( (a(1:2)) )
+ call as_size( (b(1:2)) )
+ call as_size( (c(1:2)) )
+ call as_size( (d(1:2)) )
+
+ call as_shape(a)
+ call as_shape(b)
+ call as_shape(c) ! { dg-error "cannot be an assumed-size array" }
+ call as_shape(d)
+ call as_shape(e) ! { dg-error "Rank mismatch" }
+ call as_shape( 1 ) ! { dg-error "Rank mismatch" }
+ call as_shape( (/ 1 /) )
+ call as_shape( (a) )
+ call as_shape( (b) )
+ call as_shape( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call as_shape( (d) )
+ call as_shape( (e) ) ! { dg-error "Rank mismatch" }
+ call as_shape( (1) ) ! { dg-error "Rank mismatch" }
+ call as_shape( ((/ 1 /)) )
+ call as_shape(a(1)) ! { dg-error "Rank mismatch" }
+ call as_shape(b(1)) ! { dg-error "Rank mismatch" }
+ call as_shape(c(1)) ! { dg-error "Rank mismatch" }
+ call as_shape(d(1)) ! { dg-error "Rank mismatch" }
+ call as_shape( (a(1)) ) ! { dg-error "Rank mismatch" }
+ call as_shape( (b(1)) ) ! { dg-error "Rank mismatch" }
+ call as_shape( (c(1)) ) ! { dg-error "Rank mismatch" }
+ call as_shape( (d(1)) ) ! { dg-error "Rank mismatch" }
+ call as_shape(a(1:2))
+ call as_shape(b(1:2))
+ call as_shape(c(1:2))
+ call as_shape(d(1:2))
+ call as_shape( (a(1:2)) )
+ call as_shape( (b(1:2)) )
+ call as_shape( (c(1:2)) )
+ call as_shape( (d(1:2)) )
+
+ call as_expl(a)
+ call as_expl(b)
+ call as_expl(c)
+ call as_expl(d)
+ call as_expl(e) ! { dg-error "Rank mismatch" }
+ call as_expl( 1 ) ! { dg-error "Rank mismatch" }
+ call as_expl( (/ 1, 2, 3 /) )
+ call as_expl( (a) )
+ call as_expl( (b) )
+ call as_expl( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call as_expl( (d) )
+ call as_expl( (e) ) ! { dg-error "Rank mismatch" }
+ call as_expl(a(1)) ! { dg-error "Element of assumed-shaped" }
+ call as_expl(b(1)) ! { dg-error "Element of assumed-shaped" }
+ call as_expl(c(1))
+ call as_expl(d(1))
+ call as_expl( (a(1)) ) ! { dg-error "Rank mismatch" }
+ call as_expl( (b(1)) ) ! { dg-error "Rank mismatch" }
+ call as_expl( (c(1)) ) ! { dg-error "Rank mismatch" }
+ call as_expl( (d(1)) ) ! { dg-error "Rank mismatch" }
+ call as_expl(a(1:3))
+ call as_expl(b(1:3))
+ call as_expl(c(1:3))
+ call as_expl(d(1:3))
+ call as_expl( (a(1:3)) )
+ call as_expl( (b(1:3)) )
+ call as_expl( (c(1:3)) )
+ call as_expl( (d(1:3)) )
+END SUBROUTINE test1
+
+SUBROUTINE as_size(a)
+ integer, dimension(*) :: a
+END SUBROUTINE as_size
+
+SUBROUTINE as_shape(a)
+ integer, dimension(:) :: a
+END SUBROUTINE as_shape
+
+SUBROUTINE as_expl(a)
+ integer, dimension(3) :: a
+END SUBROUTINE as_expl
+
+
+SUBROUTINE test2(a,b,c,d,e)
+ character(len=*), dimension(:) :: a
+ character(len=*), pointer, dimension(:) :: b
+ character(len=*), dimension(*) :: c
+ character(len=*), dimension(5) :: d
+ character(len=*) :: e
+
+ call cas_size(a)
+ call cas_size(b)
+ call cas_size(c)
+ call cas_size(d)
+ call cas_size(e) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size("abc") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size( (/"abc"/) )
+ call cas_size(a//"a")
+ call cas_size(b//"a")
+ call cas_size(c//"a") ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call cas_size(d//"a")
+ call cas_size(e//"a") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(("abc")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size( ((/"abc"/)) )
+ call cas_size(a(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(b(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(c(1)) ! OK in F95
+ call cas_size(d(1)) ! OK in F95
+ call cas_size((a(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size((b(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size((c(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size((d(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(a(1:2))
+ call cas_size(b(1:2))
+ call cas_size(c(1:2))
+ call cas_size(d(1:2))
+ call cas_size((a(1:2)//"a"))
+ call cas_size((b(1:2)//"a"))
+ call cas_size((c(1:2)//"a"))
+ call cas_size((d(1:2)//"a"))
+ call cas_size(a(:)(1:3))
+ call cas_size(b(:)(1:3))
+ call cas_size(d(:)(1:3))
+ call cas_size((a(:)(1:3)//"a"))
+ call cas_size((b(:)(1:3)//"a"))
+ call cas_size((d(:)(1:3)//"a"))
+ call cas_size(a(1:2)(1:3))
+ call cas_size(b(1:2)(1:3))
+ call cas_size(c(1:2)(1:3))
+ call cas_size(d(1:2)(1:3))
+ call cas_size((a(1:2)(1:3)//"a"))
+ call cas_size((b(1:2)(1:3)//"a"))
+ call cas_size((c(1:2)(1:3)//"a"))
+ call cas_size((d(1:2)(1:3)//"a"))
+ call cas_size(e(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size("abcd"(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size((e(1:3))) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(("abcd"(1:3)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+
+ call cas_shape(a)
+ call cas_shape(b)
+ call cas_shape(c) ! { dg-error "cannot be an assumed-size array" }
+ call cas_shape(d)
+ call cas_shape(e) ! { dg-error "Rank mismatch" }
+ call cas_shape("abc") ! { dg-error "Rank mismatch" }
+ call cas_shape( (/"abc"/) )
+ call cas_shape(a//"c")
+ call cas_shape(b//"c")
+ call cas_shape(c//"c") ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call cas_shape(d//"c")
+ call cas_shape(e//"c") ! { dg-error "Rank mismatch" }
+ call cas_shape(("abc")) ! { dg-error "Rank mismatch" }
+ call cas_shape( ((/"abc"/)) )
+ call cas_shape(a(1)) ! { dg-error "Rank mismatch" }
+ call cas_shape(b(1)) ! { dg-error "Rank mismatch" }
+ call cas_shape(c(1)) ! { dg-error "Rank mismatch" }
+ call cas_shape(d(1)) ! { dg-error "Rank mismatch" }
+ call cas_shape(a(1:2))
+ call cas_shape(b(1:2))
+ call cas_shape(c(1:2))
+ call cas_shape(d(1:2))
+ call cas_shape((a(1:2)//"a"))
+ call cas_shape((b(1:2)//"a"))
+ call cas_shape((c(1:2)//"a"))
+ call cas_shape((d(1:2)//"a"))
+ call cas_shape(a(:)(1:3))
+ call cas_shape(b(:)(1:3))
+ call cas_shape(d(:)(1:3))
+ call cas_shape((a(:)(1:3)//"a"))
+ call cas_shape((b(:)(1:3)//"a"))
+ call cas_shape((d(:)(1:3)//"a"))
+ call cas_shape(a(1:2)(1:3))
+ call cas_shape(b(1:2)(1:3))
+ call cas_shape(c(1:2)(1:3))
+ call cas_shape(d(1:2)(1:3))
+ call cas_shape((a(1:2)(1:3)//"a"))
+ call cas_shape((b(1:2)(1:3)//"a"))
+ call cas_shape((c(1:2)(1:3)//"a"))
+ call cas_shape((d(1:2)(1:3)//"a"))
+ call cas_size(e(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size("abcd"(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size((e(1:3))) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(("abcd"(1:3)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+
+ call cas_expl(a)
+ call cas_expl(b)
+ call cas_expl(c)
+ call cas_expl(d)
+ call cas_expl(e) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl("abc") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl((/"a","b","c"/))
+ call cas_expl(a//"a")
+ call cas_expl(b//"a")
+ call cas_expl(c//"a") ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call cas_expl(d//"a")
+ call cas_expl(e//"a") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(("abc")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(((/"a","b","c"/)))
+ call cas_expl(a(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(b(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(c(1)) ! OK in F95
+ call cas_expl(d(1)) ! OK in F95
+ call cas_expl((a(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl((b(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl((c(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl((d(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(a(1:3))
+ call cas_expl(b(1:3))
+ call cas_expl(c(1:3))
+ call cas_expl(d(1:3))
+ call cas_expl((a(1:3)//"a"))
+ call cas_expl((b(1:3)//"a"))
+ call cas_expl((c(1:3)//"a"))
+ call cas_expl((d(1:3)//"a"))
+ call cas_expl(a(:)(1:3))
+ call cas_expl(b(:)(1:3))
+ call cas_expl(d(:)(1:3))
+ call cas_expl((a(:)(1:3)))
+ call cas_expl((b(:)(1:3)))
+ call cas_expl((d(:)(1:3)))
+ call cas_expl(a(1:2)(1:3))
+ call cas_expl(b(1:2)(1:3))
+ call cas_expl(c(1:2)(1:3))
+ call cas_expl(d(1:2)(1:3))
+ call cas_expl((a(1:2)(1:3)//"a"))
+ call cas_expl((b(1:2)(1:3)//"a"))
+ call cas_expl((c(1:2)(1:3)//"a"))
+ call cas_expl((d(1:2)(1:3)//"a"))
+ call cas_expl(e(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl("abcd"(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl((e(1:3))) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(("abcd"(1:3)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+END SUBROUTINE test2
+
+SUBROUTINE cas_size(a)
+ character(len=*), dimension(*) :: a
+END SUBROUTINE cas_size
+
+SUBROUTINE cas_shape(a)
+ character(len=*), dimension(:) :: a
+END SUBROUTINE cas_shape
+
+SUBROUTINE cas_expl(a)
+ character(len=*), dimension(3) :: a
+END SUBROUTINE cas_expl
+END
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_12.f90 b/gcc/testsuite/gfortran.dg/argument_checking_12.f90
new file mode 100644
index 0000000000000000000000000000000000000000..dc5b5268ad600e9a46b758e293be5c60872cc8cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_12.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/34665
+!
+! Test argument checking
+!
+implicit none
+CONTAINS
+SUBROUTINE test2(a,b,c,d,e)
+ character(len=*), dimension(:) :: a
+ character(len=*), pointer, dimension(:) :: b
+ character(len=*), dimension(*) :: c
+ character(len=*), dimension(5) :: d
+ character(len=*) :: e
+
+ call cas_size(e)
+ call cas_size("abc")
+ call cas_size(e//"a")
+ call cas_size(("abc"))
+ call cas_size(a(1))
+ call cas_size(b(1))
+ call cas_size((a(1)//"a"))
+ call cas_size((b(1)//"a"))
+ call cas_size((c(1)//"a"))
+ call cas_size((d(1)//"a"))
+ call cas_size(e(1:3))
+ call cas_size("abcd"(1:3))
+ call cas_size((e(1:3)))
+ call cas_size(("abcd"(1:3)//"a"))
+ call cas_size(e(1:3))
+ call cas_size("abcd"(1:3))
+ call cas_size((e(1:3)))
+ call cas_size(("abcd"(1:3)//"a"))
+ call cas_expl(e)
+ call cas_expl("abc")
+ call cas_expl(e//"a")
+ call cas_expl(("abc"))
+ call cas_expl(a(1))
+ call cas_expl(b(1))
+ call cas_expl((a(1)//"a"))
+ call cas_expl((b(1)//"a"))
+ call cas_expl((c(1)//"a"))
+ call cas_expl((d(1)//"a"))
+ call cas_expl(e(1:3))
+ call cas_expl("abcd"(1:3))
+ call cas_expl((e(1:3)))
+ call cas_expl(("abcd"(1:3)//"a"))
+END SUBROUTINE test2
+
+SUBROUTINE cas_size(a)
+ character(len=*), dimension(*) :: a
+END SUBROUTINE cas_size
+
+SUBROUTINE cas_expl(a)
+ character(len=*), dimension(5) :: a
+END SUBROUTINE cas_expl
+END
+
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_3.f90 b/gcc/testsuite/gfortran.dg/argument_checking_3.f90
index e59a039564b0f46b3d9d2e4afe67621a2666998f..1e01c1f3326b3c08942938bd79d3a16d9ced548a 100644
--- a/gcc/testsuite/gfortran.dg/argument_checking_3.f90
+++ b/gcc/testsuite/gfortran.dg/argument_checking_3.f90
@@ -22,9 +22,9 @@ end interface
len2 = '12'
len4 = '1234'
- call foo(len2) ! { dg-warning "Type/rank mismatch in argument" }
- call foo("ca") ! { dg-warning "Type/rank mismatch in argument" }
- call bar("ca") ! { dg-warning "Type/rank mismatch in argument" }
+ call foo(len2) ! { dg-warning "Rank mismatch in argument" }
+ call foo("ca") ! { dg-warning "Rank mismatch in argument" }
+ call bar("ca") ! { dg-warning "Rank mismatch in argument" }
call foobar(len2) ! { dg-warning "contains too few elements" }
call foobar(len4)
call foobar("bar") ! { dg-warning "contains too few elements" }
diff --git a/gcc/testsuite/gfortran.dg/assumed_shape_ranks_1.f90 b/gcc/testsuite/gfortran.dg/assumed_shape_ranks_1.f90
index a22a45c109d63406795b7fe634b4e7c8a58ae09e..e24414ad355a4cf920a0cc82964a7e11a219b968 100644
--- a/gcc/testsuite/gfortran.dg/assumed_shape_ranks_1.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_shape_ranks_1.f90
@@ -14,8 +14,8 @@ end module addon
use addon
INTEGER :: I(2,2)
I=RESHAPE((/1,2,3,4/),(/2,2/))
- CALL TST(I) ! { dg-error "Type/rank mismatch in argument" }
- i = foo (i) ! { dg-error "Type/rank mismatch|Incompatible ranks" }
+ CALL TST(I) ! { dg-error "Rank mismatch in argument" }
+ i = foo (i) ! { dg-error "Rank mismatch|Incompatible ranks" }
CONTAINS
SUBROUTINE TST(I)
INTEGER :: I(:)
diff --git a/gcc/testsuite/gfortran.dg/c_assoc_2.f03 b/gcc/testsuite/gfortran.dg/c_assoc_2.f03
index 9bb2f1b6abceb4ac160e8967bce75c92c9e1c314..4b3b7963af9aab03523d30d769799cf19a181aa5 100644
--- a/gcc/testsuite/gfortran.dg/c_assoc_2.f03
+++ b/gcc/testsuite/gfortran.dg/c_assoc_2.f03
@@ -28,7 +28,7 @@ contains
call abort()
end if
- if(.not. c_associated(my_integer)) then ! { dg-error "Type/rank mismatch" }
+ if(.not. c_associated(my_integer)) then ! { dg-error "Type mismatch" }
call abort()
end if
end subroutine sub0
diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90
index b8a2a819b5192d84c05e53e878b5f6d549af446d..36a30672e32278ffa1e4cb0de6d2d56671d8cf3e 100644
--- a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90
@@ -20,7 +20,7 @@
USE cdf_aux_mod
INTEGER :: which
which = 1
- CALL set_bound(the_beta%parameters(1:which)) ! { dg-error "Type/rank mismatch" }
+ CALL set_bound(the_beta%parameters(1:which)) ! { dg-error "Rank mismatch" }
END SUBROUTINE cdf_beta
END MODULE cdf_beta_mod
diff --git a/gcc/testsuite/gfortran.dg/implicit_actual.f90 b/gcc/testsuite/gfortran.dg/implicit_actual.f90
index 2a6dd66c565b00f257ed4cb977ba15616463abd0..750d3f3850198f18e3289ee09fe0c0e4a645a762 100644
--- a/gcc/testsuite/gfortran.dg/implicit_actual.f90
+++ b/gcc/testsuite/gfortran.dg/implicit_actual.f90
@@ -16,7 +16,7 @@ program snafu
! use global
implicit type (t3) (z)
- call foo (zin) ! { dg-error "defined|Type/rank" }
+ call foo (zin) ! { dg-error "defined|Type mismatch" }
contains
diff --git a/gcc/testsuite/gfortran.dg/import2.f90 b/gcc/testsuite/gfortran.dg/import2.f90
index e597cfc30b97adad2342e326b3828aef818d611c..4a0128a0bf15968fb8c19028581280ca54b63534 100644
--- a/gcc/testsuite/gfortran.dg/import2.f90
+++ b/gcc/testsuite/gfortran.dg/import2.f90
@@ -71,10 +71,10 @@ program foo
integer(dp) :: i8
y%i = 2
i8 = 8
- call bar(y,i8) ! { dg-error "Type/rank mismatch in argument" }
+ call bar(y,i8) ! { dg-error "Type mismatch in argument" }
if(y%i /= 5 .or. i8/= 42) call abort()
z%i = 7
- call test(z) ! { dg-error "Type/rank mismatch in argument" }
+ call test(z) ! { dg-error "Type mismatch in argument" }
if(z%i /= 1) call abort()
end program foo
! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/pointer_intent_2.f90 b/gcc/testsuite/gfortran.dg/pointer_intent_2.f90
index 88e9a0823b06cc499fe18bf1733979559e95c05e..692570339a36cac20e292bf799ad4a6d0b25aa2e 100644
--- a/gcc/testsuite/gfortran.dg/pointer_intent_2.f90
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_2.f90
@@ -11,7 +11,7 @@ program test
integer, pointer :: p
allocate(p)
p = 33
- call a(p) ! { dg-error "Type/rank mismatch in argument" }
+ call a(p) ! { dg-error "Type mismatch in argument" }
contains
subroutine a(p)! { dg-error "has no IMPLICIT type" }
integer, pointer,intent(in) :: p ! { dg-error "POINTER attribute with INTENT attribute" }
diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_3.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_3.f90
index 5bc4523dd8d66bb8b58c63a556cfb75391163bd2..a308c0e374a5773a98e6313267926f1274fb75d8 100644
--- a/gcc/testsuite/gfortran.dg/used_dummy_types_3.f90
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_3.f90
@@ -31,7 +31,7 @@
USE T1
USE T2 , ONLY : TEST
TYPE(data_type) :: x
- CALL TEST(x) ! { dg-error "Type/rank mismatch in argument" }
+ CALL TEST(x) ! { dg-error "Type mismatch in argument" }
END
! { dg-final { cleanup-modules "T1 T2" } }
diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_4.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_4.f90
index 4bc7c3868950bfea58072eeeced788202ce670de..fb36fa7bfbd657c80b3813ff9fc37df4ae9d11f3 100644
--- a/gcc/testsuite/gfortran.dg/used_dummy_types_4.f90
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_4.f90
@@ -47,7 +47,7 @@ end module global
! These are different.
st1 = dt ! { dg-error "convert REAL" }
- call foo (st1) ! { dg-error "Type/rank mismatch in argument" }
+ call foo (st1) ! { dg-error "Type mismatch in argument" }
contains