Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/contained_module_proc_1.f90 @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
| 68:561a7518be6b | 111:04ced10e8804 |
|---|---|
| 1 ! { dg-do run } | |
| 2 ! Tests the check for PR31292, in which the module procedure | |
| 3 ! statement would put the symbol for assign_t in the wrong | |
| 4 ! namespace and this caused the interface checking to fail. | |
| 5 ! | |
| 6 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org> | |
| 7 ! | |
| 8 module chk_gfortran | |
| 9 implicit none | |
| 10 type t | |
| 11 integer x | |
| 12 end type t | |
| 13 contains | |
| 14 function is_gfortran() | |
| 15 logical is_gfortran | |
| 16 interface assignment(=) | |
| 17 module procedure assign_t | |
| 18 end interface assignment(=) | |
| 19 type(t) y(3) | |
| 20 | |
| 21 y%x = (/1,2,3/) | |
| 22 y = y((/2,3,1/)) | |
| 23 is_gfortran = y(3)%x == 1 | |
| 24 end function is_gfortran | |
| 25 | |
| 26 elemental subroutine assign_t(lhs,rhs) | |
| 27 type(t), intent(in) :: rhs | |
| 28 type(t), intent(out) :: lhs | |
| 29 | |
| 30 lhs%x = rhs%x | |
| 31 end subroutine assign_t | |
| 32 end module chk_gfortran | |
| 33 | |
| 34 program fire | |
| 35 use chk_gfortran | |
| 36 implicit none | |
| 37 if(.not. is_gfortran()) call abort() | |
| 38 end program fire |