git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
This commit is contained in:
Tobias Burnus 2012-02-18 13:31:42 +01:00 committed by Tobias Burnus
parent 141a25c268
commit d2c5dbf264
10 changed files with 31 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
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>

5
gcc/fortran/interface.c
View File

@ -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;
}

11
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,14 @@
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

4
gcc/testsuite/gfortran.dg/bessel_1.f90
View File

@ -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

2
gcc/testsuite/gfortran.dg/func_result_6.f90
View File

@ -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]

4
gcc/testsuite/gfortran.dg/hypot_1.f90
View File

@ -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

4
gcc/testsuite/gfortran.dg/interface_35.f90
View File

@ -1,5 +1,5 @@
! { 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

2
gcc/testsuite/gfortran.dg/interface_assignment_4.f90
View File

@ -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

4
gcc/testsuite/gfortran.dg/proc_ptr_comp_20.f90
View File

@ -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

2
gcc/testsuite/gfortran.dg/proc_ptr_comp_21.f90
View File

@ -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