Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/deferred_character_6.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 ! | |
| 3 ! Tests that PR66408 stays fixed. | |
| 4 ! | |
| 5 ! Contributed by <werner.blokbuster@gmail.com> | |
| 6 ! | |
| 7 module mytest | |
| 8 | |
| 9 implicit none | |
| 10 | |
| 11 type vary | |
| 12 character(:), allocatable :: string | |
| 13 end type vary | |
| 14 | |
| 15 interface assignment(=) | |
| 16 module procedure char_eq_vary | |
| 17 end interface assignment(=) | |
| 18 | |
| 19 contains | |
| 20 | |
| 21 subroutine char_eq_vary(my_char,my_vary) | |
| 22 character(:), allocatable, intent(out) :: my_char | |
| 23 type(vary), intent(in) :: my_vary | |
| 24 my_char = my_vary%string | |
| 25 end subroutine char_eq_vary | |
| 26 | |
| 27 end module mytest | |
| 28 | |
| 29 | |
| 30 program thistest | |
| 31 | |
| 32 use mytest, only: vary, assignment(=) | |
| 33 implicit none | |
| 34 | |
| 35 character(:), allocatable :: test_char | |
| 36 character(14), parameter :: str = 'example string' | |
| 37 type(vary) :: test_vary | |
| 38 type(vary) :: my_stuff | |
| 39 | |
| 40 | |
| 41 test_vary%string = str | |
| 42 if (test_vary%string .ne. str) call abort | |
| 43 | |
| 44 ! This previously gave a blank string. | |
| 45 my_stuff%string = test_vary | |
| 46 if (my_stuff%string .ne. str) call abort | |
| 47 | |
| 48 test_char = test_vary | |
| 49 if (test_char .ne. str) call abort | |
| 50 | |
| 51 my_stuff = test_vary | |
| 52 if (my_stuff%string .ne. str) call abort | |
| 53 | |
| 54 end program thistest |