What exactly are the rules for the direct assignment to the pointer returned from the function? I.e. in
at(i) = x
<...>
contains
function at(i)
type(foo_t), pointer :: at
<...>
I cannot find the right place in any documentation.
Testing with GFortran, it works if
Return type is intrinsic, e.g. integer
Return type is type but not class of the derived type
GFortran complains that the return type on LHS of the assignment expression does not have pointer attribute if the return type is class.
Intel Fortran Classic breaks with internal error if the return type is class(*).
Does it suppose to work with class returned type? In particularly, I want it to work with unlimited polymorphic class class(*). I understand that this will require run-time check of types – is this the problem with class and that is why I need to do explicit select type?
I think managed to trim the program to minimum example (below). New observation: Intel Fortran Classic doesn’t compile it neither with TYPE nor with CLASS in AT definition.
I don’t have access to ISO Fortran 2018 Standard text. Is it possible to list the constraints here?
module point_m
implicit none
! This is just a derived type work with
! The only purpose: to have overloaded assignment
! (if it makes any difference; gfortran complained about intrinsic assignment being
! used with CLASS(*) pointer)
type point_t
real :: x, y
contains
procedure, pass(self) :: copy => point_copy
generic :: assignment(=) => copy
end type
contains
subroutine point_copy(self, other)
class(point_t), intent(out) :: self
class(point_t), intent(in) :: other
self%x = other%x
self%y = other%y
end subroutine
end module
program ptrass
use point_m
implicit none
! Actual data stored here
type(point_t), dimension(10), target :: a
type(point_t) :: p
class(*), pointer :: pa
p%x = 0.1; p%y = 0.2
! I want to be able to do this, see AT() definition below
at(1) = p
! This works no matter what
pa => at(2)
select type(pa)
type is (point_t)
pa = p
end select
contains
function at(i)
integer, intent(in) :: i
! direct assignment works for TYPE but not CLASS(POINT_T) or CLASS(*)
! IFORT: doesn't work no matter what.
class(point_t), pointer :: at
at => a(i)
end function
end program
What I want: at(1) to return the associated pointer and then p is going to be copied to whatever that pointer is pointing to. I want at(1) to be lvalue in C++ -speak. I think I have seen somewhere that Fortran 2018 allows this kind of semantic (but I cannot find where I’ve seen it). GFortran does allow this if the return type of at is declared with type. But Intel Fortran doesn’t work at all. This makes me think that this kind of assignment might be GFortran extension rather than a part of the standard…
6.2 Variable
R602 variable is designator
or expr
C601 (R602) designator shall not be a constant or a subobject of a constant.
C602 (R602) expr shall be a reference to a function that has a pointer result.
1 A variable is either the data object denoted by designator or the target of expr.
I think my example is standard conforming as per Section 9.2 (Variable):
1 A variable is either the data object denoted by designator or the target of the pointer resulting from the evaluation of function-reference; this pointer shall be associated.
Execution of an intrinsic assignment causes, in effect, the evaluation of the expression expr and all expressions within variable (10.1), the possible conversion of expr to the type and type parameters of the variable (Table 10.9), and the definition of the variable with the resulting value.
The function call to compute a pointer is one such “expression within variable”, it looks like to me.
It better be associated with a valid target.
Update: Intel Fortran works if definition of at is changed to
function at(i) result (loc)
integer, intent(in) :: i
! direct assignment works for TYPE but not CLASS(POINT_T) or CLASS(*)
class(point_t), pointer :: loc
loc => a(i)
end function
(notice result(loc)). Also, notice, it works with class. I think it is a bug in Intel compiler (but there is workaround). It does complain in the main program assignment if I change the return type of at to class(*):
error #8769: If the actual argument is unlimited polymorphic, the corresponding dummy argument must also be unlimited polymorphic. [AT]…
I think this is to do with the actual assignment since class(*)-type variables are not type-compatible and explicit type selection must be performed.
As for GFortran, it looks like it has bugs left, right and center.
The bug in Intel Fortran appears to be with your original case i.e., without the RESULT clause. You may want to report this at the Intel Fortran forum.
But with the situation with polymorphic pointer as function result, my read of the standard is that conforms i.e., that it is part of the, "A pointer function reference can denote a variable in any variable definition context" facility introduced starting Fortran 2008 revision. So I reckon Intel Fortran is alright here.
Separately, note you don’t need a defined assignment with your point_t derived type, at least with the code as shown.
@mobiuseng , please note a pattern like the following with a containing derived type might be safer at the moment with the few compilers that support the Fortran 2008 feature of interest to you. With the polymorphic pointer as function result, beware of ICEs, an unfortunate situation with the state of compilers currently.
module point_m
type point_t
real :: x = 0, y = 0 ! Set appropriate defaults
end type
end module
module points_m
use point_m
type :: points_t
type(point_t), allocatable :: points(:)
contains
procedure :: at
end type
contains
function at(this, i) result(r)
class(points_t), intent(in), target :: this
integer, intent(in) :: i
type(point_t), pointer :: r
r => this%points(i)
end function
end module
use point_m
use points_m
type(points_t), target :: a
allocate( a%points(10) ) ! Or another suitable method to setup the container type
a%at(1) = point_t( x=0.1, y=0.2 )
print *, a%at(1)
end program
Just fyi, with a Fortran 2003 conformant compiler (e.g., IFORT), there is also the parameterized derived type option with the containing type:
module point_m
type point_t
real :: x = 0, y = 0 ! Set appropriate defaults
end type
end module
module points_m
use point_m
type :: points_t(n)
integer, len :: n = 1 ! Set suitable default length
type(point_t) :: points(n)
contains
procedure :: at
end type
contains
function at(this, i) result(r)
class(points_t(n=*)), intent(in), target :: this
integer, intent(in) :: i
type(point_t), pointer :: r
r => this%points(i)
end function
end module
use point_m
use points_m
type(points_t(n=10)), target :: a
a%at(1) = point_t( x=0.1, y=0.2 )
print *, a%at(1)
end program
C:\Temp>ifort /standard-semantics /warn:all a.f90
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.3.0 Build 20210609_000000
Copyright (C) 1985-2021 Intel Corporation. All rights reserved.
Microsoft (R) Incremental Linker Version 14.29.30038.1
Copyright (C) Microsoft Corporation. All rights reserved.
Fair enough. Unfortunately this is beyond my abilities. Yet, I would have preferred that GFortran’s home/wiki page would be honest: it only has partial support for F2003 (PDTs are not really working) and partial support of F2008 (this issue, maybe others).