[gcc r11-3480] Correct overwrite of alloc_comp_result_2.f90 in fix of PR96495.

[gcc r11-3480] Correct overwrite of alloc_comp_result_2.f90 in fix of PR96495.

[Paul Thomas]

https://gcc.gnu.org/g:5b26b3b3f5c75a86a5a3e851866247ac7fcb6c8b

commit r11-3480-g5b26b3b3f5c75a86a5a3e851866247ac7fcb6c8b
Author: Paul Thomas <pault@gcc.gnu.org>
Date:   Sat Sep 26 12:32:35 2020 +0100

    Correct overwrite of alloc_comp_result_2.f90 in fix of PR96495.
    
    2020-26-09  Paul Thomas  <pault@gcc.gnu.org>
    
    gcc/testsuite/
            PR fortran/96495
            * gfortran.dg/alloc_comp_result_2.f90 : Restore original.
            * gfortran.dg/alloc_comp_result_3.f90 : New test.

Diff:
---
 gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 | 94 ++++++-----------------
 gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90 | 75 ++++++++++++++++++
 2 files changed, 98 insertions(+), 71 deletions(-)

diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90
index 6b0918715d7..2e907e31558 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90
@@ -1,75 +1,27 @@
-! { dg-do run }
+! Tests the fix for PR40440, in which gfortran tried to deallocate
+! the allocatable components of the actual argument of CALL SUB
 !
-! Test the fix for PR96495 - segfaults at runtime at locations below.
+! Contributed by Juergen Reuter <juergen.reuter@desy.de>
+! Reduced testcase from Tobias Burnus  <burnus@gcc.gnu.org>
 !
-! Contributed by Paul Luckner  <paul.luckner@rwth-aachen.de>
-!
-module foo_m
-
   implicit none
-
-  type foo
-    integer, allocatable :: j(:)
-  end type
-
-  interface operator(.unary.)
-    module procedure neg_foo
-  end interface
-
-  interface operator(.binary.)
-    module procedure foo_sub_foo
-  end interface
-
-  interface operator(.binaryElemental.)
-    module procedure foo_add_foo
-  end interface
-
+  type t
+    integer, allocatable :: A(:)
+  end type t
+  type (t) :: arg
+  arg = t ([1,2,3])
+  call sub (func (arg))
 contains
-
-  elemental function foo_add_foo(f, g) result(h)
-    !! an example for an elemental binary operator
-    type(foo), intent(in) :: f, g
-    type(foo)             :: h
-
-    allocate (h%j(size(f%j)), source = f%j+g%j)
-  end function
-
-  elemental function foo_sub_foo(f, g) result(h)
-    !! an example for an elemental binary operator
-    type(foo), intent(in) :: f, g
-    type(foo)             :: h
-
-    allocate (h%j(size(f%j)), source = f%j-3*g%j)
-  end function
-
-  pure function neg_foo(f) result(g)
-    !! an example for a unary operator
-    type(foo), intent(in) :: f
-    type(foo)             :: g
-
-    allocate (g%j(size(f%j)), source = -f%j)
-  end function
-
-end module
-
-program main_tmp
-
-  use foo_m
-
-  implicit none
-
-  type(foo) f, g(2)
-
-  allocate (f%j(3))
-  f%j = [2, 3, 4]
-
-  g = f
-  if (any (g(2)%j .ne. [2, 3, 4])) stop 1
-
-  g = g .binaryElemental. (f .binary. f)     ! threw "Segmentation fault"
-  if (any (g(2)%j .ne. [-2,-3,-4])) stop 2
-
-  g = g .binaryElemental. (  .unary.  f)     ! threw "Segmentation fault"
-  if (any (g(2)%j .ne. [-4,-6,-8])) stop 3
-
-end program
\ No newline at end of file
+  function func (a)
+    type(t), pointer :: func
+    type(t), target :: a
+    integer, save :: i = 0
+    if (i /= 0) STOP 1! multiple calls would cause this abort
+    i = i + 1
+    func => a
+  end function func
+  subroutine sub (a)
+    type(t), intent(IN), target :: a
+    if (any (a%A .ne. [1,2,3])) STOP 2
+  end subroutine sub
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90
new file mode 100644
index 00000000000..8c4c982c67f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_result_3.f90
@@ -0,0 +1,75 @@
+! { dg-do run }
+!
+! Test the fix for PR96495 - segfaults at runtime at locations below.
+!
+! Contributed by Paul Luckner  <paul.luckner@rwth-aachen.de>
+!
+module foo_m
+
+  implicit none
+
+  type foo
+    integer, allocatable :: j(:)
+  end type
+
+  interface operator(.unary.)
+    module procedure neg_foo
+  end interface
+
+  interface operator(.binary.)
+    module procedure foo_sub_foo
+  end interface
+
+  interface operator(.binaryElemental.)
+    module procedure foo_add_foo
+  end interface
+
+contains
+
+  elemental function foo_add_foo(f, g) result(h)
+    !! an example for an elemental binary operator
+    type(foo), intent(in) :: f, g
+    type(foo)             :: h
+
+    allocate (h%j(size(f%j)), source = f%j+g%j)
+  end function
+
+  elemental function foo_sub_foo(f, g) result(h)
+    !! an example for an elemental binary operator
+    type(foo), intent(in) :: f, g
+    type(foo)             :: h
+
+    allocate (h%j(size(f%j)), source = f%j-3*g%j)
+  end function
+
+  pure function neg_foo(f) result(g)
+    !! an example for a unary operator
+    type(foo), intent(in) :: f
+    type(foo)             :: g
+
+    allocate (g%j(size(f%j)), source = -f%j)
+  end function
+
+end module
+
+program main_tmp
+
+  use foo_m
+
+  implicit none
+
+  type(foo) f, g(2)
+
+  allocate (f%j(3))
+  f%j = [2, 3, 4]
+
+  g = f
+  if (any (g(2)%j .ne. [2, 3, 4])) stop 1
+
+  g = g .binaryElemental. (f .binary. f)     ! threw "Segmentation fault"
+  if (any (g(2)%j .ne. [-2,-3,-4])) stop 2
+
+  g = g .binaryElemental. (  .unary.  f)     ! threw "Segmentation fault"
+  if (any (g(2)%j .ne. [-4,-6,-8])) stop 3
+
+end program