view gcc/testsuite/gfortran.dg/deferred_character_6.f90 @ 158:494b0b89df80 default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 84e7813d76e9
children
line wrap: on
line source

! { 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) STOP 1

! This previously gave a blank string.
    my_stuff%string = test_vary
    if (my_stuff%string .ne. str) STOP 2

    test_char = test_vary
    if (test_char .ne. str) STOP 3

    my_stuff = test_vary
    if (my_stuff%string .ne. str) STOP 4

end program thistest