diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f29b380c40bf0811b5f1b525beb78eb8c7904b78..a54a0b14909bc4fb13c7cf00880c66f1f9fc961d 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 acbf5becff0c62c954beb288f7055c0ac4ce57dd..a1e7622a866fe67837de985b9ae4c87e3668bb94 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 bda6acbfebb0ff4b03eed5311414554a7036fcbc..f2fbbb0f95c87034518a6f7acb0c322bfa35e7db 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 0000000000000000000000000000000000000000..1d180a0d45863b4ad195068b8a6a9382a295c25e --- /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 +