re PR fortran/36325 (specific or generic INTERFACE implies the EXTERNAL attribute)

2008-05-28  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/36325
	PR fortran/35830
	* interface.c (gfc_procedure_use): Enable argument checking for
	external procedures with explicit interface.
	* symbol.c (check_conflict): Fix conflict checking for externals.
	(copy_formal_args): Fix handling of arrays.
	* resolve.c (resolve_specific_f0, resolve_specific_s0): Fix handling
	of intrinsics.
	* parse.c (parse_interface): Non-abstract INTERFACE statement implies
	EXTERNAL attribute.


2008-05-28  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/36325
	PR fortran/35830
	* gfortran.dg/interface_23.f90: New.
	* gfortran.dg/gomp/reduction3.f90: Fixed invalid code.
	* gfortran.dg/proc_decl_12.f90: New:
	* gfortran.dg/external_procedures_1.f90: Fixed error message.

From-SVN: r136130

gcc/fortran/ChangeLog

+2008-05-28  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36325
+	PR fortran/35830
+	* interface.c (gfc_procedure_use): Enable argument checking for
+	external procedures with explicit interface.
+	* symbol.c (check_conflict): Fix conflict checking for externals.
+	(copy_formal_args): Fix handling of arrays.
+	* resolve.c (resolve_specific_f0, resolve_specific_s0): Fix handling
+	of intrinsics.
+	* parse.c (parse_interface): Non-abstract INTERFACE statement implies
+	EXTERNAL attribute.
+
 2008-05-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/36319

gcc/fortran/interface.c

@@ -2421,8 +2421,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	}
     }
 
-  if (sym->attr.external
-      || sym->attr.if_source == IFSRC_UNKNOWN)
+  if (sym->attr.if_source == IFSRC_UNKNOWN)
     {
       gfc_actual_arglist *a;
       for (a = *ap; a; a = a->next)

gcc/fortran/parse.c

@@ -1917,12 +1917,28 @@ loop:
       new_state = COMP_SUBROUTINE;
       gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
 				  gfc_new_block->formal, NULL);
+      if (current_interface.type != INTERFACE_ABSTRACT &&
+	 !gfc_new_block->attr.dummy &&
+	 gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE)
+	{
+	  reject_statement ();
+	  gfc_free_namespace (gfc_current_ns);
+	  goto loop;
+	}
       break;
 
     case ST_FUNCTION:
       new_state = COMP_FUNCTION;
       gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
 				  gfc_new_block->formal, NULL);
+      if (current_interface.type != INTERFACE_ABSTRACT &&
+	 !gfc_new_block->attr.dummy &&
+	 gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE)
+	{
+	  reject_statement ();
+	  gfc_free_namespace (gfc_current_ns);
+	  goto loop;
+	}
       break;
 
     case ST_PROCEDURE:

gcc/fortran/resolve.c

@@ -1571,7 +1571,8 @@ resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr)
       /* Existance of isym should be checked already.  */
       gcc_assert (isym);
 
-      sym->ts = isym->ts;
+      sym->ts.type = isym->ts.type;
+      sym->ts.kind = isym->ts.kind;
       sym->attr.function = 1;
       sym->attr.proc = PROC_EXTERNAL;
       goto found;
@@ -2646,8 +2647,9 @@ resolve_specific_s0 (gfc_code *c, gfc_symbol *sym)
       /* Existance of isym should be checked already.  */
       gcc_assert (isym);
 
-      sym->ts = isym->ts;
-      sym->attr.function = 1;
+      sym->ts.type = isym->ts.type;
+      sym->ts.kind = isym->ts.kind;
+      sym->attr.subroutine = 1;
       goto found;
     }
 

gcc/fortran/symbol.c

@@ -434,12 +434,14 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
 
   conf (target, external);
   conf (target, intrinsic);
-  conf (external, dimension);   /* See Fortran 95's R504.  */
+
+  if (!attr->if_source)
+    conf (external, dimension);   /* See Fortran 95's R504.  */
 
   conf (external, intrinsic);
   conf (entry, intrinsic);
 
-  if ((attr->if_source && !attr->procedure) || attr->contained)
+  if ((attr->if_source == IFSRC_DECL && !attr->procedure) || attr->contained)
     {
       conf (external, subroutine);
       conf (external, function);
@@ -3664,6 +3666,7 @@ copy_formal_args (gfc_symbol *dest, gfc_symbol *src)
       /* May need to copy more info for the symbol.  */
       formal_arg->sym->attr = curr_arg->sym->attr;
       formal_arg->sym->ts = curr_arg->sym->ts;
+      formal_arg->sym->as = gfc_copy_array_spec (curr_arg->sym->as);
 
       /* If this isn't the first arg, set up the next ptr.  For the
         last arg built, the formal_arg->next will never get set to

gcc/testsuite/ChangeLog

+2008-05-28  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36325
+	PR fortran/35830
+	* gfortran.dg/interface_23.f90: New.
+	* gfortran.dg/gomp/reduction3.f90: Fixed invalid code.
+	* gfortran.dg/proc_decl_12.f90: New:
+	* gfortran.dg/external_procedures_1.f90: Fixed error message.
+	
 2008-05-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/36319

gcc/testsuite/gfortran.dg/external_procedures_1.f90

@@ -24,7 +24,7 @@ program main
   interface
     function ext1 (y)
       real ext1, y
-      external ext1  ! { dg-error "EXTERNAL attribute conflicts with FUNCTION" }
+      external ext1  ! { dg-error "Duplicate EXTERNAL attribute" }
     end function ext1
   end interface
   inval = 1.0
@@ -38,4 +38,4 @@ contains
     inv = y * y * y
   end function inv
 end program main
-
+

gcc/testsuite/gfortran.dg/gomp/reduction3.f90

@@ -33,11 +33,6 @@ subroutine f2
 end subroutine f2
 subroutine f3
   integer :: i
-  interface
-    function ior (a, b)
-      integer :: ior, a, b
-    end function
-  end interface
   intrinsic ior
   i = 6
 !$omp parallel reduction (ior:i)

gcc/testsuite/gfortran.dg/interface_23.f90

+! { dg-do compile }
+!
+! This tests the fix for PR36325, which corrected for the fact that a
+! specific or generic INTERFACE statement implies the EXTERNAL attibute.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module a
+  interface
+    subroutine foo
+    end subroutine
+  end interface
+  external foo  ! { dg-error "Duplicate EXTERNAL attribute" }
+end module
+
+module b
+  interface
+    function sin (x)
+      real :: sin, x
+    end function
+  end interface
+  intrinsic sin  ! { dg-error "EXTERNAL attribute conflicts with INTRINSIC attribute" }
+end module
+
+! argument checking was not done for external procedures with explicit interface
+program c
+  interface
+    subroutine bar(x)
+      real :: x
+    end subroutine
+  end interface
+  call bar()  ! { dg-error "Missing actual argument" }
+end program
+
+! { dg-final { cleanup-modules "a b" } }

gcc/testsuite/gfortran.dg/proc_decl_12.f90

+! { dg-do run }
+!
+! This tests the (partial) fix for PR35830, i.e. handling array arguments
+! with the PROCEDURE statement.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+contains
+  subroutine one(a)
+      integer a(1:3)
+      if (any(a /= [1,2,3])) call abort()
+  end subroutine one
+end module m
+
+program test
+  use m
+  implicit none
+  call foo(one)
+contains
+  subroutine foo(f)
+    procedure(one) :: f
+    call f([1,2,3])
+  end subroutine foo
+end program test
+
+! { dg-final { cleanup-modules "m" } }