Fix PR libfortran/21926 matmul does not deal with non-packed result

Thomas Koenig Thomas.Koenig@online.de
Mon Jun 6 19:55:00 GMT 2005


This has been regression-tested on mainline.  OK?

This patch doesn't apply cleanly with 4.0, because of a cast
intrduced for cleanup, but the port is straightforward.

OK to apply the equivalent patch once the 4.0 branch reopens?

	Thomas

2005-06-06  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/21926
	* m4/matmul.m4:  Correct zeroing of result for non-packed
	arrays with lowest stride is one.
	* generated/matmul_c4.c:  Regenerated.
	* generated/matmul_c8.c:  Regenerated.
	* generated/matmul_i4.c:  Regenerated.
	* generated/matmul_i8.c:  Regenerated.
	* generated/matmul_r4.c:  Regenerated.
	* generated/matmul_r8.c:  Regenerated.

2005-06-06  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/21926
	* gfortran.fortran-torture/execute/intrinsic_matmul.f90:
	Test a case where the return array has lowest stride one,
	but isn't packed.

-------------- next part --------------
Index: matmul.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/matmul.m4,v
retrieving revision 1.12
diff -c -p -r1.12 matmul.m4
*** matmul.m4	15 May 2005 12:49:42 -0000	1.12
--- matmul.m4	6 Jun 2005 19:15:34 -0000
*************** sinclude(`matmul_asm_'rtype_code`.m4')dn
*** 180,186 ****
        rtype_name *abase_n;
        rtype_name bbase_yn;
  
!       memset (dest, 0, (sizeof (rtype_name) * size0((array_t *) retarray)));
  
        for (y = 0; y < ycount; y++)
  	{
--- 180,193 ----
        rtype_name *abase_n;
        rtype_name bbase_yn;
  
!       if (rystride == ycount)
! 	memset (dest, 0, (sizeof (rtype_name) * size0((array_t *) retarray)));
!       else
! 	{
! 	  for (y = 0; y < ycount; y++)
! 	    for (x = 0; x < xcount; x++)
! 	      dest[x + y*rystride] = (rtype_name)0;
! 	}
  
        for (y = 0; y < ycount; y++)
  	{
-------------- next part --------------
Index: intrinsic_matmul.f90
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_matmul.f90,v
retrieving revision 1.2
diff -c -p -r1.2 intrinsic_matmul.f90
*** intrinsic_matmul.f90	13 May 2004 06:40:53 -0000	1.2
--- intrinsic_matmul.f90	6 Jun 2005 19:37:50 -0000
*************** program intrinsic_matmul
*** 7,12 ****
--- 7,14 ----
     integer, dimension(3) :: y
     integer, dimension(2, 2) :: r
     integer, dimension(3) :: v
+    real, dimension (2,2) :: aa
+    real, dimension (4,2) :: cc
  
     a = reshape((/1, 2, 2, 3, 3, 4/), (/2, 3/))
     b = reshape((/1, 2, 3, 3, 4, 5/), (/3, 2/))
*************** program intrinsic_matmul
*** 21,24 ****
--- 23,32 ----
  
     v(1:2) = matmul(a, y)
     if (any(v(1:2) .ne. (/14, 20/))) call abort
+ 
+   aa = reshape((/ 1.0, 1.0, 0.0, 1.0/), shape(aa))
+   cc = 42.
+   cc(1:2,1:2) = matmul(aa, transpose(aa))
+   if (any(cc(1:2,1:2) .ne. reshape((/ 1.0, 1.0, 1.0, 2.0 /), (/2,2/)))) call abort
+   if (any(cc(3:4,1:2) .ne. 42.)) call abort
  end program


More information about the Fortran mailing list