This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC 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] PR32001 - ICE in min/max intrinsics with multiple arguments


MIN/MAX intrinsics allow multiple arguments which the associated checking 
routine gets provided in an 'gfc_actual_arglist' and not, as usual, in a 
global array of fixed size. To assemble the error message, the latter was 
used, which may result in an ICE if the number of arguments to MIN/MAX is 
larger than the array size.

In addition, the code compared each argument against the first one only. Thus 
code like this would not be flagged:

INTEGER :: a, b(2), c(3), res(3)
res = max(a, b, c)

Although SHAPE(c) /= SHAPE(C), B and C are conform with A respectively. 
Attached patch fixes both problems.


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

	PR fortran/32001
	* check.c (check_rest): Improved argument conformance check and fixed 
	error message generation.


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

	PR fortran/32001
	* min_max_conformance.f90: Added more testcases.


Richard confirmed in private mail that the patch fixes the problem in 
SPEC2k/fma3d and it regtested cleanly on i686-pc-linux-gnu. Ok for trunk?

	Daniel
Index: fortran/check.c
===================================================================
--- fortran/check.c	(revision 124794)
+++ fortran/check.c	(working copy)
@@ -1486,19 +1486,17 @@
 
 
 static try
-check_rest (bt type, int kind, gfc_actual_arglist *arg)
+check_rest (bt type, int kind, gfc_actual_arglist *arglist)
 {
-  gfc_expr *x, *first_arg;
-  int n;
-  char buffer[80];
+  gfc_actual_arglist *arg, *tmp;
 
-  if (min_max_args (arg) == FAILURE)
+  gfc_expr *x;
+  int m, n;
+
+  if (min_max_args (arglist) == FAILURE)
     return FAILURE;
 
-  n = 1;
-
-  first_arg = arg->expr;
-  for (; arg; arg = arg->next, n++)
+  for (arg = arglist, n=1; arg; arg = arg->next, n++)
     {
       x = arg->expr;
       if (x->ts.type != type || x->ts.kind != kind)
@@ -1518,11 +1516,14 @@
 	    }
 	}
 
-      snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
-		gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n-1],
-		gfc_current_intrinsic);
-      if (gfc_check_conformance (buffer, first_arg, x) == FAILURE)
-        return FAILURE;
+      for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++)
+        {
+	  char buffer[80];
+	  snprintf (buffer, 80, "arguments 'a%d' and 'a%d' for intrinsic '%s'",
+		    m, n, gfc_current_intrinsic);
+	  if (gfc_check_conformance (buffer, tmp->expr, x) == FAILURE)
+	    return FAILURE;
+	}
     }
 
   return SUCCESS;
Index: testsuite/gfortran.dg/min_max_conformance.f90
===================================================================
--- testsuite/gfortran.dg/min_max_conformance.f90	(revision 124794)
+++ testsuite/gfortran.dg/min_max_conformance.f90	(working copy)
@@ -1,9 +1,10 @@
 ! { dg-compile }
+! { dg-options "-fmax-errors=0" }
 ! PR 31919:  Tests for different ranks in min/max were missing.
 program pr31919
-  integer :: i4a(2, 2), i4b(2), i4c(4)
-  real(4) :: r4a(2, 2), r4b(2), r4c(4)
-  real(8) :: r8a(2, 2), r8b(2), r8c(4)
+  integer :: i4, i4a(2, 2), i4b(2), i4c(4)
+  real(4) :: r4, r4a(2, 2), r4b(2), r4c(4)
+  real(8) :: r8, r8a(2, 2), r8b(2), r8c(4)
 
   i4a = max(i4a, i4b)            ! { dg-error "Incompatible ranks" }
   i4a = max0(i4a, i4b)           ! { dg-error "Incompatible ranks" }
@@ -32,4 +33,19 @@
   r4a = min1(r4b, r4c)           ! { dg-error "different shape for arguments" }
   r4a = amin1(r4b, r4c)          ! { dg-error "different shape for arguments" }
   r8a = dmin1(r8b, r8c)          ! { dg-error "different shape for arguments" }
+
+  ! checking needs to be position independent
+  i4a = min(i4, i4a, i4, i4b)    ! { dg-error "Incompatible ranks" }
+  r4a = min(r4, r4a, r4, r4b)    ! { dg-error "Incompatible ranks" }
+  r8a = min(r8, r8a, r8, r8b)    ! { dg-error "Incompatible ranks" }
+  i4a = min(i4, i4b, i4, i4c)    ! { dg-error "different shape for arguments" }
+  r4a = min(r4, r4b, r4, r4c)    ! { dg-error "different shape for arguments" }
+  r8a = min(r8, r8b, r8, r8c)    ! { dg-error "different shape for arguments" }
+
+  i4a = max(i4, i4a, i4, i4b)    ! { dg-error "Incompatible ranks" }
+  r4a = max(r4, r4a, r4, r4b)    ! { dg-error "Incompatible ranks" }
+  r8a = max(r8, r8a, r8, r8b)    ! { dg-error "Incompatible ranks" }
+  i4a = max(i4, i4b, i4, i4c)    ! { dg-error "different shape for arguments" }
+  r4a = max(r4, r4b, r4, r4c)    ! { dg-error "different shape for arguments" }
+  r8a = max(r8, r8b, r8, r8c)    ! { dg-error "different shape for arguments" }
 end program

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