program main
use iso_fortran_env, only: dp => real64
implicit none
call test_fun1()
contains
function fun1(a, err) result(b)
real(dp), intent(in) :: a
character(:), allocatable, intent(out) :: err
real(dp) :: b(2)
if (a > 2) then
err = "a bigger than 2"
return
endif
b = 1
end function
subroutine test_fun1()
real(dp) :: a, b(2)
character(:), allocatable :: err
a = 3
b = fun1(a, err)
if (allocated(err)) then
print*,'err is allocated'
print*,'next line tries to print err'
print*,err
else
print*,b
endif
end subroutine
end program
I compile and run with
gfortran main.f90
./a.out
the result is
(base) nicholas@Nicholass-MacBook-Air test_gfortran_err % ./a.out
err is allocated
next line tries to print err
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x102fb61c7
#1 0x102fb51a3
#2 0x194092c43
#3 0x1030ac65b
zsh: segmentation fault ./a.out
My compiler version is GNU Fortran (Homebrew GCC 12.1.0) 12.1.0 and machine is a Macbook Air M1.
The problem somehow stems from fun1 having an output that is an array. The same code, except if b is a just a scalar instead of an array, works just fine.
At first glance, this looks like a compiler issue. Other than deviating from the view of striving toward “pure” functions and thus no INTENT(OUT) or INTENT(INOUT) parameters, the code looks alright.
Separately, the function result is not defined in the case where the received argument a is greater than 2. The standard requires a conforming program to define the function result and note the onus is on the programmer here.
I get the same result when b is always defined. e.g.
function fun1(a, err) result(b)
real(dp), intent(in) :: a
character(:), allocatable, intent(out) :: err
real(dp) :: b(2)
b = 1
if (a > 2) then
err = "a bigger than 2"
return
endif
end function
I’ve modified the code a bit, such that the result variable (b) and the intent(out)-variable (err) in fun1() are always defined, and also initialized err before calling fun1() optionally (the line marked by *):
program main
use iso_fortran_env, only: dp => real64
implicit none
call test_fun1()
contains
function fun1(a, err) result(b)
real(dp), intent(in) :: a
character(:), allocatable, intent(out) :: err
real(dp) :: b(2)
if (a > 2) then
b(:) = -1
err = "a bigger than 2"
return
endif
b(:) = 1
err = "OK"
end function
subroutine test_fun1()
real(dp) :: a, b(2)
character(:), allocatable :: err
!! err = "dummy" !! (*)
a = 3
b = fun1(a, err)
if (allocated(err)) then
print *, 'err is allocated'
print *, 'next line tries to print err'
print *, len(err), len_trim(err)
print *, err
endif
print *, b
end subroutine
end program
Then, if the line (*) is commented out, using Gfortran12 + Ubuntu22,
$ gfortran test.f90 && ./a.out
err is allocated
next line tries to print err
0 0
-1.0000000000000000 -1.0000000000000000
while if the line (*) is uncommented,
err is allocated
next line tries to print err
5 5
a big
-1.0000000000000000 -1.0000000000000000
The result also changes on an old MacMini, or with -fsanitize=address. It seems like the length of err is “retained” before and after the call (so 5 chars are printed when “dummy” is set). If err is not defined before the call, some garbage value will be “retained”, so resulting an undefined behavior (-> accessing invalid memory if the random value is large or negative)?
Actually testing it the machine code temporary for err is not allocated and it is a bug; so as you suspected if in the calling procedure you allocate err and make it big enough to hold the message you do not get the segfault. So in TEST_FUN1 right before calling FUN1 add “err=AAAAAAAAAAAAAAAAAAA” and you will see the length stays the same and only part of the value gets replaced; or do not do that and after testing if ERR is allocated query the length with LEN(ERR) and you will get garbage. Since any INTENT(OUT) gets deallocated I agree ERR does not have to get set although I would personally never do that; but I also really avoid leaving anything
unallocated like that so it looked “wrong” to me, I cannot think of a reason it is not standard conforming, and although ERR gets flagged as allocated I see no where where it ever allocates it, and cannot think of a reason that is not a bug.
This is a very interesting discussion! I tried a couple of different variations of the original code that do not seem to encounter the bug. One variation replaces the function with a subroutine, while the other one packs b and err into a derived type which allows one to declare the function pure.
Code
program main
use iso_fortran_env, only: dp => real64
implicit none
type :: t1
real(dp):: b(2)
character(:), allocatable :: err
endtype t1
call test_fun1()
contains
pure function fun1(a) result(t)
real(dp), intent(in) :: a
type(t1):: t
t%b = 1
if (a > 2) then
t%err = "a bigger than 2"
return
endif
end function
subroutine sub1(a,b,err)
real(dp), intent(in) :: a
real(dp), intent(out) :: b(2)
character(:), allocatable,intent(out) :: err
b = 1
if (a > 2) then
err = "a bigger than 2"
return
endif
end subroutine
subroutine test_fun1()
real(dp) :: a,b(2)
type(t1) :: t
character(:), allocatable :: err
a = 3
t = fun1(a)
if (allocated(t%err)) then
print*,'err is allocated'
print*,'next line tries to print err'
print*,t%err
else
print*,t%b
endif
a = 1
t = fun1(a)
if (allocated(t%err)) then
print*,'err is allocated'
print*,'next line tries to print err'
print*,t%err
else
print*,t%b
endif
a = 3
call sub1(a,b, err)
if (allocated(err)) then
print*,'err is allocated'
print*,'next line tries to print err'
print*,err
else
print*,b
endif
a = 1
call sub1(a,b, err)
if (allocated(err)) then
print*,'err is allocated'
print*,'next line tries to print err'
print*,err
else
print*,b
endif
end subroutine
end program
Intel Fortran has no problem.
Gfortran has problem.
The cygwin64 gfortran on windows cannot show complete string, it shows things like ''a is bigge".
Gfortran 11.2.0 on ubuntu has the same issue OP mentioned.
I don’t know why, but if you define
character(:), allocatable :: str
inside a type as below,
type :: var_char
character(:), allocatable :: str
end type var_char
Then the code work with gfortran without problem.
see below code, the !!! are the small modifications.
program main
use iso_fortran_env, only: dp => real64
implicit none
type :: var_char !!!!!!!!!!!!!!!
character(:), allocatable :: str !!!!!!!!!!!!!!!!!!!1
end type var_char !!!!!!!!!!!!!!!
call test_fun1()
contains
function fun1(a, err) result(b)
real(dp), intent(in) :: a
type(var_char) :: err !!!!!!!!!!!!!!!!!
real(dp) :: b(2)
if (a > 2) then
err%str = 'a is bigger than 2' !!!!!!!!!!!!!!!!!!!!!
return
endif
b = 1
end function
subroutine test_fun1()
real(dp) :: a, b(2)
type(var_char) :: err !!!!!!!!!!!!!!!!!!!!!
a = 3
b = fun1(a, err)
if (allocated(err%str)) then !!!!!!!!!!!!!
print*,'err is allocated'
print*,'next line tries to print err'
write(6,'(a)') err%str !!!!!!!!!!!!!!!!!
else
print*,b
endif
end subroutine
end program
See a similar topic,
In short, I don’t know why, but if
character(:), allocatable :: str
needs to be used, it is best to define it inside a type.
There is kind of a technical error here. fun1() is not defined in this original version of the code. The result is declared as a real array of length 2, but its values are not set. It is technically illegal to assign those undefined values to the array b(:). Usually a simple assignment causes no problems, it is only when those random bit patterns are used in arithmetic expressions that problems arise. But it is an error nonetheless.
However, the later modifications of the code eliminate that usually benign error, and the code still aborts, so that was not the cause of the seg fault.