Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/deferred_type_component_3.f90 @ 152:2b5abeee2509
update gcc11
author | anatofuz |
---|---|
date | Mon, 25 May 2020 07:50:57 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { dg-do run } ! ! Test the fix for PR87151 by exercising deferred length character ! array components. ! ! Based on the contribution by Valery Weber <valeryweber@hotmail.com> ! module bvec type, public :: bvec_t private character(:), dimension(:), allocatable :: vc contains PROCEDURE, PASS :: create PROCEDURE, PASS :: test_bvec PROCEDURE, PASS :: delete end type bvec_t contains subroutine create (this, switch) class(bvec_t), intent(inout) :: this logical :: switch if (switch) then allocate (character(2)::this%vc(3)) if (len (this%vc) .ne. 2) stop 1 ! The orignal problem. Gave 0. ! Check that reallocation on assign does what it should do as required by ! F2003 7.4.1.3. ie. reallocation occurs because LEN has changed. this%vc = ['abcd','efgh','ijkl'] else allocate (this%vc, source = ['abcd','efgh','ijkl']) endif end subroutine create subroutine test_bvec (this) class(bvec_t), intent(inout) :: this character(20) :: buffer if (allocated (this%vc)) then if (len (this%vc) .ne. 4) stop 2 if (size (this%vc) .ne. 3) stop 3 ! Check array referencing and scalarized array referencing if (this%vc(2) .ne. 'efgh') stop 4 if (any (this%vc .ne. ['abcd','efgh','ijkl'])) stop 5 ! Check full array io write (buffer, *) this%vc if (trim (buffer(2:)) .ne. 'abcdefghijkl') stop 6 ! Make sure that substrings work correctly write (buffer, *) this%vc(:)(2:3) if (trim (buffer(2:)) .ne. 'bcfgjk') stop 7 write (buffer, *) this%vc(2:)(2:3) if (trim (buffer(2:)) .ne. 'fgjk') stop 8 endif end subroutine test_bvec subroutine delete (this) class(bvec_t), intent(inout) :: this if (allocated (this%vc)) then deallocate (this%vc) endif end subroutine delete end module bvec program test use bvec type(bvec_t) :: a call a%create (.false.) call a%test_bvec call a%delete call a%create (.true.) call a%test_bvec call a%delete end program test