This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch, fortran] Fix PR 36341, compile-time part


Hello world,

this fixes the compile-time part of PR 36341, where the shape of matmul
wasn't calculated from its arguments if these were known.

Dominique reported a Heisenbug found during testing in the PR, which may
or may not have  I can't really think what may have caused this, but I'd
like to get a bit more feedback before committing.

Regression-tested on i686-pc-linux-gnu, without any more regressions
than those in PR 36458 and PR 36534, which are unrelated.

OK for trunk?

	Thomas

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.

Index: iresolve.c
===================================================================
--- iresolve.c	(revision 137216)
+++ iresolve.c	(working copy)
@@ -1341,6 +1341,34 @@ gfc_resolve_matmul (gfc_expr *f, gfc_exp
 
   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);
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" }
program main
  integer(kind=4), allocatable :: f(:,:)
  integer(kind=4) :: res(3)
  character(len=80) line
  allocate (f(2,2))
  f = 3
  res = maxloc(f,dim=1)
  write(line,fmt='(80I1)') res
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" }


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]