summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03
downloadcbb-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.f0388
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
+