1 files changed, 137 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated.f90
new file mode 100644
index 00000000000..24d647ef15a
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated.f90
@@ -0,0 +1,137 @@
+! Program to test the ASSOCIATED intrinsic.
+program intrinsic_associated
+   call pointer_to_section ()
+   call associate_1 ()
+   call pointer_to_derived_1 ()
+   call associated_2 ()
+end
+ 
+subroutine pointer_to_section ()
+   integer, dimension(100, 100), target :: xy
+   integer, dimension(:, :), pointer :: window
+   integer i, j, k, m, n
+   data xy /10000*0/
+   logical t
+
+   window => xy(10:50, 30:60)
+   window = 10
+   window (1, 1) = 0101
+   window (41, 31) = 4161
+   window (41, 1) = 4101
+   window (1, 31) = 0161
+
+   t = associated (window, xy(10:50, 30:60))
+   if (.not.t) call abort ()
+   if (window(1, 1) .ne. xy(10, 30)) call abort ()
+   if (window(41, 31) .ne. xy(50, 60)) call abort ()
+   if (window(1, 31) .ne. xy(10, 60)) call abort ()
+   if (window(41, 1) .ne. xy(50, 30)) call abort ()
+   if (xy(9, 29) .ne. 0) call abort ()
+   if (xy(51,29 ) .ne. 0) call abort ()
+   if (xy(9, 60) .ne. 0) call abort ()
+   if (xy(51, 60) .ne. 0) call abort ()
+   if (xy(11, 31) .ne. 10) call abort ()
+   if (xy(49, 59) .ne. 10) call abort ()
+   if (xy(11, 59) .ne. 10) call abort ()
+   if (xy(49, 31) .ne. 10) call abort ()
+end
+
+subroutine sub1 (a, ap)
+   integer, pointer :: ap(:, :)
+   integer, target :: a(10, 10)
+                                                                                
+   ap => a
+end
+
+subroutine nullify_pp (a)
+   integer, pointer :: a(:, :)
+                                                                                
+   if (.not. associated (a)) call abort ()
+   nullify (a)
+end
+
+subroutine associate_1 ()
+   integer, pointer :: a(:, :), b(:, :)
+   interface 
+      subroutine nullify_pp (a)
+         integer, pointer :: a(:, :)
+      end subroutine nullify_pp
+   end interface
+
+   allocate (a(80, 80))
+   b => a
+   if (.not. associated(a)) call abort ()
+   if (.not. associated(b)) call abort ()
+   call nullify_pp (a)
+   if (associated (a)) call abort ()
+   if (.not. associated (b)) call abort ()
+end
+
+subroutine pointer_to_derived_1 ()
+   type record
+      integer :: value
+      type(record), pointer :: rp
+   end type record
+
+   type record1
+      integer value
+      type(record2), pointer :: r1p
+   end type
+
+   type record2
+      integer value
+      type(record1), pointer :: r2p
+   end type
+
+   type(record), target :: e1, e2, e3
+   type(record1), target :: r1
+   type(record2), target :: r2
+
+   nullify (r1%r1p, r2%r2p, e1%rp, e2%rp, e3%rp)
+   if (associated (r1%r1p)) call abort ()
+   if (associated (r2%r2p)) call abort ()
+   if (associated (e2%rp)) call abort ()
+   if (associated (e1%rp)) call abort ()
+   if (associated (e3%rp)) call abort ()
+   r1%r1p => r2
+   r2%r2p => r1
+   r1%value = 11
+   r2%value = 22
+   e1%rp => e2
+   e2%rp => e3
+   e1%value = 33
+   e1%rp%value = 44
+   e1%rp%rp%value = 55
+   if (.not. associated (r1%r1p)) call abort ()
+   if (.not. associated (r2%r2p)) call abort ()
+   if (.not. associated (e1%rp)) call abort ()
+   if (.not. associated (e2%rp)) call abort ()
+   if (associated (e3%rp)) call abort ()
+   if (r1%r1p%value .ne. 22) call abort ()
+   if (r2%r2p%value .ne. 11) call abort ()
+   if (e1%value .ne. 33) call abort ()
+   if (e2%value .ne. 44) call abort ()
+   if (e3%value .ne. 55) call abort ()
+   if (r1%value .ne. 11) call abort ()
+   if (r2%value .ne. 22) call abort ()
+
+end 
+
+subroutine associated_2 ()
+   integer, pointer :: xp(:, :)
+   integer, target  :: x(10, 10)
+   integer, target  :: y(100, 100)
+   interface
+      subroutine sub1 (a, ap)
+         integer, pointer :: ap(:, :)
+         integer, target  :: a(10, 1)
+      end
+   endinterface
+
+   xp => y
+   if (.not. associated (xp)) call abort ()
+   call sub1 (x, xp)
+   if (associated (xp, y)) call abort ()
+   if (.not. associated (xp, x)) call abort ()
+end
+