gcc/testsuite/gfortran.dg/argument_checking_24.f90

   1 ! { dg-do compile }
   2 ! PR 92004 - checks in the absence of an explicit interface between
   3 ! array elements and arrays
   4 module x
   5   implicit none
   6   type t
   7      real :: x
   8   end type t
   9   type tt
  10      real :: x(2)
  11   end type tt
  12   type pointer_t
  13      real, pointer :: x(:)
  14   end type pointer_t
  15   type alloc_t
  16      real, dimension(:), allocatable :: x
  17   end type alloc_t
  18 contains
  19   subroutine foo(a)
  20     real, dimension(:) :: a
  21     real, dimension(2), parameter :: b = [1.0, 2.0]
  22     real, dimension(10) :: x
  23     type (t), dimension(1) :: vv
  24     type (pointer_t) :: pointer_v
  25     real, dimension(:), pointer :: p
  26     call invalid_1(a(1))  ! { dg-error "Rank mismatch" }
  27     call invalid_1(a) ! { dg-error "Rank mismatch" }
  28     call invalid_2(a) ! { dg-error "Element of assumed-shape or pointer" }
  29     call invalid_2(a(1))  ! { dg-error "Element of assumed-shape or pointer" }
  30     call invalid_3(b) ! { dg-error "Rank mismatch" }
  31     call invalid_3(1.0) ! { dg-error "Rank mismatch" }
  32     call invalid_4 (vv(1)%x) ! { dg-error "Rank mismatch" }
  33     call invalid_4 (b) ! { dg-error "Rank mismatch" }w
  34     call invalid_5 (b) ! { dg-error "Rank mismatch" }
  35     call invalid_5 (vv(1)%x) ! { dg-error "Rank mismatch" }
  36     call invalid_6 (x) ! { dg-error "cannot correspond to actual argument" }
  37     call invalid_6 (pointer_v%x(1)) ! { dg-error "cannot correspond to actual argument" }
  38     call invalid_7 (pointer_v%x(1)) ! { dg-error "Rank mismatch" }
  39     call invalid_7 (x) ! { dg-error "Rank mismatch" }
  40     call invalid_8 (p(1)) ! { dg-error "Rank mismatch" }
  41     call invalid_8 (x) ! { dg-error "Rank mismatch" }
  42     call invalid_9 (x) ! { dg-error "cannot correspond to actual argument" }
  43     call invalid_9 (p(1)) ! { dg-error "cannot correspond to actual argument" }
  44   end subroutine foo
  45
  46   subroutine bar(a, alloc)
  47     real, dimension(*) :: a
  48     real, dimension(2), parameter :: b = [1.0, 2.0]
  49     type (alloc_t), pointer :: alloc
  50     type (tt) :: tt_var
  51     ! None of the ones below should issue an error.
  52     call valid_1 (a)
  53     call valid_1 (a(1))
  54     call valid_2 (a(1))
  55     call valid_2 (a)
  56     call valid_3 (b)
  57     call valid_3 (b(1))
  58     call valid_4 (tt_var%x)
  59     call valid_4 (tt_var%x(1))
  60     call valid_5 (alloc%x(1))
  61     call valid_5 (a)
  62   end subroutine bar
  63 end module x