gcc/testsuite/gfortran.dg/PR105658.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-Warray-temporaries" }
   3 ! Test fix for incorrectly passing array component to unlimited polymorphic procedure
   4
   5 module test_PR105658_mod
   6    implicit none
   7    type :: foo
   8      integer :: member1
   9      integer :: member2
  10    end type foo
  11 contains
  12    subroutine print_poly(array)
  13      class(*), dimension(:), intent(in) :: array
  14      select type(array)
  15      type is (integer)
  16        print*, array
  17      type is (character(*))
  18        print *, array
  19      end select
  20    end subroutine print_poly
  21
  22    subroutine do_print(thing)
  23      type(foo), dimension(3), intent(in) :: thing
  24      type(foo), parameter :: y(3) = [foo(1,2),foo(3,4),foo(5,6)]
  25      integer :: i, j, uu(5,6)
  26
  27      call print_poly(thing%member1)   ! { dg-warning "array temporary" }
  28      call print_poly(y%member2)       ! { dg-warning "array temporary" }
  29      call print_poly(y(1::2)%member2) ! { dg-warning "array temporary" }
  30
  31      ! The following array sections work without temporaries
  32      uu = reshape([(((10*i+j),i=1,5),j=1,6)],[5,6])
  33      print *, uu(2,2::2)
  34      call print_poly (uu(2,2::2))     ! no temp needed!
  35      print *, uu(1::2,6)
  36      call print_poly (uu(1::2,6))     ! no temp needed!
  37    end subroutine do_print
  38
  39    subroutine do_print2(thing2)
  40      class(foo), dimension(:), intent(in) :: thing2
  41      call print_poly (thing2% member2) ! { dg-warning "array temporary" }
  42    end subroutine do_print2
  43
  44    subroutine do_print3 ()
  45      character(3) :: c(3) = ["abc","def","ghi"]
  46      call print_poly (c(1::2))      ! no temp needed!
  47      call print_poly (c(1::2)(2:3)) ! { dg-warning "array temporary" }
  48    end subroutine do_print3
  49
  50 end module test_PR105658_mod