Mercurial > hg > CbC > CbC_gcc
diff 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 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gcc/testsuite/gfortran.dg/deferred_character_6.f90 Fri Oct 27 22:46:09 2017 +0900 @@ -0,0 +1,54 @@ +! { dg-do run } +! +! Tests that PR66408 stays fixed. +! +! Contributed by <werner.blokbuster@gmail.com> +! +module mytest + + implicit none + + type vary + character(:), allocatable :: string + end type vary + + interface assignment(=) + module procedure char_eq_vary + end interface assignment(=) + +contains + + subroutine char_eq_vary(my_char,my_vary) + character(:), allocatable, intent(out) :: my_char + type(vary), intent(in) :: my_vary + my_char = my_vary%string + end subroutine char_eq_vary + +end module mytest + + +program thistest + + use mytest, only: vary, assignment(=) + implicit none + + character(:), allocatable :: test_char + character(14), parameter :: str = 'example string' + type(vary) :: test_vary + type(vary) :: my_stuff + + + test_vary%string = str + if (test_vary%string .ne. str) call abort + +! This previously gave a blank string. + my_stuff%string = test_vary + if (my_stuff%string .ne. str) call abort + + test_char = test_vary + if (test_char .ne. str) call abort + + my_stuff = test_vary + if (my_stuff%string .ne. str) call abort + +end program thistest