I do not believe it is possible to write a set of functions fun which can be called in the following ways:
type :: FooType
end type
type :: BarType
end type
type(FooType), allocatable :: foo ! An unallocated constant
type(BarType), allocatable :: bar ! An unallocated constant
call fun() ! No argument
call fun(foo) ! A FooType argument which is not present()
call fun(FooType()) ! A FooType argument which is present()
call fun(bar) ! A BarType argument which is not present()
call fun(BarType()) ! A BarType argument which is present()
Writing a function fun with a type(FooType), optional argument and another with a type(BarType), optional argument is not allowed because the two are ambiguous. And any attempt to resolve the ambiguity disallows passing arguments which are named but not present(), like the second and fourth cases above.
The only solution I could find previously was using a class(*), optional argument, but obviously this introduces new problems.
Can anyone come up with a nice solution to this problem using existing Fortran? Or perhaps a change to the language which would make this possible?
I tested the idea with a simple but complete program - I needed to make one additional change to the above:
call fun_complete( bar=bar ), because otherwise the first optional argument is assumed. Both gfortran and Intel Fortran oneAPI accept the attached program and do not complain when asked to verify it against the F2018 standard.
! fun_foo_bar.f90 --
! Disambiguatie subroutines with optional arguments
!
module fun_ambiguous
implicit none
interface fun
procedure fun_no_arg, fun_foo, fun_bar, fun_foo_bar
end interface
contains
subroutine fun_no_arg()
call fun_complete()
end subroutine fun_no_arg
subroutine fun_foo( foo )
real :: foo
call fun_complete( foo )
end subroutine fun_foo
subroutine fun_bar( bar )
integer :: bar
call fun_complete( bar = bar )
end subroutine fun_bar
subroutine fun_foo_bar( foo, bar )
real :: foo
integer :: bar
call fun_complete( foo, bar )
end subroutine fun_foo_bar
subroutine fun_complete( foo, bar )
real, optional :: foo
integer, optional :: bar
if ( present(foo) ) then
write(*,*) 'foo present'
endif
if ( present(bar) ) then
write(*,*) 'bar present'
endif
write(*,*) 'fun_complete done'
end subroutine fun_complete
end module fun_ambiguous
! test --
program test_fun_ambiguous
use fun_ambiguous
call fun( 1.0 )
call fun( 42 )
call fun( 1.0, 42 )
end program test_fun_ambiguous
Hm, I must have misunderstood the question. But why would the association or allocation status matter? Isn’t it the presence of the argument that is important here?
module test
implicit none
type :: FooType
end type
type :: BarType
end type
interface fun
procedure fun_no_arg, fun_foo, fun_bar
end interface
contains
subroutine fun_no_arg()
write(*,*) 'no arg'
end subroutine
subroutine fun_foo(arg)
type(FooType) :: arg
call fun_foo_(arg)
end subroutine fun_foo
subroutine fun_foo_(arg)
type(FooType), optional :: arg
write(*,*) 'foo', present(arg)
end subroutine
subroutine fun_bar(arg)
type(BarType) :: arg
call fun_bar_(arg)
end subroutine fun_bar
subroutine fun_bar_(arg)
type(BarType), optional :: arg
write(*,*) 'bar', present(arg)
end subroutine
end module
program p
use test
type(FooType), allocatable :: foo ! An unallocated constant
type(BarType), allocatable :: bar ! An unallocated constant
write(*,*) 'fun()'
call fun() ! No argument
write(*,*) 'fun(foo)'
call fun(foo) ! A FooType argument which is not present()
write(*,*) 'fun(FooType())'
call fun(FooType()) ! A FooType argument which is present()
write(*,*) 'fun(bar)'
call fun(bar) ! A BarType argument which is not present()
write(*,*) 'fun(BarType())'
call fun(BarType()) ! A BarType argument which is present()
end program
writes the output
fun()
no arg
fun(foo)
foo F
fun(FooType())
foo T
fun(bar)
bar F
fun(BarType())
bar T
So it seems to be working as intended, although I have no idea if this is standard compliant.
Taking NAG as most standard compliant compiler I have around for checking, looks like it is not:
❯ nagfor opt.f90 -g -f2018 -C=all && ./a.out
NAG Fortran Compiler Release 7.0(Yurakucho) Build 7050
[NAG Fortran Compiler normal termination]
fun()
no arg
fun(foo)
Runtime Error: opt.f90, line 47: ALLOCATABLE FOO is not currently allocated
Program terminated by fatal error
Aborted (core dumped)
Not quite what you wanted, but this is ok’ed by NAG compiler (with full runtime checks).
module m_type
type, abstract :: AbstrType
end type
type, extends(AbstrType) :: FooType
end type
type, extends(AbstrType) :: BarType
end type
end module m_type
program test
use m_type
type(FooType), allocatable :: foo ! An unallocated constant
type(BarType), allocatable :: bar ! An unallocated constant
print '(A)','fun()'
call fun() ! No argument
print '(A)','fun(foo)'
call fun(foo) ! A FooType argument which is not present()
print '(A)','fun(FooType())'
call fun(FooType()) ! A FooType argument which is present()
print '(A)','fun(bar)'
call fun(bar) ! A BarType argument which is not present()
print '(A)','fun(BarType())'
call fun(BarType()) ! A BarType argument which is present()
contains
subroutine fun(t)
use m_type
class(AbstrType), optional::t
Logical ::is_present
is_present = present(t)
If (is_present) Then
Select Type (t)
Type Is (FooType)
print '(A,1X,L1,1X,A)',"ok", is_present, "Foo"
Type Is (BarType)
print '(A,1X,L1,1X,A)',"ok", is_present, "Bar"
Class Default
print '(A,1X,L1)',"ok", is_present, "Other"
End Select
Else
print '(A,1X,L1)',"ok", is_present
End If
end subroutine fun
end program
output
fun()
ok F
fun(foo)
ok F
fun(FooType())
ok T Foo
fun(bar)
ok F
fun(BarType())
ok T Bar
Thanks @themos. This is similar to the class(*) solution I eventually gave to my original stack overflow question.
It certainly solves the problem in some cases, but it doesn’t feel like an ideal solution. e.g. it would be nice to overload fun on a case-by-case basis each time a new type is defined. And this solution doesn’t work for intrinsic types. Still, it’s better than anything I had so far, so thank you.
I think the variant behaviour of the Intel compiler is down to a known bug in ifort where present() is evaluated incorrectly for class arguments. I submitted a similar bug report to them a few months back.
For whatever it’s worth, my read of the standard is the procedure reference to fun (call fun(foo)) with an actual argument that is an unallocated allocatable object foo whereas the dummy argument is not optional does not conform. However, if I’m not mistaken, there doesn’t appear to be a numbered constraint against this, thus the processor is not required to issue a diagnostic and this is one of those instances that fall under the realm of programmer responsibility.
On the larger point about striving toward standard Fortran code to define a function that can mimic existing or future intrinsic capabilities, please note as of now, it’s an exercise in futility. The language has certain critical gaps and lacks enough in flexibility when it comes to generics, overloading, etc. that prevents the full realization of modern and compact and reusable Fortran library code in the burgeoning complexity of scientific and technical computing apps.
program opt
implicit none
integer, allocatable :: a
print *, allocated(a), is_present(a)
allocate(a)
print *, allocated(a), is_present(a)
contains
logical function is_present(a)
integer, allocatable, intent(in), optional :: a
is_present = present(a)
end function is_present
end program opt
A dummy argument or an entity that is host associated with a dummy argument is not present if the dummy argument
• does not correspond to an actual argument,
• corresponds to an actual argument that is not present, or
• does not have the ALLOCATABLE or POINTER attribute, and corresponds to an actual argument that
– has the ALLOCATABLE attribute and is not allocated, or
– has the POINTER attribute and is disassociated;
otherwise, it is present.
NAG compiler complains of allocatable function result used in function reference with an allocatable dummy.
8.5.3 ALLOCATABLE attribute
A variable with the ALLOCATABLE attribute is a variable for which space is allocated during execution.
NOTE 1
Only variables and components can have the ALLOCATABLE attribute. The result of referencing a function whose result variable has the ALLOCATABLE attribute is a value that does not itself have the ALLOCATABLE attribute.
consequently:
NAG Fortran Compiler Release 7.0(Yurakucho) Build 7048
Warning: /tmp/c.f90, line 31: Result CONSTRUCTED of function FOO_CREATE has not been assigned a value
Warning: /tmp/c.f90, line 45: Result CONSTRUCTED of function BAR_CREATE has not been assigned a value
Error: /tmp/c.f90, line 64: Expected an ALLOCATABLE variable for argument FOO (no. 1) of FOO_FUN
Error: /tmp/c.f90, line 66: Expected an ALLOCATABLE variable for argument BAR (no. 1) of BAR_FUN
so, this variant is ok
module types
type :: FooType
endtype
type :: BarType
endtype
interface FooType
module procedure foo_create
endinterface
interface BarType
module procedure bar_create
endinterface
interface fun
module procedure noarg_fun
module procedure foo_fun
module procedure bar_fun
endinterface
contains
subroutine noarg_fun()
print *, 'fun()'
endsubroutine
function foo_create() result(constructed)
type(FooType), allocatable :: constructed
allocate(constructed)
endfunction
subroutine foo_fun(foo)
type(FooType), allocatable, intent(in) :: foo
if(allocated(foo)) then
print *, 'fun(FooType())'
else
print *, 'fun(foo)'
endif
endsubroutine
function bar_create() result(constructed)
type(BarType), allocatable :: constructed
allocate(constructed)
endfunction
subroutine bar_fun(bar)
type(BarType), allocatable, intent(in) :: bar
if(allocated(bar)) then
print *, 'fun(BarType())'
else
print *, 'fun(bar)'
endif
endsubroutine
endmodule types
program test
use types
type(FooType), allocatable :: foo ! An unallocated constant
type(BarType), allocatable :: bar ! An unallocated constant
type(FooType), allocatable :: foo1
type(BarType), allocatable :: bar1
Allocate(foo1,bar1))
foo1 = FooType()
bar1 = BarType()
call fun() ! No argument
call fun(foo) ! A FooType argument which is not allocated
call fun(foo1) ! A FooType argument which is allocated
call fun(bar) ! A BarType argument which is not allocated
call fun(bar1) ! A BarType argument which is allocated
endprogram test
