[patch, libfortran] Fix PR 35595

[Thomas Koenig <tkoenig at netcologne dot de>]

Hello world,

the attached patch, rather obviously, fixes PR 35595.
Regression-tested on i686-pc-linux-gnu.  I couldn't think
of a better name for the testcase, as
intrinsic_maxlocminlocminvalmaxvalsumanyandcountsumproduct_1.f90
would have been awkward, but suggestions are certainly welcome :-)

OK for trunk?  What about 4.3?

	Thomas

2008-05-04  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/35595
	* m4/ifunction_logical.m4:  If the extent of "array"
	is less than zero, set it to zero.  Use an explicit
	flag for breaking out of the main loop to avoid, because
	the data pointer for "array" may be NULL for an empty
	array.
	* m4/ifunction.m4:  Likewise.
	* generated/all_l1.c: Regenerated.
	* generated/all_l16.c: Regenerated.
	* generated/all_l2.c: Regenerated.
	* generated/all_l4.c: Regenerated.
	* generated/all_l8.c: Regenerated.
	* generated/any_l1.c: Regenerated.
	* generated/any_l16.c: Regenerated.
	* generated/any_l2.c: Regenerated.
	* generated/any_l4.c: Regenerated.
	* generated/any_l8.c: Regenerated.
	* generated/count_16_l.c: Regenerated.
	* generated/count_1_l.c: Regenerated.
	* generated/count_2_l.c: Regenerated.
	* generated/count_4_l.c: Regenerated.
	* generated/count_8_l.c: Regenerated.
	* generated/maxloc1_16_i1.c: Regenerated.
	* generated/maxloc1_16_i16.c: Regenerated.
	* generated/maxloc1_16_i2.c: Regenerated.
	* generated/maxloc1_16_i4.c: Regenerated.
	* generated/maxloc1_16_i8.c: Regenerated.
	* generated/maxloc1_16_r10.c: Regenerated.
	* generated/maxloc1_16_r16.c: Regenerated.
	* generated/maxloc1_16_r4.c: Regenerated.
	* generated/maxloc1_16_r8.c: Regenerated.
	* generated/maxloc1_4_i1.c: Regenerated.
	* generated/maxloc1_4_i16.c: Regenerated.
	* generated/maxloc1_4_i2.c: Regenerated.
	* generated/maxloc1_4_i4.c: Regenerated.
	* generated/maxloc1_4_i8.c: Regenerated.
	* generated/maxloc1_4_r10.c: Regenerated.
	* generated/maxloc1_4_r16.c: Regenerated.
	* generated/maxloc1_4_r4.c: Regenerated.
	* generated/maxloc1_4_r8.c: Regenerated.
	* generated/maxloc1_8_i1.c: Regenerated.
	* generated/maxloc1_8_i16.c: Regenerated.
	* generated/maxloc1_8_i2.c: Regenerated.
	* generated/maxloc1_8_i4.c: Regenerated.
	* generated/maxloc1_8_i8.c: Regenerated.
	* generated/maxloc1_8_r10.c: Regenerated.
	* generated/maxloc1_8_r16.c: Regenerated.
	* generated/maxloc1_8_r4.c: Regenerated.
	* generated/maxloc1_8_r8.c: Regenerated.
	* generated/maxval_i1.c: Regenerated.
	* generated/maxval_i16.c: Regenerated.
	* generated/maxval_i2.c: Regenerated.
	* generated/maxval_i4.c: Regenerated.
	* generated/maxval_i8.c: Regenerated.
	* generated/maxval_r10.c: Regenerated.
	* generated/maxval_r16.c: Regenerated.
	* generated/maxval_r4.c: Regenerated.
	* generated/maxval_r8.c: Regenerated.
	* generated/minloc1_16_i1.c: Regenerated.
	* generated/minloc1_16_i16.c: Regenerated.
	* generated/minloc1_16_i2.c: Regenerated.
	* generated/minloc1_16_i4.c: Regenerated.
	* generated/minloc1_16_i8.c: Regenerated.
	* generated/minloc1_16_r10.c: Regenerated.
	* generated/minloc1_16_r16.c: Regenerated.
	* generated/minloc1_16_r4.c: Regenerated.
	* generated/minloc1_16_r8.c: Regenerated.
	* generated/minloc1_4_i1.c: Regenerated.
	* generated/minloc1_4_i16.c: Regenerated.
	* generated/minloc1_4_i2.c: Regenerated.
	* generated/minloc1_4_i4.c: Regenerated.
	* generated/minloc1_4_i8.c: Regenerated.
	* generated/minloc1_4_r10.c: Regenerated.
	* generated/minloc1_4_r16.c: Regenerated.
	* generated/minloc1_4_r4.c: Regenerated.
	* generated/minloc1_4_r8.c: Regenerated.
	* generated/minloc1_8_i1.c: Regenerated.
	* generated/minloc1_8_i16.c: Regenerated.
	* generated/minloc1_8_i2.c: Regenerated.
	* generated/minloc1_8_i4.c: Regenerated.
	* generated/minloc1_8_i8.c: Regenerated.
	* generated/minloc1_8_r10.c: Regenerated.
	* generated/minloc1_8_r16.c: Regenerated.
	* generated/minloc1_8_r4.c: Regenerated.
	* generated/minloc1_8_r8.c: Regenerated.
	* generated/minval_i1.c: Regenerated.
	* generated/minval_i16.c: Regenerated.
	* generated/minval_i2.c: Regenerated.
	* generated/minval_i4.c: Regenerated.
	* generated/minval_i8.c: Regenerated.
	* generated/minval_r10.c: Regenerated.
	* generated/minval_r16.c: Regenerated.
	* generated/minval_r4.c: Regenerated.
	* generated/minval_r8.c: Regenerated.
	* generated/product_c10.c: Regenerated.
	* generated/product_c16.c: Regenerated.
	* generated/product_c4.c: Regenerated.
	* generated/product_c8.c: Regenerated.
	* generated/product_i1.c: Regenerated.
	* generated/product_i16.c: Regenerated.
	* generated/product_i2.c: Regenerated.
	* generated/product_i4.c: Regenerated.
	* generated/product_i8.c: Regenerated.
	* generated/product_r10.c: Regenerated.
	* generated/product_r16.c: Regenerated.
	* generated/product_r4.c: Regenerated.
	* generated/product_r8.c: Regenerated.
	* generated/sum_c10.c: Regenerated.
	* generated/sum_c16.c: Regenerated.
	* generated/sum_c4.c: Regenerated.
	* generated/sum_c8.c: Regenerated.
	* generated/sum_i1.c: Regenerated.
	* generated/sum_i16.c: Regenerated.
	* generated/sum_i2.c: Regenerated.
	* generated/sum_i4.c: Regenerated.
	* generated/sum_i8.c: Regenerated.
	* generated/sum_r10.c: Regenerated.
	* generated/sum_r16.c: Regenerated.
	* generated/sum_r4.c: Regenerated.
	* generated/sum_r8.c: Regenerated.

