diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03 | |
download | cbb-gcc-4.6.4-upstream.tar.bz2 cbb-gcc-4.6.4-upstream.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03')
-rw-r--r-- | gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03 | 88 |
1 files changed, 88 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03 new file mode 100644 index 000000000..d975f4727 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03 @@ -0,0 +1,88 @@ +! { 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) call abort + deallocate (x) + x = y + if (x .ne. y) call abort + 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") call abort + end subroutine + subroutine test_char1 + character(len = 8), allocatable :: c1 + character(len = 8) :: c2 = "abcd1234" + c1 = "abcd1234" + if (c1 .ne. c2) call abort + deallocate (c1) + c1 = c2 + if (c1 .ne. c2) call abort + 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) call abort + deallocate (c1) + c1 = c2 + if (c1 .ne. c2) call abort + end subroutine + subroutine test_deferred_char1 + character(:), allocatable :: c + c = "Hello" + if (c .ne. "Hello") call abort + if (len(c) .ne. 5) call abort + c = "Goodbye" + if (c .ne. "Goodbye") call abort + if (len(c) .ne. 7) call abort +! 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) call abort + end subroutine + subroutine test_pass_c1 (carg) + character(:), allocatable :: carg + if (carg .ne. "Goodbye") call abort + if (len(carg) .ne. 7) call abort + carg = "Made in test!" + end subroutine + subroutine test_deferred_char4 + character(:, kind = 4), allocatable :: c + c = 4_"Hello" + if (c .ne. 4_"Hello") call abort + if (len(c) .ne. 5) call abort + c = 4_"Goodbye" + if (c .ne. 4_"Goodbye") call abort + if (len(c) .ne. 7) call abort +! 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) call abort + end subroutine + subroutine test_pass_c4 (carg) + character(:, kind = 4), allocatable :: carg + if (carg .ne. 4_"Goodbye") call abort + if (len(carg) .ne. 7) call abort + carg = 4_"Made in test!" + end subroutine +end + |