intel fortran 2003

[griflet]

Hi,

I'm trying to test the new fortran 2003 OO features. Fortran 2003 is quite interesting, because where I work there is a large database of fortran 95 code that we could reuse (> 700 000 lines of code) ...

Anyway, I started creating a "linked list" class with a cool-looking "for each in " method; it goes like:

type(C_Collection) :: mylist

type(C_Collection), pointer :: item => null()

do while ( mylist.forEach(item) )

...

end do

My goal would have been then to extend the type to any other class with "linked list" characteristics. I managed to make it work at first.

But then I went on to try to refrain the direct access to the type fields and added a layer of get and set methods; but it doesn't seem to work.

I wanted to avoid stuff like this

mylist%next => null()

by using stuff like this

call mylist.setNextPointer( null() )

but it doesn't work. I must use

ptr => null()

call mylist.setNextPointer( ptr )

so it can work.

Anyway, here's my code.

I think it should work according to fortran 2003 specifs, but it yields with ifort 11.1 in windows at compilation

catastrophic error: **Internal compiler error: internal abort** Please report this error along with the circumstances in which it occurred in a Software Problem Report. Note: File and line given may not be explicit cause of this error. compilation aborted for E:\\Projects\\griflet\\fortran\\paises\\class_colecao.F90 (code 3)

and, though it compiles, it yields a segmentation fault with ifort 12 in linux.

Anyone can help me understand what are the limitations of present limitations of intel fortran 2003?

This isn't urgent at all; it's really weekend test-drives only...

Thank you,

Cheers

Guillaume

Here's the class code.

[fortran]
[/fortran]

[fortran]  module class_collection  

  !When using classes in fortran 2003, try considering that'%' and 'target' 

  !are forbidden directives, except in 'get' and 'set' methods.

  !Encapsulate in special methods uses of 'associated' and return logical

  !result instead.

  implicit none

  private

  public C_Collection

  type C_Collection

    integer                         :: id = 1

    class(C_Collection), pointer       :: founder => null()

    class(C_Collection), pointer       :: next => null()

  contains

    !Constructors

    procedure                       :: init => init_list

    !Sets ( '%' allowed for writing )

    procedure                       :: defineId => defineId_node ! ( 'target' allowed )

    procedure                       :: defineFirst => defineFirst_node

    procedure                       :: defineNext => defineNext_node

    !Gets ( '%' allowed for reading)

    procedure                       :: getSelf => getSelf_node

    procedure                       :: getId => getId_node

    procedure                       :: getFirst => getFirst_node

    procedure                       :: getNext => getNext_node

    !C_Collection methods

    procedure                       :: hasFirst => hasFirst_node

    procedure                       :: hasNext => hasNext_node

    procedure                       :: add => add_node

    procedure                       :: forEach => forEach_item

    procedure                       :: get => get_node
  
    procedure                       :: getPrevious => getPrevious_node

    procedure                       :: getLast => getLast_node

    procedure                       :: showId => showId_node

    procedure                       :: show => show_list

    procedure                       :: remove => remove_node

    !Destructors

    procedure                       :: finalize => remove_list

  end type C_Collection

