re PR fortran/30880 (Derived types with default value -- function with ENTRY: rejecte...

2007-04-07  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30880
	* resolve.c (resolve_fl_variable): Set flag to 2 for automatic
	arrays.  Make condition for automatic array error explicit.
	If a dummy, no error on an INTENT(OUT) derived type.

2007-04-07  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30880
	* gfortran.dg/used_dummy_types_8.f90: New test.

From-SVN: r123645

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6fba5b3..66915c7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,12 @@
 2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
 
+       PR fortran/30880
+       * resolve.c (resolve_fl_variable): Set flag to 2 for automatic
+       arrays.  Make condition for automatic array error explicit.
+       If a dummy, no error on an INTENT(OUT) derived type.
+
+2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
+
        PR fortran/30872
        * expr.c (find_array_element): Correct arithmetic for rank > 1.
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 03e6360..f514e77 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5648,7 +5648,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
              || sym->as->upper[i] == NULL
              || sym->as->upper[i]->expr_type != EXPR_CONSTANT)
            {
-             flag = 1;
+             flag = 2;
              break;
            }
        }
@@ -5670,7 +5670,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
       else if (sym->attr.external)
        gfc_error ("External '%s' at %L cannot have an initializer",
                   sym->name, &sym->declared_at);
-      else if (sym->attr.dummy)
+      else if (sym->attr.dummy
+       && !(sym->ts.type == BT_DERIVED && sym->attr.intent == INTENT_OUT))
        gfc_error ("Dummy '%s' at %L cannot have an initializer",
                   sym->name, &sym->declared_at);
       else if (sym->attr.intrinsic)
@@ -5679,12 +5680,15 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
       else if (sym->attr.result)
        gfc_error ("Function result '%s' at %L cannot have an initializer",
                   sym->name, &sym->declared_at);
-      else
+      else if (flag == 2)
        gfc_error ("Automatic array '%s' at %L cannot have an initializer",
                   sym->name, &sym->declared_at);
+      else
+       goto no_init_error;
       return FAILURE;
     }
 
+no_init_error:
   /* Check to see if a derived type is blocked from being host associated
      by the presence of another class I symbol in the same namespace.
      14.6.1.3 of the standard and the discussion on comp.lang.fortran.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fb1bbbe..bbcfcde 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
 
+       PR fortran/30880
+       * gfortran.dg/used_dummy_types_8.f90: New test.
+
+2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
+
        PR fortran/30872
        * gfortran.dg/parameter_array_element_1.f90: New test.
 

diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_8.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_8.f90
new file mode 100644 (file)
index 0000000..8a966a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_8.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! Tests the fix for PR30880, in which the variable d1
+! in module m1 would cause an error in the main program
+! because it has an initializer and is a dummy.  This
+! came about because the function with multiple entries
+! assigns the initializer earlier than for other cases.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk> 
+!
+MODULE M1
+  TYPE T1
+  INTEGER :: i=7
+  END TYPE T1
+CONTAINS
+  FUNCTION F1(d1) RESULT(res)
+    INTEGER :: res
+    TYPE(T1), INTENT(OUT) :: d1
+    TYPE(T1), INTENT(INOUT) :: d2
+    res=d1%i
+    d1%i=0
+    RETURN
+  ENTRY E1(d2) RESULT(res)
+    res=d2%i
+    d2%i=0
+  END FUNCTION F1
+END MODULE M1
+
+  USE M1
+  TYPE(T1) :: D1
+  D1=T1(3)
+  write(6,*) F1(D1)
+  D1=T1(3)
+  write(6,*) E1(D1)
+END
+! { dg-final { cleanup-modules "m1" } }