diff options
| author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2008-06-29 19:06:06 +0000 |
|---|---|---|
| committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2008-06-29 19:06:06 +0000 |
| commit | 986a8d11c7dc58e3fbe44aa6b6018a04cd0093b8 (patch) | |
| tree | 9416e6dafab840d6567e990de213db8bceb34a6d /gcc | |
| parent | 082b0571b5243222c59703a96c2c4cb6e438bad8 (diff) | |
| download | gcc-986a8d11c7dc58e3fbe44aa6b6018a04cd0093b8.zip gcc-986a8d11c7dc58e3fbe44aa6b6018a04cd0093b8.tar.gz gcc-986a8d11c7dc58e3fbe44aa6b6018a04cd0093b8.tar.bz2 | |
re PR fortran/36341 (MATMUL: Bounds check missing)
2008-06-29 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36341
* iresolve.c (gfc_resolve_matmul): Copy shapes
from arguments.
2008-06-29 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36341
* gfortran.dg/matmul_bounds_1.f90: New test.
From-SVN: r137255
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/iresolve.c | 28 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/matmul_bounds_1.f90 | 25 |
4 files changed, 64 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f29b380..a54a0b1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2008-06-29 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/36341 + * iresolve.c (gfc_resolve_matmul): Copy shapes + from arguments. + 2008-06-29 Jerry DeLisle <jvdelisle@gcc.gnu.org> * invoke.texi: Add documentation for runtime behavior of diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index acbf5be..a1e7622 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -1341,6 +1341,34 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b) f->rank = (a->rank == 2 && b->rank == 2) ? 2 : 1; + if (a->rank == 2 && b->rank == 2) + { + if (a->shape && b->shape) + { + f->shape = gfc_get_shape (f->rank); + mpz_init_set (f->shape[0], a->shape[0]); + mpz_init_set (f->shape[1], b->shape[1]); + } + } + else if (a->rank == 1) + { + if (b->shape) + { + f->shape = gfc_get_shape (f->rank); + mpz_init_set (f->shape[0], b->shape[1]); + } + } + else + { + /* b->rank == 1 and a->rank == 2 here, all other cases have + been caught in check.c. */ + if (a->shape) + { + f->shape = gfc_get_shape (f->rank); + mpz_init_set (f->shape[0], a->shape[0]); + } + } + f->value.function.name = gfc_get_string (PREFIX ("matmul_%c%d"), gfc_type_letter (f->ts.type), f->ts.kind); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bda6acb..f2fbbb0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-06-29 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/36341 + * gfortran.dg/matmul_bounds_1.f90: New test. + 2008-06-29 Jakub Jelinek <jakub@redhat.com> PR testsuite/36620 diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_1.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_1.f90 new file mode 100644 index 0000000..1d180a0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/matmul_bounds_1.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +program matmul_bounds_1 + implicit none + real, dimension(3,2) :: a + real, dimension(2,3) :: b + real, dimension(3,2) :: rab + real, dimension(2,2) :: rok + real, dimension(2) :: rv + real, dimension(3) :: rw + real, dimension(3) :: x + real, dimension(2) :: y + a = 1 + b = 2 + x = 3 + y = 4 + ! These tests should throw an error + rab = matmul(a,b) ! { dg-error "Different shape" } + rv = matmul(a,y) ! { dg-error "Different shape" } + rv = matmul(x,b) ! { dg-error "Different shape" } + ! These are ok. + rw = matmul(a,y) + rv = matmul(x,a) + rok = matmul(b,a) +end program matmul_bounds_1 + |