re PR fortran/52295 (Allow internal procedure in generic interfaces)

2012-02-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52295
        * interface.c (check_interface0): Internal procs in
        generic interfaces are allowed in Fortran 2008.

2012-02-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52295
        * gfortran.dg/interface_35.f90: Use -std=f2003.
        * gfortran.dg/proc_ptr_comp_20.f90: Remove dg-warning.
        * gfortran.dg/interface_assignment_4.f90: Ditto.
        * gfortran.dg/bessel_1.f90: Ditto.
        * gfortran.dg/func_result_6.f90: Ditto.
        * gfortran.dg/hypot_1.f90: Ditto.
        * gfortran.dg/proc_ptr_comp_21.f90: Ditto.

From-SVN: r184372

gcc/fortran/ChangeLog

+2012-02-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52295
+	* interface.c (check_interface0): Internal procs in
+	generic interfaces are allowed in Fortran 2008.
+
 2012-02-17  Tobias Burnus  <burnus@net-b.de>
 	    Roland Stigge  <stigge@antcom.de>
 

gcc/fortran/interface.c

@@ -1292,9 +1292,10 @@ check_interface0 (gfc_interface *p, const char *interface_name)
 	  return 1;
 	}
 
+      /* F2003, C1207. F2008, C1207.  */
       if (p->sym->attr.proc == PROC_INTERNAL
-	  && gfc_notify_std (GFC_STD_GNU, "Extension: Internal procedure '%s' "
-			     "in %s at %L", p->sym->name, interface_name,
+	  && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Internal procedure "
+			     "'%s' in %s at %L", p->sym->name, interface_name,
 			     &p->sym->declared_at) == FAILURE)
 	return 1;
     }

gcc/testsuite/ChangeLog

+2012-02-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52295
+	* gfortran.dg/interface_35.f90: Use -std=f2003.
+	* gfortran.dg/proc_ptr_comp_20.f90: Remove dg-warning.
+	* gfortran.dg/interface_assignment_4.f90: Ditto.
+	* gfortran.dg/bessel_1.f90: Ditto.
+	* gfortran.dg/func_result_6.f90: Ditto.
+	* gfortran.dg/hypot_1.f90: Ditto.
+	* gfortran.dg/proc_ptr_comp_21.f90: Ditto.
+
 2012-02-17  Tobias Burnus  <burnus@net-b.de>
 
 	PR translation/52232

gcc/testsuite/gfortran.dg/bessel_1.f90

@@ -26,11 +26,11 @@ program test
   call check(bessel_yn (3,x4), bessel_yn (3,1.9_4))
 
 contains
-  subroutine check_r4 (a, b) ! { dg-warning "Extension: Internal procedure" }
+  subroutine check_r4 (a, b)
     real(kind=4), intent(in) :: a, b
     if (abs(a - b) > 1.e-5 * abs(b)) call abort
   end subroutine
-  subroutine check_r8 (a, b) ! { dg-warning "Extension: Internal procedure" }
+  subroutine check_r8 (a, b)
     real(kind=8), intent(in) :: a, b
     if (abs(a - b) > 1.e-7 * abs(b)) call abort
   end subroutine

gcc/testsuite/gfortran.dg/func_result_6.f90

@@ -63,7 +63,7 @@ if (ptr /= 2) call abort()
 bar = gen()
 if (ptr /= 77) call abort()
 contains
-  function foo() ! { dg-warning "Extension: Internal procedure .foo. in generic interface" }
+  function foo()
     integer, allocatable :: foo(:)
     allocate(foo(2))
     foo = [33, 77]

gcc/testsuite/gfortran.dg/hypot_1.f90

@@ -18,11 +18,11 @@ program test
   call check(hypot(x4,y4), hypot(1.9_4,-2.1_4))
 
 contains
-  subroutine check_r4 (a, b) ! { dg-warning "Extension: Internal procedure" }
+  subroutine check_r4 (a, b)
     real(kind=4), intent(in) :: a, b
     if (abs(a - b) > 1.e-5 * abs(b)) call abort
   end subroutine
-  subroutine check_r8 (a, b) ! { dg-warning "Extension: Internal procedure" }
+  subroutine check_r8 (a, b)
     real(kind=8), intent(in) :: a, b
     if (abs(a - b) > 1.e-7 * abs(b)) call abort
   end subroutine

gcc/testsuite/gfortran.dg/interface_35.f90

 ! { dg-do compile }
-! { dg-options "-std=f2008" }
+! { dg-options "-std=f2003" }
 !
 ! PR fortran/48112 (module_m)
 ! PR fortran/48279 (sidl_string_array, s_Hard)
@@ -70,7 +70,7 @@ contains
     integer, intent(in) :: a
   end subroutine
 
-  integer function get1 (s) ! { dg-error "Extension: Internal procedure .get1. in generic interface .get." }
+  integer function get1 (s) ! { dg-error "Fortran 2008: Internal procedure .get1. in generic interface .get." }
     integer :: s
   end function
 

gcc/testsuite/gfortran.dg/interface_assignment_4.f90

@@ -16,7 +16,7 @@
 
 contains
 
-  subroutine op_assign_VS_CH (var, exp) ! { dg-warning "Extension: Internal procedure" }
+  subroutine op_assign_VS_CH (var, exp)
     type(varying_string), intent(out) :: var
     character(LEN=*), intent(in)      :: exp
   end subroutine

gcc/testsuite/gfortran.dg/proc_ptr_comp_20.f90

@@ -35,12 +35,12 @@ o1%ppc => o2%ppc  ! { dg-error "Type/rank mismatch" }
 
 contains
 
-  real function f1(a,b) ! { dg-warning "Extension: Internal procedure" }
+  real function f1(a,b)
     real,intent(in) :: a,b
     f1 = a + b
   end function
 
-  integer function f2(a,b) ! { dg-warning "Extension: Internal procedure" }
+  integer function f2(a,b)
     real,intent(in) :: a,b
     f2 = a - b
   end function

gcc/testsuite/gfortran.dg/proc_ptr_comp_21.f90

@@ -19,7 +19,7 @@
 
 contains
 
-  elemental subroutine op_assign (str, ch) ! { dg-warning "Extension: Internal procedure" }
+  elemental subroutine op_assign (str, ch)
     type(nf_t), intent(out) :: str
     character(len=*), intent(in) :: ch
   end subroutine