re PR fortran/30514 ([4.1 only] zero-sized array wrongly rejected: integer :: i(1:-1))

2007-02-03  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30514
	* array.c (match_array_element_spec): If the length of an array is
	negative, adjust the upper limit to make it zero length.

	PR fortran/30660
	* resolve.c (pure_function, resolve_function): Initialize name to
	null to clear up build warnings.
	(resolve_fl_variable): Look at components explicitly to check for
	default initializer, rather than using gfc_default_initializer.

2007-02-03  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30514
	* gfortran.dg/zero_sized_2.f90: New test.

	PR fortran/30660
	* gfortran.dg/alloc_comp_basics_4.f90: New test.

	PR fortran/29820
	* gfortran.dg/actual_array_interface_1.f90: Copy source to empty
	file.

From-SVN: r121541

gcc/fortran/ChangeLog

+2007-02-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30514
+	* array.c (match_array_element_spec): If the length of an array is
+	negative, adjust the upper limit to make it zero length.
+
+	PR fortran/30660
+	* resolve.c (pure_function, resolve_function): Initialize name to
+	null to clear up build warnings.
+	(resolve_fl_variable): Look at components explicitly to check for
+	default initializer, rather than using gfc_default_initializer.
+
 2007-02-02  Steven G. Kargl <kargl@gcc.gnu.org>
 
 	PR fortran/30683

gcc/fortran/array.c

@@ -319,6 +319,15 @@ match_array_element_spec (gfc_array_spec *as)
   if (m == MATCH_NO)
     return AS_ASSUMED_SHAPE;
 
+  /* If the size is negative in this dimension, set it to zero.  */
+  if ((*lower)->expr_type == EXPR_CONSTANT
+      && (*upper)->expr_type == EXPR_CONSTANT
+      && mpz_cmp ((*upper)->value.integer, (*lower)->value.integer) < 0)
+    {
+      gfc_free_expr (*upper);
+      *upper = gfc_copy_expr (*lower);
+      mpz_sub_ui ((*upper)->value.integer, (*upper)->value.integer, 1);
+    }
   return AS_EXPLICIT;
 }
 

gcc/fortran/resolve.c

@@ -1487,6 +1487,8 @@ pure_function (gfc_expr *e, const char **name)
 {
   int pure;
 
+  *name = NULL;
+
   if (e->symtree != NULL
         && e->symtree->n.sym != NULL
         && e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
@@ -1663,6 +1665,7 @@ resolve_function (gfc_expr *expr)
 #undef GENERIC_ID
 
   need_full_assumed_size = temp;
+  name = NULL;
 
   if (!pure_function (expr, &name) && name)
     {
@@ -5534,7 +5537,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
   int flag;
   int i;
   gfc_expr *e;
-  gfc_expr *constructor_expr;
+  gfc_component *c;
   const char *auto_save_msg;
 
   auto_save_msg = "automatic object '%s' at %L cannot have the "
@@ -5668,18 +5671,21 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
 	}
     }
 
+  /* Do not use gfc_default_initializer to test for a default initializer
+     in the fortran because it generates a hidden default for allocatable
+     components.  */
+  c = NULL;
+  if (sym->ts.type == BT_DERIVED && !(sym->value || flag))
+    for (c = sym->ts.derived->components; c; c = c->next)
+      if (c->initializer)
+      break;
+
   /* 4th constraint in section 11.3:  "If an object of a type for which
      component-initialization is specified (R429) appears in the
      specification-part of a module and does not have the ALLOCATABLE
      or POINTER attribute, the object shall have the SAVE attribute."  */
-
-  constructor_expr = NULL;
-  if (sym->ts.type == BT_DERIVED && !(sym->value || flag))
-    constructor_expr = gfc_default_initializer (&sym->ts);
-
-  if (sym->ns->proc_name
+  if (c && sym->ns->proc_name
       && sym->ns->proc_name->attr.flavor == FL_MODULE
-      && constructor_expr
       && !sym->ns->save_all && !sym->attr.save
       && !sym->attr.pointer && !sym->attr.allocatable)
     {

gcc/testsuite/ChangeLog

+2007-02-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30514
+	* gfortran.dg/zero_sized_2.f90: New test.
+
+	PR fortran/30660
+	* gfortran.dg/alloc_comp_basics_4.f90: New test.
+
+	PR fortran/29820
+	* gfortran.dg/actual_array_interface_1.f90: Copy source to empty
+	file.
+
 2007-02-02  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/30683

gcc/testsuite/gfortran.dg/actual_array_interface_1.f90

+! { dg-do compile }
+! Tests the fix for PR29490, in which the creation of the
+! interface expression for the first argument of the call to
+! 'john' would cause an ICE because GFC_TYPE_ARRAY_LBOUND
+! was NULL.
+!
+! Contributed by Philip Mason <pmason@ricardo.com>
+!
+  !---------------------------------
+  program fred
+  !---------------------------------
+  real              :: dezz(1:10)
+  real, allocatable :: jack(:)
+  !
+  allocate(jack(10)); jack = 9.
+  dezz = john(jack,1)
+  print*,'dezz = ',dezz
+
+  contains
+    !---------------------------------
+    function john(t,il)
+    !---------------------------------
+    real  :: t(il:)
+    real  :: john(1:10)
+    john = 10.
+    end function john
+  end

gcc/testsuite/gfortran.dg/alloc_comp_basics_4.f90

+! { dg-do compile }
+! Tests the fix for PR30660 in which gfortran insisted that g_dest
+! should have the SAVE attribute because the hidden default
+! initializer for the allocatable component was being detected.
+!
+! Contributed by Toon Moene <toon@moene.indiv.nluug.nl>
+!
+MODULE types_m
+  TYPE grib_t
+    REAL,DIMENSION(:),ALLOCATABLE :: vdata
+  END TYPE
+END MODULE
+
+MODULE globals_m
+  USE types_m
+  TYPE(grib_t) g_dest           ! output field
+END MODULE
+! { dg-final { cleanup-modules "types_m globals_m" } }
+

gcc/testsuite/gfortran.dg/zero_sized_2.f90

+! { dg-do compile }
+! Tests the fix for PR30514 in which the bounds on m would cause an
+! error and the rest would cause the compiler to go into an infinite
+! loop.
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+integer :: i(2:0), j(1:0), m(1:-1)
+integer, parameter :: k(2:0) = 0, l(1:0) = 0
+i = k
+j = l
+m = 5
+end
+