+2006-02-14 Thomas Koenig <Thomas.Koenig@online.de>
+
+ PR fortran/25045
+ * check.c (dim_check): Perform all checks if dim is optional.
+ (gfc_check_minloc_maxloc): Use dim_check and dim_rank_check
+ to check dim argument.
+ (check_reduction): Likewise.
+
2006-02-14 Tobias Schl\81üter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/26277
static try
dim_check (gfc_expr * dim, int n, int optional)
{
- if (optional)
- {
- if (dim == NULL)
- return SUCCESS;
-
- if (nonoptional_check (dim, n) == FAILURE)
- return FAILURE;
-
- return SUCCESS;
- }
+ if (optional && dim == NULL)
+ return SUCCESS;
if (dim == NULL)
{
if (scalar_check (dim, n) == FAILURE)
return FAILURE;
+ if (nonoptional_check (dim, n) == FAILURE)
+ return FAILURE;
+
return SUCCESS;
}
ap->next->next->expr = m;
}
- if (d != NULL
- && (scalar_check (d, 1) == FAILURE
- || type_check (d, 1, BT_INTEGER) == FAILURE))
+ if (dim_check (d, 1, 1) == FAILURE)
+ return FAILURE;
+
+ if (dim_rank_check (d, a, 0) == FAILURE)
return FAILURE;
if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE)
ap->next->next->expr = m;
}
- if (d != NULL
- && (scalar_check (d, 1) == FAILURE
- || type_check (d, 1, BT_INTEGER) == FAILURE))
+ if (dim_check (d, 1, 1) == FAILURE)
+ return FAILURE;
+
+ if (dim_rank_check (d, a, 0) == FAILURE)
return FAILURE;
if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE)
--- /dev/null
+! { dg-do compile }
+subroutine foo(a,n)
+ real, dimension(2) :: a
+ integer, optional :: n
+ print *,maxloc(a,dim=n) ! { dg-error "must not be OPTIONAL" }
+ print *,maxloc(a,dim=4) ! { dg-error "is not a valid dimension index" }
+ print *,maxval(a,dim=n) ! { dg-error "must not be OPTIONAL" }
+ print *,maxval(a,dim=4) ! { dg-error "is not a valid dimension index" }
+end subroutine foo
+