mirrors/gcc
1
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-25 20:03:58 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

re PR fortran/28947 (Double MATMUL() uses wrong array elements)

Browse Source 
2006-09-10  Paul Thomas  <pault@gcc.gnu.org>

	PR libfortran/28947
	* m4/matmul.m4: For the case where the second input argument is
	transposed, ensure that the case with rank (a) == 1 is
	correctly calculated.
	* generated/matmul_r4.c: Regenerate.
	* generated/matmul_r8.c: Regenerate.
	* generated/matmul_r10.c: Regenerate.
	* generated/matmul_r16.c: Regenerate.
	* generated/matmul_c4.c: Regenerate.
	* generated/matmul_c8.c: Regenerate.
	* generated/matmul_c10.c: Regenerate.
	* generated/matmul_c16.c: Regenerate.
	* generated/matmul_i4.c: Regenerate.
	* generated/matmul_i8.c: Regenerate.
	* generated/matmul_i16.c: Regenerate.


2006-09-10  Paul Thomas  <pault@gcc.gnu.org>

	PR libfortran/28947
	gfortran.dg/matmul_4.f90: New test.

From-SVN: r116817
This commit is contained in:
Paul Thomas 2006-09-10 17:21:44 +00:00
parent 380bfbbd61
commit f0e871d647
15 changed files with 213 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2006-09-10 Paul Thomas <pault@gcc.gnu.org>
PR libfortran/28947
gfortran.dg/matmul_4.f90: New test.
2006-09-10 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28959

22
gcc/testsuite/gfortran.dg/matmul_4.f90 Normal file
View File

@ -0,0 +1,22 @@
! { dg-do run }
! Check the fix for PR28947, in which the mechanism for dealing
! with matmul (a, transpose (b)) would cause wrong results for
! a having a rank == 1.
!
! Contributed by Harald Anlauf <anlauf@gmx.de>
!
program gfcbug40
implicit none
real :: h(3,3), mat(2,3)
h(:,:) = - HUGE (1.0)/4 ! Preset unused elements suitably...
h(3,:) = 0
h(3,3) = 1
mat(:,:) = 1
h(3,:) = h(3,:) + matmul (matmul (h(3,:), transpose (mat)), mat)
if (any (h(3,:) .ne. (/2.0, 2.0, 3.0/))) call abort ()
end program gfcbug40

18
libgfortran/ChangeLog
View File

@ -1,3 +1,21 @@
2006-09-10 Paul Thomas <pault@gcc.gnu.org>
PR libfortran/28947
* m4/matmul.m4: For the case where the second input argument is
transposed, ensure that the case with rank (a) == 1 is
correctly calculated.
* generated/matmul_r4.c: Regenerate.
* generated/matmul_r8.c: Regenerate.
* generated/matmul_r10.c: Regenerate.
* generated/matmul_r16.c: Regenerate.
* generated/matmul_c4.c: Regenerate.
* generated/matmul_c8.c: Regenerate.
* generated/matmul_c10.c: Regenerate.
* generated/matmul_c16.c: Regenerate.
* generated/matmul_i4.c: Regenerate.
* generated/matmul_i8.c: Regenerate.
* generated/matmul_i16.c: Regenerate.
2006-08-27 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/28354

14
libgfortran/generated/matmul_c10.c
View File

@ -258,6 +258,20 @@ matmul_c10 (gfc_array_c10 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_COMPLEX_10 *restrict bbase_y;
GFC_COMPLEX_10 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_COMPLEX_10) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_COMPLEX_10 *restrict abase_x;

14
libgfortran/generated/matmul_c16.c
View File

@ -258,6 +258,20 @@ matmul_c16 (gfc_array_c16 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_COMPLEX_16 *restrict bbase_y;
GFC_COMPLEX_16 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_COMPLEX_16) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_COMPLEX_16 *restrict abase_x;

14
libgfortran/generated/matmul_c4.c
View File

@ -258,6 +258,20 @@ matmul_c4 (gfc_array_c4 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_COMPLEX_4 *restrict bbase_y;
GFC_COMPLEX_4 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_COMPLEX_4) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_COMPLEX_4 *restrict abase_x;

14
libgfortran/generated/matmul_c8.c
View File

@ -258,6 +258,20 @@ matmul_c8 (gfc_array_c8 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_COMPLEX_8 *restrict bbase_y;
GFC_COMPLEX_8 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_COMPLEX_8) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_COMPLEX_8 *restrict abase_x;

14
libgfortran/generated/matmul_i16.c
View File

@ -258,6 +258,20 @@ matmul_i16 (gfc_array_i16 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_INTEGER_16 *restrict bbase_y;
GFC_INTEGER_16 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_INTEGER_16) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_INTEGER_16 *restrict abase_x;

14
libgfortran/generated/matmul_i4.c
View File

@ -258,6 +258,20 @@ matmul_i4 (gfc_array_i4 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_INTEGER_4 *restrict bbase_y;
GFC_INTEGER_4 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_INTEGER_4) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_INTEGER_4 *restrict abase_x;

14
libgfortran/generated/matmul_i8.c
View File

@ -258,6 +258,20 @@ matmul_i8 (gfc_array_i8 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_INTEGER_8 *restrict bbase_y;
GFC_INTEGER_8 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_INTEGER_8) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_INTEGER_8 *restrict abase_x;

14
libgfortran/generated/matmul_r10.c
View File

@ -258,6 +258,20 @@ matmul_r10 (gfc_array_r10 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_REAL_10 *restrict bbase_y;
GFC_REAL_10 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_REAL_10) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_REAL_10 *restrict abase_x;

14
libgfortran/generated/matmul_r16.c
View File

@ -258,6 +258,20 @@ matmul_r16 (gfc_array_r16 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_REAL_16 *restrict bbase_y;
GFC_REAL_16 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_REAL_16) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_REAL_16 *restrict abase_x;

14
libgfortran/generated/matmul_r4.c
View File

@ -258,6 +258,20 @@ matmul_r4 (gfc_array_r4 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_REAL_4 *restrict bbase_y;
GFC_REAL_4 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_REAL_4) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_REAL_4 *restrict abase_x;

14
libgfortran/generated/matmul_r8.c
View File

@ -258,6 +258,20 @@ matmul_r8 (gfc_array_r8 * const restrict retarray,
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const GFC_REAL_8 *restrict bbase_y;
GFC_REAL_8 s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (GFC_REAL_8) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const GFC_REAL_8 *restrict abase_x;

14
libgfortran/m4/matmul.m4
View File

@ -260,6 +260,20 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
/* dest[x,y] += a[x,n] * b[n,y] */
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
else if (GFC_DESCRIPTOR_RANK (a) == 1)
{
const rtype_name *restrict bbase_y;
rtype_name s;
for (y = 0; y < ycount; y++)
{
bbase_y = &bbase[y*bystride];
s = (rtype_name) 0;
for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s;
}
}
else
{
const rtype_name *restrict abase_x;