gcc/testsuite/gfortran.dg/is_contiguous_4.f90

   1 ! { dg-do run }
   2 ! PR fortran/114001 - IS_CONTIGUOUS and polymorphic dummy
   3
   4 program main
   5   implicit none
   6   integer :: i, cnt = 0
   7   logical :: expect
   8   integer, target  :: m(10) = [(i,i=1,size(m))]
   9   integer, pointer :: p(:)
  10   type t
  11      integer :: j
  12   end type t
  13   type(t),  pointer :: tt(:), tp(:)     ! Type pointer
  14   class(t), pointer :: ct(:), cp(:)     ! Class pointer
  15
  16   p => m(1:3)
  17   expect = is_contiguous (p)
  18   print *, "is_contiguous (p)=", expect
  19   if (.not. expect) stop 91
  20   call sub_star (p, expect)
  21   p => m(1::3)
  22   expect = is_contiguous (p)
  23   print *, "is_contiguous (p)=", expect
  24   if (expect) stop 92
  25   call sub_star (p, expect)
  26
  27   allocate (tt(10))
  28   tt(:)% j = m
  29   tp => tt(4:6)
  30   expect = is_contiguous (tp)
  31   if (.not. expect) stop 96
  32   print *, "is_contiguous (tp)=", expect
  33   call sub_t (tp, expect)
  34   tp => tt(4::3)
  35   expect = is_contiguous (tp)
  36   if (expect) stop 97
  37   print *, "is_contiguous (tp)=", expect
  38   call sub_t (tp, expect)
  39
  40   allocate (ct(10))
  41   ct(:)% j = m
  42   cp => ct(7:9)
  43   expect = is_contiguous (cp)
  44   print *, "is_contiguous (cp)=", expect
  45   if (.not. expect) stop 98
  46   call sub_t (cp, expect)
  47   cp => ct(4::3)
  48   expect = is_contiguous (cp)
  49   print *, "is_contiguous (cp)=", expect
  50   if (expect) stop 99
  51   call sub_t (cp, expect)
  52
  53 contains
  54
  55   subroutine sub_star (x, expect)
  56     class(*), intent(in) :: x(:)
  57     logical,  intent(in) :: expect
  58     cnt = cnt + 10
  59     if (is_contiguous (x) .neqv. expect) then
  60        print *, "sub_star(1): is_contiguous (x)=", is_contiguous (x), expect
  61        stop (cnt + 1)
  62     end if
  63     select type (x)
  64     type is (integer)
  65        if (is_contiguous (x) .neqv. expect) then
  66           print *, "sub_star(2): is_contiguous (x)=", is_contiguous (x), expect
  67           stop (cnt + 2)
  68        end if
  69     end select
  70   end
  71
  72   subroutine sub_t (x, expect)
  73     class(t), intent(in) :: x(:)
  74     logical,  intent(in) :: expect
  75     cnt = cnt + 10
  76     if (is_contiguous (x) .neqv. expect) then
  77        print *, "sub_t: is_contiguous (x)=", is_contiguous (x), expect
  78        stop (cnt + 3)
  79     end if
  80   end
  81 end