mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-12-02 16:23:56 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

re PR fortran/36341 (MATMUL: Bounds check missing)

Browse Source 
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
This commit is contained in:
Thomas Koenig 2008-06-29 19:06:06 +00:00
parent 082b0571b5
commit 986a8d11c7
4 changed files with 64 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -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

28
gcc/fortran/iresolve.c
View File

@ -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);

5
gcc/testsuite/ChangeLog
View File

@ -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

25
gcc/testsuite/gfortran.dg/matmul_bounds_1.f90 Normal file
View File

@ -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