gcc/testsuite/gfortran.dg/char_length_3.f90

   1 ! { dg-do compile }
   2 ! PR fortran/25071
   3 ! Check if actual argument is too short
   4 !
   5         program test
   6            implicit none
   7            character(len=10) :: v
   8            character(len=10), target :: x
   9            character(len=20), target :: y
  10            character(len=30), target :: z
  11            character(len=10), pointer :: ptr1
  12            character(len=20), pointer :: ptr2
  13            character(len=30), pointer :: ptr3
  14            character(len=10), allocatable :: alloc1(:)
  15            character(len=20), allocatable :: alloc2(:)
  16            character(len=30), allocatable :: alloc3(:)
  17            call foo(v) ! { dg-warning "actual argument shorter than of dummy" }
  18            call foo(x) ! { dg-warning "actual argument shorter than of dummy" }
  19            call foo(y)
  20            call foo(z)
  21            ptr1 => x
  22            call foo(ptr1) ! { dg-warning "actual argument shorter than of dummy" }
  23            call bar(ptr1) ! { dg-warning "Character length mismatch" }
  24            ptr2 => y
  25            call foo(ptr2)
  26            call bar(ptr2)
  27            ptr3 => z
  28            call foo(ptr3)
  29            call bar(ptr3) ! { dg-warning "Character length mismatch" }
  30            allocate(alloc1(1))
  31            allocate(alloc2(1))
  32            allocate(alloc3(1))
  33            call arr(alloc1) ! { dg-warning "Character length mismatch" }
  34            call arr(alloc2)
  35            call arr(alloc3) ! { dg-warning "Character length mismatch" }
  36         contains
  37         subroutine foo(y)
  38            character(len=20) :: y
  39            y = 'hello world'
  40         end subroutine
  41         subroutine bar(y)
  42            character(len=20),pointer :: y
  43            y = 'hello world'
  44         end subroutine
  45         subroutine arr(y)
  46            character(len=20),allocatable :: y(:)
  47            y(1) = 'hello world'
  48         end subroutine
  49        end
  50
  51  ! Remove -Wstringop-overflow warnings.
  52  ! { dg-prune-output "overflows the destination" }