contains

  !Constructors

  subroutine init_list(self, id)

    class(C_Collection)              :: self

    class(C_Collection), pointer     :: ptr

    integer, optional             :: id

    if ( .not. self.hasFirst() ) then      

      if ( present(id) ) then

        call self.defineId( id )

      end if

      ptr => self.getSelf()

      call self.defineFirst( ptr )

      ptr => null()

      call self.defineNext( ptr )

      write(*,*) 'Criado item numero ', self.getId()

    end if

  end subroutine init_list

  !Sets ( '%' allowed for writing )

  subroutine defineId_node(self, id)

    class(C_Collection)              :: self

    integer                       :: id

    self%id = id

  end subroutine defineId_node

  subroutine defineFirst_node(self, primeiro)

    class(C_Collection)              :: self

    class(C_Collection), pointer     :: primeiro

    self%founder => primeiro

  end subroutine defineFirst_node

  subroutine defineNext_node(self, next)

    class(C_Collection)              :: self

    class(C_Collection), pointer     :: next

    self%next => next

  end subroutine defineNext_node

  !Gets ( '%' allowed for reading) 

  function getSelf_node(self) result(proprio)

    class(C_Collection), target      :: self

    class(C_Collection), pointer     :: proprio

    proprio => self

  end function getSelf_node

  function getId_node(self) result(id)

    class(C_Collection)              :: self

    integer                        :: id

    id = self%id

  end function getId_node

  function getFirst_node(self) result(primeiro)

    class(C_Collection)                          :: self

    class(C_Collection), pointer                 :: primeiro

    primeiro => self%founder

  end function getFirst_node

  function getNext_node(self) result(next)

    class(C_Collection)              :: self

    class(C_Collection), pointer     :: next, ptr

    if ( self.hasNext() ) then

      next => self%next

    else

      next => null()

    end if

  end function getNext_node

  !C_Collection methods

  function hasFirst_node(self) result(tem)
  
    class(C_Collection), intent(in)  :: self

    logical                       :: tem

    class(C_Collection), pointer     :: primeiro

    primeiro => self.getFirst()

    if ( associated( primeiro ) ) then

      tem = .true.

    else

      tem = .false.

    end if

  end function hasFirst_node

  function hasNext_node(self) result(tem)

    class(C_Collection), intent(in)  :: self

    logical                       :: tem

    class(C_Collection), pointer     :: next

    next => self.getNext()

    if ( associated( next ) ) then
      
      tem = .true.

    else

      tem = .false.

    end if

  end function hasNext_node

  subroutine add_node(self)

    class(C_Collection), intent(in)  :: self

    class(C_Collection), pointer     :: ultimo, new, primeiro

    if ( .not. self.hasFirst() ) then

      call self.init()

    end if

    write(*,*)'a'

    primeiro => self.getFirst()

    write(*,*) 'b'

    ultimo => self.getLast()

    write(*,*) 'c'

    allocate(new)
    
    call new.defineId( ultimo.getId() + 1 )

    call new.defineFirst( primeiro )

    call ultimo.defineNext( new )

    write(*,*) 'Criado item numero ', new.getId()

  end subroutine add_node

  function forEach_item(self, item) result(keepup)

    !Simulates 'for each  in  do ... end do'

    !usage: do while ( Lista.forEach (item) )

    !usage: ...

    !usage: end do

    class(C_Collection)                             :: self

    class(C_Collection), pointer, intent(inout)     :: item

    class(C_Collection), pointer                    :: ptr
    
    class(C_Collection), pointer                    :: itemZero => null()

    logical                                      :: keepup

    if ( .not. associated( item ) ) then

      allocate( itemZero )

      call itemZero.defineId(0)

      ptr => self.getFirst()

      call itemZero.defineFirst( ptr )

      ptr => self.getSelf()

      call itemZero.defineNext( ptr )

      item => itemZero

    end if

    if ( item.hasNext() ) then

      item => item.getNext()
  
      keepup = .true.

    else

      item => null()
      
      keepup = .false.

    end if

    if ( associated( itemZero ) ) then

      deallocate( itemZero )

    end if

  end function forEach_item

  function get_node(self,id) result(node)

    class(C_Collection)              :: self

    class(C_Collection), pointer     :: node

    integer                       :: id

    node => self.getFirst()

    do while ( node.getId() .ne. id )

      if ( node.hasNext() ) then

        node => node.getNext()

      else

        id = node.getId()

        write(*,*) 'WARN 000: Nao se encontrou o node ', id, ' na collection.'

      end if

    end do

  end function get_node

  function getPrevious_node(self) result(anterior)

    class(C_Collection)              :: self

    class(C_Collection), pointer     :: anterior, next

    anterior => self.getFirst()

    if ( self.getId() .ne. anterior.getId() ) then

      next => anterior.getNext()

      do while ( next.getId() .ne. self.getId() )

        if ( next.hasNext() ) then

          anterior => anterior.getNext()

          next => next.getNext()

        else

          write(*,*) 'WARN 001: Nao foi encontrado o node anterior na collection'

          write(*,*) 'collection corrompida.'

          exit
          
        endif

      end do

    endif

  end function getPrevious_node

  function getLast_node(self) result(ultimo)

    class(C_Collection)              :: self

    class(C_Collection), pointer     :: ultimo

    ultimo => self.getSelf()

    do while ( ultimo.hasNext() )

      ultimo => ultimo.getNext()

    end do

  end function getLast_node

  subroutine showId_node(self)

    class(C_Collection)          :: self

    class(C_Collection), pointer :: ptr

    ptr => self.getPrevious()

    if ( self.getId() .eq. ptr.getId() ) then

      write(*,*) 'O item e o founder da list.'

    else

      write(*,*) 'O item anterior tem numero ', ptr.getId()

    end if

    write(*,*) 'O numero do item e o ', self.getId()

    ptr => self.getNext()

    if ( .not. self.hasNext() ) then

      write(*,*) 'O item e o ultimo da list.'

    else

      write(*,*) 'O item next tem numero', ptr.getId()

    end if

    write(*,*) ''

  end subroutine showId_node

  subroutine show_list(self)

    class(C_Collection)          :: self

    class(C_Collection), pointer :: item => null()

    do while ( self.forEach(item) )

      call item.showId()

    end do

    write(*,*) 'Lista mostrada.'

    write(*,*) ''

  end subroutine show_list

  subroutine remove_node(self)

    class(C_Collection)             :: self

    class(C_Collection), pointer    :: ultimo, preprevious, ptr

    ultimo => self.getLast()

    preprevious => ultimo.getPrevious()

    if ( ultimo.getId() .eq. preprevious.getId() ) then

      write(*,*) 'WARN: A list contem apenas o seu elemento founder.'

      write(*,*) 'No se remove o elemento founder da list.'

      write(*,*) 'O elemento founder so pode ser removido externamente.'

    else

      write(*,*) 'Removido item numero ', ultimo.getId()

      deallocate(ultimo)

    endif

    ptr => null()

    call preprevious.defineNext( ptr )

  end subroutine remove_node

  !Destructors

  subroutine remove_list(self)

    class(C_Collection)              :: self

    class(C_Collection), pointer     :: first

    first => self.getFirst()

    do while ( first.hasNext() )

      call first.remove()

    end do

    write(*,*) 'Lista esvaziada.'

    write(*,*) ''

  end subroutine remove_list

