Community
cancel
Showing results for 
Search instead for 
Did you mean: 
Highlighted
Valued Contributor II
27 Views

Program crashes using polymorphic variables

The program below crashes in the first iteration of QUICKSORT, using Intel Fortran 2015, whereas it works correctly (or perhaps more accurately: it produces the expected output) using gfortran .4.9.3. Wrt the first iteration: I inserted a write statement to see what part of the array is being handled. Only one line of output resulted - size = 10, then it crashed.

I wrote it as an answer to a question about generic programming in Fortran. It may be related to the use of polymorphic variables, as I have another version using sortable classes that does do the job fine (and gfortran produces a somewhat strange result). So I may have reached a boundary as far as today's compilers are concerned (well, newer versions do exist, so perhaps, "last night's compilers?)

! quicksort.f90 --
!     Implement a generic QUICKSORT
!
!     Numeric basic types and a sortable class supported
!
module quicksort_def
    implicit none

    type, abstract :: sortable
        !integer :: value
    contains
        procedure(assign_object), deferred        :: copy
        procedure(one_lower_than_two), deferred   :: lower
    end type sortable

    abstract interface
        subroutine assign_object( left, right )
            import                         :: sortable
            class(sortable), intent(inout) :: left
            class(sortable), intent(in)    :: right
        end subroutine assign_object
    end interface

    abstract interface
        logical function one_lower_than_two( op1, op2 )
            import                      :: sortable
            class(sortable), intent(in) :: op1, op2
        end function one_lower_than_two
    end interface

    interface operator(<)
        module procedure lower
    end interface

contains
!
! Generic part
!
logical function lower( op1, op2 )
    class(*), intent(in) :: op1, op2

    select type (op1)
        type is (integer)
            select type (op2)
                type is (integer)
                    lower = op1 < op2
            end select

        type is (real)
            select type (op2)
                type is (real)
                    lower = op1 < op2
            end select

        class is (sortable)
            select type (op2)
                class is (sortable)
                    lower = op1%lower(op2)
            end select
    end select
end function lower

subroutine copy( op1, op2 )
    class(*) :: op1, op2

    select type (op1)
        type is (integer)
            select type (op2)
                type is (integer)
                    op1 = op2
            end select

        type is (real)
            select type (op2)
                type is (real)
                    op1 = op2
            end select

        class is (sortable)
            select type (op2)
                class is (sortable)
                    call op1%copy( op2 )
            end select
    end select
end subroutine copy

recursive subroutine quicksort( array )
    class(*), dimension(:) :: array

    class(*), allocatable :: v, tmp
    integer               :: i, j

    i = 1
    j = size(array)

    allocate( v,   source = array(1) )
    allocate( tmp, source = array(1) )

    call copy( v, array((j+i)/2) ) ! Use the middle element

    do
        do while ( array(i) < v )
            i = i + 1
        enddo
        do while ( v < array(j) )
            j = j - 1
        enddo

        if ( i <= j ) then
            call copy( tmp,      array(i) )
            call copy( array(i), array(j) )
            call copy( array(j), tmp      )
            i        = i + 1
            j        = j - 1
        endif

        if ( i > j ) then
            exit
        endif
    enddo

    if ( 1 < j ) then
        call quicksort( array(1:j) )
    endif
    if ( i < size(array) ) then
        call quicksort( array(i:) )
    endif
end subroutine quicksort

end module quicksort_def


! test program
program test_quicksort
    use quicksort_def

    implicit none

    integer, dimension(10) :: int_array
    real, dimension(10)    :: real_array
    integer                :: i

    do i = 1,size(int_array)
        int_array(i)  = 11 - i
        real_array(i) = 11.0 - i
    enddo

    write(*,*) 'Sorting ...'
    call quicksort( int_array )
    call quicksort( real_array )

    write(*,*) 'Result:'
    write(*,'(i10)')   int_array
    write(*,'(f10.2)') real_array

end program test_quicksort

 

0 Kudos
9 Replies
Highlighted
Employee
27 Views

Thanks for your report. I escalated this issue to the development team (DPD200376764).

0 Kudos
Highlighted
Valued Contributor III
27 Views

The above code basically goes into an infinite loop in function named lower because of the overloaded intrinsic operation of "<" with a procedure containing two unlimited polymorphic arguments.  If one renames the defined operation to, say, .islessthan. and changes lines 102 and 105 to use this name, then the code runs fine.  I'm not convinced there is a compiler problem here; one just has to beware when one is dealing with unlimited polymorphism.

Separately, the abstract derived type "sortable" plays no role in the code as shown.  The particular test program of only default integer and real arrays can be made to work with simpler code:

! quicksort.f90 --
!     Implement a generic QUICKSORT
!
!     default integer and real supported
!
module quicksort_def

   implicit none

   private

   public :: quicksort

