Consider the following class structure, which involves three separate modules:
!----------------------- in file a.f
module parent_body_mod
type :: face
class(parent_body), pointer :: bPtr
end type
type, abstract :: parent_body
integer i
type(face) :: f
end type
end module parent_body_mod
!------------------------ in file b.f
module body_mod
use parent_body_mod
type, extends(parent_body) :: body
end type
interface body
procedure :: new_body
end interface
contains
function new_body() result(b)
type(body), target :: b
b%i = 123
b%f%bPtr => b
end function
end module body_mod
!--------------------------- in file c.f
module body_group_mod
use body_mod
type :: body_group
type(body), allocatable :: b
end type
interface body_group
procedure :: new_body_group
end interface
contains
function new_body_group() result(bg)
type(body_group) :: bg
allocate(bg%b)
bg%b = body()
end function
end module body_group_mod
!------------------- The main program
use body_group_mod
type(body_group) :: my_bg
my_bg = body_group()
print *, my_bg%b%f%bPtr%i
end
!--------------------------------------
The expected output is 123, whereas the actual output is something random. The code is compiled using ifort version 18.0.1. Note that the same issue doesn't happen when using "body" class itself, i.e. the following works just fine:
type(body), allocatable :: my_b
allocate(my_b)
my_b = body()
print *, my_b%f%bPtr%i ! This produces 123 as expected.
Any help is appreciated.
The code is non conforming.
Pointers associated with unsaved local variables of a procedure become undefined when the execution of the procedure completes (F2008 16.5.2.5 (5)). The function result b in function new_body is considered such a local variable (F2008 1.3.154.1), hence the pointer component b%f%bPtr becomes undefined after the function call.
Function results are a little special compare to other local unsaved variables, in that their value is available longer than the variable exists - see F2008 Note 12.41 for some discussion.
Another way of thinking of the problems is that with the statement bg%b = body(), the body on the left hand side is a different object from the body on the right hand side. The assignment just copies the value of the right hand side object - once that assignment is complete, the right hand side object ceases to exist. Nowhere is there code to say that when the value of a body object is transferred - the pointer component needs to be updated to reference the left hand side variable being assigned to. Also note that the left hand side bg%b does not have the TARGET attribute - so there is no way that a pointer can be validly associated with it anyway.
Related
I'm trying to make a custom data-type constructor by overloading the type name. However, when making the call, the default constructor gets called instead. I cannot understand what I am doing wrong.
Here's a code snippet that has the problem.
module test
type, public :: foo
character(512) :: str
logical :: flag1
logical :: flag2
end type
! overload foo data-type
interface foo
module procedure make_foo
end interface
contains
! custom constructor
function make_foo(str, flag1) result(self)
implicit none
type(foo) :: self
character(512), intent(in) :: str
logical, intent(in), optional :: flag1
self % str = str ! this needs to be passed
self % flag1 = .false. ! this needs to be optional, and is false by default
if (present(flag1)) self % flag1 = flag1
self % flag2 = .false. ! this cannot be passed and is always false by default
end function
end module
program tmp
use test
implicit none
type(foo) :: a
a = foo("hello") ! error here
end program
I want to have a custom constructor that requires str to be passed, that allows for the optional specification of flag1 and that deals with flag2 always by itself.
When testing the data-type using its constructor, it uses the default constructor and it complains for missing components.
No initializer for component 'flag1' given in the structure constructor at (1)
I am using gfortran 10.2.0
The assignment statement
a = foo("hello")
is taken to be a reference to the generic foo if possible, and a reference to the default structure constructor for the type foo otherwise.
In the case here, the generic foo has one specific interface: make_foo. For reference to the generic foo we need foo("hello") to be consistent with make_foo.
The dummy argument str is declared as character(512) and so we are not allowed to reference it with actual argument the literal constant "Hello": that constant is (much) too short.1
The compiler falls back to the default structure constructor, and then (rightly) complains that there are components without default initialization which haven't been given values.
This reference can be fixed in one of two ways:
provide an actual argument of length at least 512
make str shorter, or better, assumed length
To address a concern about assumed length str: even if it's length 5, it still can be used in the assignment self%str = str as it will be padded with blanks at the end to make its length up to the 512 of self%str.
Whether that's strictly sufficient to deem the reference "inconsistent" is irrelevant: in trying to do this one doesn't have a Fortran program, so one can't demand the compiler tries that reference.
I am trying to the assign value to a variable at the time of declaration and use that variable to declare the dimensions of some arrays as follows,
type (typ_A), intent (in) :: str_A
integer, parameter ::
x val_4 = (str_A%val_1 + str_A%val_2),
x val_5 = str_A%val_3
integer :: array_1(str_A%val_1, str_A%val_2), array_2(val_4, val_5)
In this code, the array_1 is declared properly with the expected sizes but the array_2 is not declared. Also, I am getting errors like "This symbol must be a defined parameter, an enumerator, or an argument of an inquiry function that evaluates to a compile-time constant."
Note - I can straight away use the expression of val_4 to declare array_2, but sometimes, the expression (str_A%val_1 + str_A%val_2 + ....) is very large and have to use it to define multiple arrays. Hence, for better readability and less number of lines, I want to put it in a variable (val_4 in this case)
A Fortran parameter must be computable at compile time, as the error message hints, and str_A%val_1 etc are not known at compile time.
You can't use a variable directly for this, but you can create a nested argument:
subroutine x (str_A)
type(whatever),intent(in)::str_A
call x_2 (str_A, str_A%val_1 + str_A%val_2)
contains
subroutine x_2 (str_A, mydim)
type(whatever),intent(in)::str_A
integer::mydim
integer:: ary1(mydim), ary2(mydim), ary3(mydim)
...
end subroutine x_2
end subroutine x
or if you can put at least the type and a helper function in a containing module you can do:
module t
type whatever ...
contains
pure function mydim(str_A)
integer::mydim
type(whatever),intent(in)::str_A
mydim = str_A%val_1 + str_A%val_2
end function mydim
subroutine y (str_A)
type(whatever),intent(in)::str_A
integer:: ary1(mydim(str_A)), ary2(mydim(str_A)), ary3(mydim(str_A))
...
end subroutine y
end module t
Added since you may not have considered/realized it:
Alternatively you could simply use ALLOCATABLE arrays instead; those can be allocated (not declared) with bounds computed by any runtime expression, including a local variable.
The answer of #dave_thompson_085 already answers the root for your problem.
A Fortran parameter must be computable at compile time
There are four possibilities to achieve the behaviour you want:
If you use the block statement you create a local, nested scope where you can declare new variables. You can then declare arrays that use runtime variables outside of the block for their shapes.
integer :: n
n = compute_at_runtime()
block
integer :: M(n)
! do something with M
end block
! M does not exist anymore
As #dave_thompson_085 also put it in his answer, you can use contained procedures with a local nested scope, to declare array with runtime variables that exist outside of the procedure.
Or you use allocatable for dynamic memory and automatic destruction/deallocation.
Or you use pointer for dynamic memory, but then you have to manually cleanup.
Is the following code where a local, saved variable is exposed to an outside scope valid Fortran(>=2003) code?
I intentionally did not specify a year for the standard. If the answers differ for different standards, assuming that pointers are supported, I would be also happy to hear the answer.
program test_save
implicit none
integer, pointer :: ptr
ptr => get_number(5)
write(*, *) ptr
contains
function get_number(n) result(res)
integer, intent(in) :: n
integer, pointer :: res
integer, target, save :: internal_n
internal_n = n
res => internal_n
end function
end program
The point to consider is whether the target of res remains defined when the function exits (F2018 19.6.6p1(16)). Because the target has the SAVE attribute, it does remain defined (F2018 19.6.6p1(3)), and therefore the pointer remains defined.
Here's the example.
module example
type scheme_object
end type scheme_object
type, extends( scheme_object ) :: scheme_primitive_procedure
procedure(packageable_function), pointer, nopass :: proc_pointer
end type scheme_primitive_procedure
abstract interface
function packageable_function() result( retval )
import :: scheme_object
class(scheme_object), pointer :: retval
end function packageable_function
end interface
contains
recursive function make_primitive_procedure_object() result( retval_pointer )
type(scheme_primitive_procedure), pointer :: retval
class(scheme_object), pointer :: retval_pointer
allocate( scheme_primitive_procedure :: retval )
retval%proc_pointer => make_primitive_procedure_object
retval_pointer => retval
end function make_primitive_procedure_object
end module example
The MWE is slightly overcomplicated in the name of making the code shorter. Simply speaking, an instance of scheme_primitive_procedure should encapsulate functions returning various subtypes of scheme_object.
In the make_primitive_procedure_object the result type is a subtype of scheme_object, representing functions returning scheme objects.
What is wrong with this code? The problem is that I don't really want to only_ever return class(scheme_object)s from my procedures. I want my procedures to return pointers to various subtypes of scheme_object without explicit up-casting.
Is this possible?
If a procedure pointer object has an explicit interface (which is required for procedure pointer objects that have polymorphic arguments, amongst many other things - F2018 15.4.2.2p1), then the characteristics of the target procedure must match (bar pureness) - 10.2.2.4p3). The characteristics of a procedure that is a function include the declared type of the function result (15.3.1p1/15.3.3p1).
The declared type of the function result of the procedure must match the declared type of the function result of the procedure pointer.
I defined a derived type and encountered some problems with memory deallocation although I had written the final procedure. The code is as follows
module ModuleCoordinate
implicit none
type :: TCoordinate
real(8),dimension(:),pointer :: Coordinate => NULL()
contains
procedure :: TCoordinateAssignment
generic,public :: Assignment(=) => TCoordinateAssignment
final :: TCoordinateDel
end type TCoordinate
interface TCoordinate
module procedure :: TCoordinateInit
end interface TCoordinate
contains
subroutine TCoordinateDel(self)
type(TCoordinate),intent(inout) :: self
if(associated(self%Coordinate))deallocate(self%Coordinate)
end subroutine TCoordinateDel
subroutine TCoordinateAssignment(O1,O2)
class(TCoordinate),intent(out) :: O1
type(TCoordinate),intent(in) :: O2
if(associated(O2%Coordinate))allocate(O1%Coordinate,source=O2%Coordinate)
end subroutine TCoordinateAssignment
type(TCoordinate) function TCoordinateInit(IVal1,IVal2) result(self)
real(8),intent(in) :: IVal1,IVal2
allocate(self%Coordinate(2))
self%Coordinate=(/IVal1,IVal2/)
end function TCoordinateInit
end module ModuleCoordinate
The test code is as follows
program test
implicit none
integer(4),parameter :: NLoop=40000
integer(4) :: i
do i=1,NLoop
call TestMemory1()
call TestMemory2()
end do
pause
end program test
subroutine TestMemory1()
use ModuleCoordinate
implicit none
integer(4),parameter :: DN=10
integer(4) :: i
type(TCoordinate),dimension(DN) :: a
do i=1,DN
a(i)=TCoordinate(1.0_8,1.0_8)
end do
end subroutine TestMemory1
subroutine TestMemory2()
use ModuleCoordinate
implicit none
type(TCoordinate) :: b1,b2,b3,b4,b5,b6,b7,b8,b9,b10
b1=TCoordinate(1.0_8,1.0_8)
b2=TCoordinate(1.0_8,1.0_8)
b3=TCoordinate(1.0_8,1.0_8)
b4=TCoordinate(1.0_8,1.0_8)
b5=TCoordinate(1.0_8,1.0_8)
b6=TCoordinate(1.0_8,1.0_8)
b7=TCoordinate(1.0_8,1.0_8)
b8=TCoordinate(1.0_8,1.0_8)
b9=TCoordinate(1.0_8,1.0_8)
b10=TCoordinate(1.0_8,1.0_8)
end subroutine TestMemory2
It turns out that the subroutine TestMemory2 is OK while TestMemory1 is not, which means that when an array of this derived type is declared the final procedure doesn't work and the memory leaks.
However, if I delete the => NULL() on the right of the Coordinate in the definition of this derived type, both subroutines seem to work well.
What makes the difference when the pointer Coordinate is being deallocated?
The complier is ifort_2013_sp1.3.174 if it matters.
In the description of the finalization process we see (Fortran 2008, 4.5.6.2)
If the dynamic type of the entity has a final subroutine whose dummy argument has the same kind type parameters and rank as the entity being finalized, it is called with the entity as an actual argument. Otherwise, if there is an elemental final subroutine whose dummy argument has the same
kind type parameters as the entity being finalized, it is called with the entity as an actual argument. Otherwise, no subroutine is called at this point.
There is a final subroutine for the derived type provided only for scalar (rank-0) entities. To have finalization for your rank-1 entity the simplest way (it seems, in this case) is to make the subroutine you have elemental.
I'm slightly reluctant to mention the =>NULL() aspect as I have no current means of testing what I'm about to write, but I'll speculate.
Without the =>NULL() default initialization the pointer component has undefined association status. This means, that when you do
b1=TCoordinate(1.0_8,1.0_8)
interesting things happen.
As part of the assignment b1 is finalized on entry to TCoordinateAssignment. The finalization involves calling associated with the pointer which is of undefined association status. This is not allowed (with the consequence that any result could come about).