gdb/testsuite/gdb.fortran/array-slices.f90

   1 ! Copyright 2019 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 subroutine show (message, array)
  17   character (len=*) :: message
  18   integer, dimension (:,:) :: array
  19
  20   print *, message
  21   do i=LBOUND (array, 2), UBOUND (array, 2), 1
  22      do j=LBOUND (array, 1), UBOUND (array, 1), 1
  23         write(*, fmt="(i4)", advance="no") array (j, i)
  24      end do
  25      print *, ""
  26  end do
  27  print *, array
  28  print *, ""
  29
  30 end subroutine show
  31
  32 program test
  33
  34   interface
  35      subroutine show (message, array)
  36        character (len=*) :: message
  37        integer, dimension(:,:) :: array
  38      end subroutine show
  39   end interface
  40
  41   integer, dimension (1:10,1:10) :: array
  42   integer, allocatable :: other (:, :)
  43
  44   allocate (other (-5:4, -2:7))
  45
  46   do i=LBOUND (array, 2), UBOUND (array, 2), 1
  47      do j=LBOUND (array, 1), UBOUND (array, 1), 1
  48         array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
  49      end do
  50   end do
  51
  52   do i=LBOUND (other, 2), UBOUND (other, 2), 1
  53      do j=LBOUND (other, 1), UBOUND (other, 1), 1
  54         other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
  55      end do
  56   end do
  57
  58   call show ("array", array)
  59   call show ("array (1:5,1:5)", array (1:5,1:5))
  60   call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
  61   call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
  62   call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
  63
  64   call show ("other", other)
  65   call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
  66   call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
  67
  68   deallocate (other)
  69   print *, "" ! Final Breakpoint.
  70 end program test