trunk/gcc/testsuite/gfortran.dg/argument_checking_14.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-std=f95" }
   3 !
   4 ! PR fortran/34796
   5 !
   6 ! This checks for Fortran 2003 extensions.
   7 !
   8 ! Argument checks:
   9 ! - elements of deferred-shape arrays (= non-dummies) are allowed
  10 !   as the memory is contiguous
  11 ! - while assumed-shape arrays (= dummy arguments) and pointers are
  12 !   not (strides can make them non-contiguous)
  13 ! and
  14 ! - if the memory is non-contigous, character arguments have as
  15 !   storage size only the size of the element itself, check for
  16 !   too short actual arguments.
  17 !
  18 subroutine test2(assumed_sh_dummy, pointer_dummy)
  19 implicit none
  20 interface
  21   subroutine rlv2(y)
  22     character   :: y(3)
  23   end subroutine rlv2
  24 end interface
  25
  26 character(3)          :: assumed_sh_dummy(:,:,:)
  27 character(3), pointer :: pointer_dummy(:,:,:)
  28
  29 character(3), allocatable :: deferred(:,:,:)
  30 character(3), pointer     :: ptr(:,:,:)
  31 call rlv2(deferred(1,1,1))         ! Valid since contiguous
  32 call rlv2(ptr(1,1,1))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  33 call rlv2(assumed_sh_dummy(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  34 call rlv2(pointer_dummy(1,1,1))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  35
  36 ! The following is kind of ok: The memory access it valid
  37 ! We warn nonetheless as the result is not what is intented
  38 ! and also formally wrong.
  39 ! Using (1:string_length) would be ok.
  40 call rlv2(deferred(1,1,1)(1:3))         ! OK
  41 call rlv2(ptr(1,1,1)(1:1))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  42 call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  43 call rlv2(pointer_dummy(1,1,1)(1:3))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  44 end
  45
  46 subroutine test3(assumed_sh_dummy, pointer_dummy)
  47 implicit none
  48 interface
  49   subroutine rlv3(y)
  50     character   :: y(2)
  51   end subroutine rlv3
  52 end interface
  53
  54 character(2)          :: assumed_sh_dummy(:,:,:)
  55 character(2), pointer :: pointer_dummy(:,:,:)
  56
  57 character(2), allocatable :: deferred(:,:,:)
  58 character(2), pointer     :: ptr(:,:,:)
  59 call rlv3(deferred(1,1,1))         ! Valid since contiguous
  60 call rlv3(ptr(1,1,1))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  61 call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  62 call rlv3(pointer_dummy(1,1,1))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  63
  64 call rlv3(deferred(1,1,1)(1:2))         ! Valid since contiguous
  65 call rlv3(ptr(1,1,1)(1:2))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  66 call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  67 call rlv3(pointer_dummy(1,1,1)(1:2))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
  68 end