Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

Strange behaviour of [FINAL] type-bound-procedures and pointers in derived types

S_B_1
Beginner
516 Views

While testing the Fortran 2003 compiler features after a recent compiler upgrade, I've stumbled across a strange behaviour which occurs when one has both a type-bound deconstructor and a pointer to another derived type within the same type:

Symptoms:

When a derived type contains both a pointer to another derived type and a type-bound deconstructor (keyword "FINAL"), the pointer target isn't properly associated. It can be allocated and values can be assigned, but as soon as any type of control transfer (calling a subroutine, returning from the constructor, etc.) occurs, the pointer target memory seems to scramble - see sample code below (implicit none implied).

Work around:

Remove or change the deconstructor to a "normal" type-bound-procedure.

 

Why would this happen?

 

 

Version: Intel® Parallel Studio XE 2016 Update 3 Composer Edition for Fortran Windows* Integration for Microsoft Visual Studio* 2013, Version 16.0.0062.12

 

Sample code:

 

programm test_DeConstr
 
   ! --------------------------------------------------------------------------
    module ds_p
    
    type testp
        character(len=10)               ::  c
        integer                         ::  i
    end type testp
    
    end module
    
    
    ! --------------------------------------------------------------------------
    module mod_fails
    use ds_p
    
    type ds_fail
        integer                         ::  i
        type(testp), pointer            ::  p
    contains
        procedure                       ::  toString
        final                           ::  clean
    end type
    
    interface ds_fail
        module procedure constructorF
    end interface
    
    contains
    
    subroutine toString(self)
        class(ds_fail)                  ::  self    
        
        write(*,*) 'Testing Failure: ', self%i, self%p%c, self%p%i
    end subroutine
    
    function constructorF
        type(ds_fail)                   ::  constructorF
        
        constructorF%i   = 3
        allocate(constructorF%p)
        constructorF%p%c = '1234567890'
        constructorF%p%i = 100
    end function
    
    impure elemental subroutine clean(self)
        type(ds_fail), intent(inout)    ::  self
    
        deallocate(self%p)
    end subroutine
    
    end module
    
    
    ! --------------------------------------------------------------------------
    module mod_works
    use ds_p
    
    type ds_work
        integer                         ::  i
        type(testp), pointer            ::  p
    contains
        procedure                       ::  toString
    end type
    
    interface ds_work
        module procedure constructorW
    end interface
    
    contains
    
    subroutine toString(self)
        class(ds_work)                  ::  self    
        
        write(*,*) 'Test Working:    ', self%i, self%p%c, self%p%i
    end subroutine
    
    function constructorW
        type(ds_work)                   ::  constructorW
        
        constructorW%i   = 4
        allocate(constructorW%p)
        constructorW%p%c = '0987654321'
        constructorW%p%i = 101
    end function
    
    end module
    
    
    ! --------------------------------------------------------------------------
    program test
    
    use mod_fails
    use mod_works
    
    implicit none
    
    type(ds_fail)   ::  fails
    type(ds_work)   ::  works
    
    
    works = ds_work()
    fails = ds_fail()
    
    
    call works%toString()
    call fails%toString()
    
end program

 

0 Kudos
17 Replies
S_B_1
Beginner
516 Views

Typo in the code snippet above:

Delete the first line ...

 

0 Kudos
Steven_L_Intel1
Employee
516 Views

Clearly a bug, At first blush it seems related to also using /check:pointer. Investigation in progress.

0 Kudos
FortranFan
Honored Contributor II
516 Views

Steve Lionel (Intel) wrote:

Clearly a bug, At first blush it seems related to also using /check:pointer. Investigation in progress.

Steve,

I haven't had a chance to review the original post and the code in this thread in any detail, but as you investigate further, can you please also refer back to this thread https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/637512 and my questions therein about both the Fortran 2008 standard specifications for finalization and the Intel Fortran support for it.  That is, when you say above, "Clearly a bug", what exactly you mean by it and whether it is tied to type finalization?  And you thoughts in the context of what OP is asking about in this thread vis-a-vis the Fortran 2008 standard specification on finalization which seems to come in the way of 'construction' of types with finalization.

Thanks,

0 Kudos
Steven_L_Intel1
Employee
516 Views

After I have dug in a bit more I'll respond in detail. It may take me a few days. But it seems my comment about /check:bounds may have been premature.

0 Kudos
IanH
Honored Contributor II
516 Views

The result of calling the constructorF procedure will be finalised when the assignment statement `fails = ds_fail()` completes.  The finalization procedure deallocates the pointer component of the function result.  Intrinsic assignment has been used, which means that the pointer component of the function result is associated with the same object as the pointer object of the `fails` variable on the left hand side - i.e. the target of the pointer component of the `fails` variable has been deallocated, after fianlization of the function result the pointer component of the `fails` variable is undefined.  The toString procedure referenced by `call fails%toString()` then references that undefined pointer component.  Bad things may then happen.

