gcc/testsuite/gfortran.dg/optional_dim_3.f90

   1 ! { dg-do run }
   2 ! PR34540 cshift, eoshift, kind=1 and kind=2 arguments.
   3 ! Test case thanks to Thomas Koenig.
   4 module tst_foo
   5   implicit none
   6 contains
   7   subroutine tst_optional(a,n1,n2)
   8     integer(kind=1), intent(in), optional:: n1
   9     integer(kind=2), intent(in), optional:: n2
  10     integer(kind=1), dimension(2) :: s1
  11     character(64) :: testbuf
  12     real, dimension(:,:) :: a
  13     s1 = (/1, 1/)
  14     write(testbuf,'(4F10.2)') cshift(a, shift=s1)
  15     if (testbuf /= "      2.00      1.00      4.00      3.00") CALL abort
  16     write(testbuf,'(4F10.2)') cshift(a,shift=s1,dim=n2)
  17     if (testbuf /= "      2.00      1.00      4.00      3.00") CALL abort
  18     write(testbuf,'(4F10.2)') eoshift(a,shift=s1,dim=n1)
  19     if (testbuf /= "      2.00      0.00      4.00      0.00") CALL abort
  20     write(testbuf,'(4F10.2)') eoshift(a,shift=s1,dim=n2)
  21     if (testbuf /= "      2.00      0.00      4.00      0.00") CALL abort
  22   end subroutine tst_optional
  23  subroutine sub(bound, dimmy)
  24    integer(kind=8), optional :: dimmy
  25    logical, optional :: bound
  26    logical :: lotto(4)
  27    character(20) :: testbuf
  28    lotto = .false.
  29    lotto = cshift((/.true.,.false.,.true.,.false./),1,dim=dimmy)
  30    write(testbuf,*) lotto
  31    if (trim(testbuf).ne." F T F T") call abort
  32    lotto = .false.
  33    lotto = eoshift((/.true.,.true.,.true.,.true./),1,boundary=bound,dim=dimmy)
  34    lotto = eoshift(lotto,1,dim=dimmy)
  35    write(testbuf,*) lotto
  36    if (trim(testbuf).ne." T T F F") call abort
  37  end subroutine
  38 end module tst_foo
  39
  40 program main
  41   use tst_foo
  42   implicit none
  43   real, dimension(2,2) :: r
  44   integer(kind=1) :: d1
  45   integer(kind=2) :: d2
  46   data r /1.0, 2.0, 3.0, 4.0/
  47   d1 = 1_1
  48   d2 = 1_2
  49   call tst_optional(r,d1, d2)
  50   call sub(bound=.false., dimmy=1_8)
  51   call sub()
  52 end program main