- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I am upgrading to Fortran 2021.6.0 on Windows. Previously using 19.1.3. I am now getting a warning #6178: The return value of this FUNCTION has not been defined [CPTR].
Now CPTR is not a function and should be private. I don't get warnings with ifort 19.1.3 of gfortran 11.2.
The reduced test case is below. It is the remains of a generic binary heap library using c_ptr as generic pointers. Have I done something wrong? This is quite likely as I am venturing into the unknown. Code appears to work. The gfortran version survives torture tests with tens of millions of elements of several different types (each in their own trees) under valgrind.
The problem "goes away" if the line aptr = peek(H%bheap) in function element_bheap_peek of module element_bheap_m is replaced with something else, such as nullify(aptr).
AFAICT CPTR is private to bheap_m and shouldn't be visible in file element_bheap.f90.
Compiler output
1>Compiling with Intel® Fortran Compiler Classic 2021.6.0 [Intel(R) 64]...
1>element.f90
1>bheap.f90
1>element_bheap.f90
1>C:\dev\SI10\trafficassignment\shortestpath\tests\element_bheap.f90: warning #6178: The return value of this FUNCTION has not been defined. [CPTR]
1>test_bheap_01.f90
1>C:\dev\SI10\trafficassignment\shortestpath\tests\test_bheap_01.f90: warning #6178: The return value of this FUNCTION has not been defined. [CPTR]
bheap.f90: The generic part
! This started life as a generic binary heap module
! Most of the code was deleted while looking for a compiler warning
! Data is stored as C_PTR to objects of some type that extends the base module
module bheap_m
use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
implicit none
private
type, public :: bheap
integer :: max_size = 0
integer :: size = 0
type(c_ptr), allocatable, private :: cptr(:)
end type
public init, add, peek
interface init; procedure bheap_init; end interface
interface add; procedure bheap_add; end interface
interface peek; procedure bheap_peek; end interface
contains
subroutine bheap_init(H, max_size)
type(bheap) :: H
integer, intent(in) :: max_size
H%max_size = max(max_size,0)
H%size = 0
if (allocated(H%cptr)) deallocate(H%cptr)
if (H%max_size>0) allocate(H%cptr(H%max_size))
end subroutine
! Return C pointer to first element of heap
! Return c_null_ptr if heap is empty
pure function bheap_peek(H) result(cptr)
type(bheap), intent(in) :: H
type(c_ptr) :: cptr
if (H%size>0) then
cptr = H%cptr(1)
else
cptr = c_null_ptr
end if
end function
! Add a to heap H. Do not rebuild heap.
subroutine bheap_add(H,cptr)
type(bheap), intent(inout) :: H
type(c_ptr), intent(in) :: cptr
if (H%size >= H%max_size) stop 'In bheap_add: to many items'
if (.not. allocated(H%cptr)) stop 'In bheap_add: H unallocated'
H%size = H%size + 1
H%cptr(H%size) = cptr
end subroutine
end module
element.f90: The data structure to be stored in the heap
module element_m
implicit none
type :: element
integer :: id = 0
real :: priority = 0.0
end type
end module
element_bheap.f90: Specializing the generic binary heap
module element_bheap_m
! specialize binary heap for type(element)
use, intrinsic :: iso_c_binding, only: c_loc, c_f_pointer, c_ptr
use bheap_m
use element_m
implicit none
private
type, public, extends(bheap) :: element_bheap; end type
public init, add, peek
interface init; procedure element_bheap_init; end interface
interface add; procedure element_bheap_add; end interface
interface peek; procedure element_bheap_peek; end interface
contains
! Initialize heap of type(element_bheap)
subroutine element_bheap_init(H,max_size)
type(element_bheap) :: H
integer, intent(in) :: max_size
call init(H%bheap,max_size) ! calls init for type(bheap)
end subroutine
! Return ptr to first member of heap
function element_bheap_peek(H) result(a)
type(element_bheap), intent(in) :: H
type(element), pointer :: a
type(c_ptr) :: aptr
aptr = peek(H%bheap) ! <---- this is the problem
!nullify(aptr)
call c_f_pointer(aptr,a)
end function
! Add type(element) a to heap H. Do not rebuild heap.
subroutine element_bheap_add(H,a)
type(element_bheap) :: H
type(element), target :: a
call add(H%bheap,c_loc(a)) ! calls add for type(bheap)
end subroutine
end module
Driver routine
program test_bheap_01
use element_m
use bheap_m
use element_bheap_m
implicit none
type(element), target :: a(8)
type(element), pointer :: fptr
type(element_bheap) :: heap
integer i
! initialize
call init(heap,max_size=size(a))
do i = 1, size(a)
a(i) = element(i,0.1*i)
call add(heap,a(i)) ! add data without forming heap
end do
fptr => peek(heap)
write(*,*) a(1)%id, fptr%id, a(1)%priority, fptr%priority
end program
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Due to what is private in bheap.f90, you may be required to have the import statement in the contains procedures of module bheap_m.
See: IMPORT (intel.com)
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I don't see that IMPORT is needed anywhere. What I find interesting is that there is no line number given and that the symbol named is not a function. That the line aptr = peek(H%bheap) is what triggers the warning tells me that the compiler has become confused somehow. This is a bug.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
FWIW I suspect that the line causing the error is line 39 in bheap.f90
cptr = H%cptr(1)
This is the only line where cptr might be presumed to be a function (when cptr is otherwise undefined, and with implict typing could be construed as a UDT procedure).
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The error message: The return value of this FUNCTION has not been defined. [CPTR]
Implies CPTR is (presumed to be) a function without a return type.
The only place where there is a ...CPTR(...) is line:
cptr = H%cptr(1)
The error message would therefore seem to have mistaken that line for a UDT member function (without return type). In the code provided, there is no other execution statement containing ...cptr(...)
True, while CPTR() is an array in type bheap, the error message indicates the compiler mistook H%cptr(1) as a function call. I agree that this is a bug.
>>I don't see that IMPORT is needed anywhere.
While this is a true statement, what happens when IMPORT is added to the offending subroutine bheap_peek?
It wouldn't hurt to add IMPLICIT NONE, and/or IMPLICIT NONE (EXTERNAL)
This may provide additional insight as to where in the compiler code the syntactical error is located.
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
cptr is an allocatable array component of type bheap.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I tried this code on ifort 2021.5.0 [Intel(R) 64] and got no warning.
Rebuild started...
1>------ Rebuild All started: Project: bheap (IFORT), Configuration: Debug x64 ------
2>------ Rebuild All started: Project: element (IFORT), Configuration: Debug x64 ------
1>Deleting intermediate files and output files for project 'bheap', configuration 'Debug|x64'.
2>Deleting intermediate files and output files for project 'element', configuration 'Debug|x64'.
1>Compiling with Intel® Fortran Compiler Classic 2021.5.0 [Intel(R) 64]...
2>Compiling with Intel® Fortran Compiler Classic 2021.5.0 [Intel(R) 64]...
1>bheap.f90
2>element.f90
1>Creating library...
2>Creating library...
1>
1>Build log written to "file://D:\c\vs2022\fforum\fheap\bheap\x64\Debug\BuildLog.htm"
2>
1>bheap - 0 error(s), 0 warning(s)
2>Build log written to "file://D:\c\vs2022\fforum\fheap\element\x64\Debug\BuildLog.htm"
2>element - 0 error(s), 0 warning(s)
3>------ Rebuild All started: Project: element_bheap (IFORT), Configuration: Debug x64 ------
3>Deleting intermediate files and output files for project 'element_bheap', configuration 'Debug|x64'.
3>Compiling with Intel® Fortran Compiler Classic 2021.5.0 [Intel(R) 64]...
3>element_bheap.f90
3>Creating library...
3>
3>Build log written to "file://D:\c\vs2022\fforum\fheap\element_bheap\x64\Debug\BuildLog.htm"
3>element_bheap - 0 error(s), 0 warning(s)
4>------ Rebuild All started: Project: test_bheap_01 (IFORT), Configuration: Debug x64 ------
4>Deleting intermediate files and output files for project 'test_bheap_01', configuration 'Debug|x64'.
4>Compiling with Intel® Fortran Compiler Classic 2021.5.0 [Intel(R) 64]...
4>test_bheap_01.f90
4>Linking...
4>Embedding manifest...
4>
4>Build log written to "file://D:\c\vs2022\fforum\fheap\test_bheap_01\x64\Debug\BuildLog.htm"
4>test_bheap_01 - 0 error(s), 0 warning(s)
========== Rebuild All: 4 succeeded, 0 failed, 0 skipped ==========
I tried this code on ifort 2021.6.0 [Intel(R) 64] and got the same warnings.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I tried the code and did get the warning, in 2021.5.0 and 2021.6.0.
D:\Projects\Console15>ifort -c element.f90
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.6.0 Build 20220226_000000
Copyright (C) 1985-2022 Intel Corporation. All rights reserved.
D:\Projects\Console15>ifort -c element_bheap.f90
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.6.0 Build 20220226_000000
Copyright (C) 1985-2022 Intel Corporation. All rights reserved.
element_bheap.f90: warning #6178: The return value of this FUNCTION has not been defined. [CPTR]
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I was trying to duplicate using command line for 2021.5 instead of VS2022 and have not got it to build because of
test_bheap_01.obj : error LNK2019: unresolved external symbol ELEMENT_BHEAP_M_mp_ELEMENT_BHEAP_INIT referenced in function MAIN__
test_bheap_01.obj : error LNK2019: unresolved external symbol ELEMENT_BHEAP_M_mp_ELEMENT_BHEAP_ADD referenced in function MAIN__
test_bheap_01.obj : error LNK2019: unresolved external symbol ELEMENT_BHEAP_M_mp_ELEMENT_BHEAP_PEEK referenced in function MAIN__
which is some mistake of mine somewhere; the no errors were from VS projects with a good dependency configuration and many "default" options.
What I find interesting is that I got no errors or warnings when I combined all files into one file and built that with "ifort /Qm64 /Zi fheap.f90" on 2021.5, but on 2021.6 I do.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
It's not a syntactical error. Rather, some usage has corrupted the compiler's symbol table. That there is no locator information is a clue.
Adding import doesn't change the behavior.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks for the sanity check. I have simplified the example to a smaller compile-only case with everything public, interfaces removed, etc.
EDIT: I believe the generated code is correct but the diagnostic is wrong (which is comforting). This module is the foundation for a few graph theoretic algorithms, including Djikstra's shortest path and Yen's k-shortest paths. The results from my testsuite are consistent across ifort, gfortran and python.
! This started life as a generic binary heap module
! Most of the code was deleted while looking for a compiler warning
! Data is stored as C_PTR to objects of some type that extends the base module
module bheap_m
use, intrinsic :: iso_c_binding, only: c_ptr
implicit none
type, public :: bheap
integer :: max_size = 0
integer :: size = 0
type(c_ptr), allocatable :: cptr(:)
end type
contains
! Return C pointer to first element of heap
pure function bheap_peek(H) result(cptr)
type(bheap), intent(in) :: H
type(c_ptr) :: cptr
cptr = H%cptr(1)
end function
end module
module integer_bheap_m
! specialize binary heap for type integer
use, intrinsic :: iso_c_binding, only: c_loc, c_f_pointer, c_ptr
use bheap_m
implicit none
type, public, extends(bheap) :: integer_bheap; end type
contains
! Return ptr to first member of heap
function integer_bheap_peek(H) result(a)
type(integer_bheap), intent(in) :: H
integer, pointer :: a
type(c_ptr) :: aptr
aptr = bheap_peek(H%bheap) ! <---- this is the problem
call c_f_pointer(aptr,a)
end function
end module
Compiling with Intel® Fortran Compiler Classic 2021.6.0 [Intel(R) 64]...
bheap.f90
C:\dev\SI10\trafficassignment - Copy\shortestpath\src\bheap.f90: warning #6178: The return value of this FUNCTION has not been defined. [CPTR]
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Not that this resolves the problem, if you are compiling as x64, type(c_ptr) is 64 bits, while the pointer "integer, pointer :: a" is 64 bits, the pointee is 32-bits. Thus dereferencing the returned integer reference will reference the 32 lsb's of the former c_ptr. Is this your intention?
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Jim,
Re: "if you are compiling as x64, type(c_ptr) is 64 bits, while the pointer "integer, pointer :: a" is 64 bits, the pointee is 32-bits. Thus dereferencing the returned integer reference will reference the 32 lsb's of the former c_ptr. Is this your intention?," not sure I understand. I assume you mean the target (in Fortran parlance) when you mention pointee. The storage size of type(c_ptr) vs that of the pointee (target) should not matter at all, generally speaking.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
>>The storage size of type(c_ptr) vs that of the pointee (target) should not matter at all, generally speaking.
This assumes that the "object" pointed to (by H%bheap%cptr(1)) is an integer (or at least the 1st 4-bytes of the object are an integer).
Seeing that this module appears to manage a heap, the "integer, pointer", indicates that any header info contained in the object (e.g. link) is to be manipulated using/as 32-bit values (which may restrict the capacity of said heap). David needs to make the decision as to if the presumed node link is designed to be held as a 32-bit integer. This may be sufficient... maybe it is not.
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Jim,
I don't agree with you (but I have been wrong before). My understanding is that Fortran pointers are typed and the size of the pointer doesn't depend on the size of the type. It is (almost) impossible to get the address of a pointer variable unless you use C_LOC().
Anyway, I found:
- The CPTR being complained about is the name of the result of function bheap_peek. Change that and the name reported in the diagnostic follows
- Changing function bheap_peek as below eliminates the warning
- Similar changes in my full application eliminate the other warnings.
Job done.
! Return C pointer to first element of heap
type(c_ptr) pure function bheap_peek(H)
type(bheap), intent(in) :: H
bheap_peek = H%cptr(1)
end function
.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
>>My understanding is that Fortran pointers are typed and the size of the pointer doesn't depend on the size of the type.
While that is true, that which it points to was declared as type integer (4-bytes). IIF this is to be used as a node pointer, for example heap management linked list of empty nodes, you may (will) experience problems or have restrictions on your heap.
You have not provided complete design details of your heap management, as such I am simply raising a red flag for a potential problem in your design.
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
>> You have not provided complete design details of your heap management, as such I am simply raising a red flag for a potential problem in your design.
Yes. Thanks for taking an interest. I am not authorized to release the full code and management are busy. I would like to open-source some of our code but ...
In theory the integer in question is data, and can be replaced by any type. I will have a play with integer(1) and character types.

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page