A pointer component that is being used with value semantics generally needs to accompanied by defined assignment.

0 Kudos
S_B_1
Beginner
516 Views

Thanks for the quick answers.

 

@IanH:

I've tried to use a defined assignment, but I'm still encountering the error. Code for the changed parts is below. Am I doing something wrong?

Having to always override the '=' operator as soon as you have a pointer in the derived type does seem an annoying amount of work  to be able to use an automatic deconstructor ... .

 

Code (Defined assignment):

    ! --------------------------------------------------------------------------
    module ds_p
    
    type testp
        character(len=10)               :: c
        integer                         :: i
    contains
        procedure                       :: assign_dsP
        generic                         :: assignment(=) => assign_dsP
    end type testp
    
    contains
    
    subroutine assign_dsP(to, from)
       class(testp), intent(out)        :: to 
       type(testp), intent(in)          :: from
      
       to%i   = from%i
       to%c   = from%c
    end subroutine
   
    end module
    
    
    ! --------------------------------------------------------------------------
    module mod_fails
    use ds_p
    
    type ds_fail
        integer                         :: i
        type(testp), pointer            :: p
    contains
        procedure                       :: toString
        final                           :: clean
        procedure                       :: assign_dsFail
        generic                         :: assignment(=) => assign_dsFail
    end type
    
    interface ds_fail
        module procedure constructorF
    end interface
    
   contains
    
   subroutine assign_dsFail(to, from)
      class(ds_fail), intent(out)       :: to 
      type(ds_fail), intent(in)         :: from
      
      to%i   = from%i
      to%p   = from%p
   end subroutine
   
    subroutine toString(self)
        class(ds_fail)                  :: self    
        
        write(*,*) 'Testing Failure: ', self%i, self%p%c, self%p%i
    end subroutine
    
    function constructorF
        type(ds_fail)                   :: constructorF
        
        constructorF%i   = 3
        allocate(constructorF%p)
        constructorF%p%c = '1234567890'
        constructorF%p%i = 100
    end function
    
    impure elemental subroutine clean(self)
        type(ds_fail), intent(inout)    :: self
    
        deallocate(self%p)
    end subroutine
    
    end module

 

0 Kudos
Steven_L_Intel1
Employee
516 Views

I concur with Ian's explanation of what goes wrong in S.B.'s program. Intrinsic assignment of a derived type with pointer components just copies the pointer (pointer assignment), and since the final procedure deallocates the target, the result is unallocated and unpredictable.

The simple solution here is to make the p component allocatable instead of pointer. You then don't need the final procedure. The assignment will then copy the value, allocating it if necessary, and any allocation in the constructor will be automatically deallocated.

0 Kudos
IanH
Honored Contributor II
516 Views

In #7, the defined assignment in the `test_p` type is superfluous or perhaps harmful - it just supplants intrinsic assignment with something that is less capable (defined assignment doesn't do automatic reallocation of allocatables).  The defined assignment in the `ds_fail` type is problematic - when the procedure `assign_dsFail` is invoked, the pointer component in the intent(out) dummy argument `to` is undefined.  The assignment statement in the body of `assign_dsFail` then attempts to define the target of that undefined pointer component.  Bad things may happen.

