[Bug fortran/41539] New: Calling function which takes CLASS: Rank comparison does not work

["burnus at gcc dot gnu dot org" <gcc-bugzilla at gcc dot gnu dot org>]

The following program compiles with ifort and with NAG f95 but fails with
gfortran with:

  call qsort(A,tmp)
             1
Error: Rank mismatch in argument 'a' at (1) (0 and 1)


( The program was motivated by
http://groups.google.com/group/comp.lang.fortran/msg/cde7f6104f6c29c7 )


module m_qsort
  implicit none
  type, abstract :: sort_t
  contains
    procedure(lt_cmp), deferred :: lt_cmp
  end type sort_t
  interface
    logical function lt_cmp(a,b)
      import
      class(sort_t), intent(in) :: a, b
    end function lt_cmp
  end interface
contains
  subroutine qsort(a,tmp)
    class(sort_t), intent(inout) :: a(:),tmp
    ! Fixme: Replace "tmp" by a local var and "allocate(tmp, source=a)"
  end subroutine qsort
end module m_qsort

module test
  use m_qsort
  implicit none
  type, extends(sort_t) :: sort_int_t
    integer :: i
  contains
    procedure :: lt_cmp => lt_cmp_int
  end type
contains
  logical function lt_cmp_int(a,b) result(cmp)
    class(sort_int_t), intent(in) :: a
    class(sort_t), intent(in) :: b
    select type(b)
      type is(sort_int_t)
        if (a%i < b%i) then
          cmp = .true.
        else
          cmp = .false.
        end if
      class default
        stop 'Something went wrong'
    end select
  end function lt_cmp_int
end module test

program main
  use test
  type(sort_int_t) :: A(5), tmp
  A(:)%i = [1 , 4, 5, 2, 3]
  print *, A
  call qsort(A,tmp)
  print *, A
end program main


-- 
           Summary: Calling function which takes CLASS: Rank comparison does
                    not work
           Product: gcc
           Version: 4.5.0
            Status: UNCONFIRMED
          Keywords: rejects-valid
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: burnus at gcc dot gnu dot org


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=41539