2008-05-04  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/35595
	* gfortran.dg/intinsic_ifunction_1.f90:  New test case.

! { dg-do run }
! PR 35995 - ifunction.m4 and ifunction_logical.m4 had a bug
! where zero-sized arguments were not handled correctly.
! Test case provided by Dick Hendrickson, amended by
! Thomas Koenig.

      program try_gf0026_etc

      call       gf0026(  0,  1)
      call       foo   (  0,  1)

      end program

      SUBROUTINE GF0026(nf0,nf1)
      LOGICAL LDA(9)
      INTEGER IDA(NF0,9), iii(9)

      lda = (/ (i/2*2 .eq. I, i=1,9) /)
      LDA = ALL ( IDA .NE. -1000,  1)
      if (.not. all(lda)) call abort
      if (.not. all(ida .ne. -1000)) call abort

      lda = (/ (i/2*2 .eq. I, i=1,9) /)
      LDA = any ( IDA .NE. -1000,  1)
      print *, lda          !expect FALSE
      if (any(lda)) call abort
      print *, any(ida .ne. -1000)   !expect FALSE
      if (any(ida .ne. -1000)) call abort

      iii = 137
      iii = count ( IDA .NE. -1000,  1)
      if (any(iii /= 0)) call abort
      if (count(ida .ne. -1000) /= 0) call abort

      END SUBROUTINE

      subroutine foo (nf0, nf1)
      integer, dimension(9):: res, iii
      integer, dimension(nf0,9) :: ida
      res = (/ (-i, i=1,9) /)
      res = product (ida, 1)
      if (any(res /= 1)) call abort
      end subroutine foo

Index: m4/ifunction_logical.m4
===================================================================
--- m4/ifunction_logical.m4	(revision 134490)
+++ m4/ifunction_logical.m4	(working copy)
@@ -40,6 +40,7 @@ name`'rtype_qual`_'atype_code (rtype * c
   index_type delta;
   index_type dim;
   int src_kind;
+  int continue_loop;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
@@ -48,6 +49,9 @@ name`'rtype_qual`_'atype_code (rtype * c
   src_kind = GFC_DESCRIPTOR_SIZE (array);
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len < 0)
+    len = 0;
+
   delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
@@ -147,7 +151,8 @@ name`'rtype_qual`_'atype_code (rtype * c
 
   dest = retarray->data;
 
-  while (base)
+  continue_loop = 1;
+  while (continue_loop)
     {
       const GFC_LOGICAL_1 * restrict src;
       rtype_name result;
@@ -185,7 +190,7 @@ define(FINISH_ARRAY_FUNCTION,
           if (n == rank)
             {
               /* Break out of the look.  */
-              base = NULL;
+              continue_loop = 0;
               break;
             }
           else
Index: m4/ifunction.m4
===================================================================
--- m4/ifunction.m4	(revision 134830)
+++ m4/ifunction.m4	(working copy)
@@ -39,12 +39,15 @@ name`'rtype_qual`_'atype_code (rtype * c
   index_type len;
   index_type delta;
   index_type dim;
+  int continue_loop;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len < 0)
+    len = 0;
   delta = array->dim[dim].stride;
 
   for (n = 0; n < dim; n++)
@@ -131,7 +134,8 @@ name`'rtype_qual`_'atype_code (rtype * c
   base = array->data;
   dest = retarray->data;
 
-  while (base)
+  continue_loop = 1;
+  while (continue_loop)
     {
       const atype_name * restrict src;
       rtype_name result;
@@ -169,8 +173,8 @@ define(FINISH_ARRAY_FUNCTION,
           if (n == rank)
             {
               /* Break out of the look.  */
-              base = NULL;
-              break;
+	      continue_loop = 0;
+	      break;
             }
           else
             {