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]

[fortran, patch] PR31919, ice if array arguments are not conformable


This patch adds a check for array conformance to the MIN/MAX family of 
intrinsics:

$> cat pr31919.f90
integer :: a(2, 2), b(2)
print *, min(a, b)
end

$> gfortran-svn pr31919.f90
pr31919.f90:2.13:

print *, min(a, b)
            1
Error: Incompatible ranks in min at (1)


:ADDPATCH fortran:

gcc/fortran
2007-05-14  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/31919
        * check.c (check_rest): Added check for array conformance.

gcc/testsuite
2007-05-14  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/31919
        * gfortran.dg/pr31919.f90: New test.


Regression tested on i686-pc-linux-gnu without regressions. 
Ok for trunk and 4.2 after re-opening?

Regards
	Daniel
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 124718)
+++ gcc/fortran/check.c	(working copy)
@@ -1491,7 +1491,7 @@
 static try
 check_rest (bt type, int kind, gfc_actual_arglist *arg)
 {
-  gfc_expr *x;
+  gfc_expr *x, *first_arg;
   int n;
 
   if (min_max_args (arg) == FAILURE)
@@ -1499,6 +1499,7 @@
 
   n = 1;
 
+  first_arg = arg->expr;
   for (; arg; arg = arg->next, n++)
     {
       x = arg->expr;
@@ -1518,6 +1519,9 @@
 	      return FAILURE;
 	    }
 	}
+
+        if (gfc_check_conformance(gfc_current_intrinsic, first_arg, x) == FAILURE)
+          return FAILURE;
     }
 
   return SUCCESS;
Index: gcc/testsuite/gfortran.dg/pr31919.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr31919.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/pr31919.f90	(revision 0)
@@ -0,0 +1,20 @@
+! { dg-compile }
+program pr31919
+  integer :: i4a(2, 2), i4b(2)
+  real(4) :: r4a(2, 2), r4b(2)
+  real(8) :: r8a(2, 2), r8b(2)
+
+  i4a = max(i4a, i4b)            ! { dg-error "Incompatible ranks" }
+  i4a = max0(i4a, i4b)           ! { dg-error "Incompatible ranks" }
+  r4a = amax0(i4a, i4b)          ! { dg-error "Incompatible ranks" }
+  i4a = max1(r4a, r4b)           ! { dg-error "Incompatible ranks" }
+  r4a = amax1(r4a, r4b)          ! { dg-error "Incompatible ranks" }
+  r8a = dmax1(r8a, r8b)          ! { dg-error "Incompatible ranks" }
+
+  i4a = min(i4a, i4b)            ! { dg-error "Incompatible ranks" }
+  i4a = min0(i4a, i4b)           ! { dg-error "Incompatible ranks" }
+  i4a = amin0(i4a, i4b)          ! { dg-error "Incompatible ranks" }
+  r4a = min1(r4a, r4b)           ! { dg-error "Incompatible ranks" }
+  r4a = amin1(r4a, r4b)          ! { dg-error "Incompatible ranks" }
+  r8a = dmin1(r8a, r8b)          ! { dg-error "Incompatible ranks" }
+end program

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