gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03

! { dg-do run }
! Test (re)allocation on assignment of scalars
!
! Contributed by Paul Thomas  <pault@gcc.gnu.org>
!
  call test_real
  call test_derived
  call test_char1
  call test_char4
  call test_deferred_char1
  call test_deferred_char4
contains
  subroutine test_real
    real, allocatable :: x
    real :: y = 42
    x = 42.0
    if (x .ne. y) STOP 1
    deallocate (x)
    x = y
    if (x .ne. y) STOP 2
  end subroutine   
  subroutine test_derived
    type :: mytype
      real :: x
      character(4) :: c
    end type
    type (mytype), allocatable :: t
    t = mytype (99.0, "abcd")
    if (t%c .ne. "abcd") STOP 3
  end subroutine   
  subroutine test_char1
    character(len = 8), allocatable :: c1
    character(len = 8) :: c2 = "abcd1234"
    c1 = "abcd1234"
    if (c1 .ne. c2) STOP 4
    deallocate (c1)
    c1 = c2
    if (c1 .ne. c2) STOP 5
  end subroutine    
  subroutine test_char4
    character(len = 8, kind = 4), allocatable :: c1
    character(len = 8, kind = 4) :: c2 = 4_"abcd1234"
    c1 = 4_"abcd1234"
    if (c1 .ne. c2) STOP 6
    deallocate (c1)
    c1 = c2
    if (c1 .ne. c2) STOP 7
  end subroutine
  subroutine test_deferred_char1  
    character(:), allocatable :: c
    c = "Hello"
    if (c .ne. "Hello") STOP 8
    if (len(c) .ne. 5) STOP 9
    c = "Goodbye"
    if (c .ne. "Goodbye") STOP 10
    if (len(c) .ne. 7) STOP 11
! Check that the hidden LEN dummy is passed by reference
    call test_pass_c1 (c)
    if (c .ne. "Made in test!") print *, c
    if (len(c) .ne. 13) STOP 12
  end subroutine
  subroutine test_pass_c1 (carg)
    character(:), allocatable :: carg
    if (carg .ne. "Goodbye") STOP 13
    if (len(carg) .ne. 7) STOP 14
    carg = "Made in test!"
  end subroutine
  subroutine test_deferred_char4
    character(:, kind = 4), allocatable :: c
    c = 4_"Hello"
    if (c .ne. 4_"Hello") STOP 15
    if (len(c) .ne. 5) STOP 16
    c = 4_"Goodbye"
    if (c .ne. 4_"Goodbye") STOP 17
    if (len(c) .ne. 7) STOP 18
! Check that the hidden LEN dummy is passed by reference
    call test_pass_c4 (c)
    if (c .ne. 4_"Made in test!") print *, c
    if (len(c) .ne. 13) STOP 19
  end subroutine
  subroutine test_pass_c4 (carg)
    character(:, kind = 4), allocatable :: carg
    if (carg .ne. 4_"Goodbye") STOP 20
    if (len(carg) .ne. 7) STOP 21
    carg = 4_"Made in test!"
  end subroutine
end