From 7114ab45797aeeca8ef7ca25b215319d551a2b1c Mon Sep 17 00:00:00 2001
From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Tue, 6 Jul 2010 19:48:58 +0000
Subject: [PATCH] PR fortran/PR44693
2010-07-06 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/PR44693
* check.c (dim_rank_check): Also check intrinsic functions.
Adjust permissible rank for functions which reduce the rank of
their argument. Spread is an exception, where DIM can
be one larger than the rank of array.
2010-07-06 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/PR44693
* gfortran.dg/dim_range_1.f90: New test.
* gfortran.dg/minmaxloc_4.f90: Remove invalid test.
From-SVN: r161884
---
gcc/fortran/ChangeLog | 8 ++++++++
gcc/fortran/check.c | 11 +++++++----
gcc/testsuite/ChangeLog | 5 +++++
gcc/testsuite/gfortran.dg/dim_range_1.f90 | 17 +++++++++++++++++
gcc/testsuite/gfortran.dg/minmaxloc_4.f90 | 6 ------
5 files changed, 37 insertions(+), 10 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dim_range_1.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7714abf4d381..0d43b6c63e6c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2010-07-06 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/PR44693
+ * check.c (dim_rank_check): Also check intrinsic functions.
+ Adjust permissible rank for functions which reduce the rank of
+ their argument. Spread is an exception, where DIM can
+ be one larger than the rank of array.
+
2010-07-05 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/44797
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 345271724315..27bd900f9e3e 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -473,12 +473,15 @@ dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed)
if (dim == NULL)
return SUCCESS;
- if (dim->expr_type != EXPR_CONSTANT
- || (array->expr_type != EXPR_VARIABLE
- && array->expr_type != EXPR_ARRAY))
+ if (dim->expr_type != EXPR_CONSTANT)
return SUCCESS;
- rank = array->rank;
+ if (array->expr_type == EXPR_FUNCTION && array->value.function.isym
+ && array->value.function.isym->id == GFC_ISYM_SPREAD)
+ rank = array->rank + 1;
+ else
+ rank = array->rank;
+
if (array->expr_type == EXPR_VARIABLE)
{
ar = gfc_find_array_ref (array);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6fc6b3bfdec5..80822314516f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-07-06 Thomas Koenig <tkoenig@gcc.gnu.org>
+ PR fortran/PR44693
+ * gfortran.dg/dim_range_1.f90: New test.
+ * gfortran.dg/minmaxloc_4.f90: Remove invalid test.
+
2010-07-06 Jason Merrill <jason@redhat.com>
PR c++/44703
diff --git a/gcc/testsuite/gfortran.dg/dim_range_1.f90 b/gcc/testsuite/gfortran.dg/dim_range_1.f90
new file mode 100644
index 000000000000..59f3f431143e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dim_range_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR 44693 - check for invalid dim even in functions.
+! Based on a test case by Dominique d'Humieres.
+subroutine test1(esss,Ix,Iyz, n)
+ real(kind=kind(1.0d0)), dimension(n), intent(out) :: esss
+ real(kind=kind(1.0d0)), dimension(n,n,n) :: sp
+ real(kind=kind(1.0d0)), dimension(n,n) :: Ix,Iyz
+ esss = sum(Ix * Iyz, 0) ! { dg-error "is not a valid dimension index" }
+ esss = sum(Ix * Iyz, 1)
+ esss = sum(Ix * Iyz, 2)
+ esss = sum(Ix * Iyz, 3) ! { dg-error "is not a valid dimension index" }
+ sp = spread (ix * iyz, 0, n) ! { dg-error "is not a valid dimension index" }
+ sp = spread (ix * iyz, 1, n)
+ sp = spread (ix * iyz, 2, n)
+ sp = spread (ix * iyz, 3, n)
+ sp = spread (ix * iyz, 4, n) ! { dg-error "is not a valid dimension index" }
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_4.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_4.f90
index 2ea2e7b86abd..673739518dcb 100644
--- a/gcc/testsuite/gfortran.dg/minmaxloc_4.f90
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_4.f90
@@ -3,7 +3,6 @@
PROGRAM TST
IMPLICIT NONE
REAL :: A(1,3)
- REAL :: B(3,1)
A(:,1) = 10
A(:,2) = 20
A(:,3) = 30
@@ -13,9 +12,4 @@ PROGRAM TST
if (minloc(sum(a(:,1:3),1),1) .ne. 1) call abort()
if (maxloc(sum(a(:,1:3),1),1) .ne. 3) call abort()
- B(1,:) = 10
- B(2,:) = 20
- B(3,:) = 30
- if (minloc(sum(b(1:3,:),2),2) .ne. 1) call abort()
- if (maxloc(sum(b(1:3,:),2),2) .ne. 3) call abort()
END PROGRAM TST
--
GitLab