From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; 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.
---
 gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03 | 88 +++++++++++++++++++++++
 1 file changed, 88 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03

(limited to 'gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03')

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
+
-- 
cgit v1.2.3