gcc/testsuite/gfortran.dg/internal_pack_15.f90

   1 ! { dg-do run }
   2 ! { dg-options "-Warray-temporaries" }
   3 ! PR 57023
   4 ! This used to cause wrong packing because a(1:n,1:n) was
   5 ! assumed to be a full array.
   6 module mymod
   7   implicit none
   8 contains
   9   subroutine foo1(a,n)
  10     integer, dimension(n,n), intent(inout) :: a
  11     integer :: n
  12     n = n - 1
  13     call baz(a(1:n,1:n),n)  ! { dg-warning "array temporary" }
  14   end subroutine foo1
  15
  16   subroutine foo2(a,n)
  17     integer, dimension(n,n), intent(inout) :: a
  18     integer :: n
  19     call decrement(n)
  20     call baz(a(1:n,1:n),n)  ! { dg-warning "array temporary" }
  21   end subroutine foo2
  22
  23   subroutine foo3(a,n)
  24     integer, dimension(n,n), intent(inout) :: a
  25     integer :: n, m
  26     m = n - 1
  27     call baz(a(1:m,1:m),m)  ! { dg-warning "array temporary" }
  28   end subroutine foo3
  29
  30   subroutine foo4(a,n)
  31     integer, dimension(n,n), intent(inout) :: a
  32     integer, intent(in) :: n
  33     a(1:n,1:n) = 1
  34   end subroutine foo4
  35
  36   subroutine baz(a,n)
  37     integer, dimension(n,n), intent(inout) :: a
  38     integer, intent(in) :: n
  39     a = 1
  40   end subroutine baz
  41
  42   subroutine decrement(n)
  43     integer, intent(inout) :: n
  44     n = n - 1
  45   end subroutine decrement
  46
  47 end module mymod
  48
  49 program main
  50   use mymod
  51   implicit none
  52   integer, dimension(5,5) :: a, b
  53   integer :: n
  54
  55   b = 0
  56   b(1:4,1:4) = 1
  57
  58   n = 5
  59   a = 0
  60   call foo1(a,n)
  61   if (any(a /= b)) call abort
  62
  63   n = 5
  64   a = 0
  65   call foo2(a,n)
  66   if (any(a /= b)) call abort
  67
  68   n = 5
  69   a = 0
  70   call foo3(a,n)
  71   if (any(a /= b)) call abort
  72
  73   n = 5
  74   a = 0
  75   call foo4(a,n)
  76   if (any(a /= 1)) call abort
  77 end program main