end module class_collection

!----------------- Program -----------------------------

program unitTests_collection

  use class_collection

  implicit none

  integer                     :: i

  type(C_Collection)             :: list

  call list.init(1)

  do i = 2, 15

    call list.add()

  end do

  write(*,*) ''

  call list.show()

  call list.finalize()

  call list.show()

end program unitTests_collection
[/fortran]

[Steven_L_Intel1]

First look at this tells me that there's an infinite recursion loop between HasNext and GetNext, causing the runtime error. I will look at this in more detail.

[Steven_L_Intel1]

Yep, that's exactly the problem.

add_node calls self.get_last (you do understand that the use of . instead of % is non-standard?)

get_last has this:

[plain]    do while ( ultimo.hasNext() )
      ultimo => ultimo.getNext()
    end do[/plain]

and the first thing hasNext does is:

[plain]  next => self.getNext()[/plain]

So now we are in getNext and the first thing it does is:

[plain]   if ( self.hasNext() ) then[/plain]

This is an infinite recursion, blowing the stack. The end result is usually a segfault/access violation, though I have seen it simply cause the program to exit without any messages.

[griflet]

Hi guys,

I found my error :( The 'has' function was calling the 'get' function, and the 'get' function was calling the 'has' function, over and over again, until segmentation fault (aka stack-overflow).

The 'has' must not use the 'get' and directly read the intrinsic fields of the type ...

So, it compiles and runs well with intel fortran 12 in linux. But it doesn't compiles in intel fortran 11.1 in windows.

My problem is solved, though I'd like to know how can i make it compile with intel fortran 11.1 in windows (for which my group owns a license).

Thanks.

[fortran]  function hasNext_node(self) result(has)  
  
    class(C_Collection), intent(in)  :: self  
  
    logical                       :: has
   
    if ( associated( self%next ) ) then  
        
      has = .true.  
  
    else  
  
      has = .false.  
  
    end if  
  
  end function hasNext_node  [/fortran]

[Steven_L_Intel1]

Have the license holder log in to the Intel Registration Center - it may be that you are eligible to download and use the current version, or at least a newer one. It may not be possible to find a workaround for 11.1.

[griflet]

Thank you Steve!

Yes, that was that! I didn't see your reply until today because i didn't hit the refresh button :)

Ok, I will see if I can get an upgrade for ifort 12 with the current license...

Another thing I changed was:

Functions that return pointers are not safe to use. In ifort 12, something like:

do while ( associated(list.getNext() )

doesn't work (yet). What does work is a function that returns a scalar variable:

do while ( list.hasNext() ).

That's why I transformed all my

next => list.getNext()

into

call list.getNext(next)

that way, the user of the class isn't lead into error.

Unfortunately, it makes the code look a lot less sexy. I like the recursiveness of using functions whenever I can... I hope that some future update of ifort will allow to use safely functions that return pointers.

Thank you for your help and I think I will continue to explore the fortran 2003 OO possibilities ...

Best regards

[Steven_L_Intel1]

I tried an example that declared a function returning a pointer and using a reference to the function as an argument to ASSOCIATED. It worked exactly as I expected in 12.0.5. Can you show me a short example where it does not work? Remember that the function result starts out as undefined, so if you don't define the pointer or NULLIFY it, the results are unpredictable.