Pointers in Fortran (as of Fortran 2003) should primarily be used when you need to reference some thing that is being managed elsewhere.  In the situation where the pointer component is just acting as a reference, when you assign an object with a pointer component, you generally want the copy of the original object to reference the same thing (there's still only one thing being managed elsewhere, but you now have two objects referencing that one thing).  That is the behaviour that intrinsic assignment delivers.  In the situation where the pointer component is just acting as a reference, you generally do not want the pointer component to be deallocated during finalization of the object with the component - as the thing that the pointer component references is being managed elsewhere!

A somewhat redundant alternative situation in Fortran 2003 is that you actually want value semantics with the pointer component - the thing referenced by the pointer component is actually owned by the object with the pointer component, when you copy an object you want to create a new copy of the thing to be referenced by the pointer component in the original object and when an instance of an object ceases to exist you want the thing referenced by the pointer component to be deallocated.  If you use an allocatable components rather than a pointer component then, as Steve suggests, you get this behaviour for free.  But if there is some reason that you cannot or do not want to use an allocatable component, then you need to provide the appropriate defined assignment and finalization code to make the pointer component work as you want it to.

It is not the mere presence of a pointer component that requires defined assignment and finalization - they are required because of the way in which you are trying to use the pointer component.

 

0 Kudos
S_B_1
Beginner
516 Views

Thanks very much for the very through explanation, IanH.

I unluckily cannot use ALLOCATABLE, as the code is a wrapper to improve the data handling for a f95 library which needs the derived type to be a pointer.

To conclude: the exhibited behaviour isn't a bug in the compiler, but expected, standart-conformant behaviour (if I understood the explanations correctly).

Thank you again, Steve & IanH for your help.

 

0 Kudos
Steven_L_Intel1
Employee
516 Views

Eh? You can't use allocatable but you can use type-bound procedures and FINAL?

0 Kudos
S_B_1
Beginner
516 Views

The library, which I need to use, provides several global variables of "type(x), pointer" and some functions/subroutines with 8+ arguments (also often in the form of "type(x), pointer" as well) each. Has to have such a setup as the main user of the library needs such data structures (their first program version is from the ~seventies).

I'm using the library for something else and am encapsulating everything for a much nicer data handling as the library does not provide constructors/deconstructors. Can't change anything in the library, so I'm trying to wrap it in f03-oop.

Library-equivalent is "module ds_p" (+some global vars & routines which are/expect "type(testp), pointer") and I'm writing "module mod_works/mod_fails" as a wrapper.

0 Kudos
IanH
Honored Contributor II
516 Views

S B. wrote:

To conclude: the exhibited behaviour isn't a bug in the compiler, but expected, standart-conformant behaviour (if I understood the explanations correctly).

The exhibited behaviour appears to be the consequence of a non-conforming program.  When the program is non-conforming, there are no guarantees - anything is permitted to happen and you can't expect to see a particular thing.

I think the attached variant is conforming, and perhaps behaves as the standard proscribes.  In addition to providing defined assignment and finalization for the type with the pointer component, I default initialize the pointer component such that it is nullified, which helps ensure that the pointer association status of the pointer is not undefined when it is finalized.  In intrinsic assignment, the left hand side object of the assignment statement is finalized immediately prior to receiving the value of the right hand side - this would have been another issue with the original code.  In the following example defined assignment is used - but that defined assignment is implemented by a procedure that has the left hand side of the assignment associated with an intent(out) dummy argument - that association will also trigger finalization of the left hand side of the assignment prior to executing the body of the defined assignment procedure.

module ds_p
  implicit none
  
  type testp
    character(len=10) :: c
    integer :: i
  end type testp
end module ds_p

module mod_fails
  use ds_p
  implicit none
  
  type ds_fail
    integer :: i = -1
    type(testp), pointer :: p => null()
  contains
    procedure :: assign
    generic :: assignment(=) => assign
    procedure ::  toString
    final :: clean
  end type
  
  interface ds_fail
    module procedure constructorF
  end interface
contains
  function constructorF(number)
    integer, intent(in) :: number
    type(ds_fail) :: constructorF
    
    constructorF%i = number
    allocate(constructorF%p)
    constructorF%p = testp('1234567890', 100)
  end function
  
  impure elemental subroutine assign(lhs, rhs)
    class(ds_fail), intent(out) :: lhs
    type(ds_fail), intent(in) :: rhs
    
    print "('Assigning with i of ',i0)", rhs%i
    lhs%i = rhs%i
    if (associated(rhs%p)) then
      allocate(lhs%p)
      lhs%p = rhs%p
    end if
  end subroutine assign
  
  impure elemental subroutine clean(self)
    type(ds_fail), intent(inout)    ::  self
    
    print "('Finalizing with i of ',i0)", self%i
    if (associated(self%p)) deallocate(self%p)
  end subroutine
  
  subroutine toString(self)
    class(ds_fail), intent(in) :: self
    
    write (*,*) 'Testing: ', self%i, self%p
  end subroutine
end module

program test
  use mod_fails
  implicit none
  
  type(ds_fail)   ::  a
  integer :: i
  
  ! a should be finalized before being assigned.
  ! function result should be finalized after being assigned.
  a = ds_fail(1)
  call a%toString()
  
  ! Entities existing when the main program ends are not finalized, 
  ! so do some testing in a subprogram.  And do it in a loop, so 
  ! that we might observe memory leaks.
  do i = 2, 1000000
    call internal(i)
  end do
contains
  subroutine internal(i)
    integer, intent(in) :: i
    type(ds_fail) :: b
    
    ! b should be finalized before being assigned.
    b = a
    call b%toString()
    ! b should be finalized before being assigned.
    ! function result should be finalized after being assigned.
    b = ds_fail(i)
    call b%toString()
    ! b should be finalized when procedure ends.
  end subroutine internal
end program

 

0 Kudos
FortranFan
Honored Contributor II
516 Views

IanH,

Given the needs expressed by OP about pointer components of a wrapper type (which is indeed a very valid use case among the users of Fortran), what you show in Message #13 is perhaps the only standard-conforming solution.  In it, the allocation of the component of the derived type that has a pointer attribute [ type(testp), pointer :: p ] has to be done twice; once during construction of the function result (line #33 above) and secondly during defined assignment (line #44).  It comes across as inefficient, prohibitive even, depending on the derived type component (that is, what constitutes testp), but I don't think there is any other way out in standard Fortran.

Given what you know about OO support in other languages (e.g., C++) and aspects around reference types with value semantics and so forth, is it the same situation?  Meaning, from a layman's point-of-view, an object is getting instantiated as in line #33 with 'a = ds_fail(i)'.  Let us put aside language details for a moment: does object instantiation in other languages require memory allocation twice during a similar looking operation toward object instantiation, say as done with the 'new' keyword in C++ or Microsoft's C#?

Thanks,

0 Kudos
IanH
Honored Contributor II
516 Views

(I can't comment about C#.)

What is considered a "similar looking operation" is going to be subjective.  I could write similar looking Fortran code that would avoid the need for the two separate allocations - by exposing a construction method that was a subroutine with an intent(out) argument rather than using the combination of a function plus assignment.  But the result from such a subroutine cannot be directly referenced in an expression or supplied as an dummy argument, while a construction method that is a function can be.  Depending on the circumstances these considerations (and others) will differ in importance - different implementation choices for different circumstances.

C++ has some concepts that are not present in Fortran that could make a difference, again depending on the precise definition of "similar looking".  Initialization in C++ is a distinct operation from assignment, and, unlike Fortran, C++ initialization is a "runtime" operation.  The Fortran main program in #13 has the usual separate declaration of the `a` object, with the initial definition of `a` provided by an assignment statement.  In C++ a more typical approach would be for that initial definition and declaration to be in the one statement, with the construction method actually being through invocation of a constructor of the class.  This results in in-place construction - akin to using a Fortran subroutine as the construction method. 

C++ also has the concept of copy elision, that may come into play depending on things have been coded.  A call to a copy constructor that might otherwise be implied by syntax can be elided (must be elided in some cases), even if that call to the copy constructor would have observable side effects.  The defined assignment in #13 includes, just for runtime clarity, an output statement.  If defined assignment in Fortran is taken to be the same as a copy constructor (which is a bit of a leap), then would a C++ program that omitted the corresponding output be considered similar looking?  Realistically in C++ code, you do not do things in your copy constructors that rely upon the copy constructor being called - and that optimisation ends up being very useful.

To a reasonable first approximation, the memory allocations that are required are the same for code in the two languages that achieves the same outcome.    That doesn't mean that the memory allocations will be the same for all possible implementations in the two languages - different implementation choices will make a difference.

0 Kudos
S_B_1
Beginner
515 Views

Thank you kindly, IanH, for the example. Seems I had forgotten to alloc the target pointer during the assignment definition ... :-( .

As FortranFan suspects, using the above method to wrap all the types in the library is too inefficient timewise (does e.g. include at least one "pointer to type which contains another pointer").

I'll stay with the workaround of a type-bound-deconstructor, which needs to be manually called (i.e. no FINAL keyword).

 

 

 

0 Kudos
IanH
Honored Contributor II
515 Views

S B. wrote:

As FortranFan suspects, using the above method to wrap all the types in the library is too inefficient timewise (does e.g. include at least one "pointer to type which contains another pointer").

I'll stay with the workaround of a type-bound-deconstructor, which needs to be manually called (i.e. no FINAL keyword).

I don't follow.  When you way "inefficient timewise" are you talking programmer time or execution time?

If you go to the effort of writing a wrapper type with a "type bound deconstructor", then the programmer time is going to be basically the same. 

If you are talking about execution time, then FortranFan's comments were about the time required to define an object using a constructor in the form of a function reference followed by assignment.  If this is a problem, then just use a subroutine to do the construction instead.  How you destroy your objects is a different matter - I expect no difference in execution efficiency between using a finalizer versus a manual call, however I expect a significant improvement in code robustness if finalizers are used. 

 

 

0 Kudos
S_B_1
Beginner
515 Views

I was talking about programmer time (did then miss-understand FortranFan's comment). Might well be an overreaction on my part, as I tend to have a slight aversion to typing code for deep copies of nested pointers ... .

As I don't need all the provided types, I'm nullifying the unneeded ones and just check in the deconstructor that they're actually unused (error msg otherwise). Might as well copy that code over (with slight adjustments) (types aren't instantiated or passed too often so the perf-hit is small). Thanks for the comment (and your time spend writing them) - stopped me from going down the gut-reaction path.

I do fully agree on the improvements in code robustness when using finalizers - that's why I tried using them in the first place :-).

0 Kudos
Reply