gdb/testsuite/gdb.fortran/associated.f90

   1 ! Copyright 2021-2022 Free Software Foundation, Inc.
   2 !
   3 ! This program is free software; you can redistribute it and/or modify
   4 ! it under the terms of the GNU General Public License as published by
   5 ! the Free Software Foundation; either version 3 of the License, or
   6 ! (at your option) any later version.
   7 !
   8 ! This program is distributed in the hope that it will be useful,
   9 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 ! GNU General Public License for more details.
  12 !
  13 ! You should have received a copy of the GNU General Public License
  14 ! along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 !
  17 ! Start of test program.
  18 !
  19 program test
  20
  21   ! Things to point at.
  22   integer, target :: array_1d (1:10) = 0
  23   integer, target :: array_2d (1:10, 1:10) = 0
  24   integer, target :: an_integer = 0
  25   integer, target :: other_integer = 0
  26   real, target :: a_real = 0.0
  27
  28   ! Things to point with.
  29   integer, pointer :: array_1d_p (:) => null ()
  30   integer, pointer :: other_1d_p (:) => null ()
  31   integer, pointer :: array_2d_p (:,:) => null ()
  32   integer, pointer :: an_integer_p => null ()
  33   integer, pointer :: other_integer_p => null ()
  34   real, pointer :: a_real_p => null ()
  35
  36   ! The start of the tests.
  37   call test_associated (associated (array_1d_p))
  38   call test_associated (associated (array_1d_p, array_1d))
  39
  40   array_1d_p => array_1d
  41   call test_associated (associated (array_1d_p, array_1d))
  42
  43   array_1d_p => array_1d (2:10)
  44   call test_associated (associated (array_1d_p, array_1d))
  45
  46   array_1d_p => array_1d (1:9)
  47   call test_associated (associated (array_1d_p, array_1d))
  48
  49   array_1d_p => array_2d (3, :)
  50   call test_associated (associated (array_1d_p, array_1d))
  51   call test_associated (associated (array_1d_p, array_2d (2, :)))
  52   call test_associated (associated (array_1d_p, array_2d (3, :)))
  53
  54   array_1d_p => null ()
  55   call test_associated (associated (array_1d_p))
  56   call test_associated (associated (array_1d_p, array_2d (3, :)))
  57
  58   call test_associated (associated (an_integer_p))
  59   call test_associated (associated (an_integer_p, an_integer))
  60   an_integer_p => an_integer
  61   call test_associated (associated (an_integer_p))
  62   call test_associated (associated (an_integer_p, an_integer))
  63
  64   call test_associated (associated (an_integer_p, other_integer_p))
  65   other_integer_p => other_integer
  66   call test_associated (associated (other_integer_p))
  67   call test_associated (associated (an_integer_p, other_integer_p))
  68   call test_associated (associated (other_integer_p, an_integer_p))
  69   call test_associated (associated (other_integer_p, an_integer))
  70
  71   other_integer_p = an_integer_p
  72   call test_associated (associated (an_integer_p, other_integer_p))
  73   call test_associated (associated (other_integer_p, an_integer_p))
  74
  75   call test_associated (associated (a_real_p))
  76   call test_associated (associated (a_real_p, a_real))
  77   a_real_p => a_real
  78   call test_associated (associated (a_real_p, a_real))
  79
  80   ! Setup for final tests, these are performed at the print line
  81   ! below.  These final tests are all error conditon checks,
  82   ! i.e. things that can't be compiled into Fortran.
  83   array_1d_p => array_1d
  84
  85   print *, "" ! Final Breakpoint
  86   print *, an_integer
  87   print *, a_real
  88
  89 contains
  90
  91   subroutine test_associated (answer)
  92     logical :: answer
  93
  94     print *,answer      ! Test Breakpoint
  95   end subroutine test_associated
  96
  97 end program test