contains

   recursive subroutine quicksort( array )
   
      !.. argument list
      class(*), intent(inout) :: array(:)

      !.. local variables
      integer :: i
      integer :: j
      
      i = 1
      j = size(array)

      select type ( array )

         type is ( integer )

            blk_i: block

               integer :: v
               integer :: tmp

               include "i.f90"

            end block blk_i

         type is ( real )

            blk_r: block

               real :: v
               real :: tmp

               include "i.f90"

            end block blk_r

         class default

            !.. appropriate action elided
            !   need concrete design of sortable type to make use of it

      end select

      if ( 1 < j ) then
         call quicksort( array(1:j) )
      end if
      if ( i < size(array) ) then
         call quicksort( array(i:) )
      end if

      return

   end subroutine quicksort

end module quicksort_def

Include file "i.f90":

      v = array((j+i)/2) ! Use the middle element

      do
         do while ( array(i) < v )
            i = i + 1
         end do
         do while ( v < array(j) )
            j = j - 1
         end do

         if ( i <= j ) then
            tmp = array(i)
            array(i) = array(j)
            array(j) = tmp
            i = i + 1
            j = j - 1
         end if

         if ( i > j ) then
            exit
         end if
      end do
program test_quicksort
! test program

   use quicksort_def

   implicit none

   integer, dimension(10) :: int_array
   real, dimension(10)    :: real_array
   integer                :: i

   do i = 1,size(int_array)
      int_array(i)  = 11 - i
      real_array(i) = 11.0 - i
   enddo

   write(*,*) 'Sorting ...'
   call quicksort( int_array )
   call quicksort( real_array )

   write(*,*) 'Result:'
   write(*,'(i10)')   int_array
   write(*,'(f10.2)') real_array

   stop

end program test_quicksort

Upon execution using Intel Fortran:

 Sorting ...
 Result:
         1
         2
         3
         4
         5
         6
         7
         8
         9
        10
      1.00
      2.00
      3.00
      4.00
      5.00
      6.00
      7.00
      8.00
      9.00
     10.00
Press any key to continue . . .

 

0 Kudos
Highlighted
Valued Contributor II
27 Views

I do not quite agree: I resolve the unlimited polymorphism using the select type construct. So within these type cases the compiler can and should choose the intrinsic operations, as it knows the actual type of the polymorphic variables.

I agree that the sortable class plays no role in the program as given - it was to illustrate how you could this for non-intrinsic types.

 

0 Kudos
Highlighted
Valued Contributor III
27 Views

arjenmarkus wrote:

I do not quite agree: I resolve the unlimited polymorphism using the select type construct. So within these type cases the compiler can and should choose the intrinsic operations, as it knows the actual type of the polymorphic variables. ..

I guess this should come down to the standard - does it say explicitly say as such and if so, where?  I don't recall seeing it as such, so it'll be helpful to know it.  From what I remember, don't the rules for procedure overloading as described in the  standard effectively come down to the defined operation takes precedence over the intrinsic one?  Below is a simpler test case using which Intel development team can provide feedback on how the compiler should work in strict accordance with the standard and if there are aspects left up to the processor, how they want to approach it.

module m

   implicit none

   private

   interface operator(<)
      module procedure lower
   end interface operator(<)
   public :: operator(<)

contains

   function lower( op1, op2 ) result(islessthan)

      !.. argument list
      class(*), intent(in) :: op1, op2
      !.. function result
      logical :: islessthan

      !.. local variables
      integer :: in1
      integer :: in2

      print *, " enter lower: "
      islessthan = .false.

      select type (op1)

         type is (integer)

            in1 = op1
            print *, " op 1 = ", in1

            select type (op2)

               type is (integer)

                  in2 = op2
                  print *, " op 2 = ", in2

                  islessthan = op1 < op2

            end select

         type is (real)

            select type (op2)

               type is (real)

                  islessthan = op1 < op2

            end select

         class default

            !.. appropriate action elided

      end select

   end function lower

end module m
program p

   use m, only : operator(<)

   implicit none

   logical :: islessthan

   islessthan = ( 0 < 42 )
   print *, " is 0 < 42? ", islessthan

   stop

end program p

Upon execution,

  op 1 =  0
  op 2 =  42
  enter lower:
  op 1 =  0
  op 2 =  42
  enter lower:
  op 1 =  0
  op 2 =  42
  enter lower:
  op 1 =  0
  op 2 =  42
  enter lower:
  op 1 =  0
  op 2 =  42
  enter lower:
  op 1 =  0
  op 2 =  42
  enter lower:
  op 1 =  0
  op 2 =  42
  enter lower:
  op 1 =  0
  op 2 =  42
  enter lower:
...

loop_0.png

0 Kudos
Highlighted
Valued Contributor II
27 Views

