re PR fortran/26779 (Internal module procedure may not have private type dummy arguments)

2006-03-28 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/26779
	*resolve.c (resolve_fl_procedure): Do not check the access of
	derived types for internal procedures.


2006-03-28 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/26779
	* gfortran.dg/private_type_5.f90: New test.

From-SVN: r112442

gcc/fortran/ChangeLog

+2006-03-28 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/26779
+	*resolve.c (resolve_fl_procedure): Do not check the access of
+	derived types for internal procedures.
+
 2006-03-27  Jakub Jelinek  <jakub@redhat.com>
 
 	* io.c (check_io_constraints): Don't look at

gcc/fortran/resolve.c

@@ -4834,9 +4834,13 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
         }
     }
 
-  /* Ensure that derived type formal arguments of a public procedure
-     are not of a private type.  */
-  if (gfc_check_access(sym->attr.access, sym->ns->default_access))
+  /* Ensure that derived type for are not of a private type.  Internal
+     module procedures are excluded by 2.2.3.3 - ie. they are not
+     externally accessible and can access all the objects accesible in
+     the host. */
+  if (!(sym->ns->parent
+	    && sym->ns->parent->proc_name->attr.flavor == FL_MODULE)
+	&& gfc_check_access(sym->attr.access, sym->ns->default_access))
     {
       for (arg = sym->formal; arg; arg = arg->next)
 	{

gcc/testsuite/ChangeLog

+2006-03-28 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/26779
+	* gfortran.dg/private_type_5.f90: New test.
+
 2006-03-27  David Edelsohn  <edelsohn@gnu.org>
 
 	* objc.dg/objc-nofilename-1.m: Limit to Darwin.

gcc/testsuite/gfortran.dg/private_type_5.f90

+! { dg-do compile }
+! Tests the fix for PR26779, where an error would occur because
+! init was detected to be public with a private type dummy argument.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module test
+  public sub
+  type, private :: t
+    integer :: i
+  end type t
+contains
+  subroutine sub (arg)
+    integer arg
+    type(t) :: root
+    call init(root, arg)
+  contains
+    subroutine init(ir, i)
+      integer i
+      type(t) :: ir
+      ir%i = i
+    end subroutine init
+  end subroutine sub
+end module test
\ No newline at end of file