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/pointer_check_3.f90 | 86 +++++++++++++++++++++++++++
 1 file changed, 86 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pointer_check_3.f90

(limited to 'gcc/testsuite/gfortran.dg/pointer_check_3.f90')

diff --git a/gcc/testsuite/gfortran.dg/pointer_check_3.f90 b/gcc/testsuite/gfortran.dg/pointer_check_3.f90
new file mode 100644
index 000000000..23596e44e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_3.f90
@@ -0,0 +1,86 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+!
+! { dg-output ".*At line 61.*Pointer actual argument 'ptr2' is not associated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for variable actuals
+!
+
+subroutine test1(a)
+  integer :: a
+  a = 4444
+end subroutine test1
+
+subroutine test2(a)
+  integer :: a(2)
+  a = 4444
+end subroutine test2
+
+subroutine ppTest(f)
+  implicit none
+  external f
+  call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+  implicit none
+  external :: test1, test2, ppTest
+  integer, pointer :: ptr1, ptr2(:)
+  integer, allocatable :: alloc2(:)
+  procedure(), pointer :: pptr
+
+  allocate(ptr1,ptr2(2),alloc2(2))
+  pptr => sub
+  ! OK
+  call test1(ptr1)
+  call test3(ptr1)
+
+  call test2(ptr2)
+  call test2(alloc2)
+  call test4(ptr2)
+  call test4(alloc2)
+  call ppTest(pptr)
+  call ppTest2(pptr)
+
+  ! Invalid 1:
+  deallocate(alloc2)
+!  call test2(alloc2)
+!  call test4(alloc2)
+
+  ! Invalid 2:
+   deallocate(ptr1,ptr2)
+   nullify(ptr1,ptr2)
+!   call test1(ptr1)
+!   call test3(ptr1)
+   call test2(ptr2)
+!   call test4(ptr2)
+
+  ! Invalid 3:
+  nullify(pptr)
+!  call ppTest(pptr)
+  call ppTest2(pptr)
+
+contains
+  subroutine test3(b)
+    integer :: b
+    b = 333
+  end subroutine test3
+  subroutine test4(b)
+    integer :: b(2)
+    b = 333
+  end subroutine test4
+  subroutine sub()
+    print *, 'Hello World'
+  end subroutine sub
+  subroutine ppTest2(f)
+    implicit none
+    procedure(sub) :: f
+    call f()
+  end subroutine ppTest2
+end Program RunTimeCheck
-- 
cgit v1.2.3