PATCH: PR fortran/26041: [4.1]: FORTRAN compiler won't compile the valid code

[H. J. Lu]

These are the backported patches for PR 26041 against gcc 4.1.


H.J.
----
2006-02-02  H.J. Lu  <hongjiu.lu@intel.com>

	PR fortran/26041
	PR fortran/26064
	* resolve.c (resolve_types): New function.
	(resolve_codes): Likewise.
	(gfc_resolve): Use them.

--- gcc/fortran/resolve.c.26041	2006-02-01 12:30:03.000000000 -0800
+++ gcc/fortran/resolve.c	2006-02-02 12:18:19.000000000 -0800
@@ -5771,21 +5771,20 @@ resolve_fntype (gfc_namespace * ns)
 }
 
 
-/* This function is called after a complete program unit has been compiled.
-   Its purpose is to examine all of the expressions associated with a program
-   unit, assign types to all intermediate expressions, make sure that all
-   assignments are to compatible types and figure out which names refer to
-   which functions or subroutines.  */
+/* Examine all of the expressions associated with a program unit,
+   assign types to all intermediate expressions, make sure that all
+   assignments are to compatible types and figure out which names
+   refer to which functions or subroutines.  It doesn't check code
+   block, which is handled by resolve_code.  */
 
-void
-gfc_resolve (gfc_namespace * ns)
+static void
+resolve_types (gfc_namespace * ns)
 {
-  gfc_namespace *old_ns, *n;
+  gfc_namespace *n;
   gfc_charlen *cl;
   gfc_data *d;
   gfc_equiv *eq;
 
-  old_ns = gfc_current_ns;
   gfc_current_ns = ns;
 
   resolve_entries (ns);
@@ -5803,7 +5802,7 @@ gfc_resolve (gfc_namespace * ns)
 		   "also be PURE", n->proc_name->name,
 		   &n->proc_name->declared_at);
 
-      gfc_resolve (n);
+      resolve_types (n);
     }
 
   forall_flag = 0;
@@ -5827,12 +5826,43 @@ gfc_resolve (gfc_namespace * ns)
   for (eq = ns->equiv; eq; eq = eq->next)
     resolve_equivalence (eq);
 
-  cs_base = NULL;
-  resolve_code (ns->code, ns);
-
   /* Warn about unused labels.  */
   if (gfc_option.warn_unused_labels)
     warn_unused_label (ns);
+}
+
+
+/* Call resolve_code recursively.  */
+
+static void
+resolve_codes (gfc_namespace * ns)
+{
+  gfc_namespace *n;
+
+  for (n = ns->contained; n; n = n->sibling)
+    resolve_codes (n);
+
+  gfc_current_ns = ns;
+  cs_base = NULL;
+  resolve_code (ns->code, ns);
+}
+
+
+/* This function is called after a complete program unit has been compiled.
+   Its purpose is to examine all of the expressions associated with a program
+   unit, assign types to all intermediate expressions, make sure that all
+   assignments are to compatible types and figure out which names refer to
+   which functions or subroutines.  */
+
+void
+gfc_resolve (gfc_namespace * ns)
+{
+  gfc_namespace *old_ns;
+
+  old_ns = gfc_current_ns;
+
+  resolve_types (ns);
+  resolve_codes (ns);
 
   gfc_current_ns = old_ns;
 }
2006-02-02  H.J. Lu  <hongjiu.lu@intel.com>

	PR fortran/26041
	PR fortran/26064
	* gfortran.dg/sibling_dummy_procedure_1.f90: New file.
	* gfortran.dg/sibling_dummy_procedure_2.f90: Likewise.
	* gfortran.dg/sibling_dummy_procedure_3.f90: Likewise.

--- gcc/testsuite/gfortran.dg/sibling_dummy_procedure_1.f90.test	2006-02-02 14:20:11.000000000 -0800
+++ gcc/testsuite/gfortran.dg/sibling_dummy_procedure_1.f90	2006-02-02 08:57:09.000000000 -0800
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! This checks the fix for PR 26041.
+!
+! Contributed by H.J. Lu  <hongjiu.lu@intel.com>
+module foo
+   public    bar_
+   interface bar_
+      module procedure bar
+   end interface
+   public    xxx_
+   interface xxx_
+      module procedure xxx
+   end interface
+contains
+   subroutine bar(self, z)
+      interface
+         function self(z) result(res)
+	    real z
+            real(kind=kind(1.0d0)) :: res
+         end function
+      end interface
+   end subroutine
+   subroutine xxx(self,z)
+      interface
+         function self(z) result(res)
+	    real z
+            real(kind=kind(1.0d0)) :: res
+         end function
+      end interface
+      call bar(self, z)
+   end subroutine
+end
--- gcc/testsuite/gfortran.dg/sibling_dummy_procedure_2.f90.test	2006-02-02 14:20:11.000000000 -0800
+++ gcc/testsuite/gfortran.dg/sibling_dummy_procedure_2.f90	2006-02-02 08:57:09.000000000 -0800
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! This checks the fix for PR 26041.
+!
+! Contributed by H.J. Lu  <hongjiu.lu@intel.com>
+module foo
+   public    bar_
+   interface bar_
+      module procedure bar
+   end interface
+   public    xxx_
+   interface xxx_
+      module procedure xxx
+   end interface
+contains
+   subroutine bar(self, z)
+      interface
+         function self(z) result(res)
+	    real z
+            real(kind=kind(1.0d0)) :: res
+         end function
+      end interface
+   end subroutine
+   subroutine xxx(self,z)
+      interface
+         function self(z) result(res)
+	    real z
+            real(kind=kind(1.0d0)) :: res
+         end function
+      end interface
+      call bar_(self, z)
+   end subroutine
+end
--- gcc/testsuite/gfortran.dg/sibling_dummy_procedure_3.f90.test	2006-02-02 14:20:11.000000000 -0800
+++ gcc/testsuite/gfortran.dg/sibling_dummy_procedure_3.f90	2006-02-02 08:57:09.000000000 -0800
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! This checks the fix for PR 26064
+!
+! Contributed by Sven Buijssen <sven.buijssen@math.uni-dortmund.de>
+module ice
+  implicit none
+  contains
+
+    subroutine foo()
+    contains
+
+      subroutine bar(baz)
+        integer, optional :: baz
+        if (present(baz)) then
+        endif
+      end subroutine bar
+    end subroutine foo
+end module