Hi all,
I am in a software package submission process, and when I undertake it I get the following warning that prevents me to complete it:
use numbers_utils
| 1
Warning: Type specified for intrinsic function ‘size’ at (1) is ignored [-Wsurprising]
In particular, I have overloaded the intrinsic function “size” in the module “types”, that I import into “numbers_utils”. The definition of the overloaded interface follows:
interface size
module procedure number__size
module procedure graph__size
end interface size
...
pure function number__size (x) result(sz)
implicit none
type(number), intent(in) :: x
integer :: sz
sz = 0
if (is_allocated(x)) sz = product(x%shp)
end function number__size
pure function graph__size (x) result(sz)
implicit none
type(graph), intent(in) :: x
integer :: sz
sz = 0
if (is_allocated(x)) sz = size(x%nodes)
end function graph__size
I am compiling with “gfortran” version 7.5.0 on Ubuntu 18.04, and am not able to reproduce the warning on my environment and not even a couple of VM that I have running on AWS. The submission process runs on a Debian server. As quick fix I will avoid the overloading which I think it is what is causing the problem. However I would be glad if someone could point me towards the actual cause of this warning, so as to correctly write the overloaded interface in the future.
Could you isolate a complete minimal working example?
I tried creating my own, but could not reproduce the error:
module test_size
implicit none
type graph
real, allocatable :: nodes(:)
end type
interface size
module procedure graph__size
end interface
contains
pure function graph__size (x) result(sz)
implicit none
type(graph), intent(in) :: x
integer :: sz
sz = 0
if (allocated(x%nodes)) sz = size(x%nodes)
end function graph__size
end module
module utils
use test_size
end module
program main
use utils
implicit none
type(graph) :: x
allocate(x%nodes(10))
print *, size(x)
end program
Hi @ivanpribec,
thanks a lot for thanking the time to try this out. Unfortunately I cannot reproduce the warning either. I tried locally, and on a couple of virtual machine in AWS without getting the warning.
I’ll try to isolate the example as you suggested.
Another detail is that type attributes in my case are pointers. Thus it should be
type graph
real, pointer :: nodes( : ) => null()
end type
Thanks again and I hope to get back with the isolated example asap!
Extending a existing generic (including an intrinsic one) is allowed as long as the new specific procedures are distinguishable from each other and from the existing specifics already in the generic. In particular, this process does not alter any of the existing specifics. So the Warning is, indeed, a “surprise”. I suspect it was a bug in gfortran in the past. Note that gfortran 7.5.0 is fairly old, and the problem might have been since fixed.
Hi @billlong,
that the conclusion I ended up with as well. Apologies to @ivanpribec it is quite time consuming for me to isolate a reproducible example from the large body of code I have. Further more I am quite skeptical on the possibility of reproducing the warning consistently. Thus I will take the answer of @billlong and close the issue. Thanks to you both for your help.
1 Like
Here is a reproducer along similar lines upon which I stumbled in my code, when using -Wsurprising.
module iso_varying_string
implicit none
integer, parameter, private :: GET_BUFFER_LEN = 1
type, public :: varying_string
private
character(LEN=1), dimension(:), allocatable :: chars
end type varying_string
interface assignment(=)
module procedure op_assign_CH_VS
module procedure op_assign_VS_CH
end interface assignment(=)
interface char
module procedure char_auto
module procedure char_fixed
end interface char
interface len
module procedure len_
end interface len
interface trim
module procedure trim_
end interface trim
public :: assignment(=)
public :: char
public :: len
public :: trim
private :: op_assign_CH_VS
private :: op_assign_VS_CH
private :: char_auto
private :: char_fixed
private :: len_
private :: trim_
contains
elemental function len_ (string) result (length)
type(varying_string), intent(in) :: string
integer :: length
if(ALLOCATED(string%chars)) then
length = SIZE(string%chars)
else
length = 0
endif
end function len_
elemental subroutine op_assign_CH_VS (var, exp)
character(LEN=*), intent(out) :: var
type(varying_string), intent(in) :: exp
end subroutine op_assign_CH_VS
elemental subroutine op_assign_VS_CH (var, exp)
type(varying_string), intent(out) :: var
character(LEN=*), intent(in) :: exp
end subroutine op_assign_VS_CH
pure function char_auto (string) result (char_string)
type(varying_string), intent(in) :: string
character(LEN=len(string)) :: char_string
integer :: i_char
forall(i_char = 1:len(string))
char_string(i_char:i_char) = string%chars(i_char)
end forall
end function char_auto
pure function char_fixed (string, length) result (char_string)
type(varying_string), intent(in) :: string
integer, intent(in) :: length
character(LEN=length) :: char_string
char_string = char(string)
end function char_fixed
elemental function trim_ (string) result (trim_string)
type(varying_string), intent(in) :: string
type(varying_string) :: trim_string
trim_string = TRIM(char(string))
end function trim_
end module iso_varying_string
module diagnostics
use iso_varying_string, string_t => varying_string
implicit none
private
public :: int2char
public :: int2fixed
contains
pure function int2fixed (i) result (c)
integer, intent(in) :: i
character(200) :: c
end function int2fixed
pure function int2char (i) result (c)
integer, intent(in) :: i
character(len (trim (int2fixed (i)))) :: c
end function int2char
end module diagnostics
module os_interface
use iso_varying_string, string_t => varying_string
use diagnostics
end module os_interface