deallocating a polymorphic pointer

[hs-napa]

Hi,

What is the correct way to deallocate the object a polymorphic pointer points to? A simple DEALLOCATE gives runtime error:

forrtl: severe (173): A pointer passed to DEALLOCATE points to an array that cannot be deallocated

here is the sample code. I used compiler version 11.1.054

MODULE SHAPES
PRIVATE

   TYPE, PUBLIC, ABSTRACT :: SHAPE
   CONTAINS
     PROCEDURE(DRAW), DEFERRED :: DRAW
   END TYPE

   TYPE, PUBLIC, EXTENDS(SHAPE) :: SQUARE
   CONTAINS
     PROCEDURE :: DRAW => SQUARE_DRAW
   END TYPE

   TYPE, PUBLIC, EXTENDS(SHAPE) :: TRIANGLE
   CONTAINS
     PROCEDURE :: DRAW => TRIANGLE_DRAW
   END TYPE

   ABSTRACT INTERFACE
     SUBROUTINE DRAW( this )
       IMPORT SHAPE
       CLASS(SHAPE) :: this
     END SUBROUTINE
   END INTERFACE

PUBLIC :: CREATE_SHAPE

CONTAINS
   SUBROUTINE TRIANGLE_DRAW( this )
     CLASS(TRIANGLE) :: this
     WRITE(*,*) "Drawing TRIANGLE"
   END SUBROUTINE

   SUBROUTINE SQUARE_DRAW( this )
     CLASS(SQUARE) :: this
     WRITE(*,*) "Drawing SQUARE"
   END SUBROUTINE

   SUBROUTINE CREATE_SHAPE( name, new )
     IMPLICIT NONE
     CLASS(SHAPE), POINTER, INTENT(OUT) :: new
     CHARACTER(LEN=*), INTENT(IN) :: name
     CLASS(TRIANGLE), POINTER :: my_triangle
     CLASS(SQUARE), POINTER :: my_square

     new => NULL( )
     SELECT CASE( name )
     CASE ( 'TRIANGLE' )
       ALLOCATE( my_triangle )
       new => my_triangle
     CASE ( 'SQUARE' )
       ALLOCATE( my_square )
       new => my_square
     END SELECT
     RETURN
   END SUBROUTINE

END MODULE

PROGRAM TEST
  USE SHAPES
  IMPLICIT NONE
  CLASS(SHAPE), POINTER :: my_shape

  CALL CREATE_SHAPE( 'TRIANGLE', my_shape )
  CALL my_shape%DRAW()

  DEALLOCATE( my_shape ) !! <- runtime error!!

  CALL CREATE_SHAPE( 'SQUARE', my_shape )
  CALL my_shape%DRAW()

  DEALLOCATE( my_shape )
END PROGRAM

[Steven_L_Intel1 · Accepted solution]

This is an interesting issue that came to our attention recently. At present, we do not allow deallocation of a pointer which became defined through pointer assignment, though there are circumstances where this might be legal. I'll bring this to the developers' attention.

Let me suggest, however, that there is a much more elegant way to do what you show here, and this works:

MODULE SHAPES
PRIVATE

TYPE, PUBLIC, ABSTRACT :: SHAPE
CONTAINS
PROCEDURE(DRAW), DEFERRED :: DRAW
END TYPE

TYPE, PUBLIC, EXTENDS(SHAPE) :: SQUARE
CONTAINS
PROCEDURE :: DRAW => SQUARE_DRAW
END TYPE

TYPE, PUBLIC, EXTENDS(SHAPE) :: TRIANGLE
CONTAINS
PROCEDURE :: DRAW => TRIANGLE_DRAW
END TYPE

ABSTRACT INTERFACE
SUBROUTINE DRAW( this )
IMPORT SHAPE
CLASS(SHAPE) :: this
END SUBROUTINE
END INTERFACE

PUBLIC :: CREATE_SHAPE

CONTAINS
SUBROUTINE TRIANGLE_DRAW( this )
CLASS(TRIANGLE) :: this
WRITE(*,*) "Drawing TRIANGLE"
END SUBROUTINE

SUBROUTINE SQUARE_DRAW( this )
CLASS(SQUARE) :: this
WRITE(*,*) "Drawing SQUARE"
END SUBROUTINE

SUBROUTINE CREATE_SHAPE( name, new )
IMPLICIT NONE
CLASS(SHAPE), ALLOCATABLE, INTENT(OUT) :: new
CHARACTER(LEN=*), INTENT(IN) :: name

SELECT CASE( name )
CASE ( 'TRIANGLE' )
ALLOCATE( TRIANGLE :: new )
CASE ( 'SQUARE' )
ALLOCATE( SQUARE :: new )
END SELECT
RETURN
END SUBROUTINE

END MODULE

PROGRAM TEST
USE SHAPES
IMPLICIT NONE
CLASS(SHAPE), ALLOCATABLE :: my_shape

CALL CREATE_SHAPE( 'TRIANGLE', my_shape )
CALL my_shape%DRAW()

DEALLOCATE( my_shape ) !! <- runtime error!!

CALL CREATE_SHAPE( 'SQUARE', my_shape )
CALL my_shape%DRAW()

DEALLOCATE( my_shape )
END PROGRAM

[hs-napa]

Thank you for a beautiful solution for the problem!

I can live with the restriction of not being able to deallocate pointers which became defined through pointer assignment. I just needed a way to dispose the object created by the "factory method" CREATE_SHAPE. Creating a memory leak is not an option ;).

[Steven_L_Intel1]

If you use ALLOCATABLE, you'll never get a memory leak. (Or at least you're not supposed to.) My advice is that anytime you think you want a POINTER, see if ALLOCATBLE will work for you instead. Note that with ALLOCATABLE, INTENT(OUT), the old storage is automatically deallocated on entry to the subroutine.

[hs-napa]

That's even better! I did a quick test with it and I really do not need a pointer type. For some reason I had the misunderstanding that polymorphism in Fortran 2003 only works with the use of pointers. The object oriented features in FORTRAN 2003 are quite different from what I'm used to in other languages. I suppose it takes some time for me to feel comfortable with it.

Many thanks.

[Steven_L_Intel1]

This is expected to be fixed in 11.1 Update 7, due late August.