Hm, my understanding is that defined operations cannot override operations defined for intrinsic types.

0 Kudos
Highlighted
Valued Contributor III
27 Views

Here's some tidbit that may help Intel development team during their review.  Fortran 2008 standard (J3/10-007r1 WD 1539-1 2010-11-24) documentation says in section 12.4 Restrictions on generic declarations:

11 12.4.3.4.5 Restrictions on generic declarations 
.. 
38 not all functions or not all subroutines. If a generic invocation applies to both a specific procedure from an 
39 interface and an accessible intrinsic procedure, it is the specific procedure from the interface that is referenced. 

Metcalf et al. in "Modern Fortran Explained" say in section 5.18:

"If a generic invocation is ambiguous between a non-intrinsic and an intrinsic procedure, the non-intrinsic procedure is invoked."

 

0 Kudos
Highlighted
Valued Contributor III
27 Views

In a new thread on comp.lang.fortran related to the code in Message #5, IanH commented:

IanH wrote:

Note that paragraph starts "Within the scope of a generic name...".  An 
operator is not a name.  The context for the text from Modern Fortran 
Explained that you quoted is similar. 

I think the standard should specify that you cannot override intrinsic 
operations.  I see no benefit in permitting such operations to be 
overridden by CLASS(*) dummy argument functions, but I see the 
considerable possibility for lots of cost in terms of implementation and 
language specification complexity.  I think the apparently ability to do 
such an override is an oversight in the wording of the standard that has 
arisen with the introduction of CLASS(*). 

12.4.3.4.2 says in regards to defined operations that "...the types, 
kind type parameters, or ranks of the dummy arguments shall differ from 
those required for the intrinsic operation".  For the aspect of type, 
instead of "differ" it should say something like "type shall not be 
compatible". 

I note that interp F08/0087 explicitly broke Fortran 95 compatibility in 
order to squish the related possibility of overriding assignment of 
intrinsic types. 

Perhaps someone from the Intel team who interface with the standards committee can seek an interpretation and clarification on the current standard that may lead to a change in wording of the standard, assuming the standard did mean one "cannot override intrinsic 
operations .. an oversight .. that has arisen with the introduction of CLASS(*)"?

But for Intel compiler, it would mean more than a change in wording but a fix to prevent such overrides.

But I'm not convinced this is just an oversight in the wording of the standard.  My hunch is the standard did mean to allow this, but the oversight is in not extending the INTRINSIC statement to include operators.  If one could do as shown in line 21 below, it will be a cleaner way to deal with such situations in my simple-minded thinking.

module m

   implicit none

   private

   interface operator(<)
      module procedure lower
   end interface operator(<)
   public :: operator(<)

contains

   function lower( op1, op2 ) result(islessthan)

      !.. argument list
      class(*), intent(in) :: op1, op2
      !.. function result
      logical :: islessthan

      intrinsic :: operator(<) !.. NOT SUPPORTED AT PRESENT, but it should be

      !.. local variables
      integer :: in1
      integer :: in2

      print *, " enter lower: "
      islessthan = .false.

      select type (op1)

         type is (integer)

            in1 = op1
            print *, " op 1 = ", in1

            select type (op2)

               type is (integer)

                  in2 = op2
                  print *, " op 2 = ", in2

                  islessthan = op1 < op2

            end select

         type is (real)

            select type (op2)

               type is (real)

                  islessthan = op1 < op2

            end select

         class default

            !.. appropriate action elided

      end select

   end function lower

end module m

 

0 Kudos
Highlighted
Employee
27 Views

Yes this does currently result in infinite recursion. The development team has decided that the compiler should instead be doing intrinsic less-than. 

0 Kudos
Highlighted
Valued Contributor III
27 Views

AmandaS (Intel) wrote:

Yes this does currently result in infinite recursion. The development team has decided that the compiler should instead be doing intrinsic less-than. 

Amanda,

Thanks for the feedback.  Is it possible for the development team to provide some additional background on the rationale used for their decision?  Can they provide reference information in the Fortran standard that guided them toward the decision, or if this is a case where the standard pretty much leaves it up to the "processor", then where does it indicate so?  I ask because my own read of the standard suggests there is a gap when it comes to user overloads of intrinsic operations with unlimited polymorphic dummy arguments and what would be the consequent order of operations.  But I could be wrong; I don't have the patience and experience to interpret "standard speak".

At present, my sense is it will be very useful if the Intel reps on the Fortran standards committee can work with the committee to get clarification on this.  And if applicable, the committee can perhaps ponder over the value of extending the "INTRINSIC" statement to cover operators too, like I show in Message #8.  But if the development team does not think all this is necessary, then it will be good to understand why they think so i.e., which sections in the standard inform them on how this should be handled.

Thanks,

0 Kudos