passing subroutine names and interface blocks

Brian_Murphy · ‎01-29-2020

I'm an old dog, and new tricks don't come easy. I'm trying to setup an interface block in a module for a routine which takes the name of a subroutine as one its arguments, and I'm stumped. The argument "callback" will be the name of a subroutine which takes one input argument of the same type as the handle variable. How does one declare the procedure argument?

INTERFACE
        function TF_SetLeaseCallback(handle, callback) bind(c, name = 'TF_SetLeaseCallback') result(retval) 
            import 
            integer(c_int32_t), value :: handle
            WHATGOESHERE :: callback 
            integer(c_long) :: retval
        end function 
        subroutine callback(status)
            integer(c_int32_t) :: status
        end subroutine
END INTERFACE

FortranFan · ‎01-30-2020

See this: https://gcc.gnu.org/onlinedocs/gfortran/Working-with-Pointers.html

Brian_Murphy · ‎01-30-2020

Thank you, FortranFan. That was exactly what I needed. The following did the trick.

TYPE(C_FUNPTR), INTENT(IN), VALUE :: callback

Steve_Lionel · ‎01-30-2020

Oh, no, don't do that! The proper way to do this is as follows:

ABSTRACT INTERFACE
  subroutine callback_int(status) bind(C)
    import
    integer(c_int32_t), value :: status
  end subroutine callback_int
END INTERFACE

INTERFACE
        function TF_SetLeaseCallback(handle, callback) bind(c, name = 'TF_SetLeaseCallback') result(retval) 
            import 
            integer(c_int32_t), value :: handle
            procedure(callback_int):: callback 
            integer(c_long) :: retval
        end function 
END INTERFACE

Brian_Murphy · ‎01-30-2020

That works, but why is it better? What I had worked, too.

In the main program I had this:

TYPE(C_FUNPTR) :: tfcallback
hr = TF_SetLeaseCallback(tfHandle, tfcallback)
.
.
.
subroutine tfcallback
	return
end

Doing it your way the compiler complained until I changed the declaration to this:

procedure() :: tfcallback

Is that the right way?

Steve_Lionel · ‎01-30-2020

It's better because it enforces the interface. Your variation does away with the explicit interface, which means no checking.

The snippet you show here makes no sense. tfcallback can't be both a subroutine and a variable of type C_FUNPTR. You would just give the name of the subroutine you want to pass as the actual argument.

Can you show a small but complete example that shows a complaint?

Brian_Murphy · ‎01-30-2020

TYPE(C_FUNPTR) :: tfcallback

worked with the interface in quote #1 plus the fix in quote #3. It compiled and ran just like it should. Maybe I got lucky with two wrongs making a right.

When I changed the interface to quote #4, the compile error was...

error #6636: When a dummy argument is a subroutine, the corresponding actual argument must also be a subroutine.   [TFCALLBACK]

Changing TYPE(C_FUNPTR) to procedure() was just a guess on my part, but then it compiled and ran with no trouble.

Steve_Lionel · ‎01-30-2020

I still don't understand what you did. Please show a complete example. You certainly can't pass a C_FUNPTR to an argument declared as a procedure.

Brian_Murphy · ‎01-30-2020

I passed a C_FUNPTR to an argument of type C_FUNPTR, and that compiled and ran fine. I sort of understand this one.

I passed a procedure() to an argument of type procedure(callback_int). I don't understand this one, but it ran, too.

Steve_Lionel · ‎01-30-2020

procedure() has implicit interface so it will match anything. Do I gather that you're not actually passing a procedure name but one dummy argument to another? I will ask again - please provide a small but complete example that demonstrates what you're doing so that I can understand it. Your various posts so far seem inconsistent to me.

mecej4 · ‎01-30-2020

I suspect that the body of code that is being "improved/modernized" is old Fortran 77 code that works fine with implicit interfaces for all subroutines and functions. If so, it should suffice for the old dog to use the equally ancient "trick" of declaring actual procedure arguments EXTERNAL. There is no need for adding interface blocks or C interoperability features to such code, and adding pretentious declarations such as procedure () ... to such code is as effective as sprinkling holy water.

There are third party tools that can read Fortran 77 source and generate interface blocks.

Steve_Lionel · ‎01-30-2020

I agree that one can take the easy way out with EXTERNAL, but I'd expect that's already done since that's how you do it in F77.

Brian started this thread by saying he wanted to write an interface block, so let's help him do that in the modern Fortran way. Using interface blocks provides the compiler with information that may detect or prevent errors.

mecej4 · ‎01-30-2020

If the dummy procedure argument is used in many subprograms, putting the interface to that procedure in a module and simply using that module in each of the subprograms is the way to write clean code. However, that is possible only with an abstract interface, and that feature was not yet present in Fortran 90 or 95, so one has to repeat the interface block (or put it into an include file) if the compiler is pre-F2003.

FortranFan · ‎01-30-2020

Steve Lionel (Ret.) (Blackbelt) wrote:
Oh, no, don't do that! The proper way to do this is as follows: ..

@Brian Murphy,

Note there is a certain aspect element of "pick your poison" here . What really matters in mixed-language programming is to get your interface(s) correct and if there is something amiss in an interface, it won't matter whether you're using the TYPE(C_FUNPTR) approach or the PROCEDURE(..) one.

You don't explain your scenario in sufficient detail. It's possible you're trying to make use of a library (or libraries) in C (perhaps a DLL) in a Fortran program. If that's the case, say the C library and the functions therein are as follows:

// C library

#include <stdio.h>

// Function pointer prototype for callback
typedef void (*CallbackFunc)(const int);

// Function prototypes
void Clibfunc(int*);
extern Fsub(const int, CallbackFunc);
void Cb(const int);

void Clibfunc(int *x) {
   printf("In Cfunc: x = %d\n", *x);
   (*x)++;
   Fsub(*x, Cb);
   return;
}

// Implementation of callback function
void Cb(const int x) {
   printf("In C callback function Cb: x = %d\n", x);
   return;
}

If you want to go with modern Fortran, a recommendation will be to write a MODULE to interoperate with the above C library like so:

module m

   use, intrinsic :: iso_c_binding, only : c_int, c_funptr, c_f_procpointer, c_associated

   abstract interface
      subroutine ICallBack( x ) bind(C)
         import :: c_int
         !integer(c_int), intent(in), value :: x  !<--  A
         integer(c_int), intent(in) :: x          !<--  B
      end subroutine
   end interface

   interface
      subroutine Clibfunc(n) bind(C, name="Clibfunc")
         import :: c_int
         integer(c_int), intent(inout) :: n
      end subroutine
   end interface

contains

   subroutine Fsub(a, cb) bind(C, name="Fsub")

      integer(c_int), intent(in), value :: a
      procedure(ICallBack) :: cb

      print *, "In Fsub"
      call cb(a)

   end subroutine

end module

You can then write a Fortran program to make use of the C library via your module as follows:

   use, intrinsic :: iso_c_binding, only : c_int
   use m, only : Clibfunc

   integer(c_int) :: x

   x = 0
   call Clibfunc(x)

end

Note in the module the lines marked A and B: A is the right interface whereas B is incorrect due to the missing VALUE attribute. But line A is commented out.

If you can compile and link the above code, the program output will not match expected results and the use of PROCEDURE(..) approach will make no difference:

C:\Temp>type c.c
// C library

#include <stdio.h>

// Function pointer prototype for callback
typedef void (*CallbackFunc)(const int);

// Function prototypes
void Clibfunc(int*);
extern Fsub(const int, CallbackFunc);
void Cb(const int);

void Clibfunc(int *x) {
   printf("In Cfunc: x = %d\n", *x);
   (*x)++;
   Fsub(*x, Cb);
   return;
}

// Implementation of callback function
void Cb(const int x) {
   printf("In C callback function Cb: x = %d\n", x);
   return;
}

C:\Temp>cl /c /W3 /EHsc c.c
Microsoft (R) C/C++ Optimizing Compiler Version 19.24.28316 for x64
Copyright (C) Microsoft Corporation.  All rights reserved.

c.c

C:\Temp>type m.f90
module m

   use, intrinsic :: iso_c_binding, only : c_int, c_funptr, c_f_procpointer, c_associated

   abstract interface
      subroutine ICallBack( x ) bind(C)
         import :: c_int
         !integer(c_int), intent(in), value :: x  !<--  A
         integer(c_int), intent(in) :: x          !<--  B
      end subroutine
   end interface

   interface
      subroutine Clibfunc(n) bind(C, name="Clibfunc")
         import :: c_int
         integer(c_int), intent(inout) :: n
      end subroutine
   end interface

contains

   subroutine Fsub(a, cb) bind(C, name="Fsub")

      integer(c_int), intent(in), value :: a
      procedure(ICallBack) :: cb

      print *, "In Fsub"
      call cb(a)

   end subroutine

end module

C:\Temp>ifort /c /standard-semantics /warn:all /stand:f18 m.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.0.166 Build 20191121
Copyright (C) 1985-2019 Intel Corporation.  All rights reserved.


C:\Temp>type p.f90
   use, intrinsic :: iso_c_binding, only : c_int
   use m, only : Clibfunc

   integer(c_int) :: x

   x = 0
   call Clibfunc(x)

end

C:\Temp>ifort /c /standard-semantics /warn:all /stand:f18 p.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.0.166 Build 20191121
Copyright (C) 1985-2019 Intel Corporation.  All rights reserved.


C:\Temp>link p.obj m.obj c.obj /subsystem:console /out:p.exe
Microsoft (R) Incremental Linker Version 14.24.28316.0
Copyright (C) Microsoft Corporation.  All rights reserved.


C:\Temp>p.exe
In Cfunc: x = 0
 In Fsub
In C callback function Cb: x = -198182976

On the other hand, say the interface is fixed and the approach is TYPE(C_FUNPTR). Not only will the code will function as expected, you will avail yourself of the interface checking benefits plus if you wish to, you can retain control should a NULL pointer come through from the C side of the code - note this can happen in mixed-language applications.. But you'll pay for all this with some added code verbosity - see below.

C:\Temp>type c.c
// C library

#include <stdio.h>

// Function pointer prototype for callback
typedef void (*CallbackFunc)(const int);

// Function prototypes
void Clibfunc(int*);
extern Fsub(const int, CallbackFunc);
void Cb(const int);

void Clibfunc(int *x) {
   printf("In Cfunc: x = %d\n", *x);
   (*x)++;
   Fsub(*x, Cb);
   return;
}

// Implementation of callback function
void Cb(const int x) {
   printf("In C callback function Cb: x = %d\n", x);
   return;
}

C:\Temp>cl /c /W3 /EHsc c.c
Microsoft (R) C/C++ Optimizing Compiler Version 19.24.28316 for x64
Copyright (C) Microsoft Corporation.  All rights reserved.

c.c

C:\Temp>type m.f90
module m

   use, intrinsic :: iso_c_binding, only : c_int, c_funptr, c_f_procpointer, c_associated

   abstract interface
      subroutine ICallBack( x ) bind(C)
         import :: c_int
         integer(c_int), intent(in), value :: x  !<--  A
         !integer(c_int), intent(in) :: x          !<--  B
      end subroutine
   end interface

   interface
      subroutine Clibfunc(n) bind(C, name="Clibfunc")
         import :: c_int
         integer(c_int), intent(inout) :: n
      end subroutine
   end interface

contains

   subroutine Fsub(a, pcb) bind(C, name="Fsub")

      integer(c_int), intent(in), value :: a
      type(c_funptr), intent(in), value :: pcb

      ! Local variables
      procedure(ICallBack), pointer :: cb

      print *, "In Fsub"
      if ( .not. c_associated(pcb) ) then
         ! Check for a null pointer; you can do error stop also
         print *, "callback function is not associated with a valid target"
         return
      end if
      call c_f_procpointer( pcb, cb )
      call cb(a)

   end subroutine

end module

C:\Temp>ifort /c /standard-semantics /warn:all /stand:f18 m.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.0.166 Build 20191121
Copyright (C) 1985-2019 Intel Corporation.  All rights reserved.


C:\Temp>ifort /c /standard-semantics /warn:all /stand:f18 p.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.0.166 Build 20191121
Copyright (C) 1985-2019 Intel Corporation.  All rights reserved.


C:\Temp>link p.obj m.obj c.obj /subsystem:console /out:p.exe
Microsoft (R) Incremental Linker Version 14.24.28316.0
Copyright (C) Microsoft Corporation.  All rights reserved.


C:\Temp>p.exe
In Cfunc: x = 0
 In Fsub
In C callback function Cb: x = 1

C:\Temp>

FortranFan · ‎01-30-2020

FortranFan wrote:
.. you can retain control should a NULL pointer come through from the C side of the code - note this happen....

So here's a contrived scenario where you get a program exception should a bad pointer come through; the use of the PROCEDURE(..) approach is going to be of little help here.

C:\Temp>type c.c
// C library

#include <stdio.h>

// Function pointer prototype for callback
typedef void (*CallbackFunc)(const int);

// Function prototypes
void Clibfunc(int*);
extern Fsub(const int, CallbackFunc);
void Cb(const int);

CallbackFunc CB = NULL;

void Clibfunc(int *x) {
   printf("In Cfunc: x = %d\n", *x);
   (*x)++;
   Fsub(*x, CB); //<-- Note mistaken reference to CB instead of Cb
   return;
}

// Implementation of callback function
void Cb(const int x) {
   printf("In C callback function Cb: x = %d\n", x);
   return;
}

C:\Temp>cl /c /W3 /EHsc c.c
Microsoft (R) C/C++ Optimizing Compiler Version 19.24.28316 for x64
Copyright (C) Microsoft Corporation.  All rights reserved.

c.c

C:\Temp>type m.f90
module m

   use, intrinsic :: iso_c_binding, only : c_int

   abstract interface
      subroutine ICallBack( x ) bind(C)
         import :: c_int
         integer(c_int), intent(in), value :: x
      end subroutine
   end interface

   interface
      subroutine Clibfunc(n) bind(C, name="Clibfunc")
         import :: c_int
         integer(c_int), intent(inout) :: n
      end subroutine
   end interface

contains

   subroutine Fsub(a, cb) bind(C, name="Fsub")

      integer(c_int), intent(in), value :: a
      procedure(Icallback) :: cb

      call cb(a)

   end subroutine

end module

C:\Temp>ifort /c /standard-semantics /warn:all /stand:f18 m.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.0.166 Build 20191121
Copyright (C) 1985-2019 Intel Corporation.  All rights reserved.


C:\Temp>type p.f90
   use, intrinsic :: iso_c_binding, only : c_int
   use m, only : Clibfunc

   integer(c_int) :: x

   x = 0
   call Clibfunc(x)

end

C:\Temp>ifort /c /standard-semantics /warn:all /stand:f18 p.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.0.166 Build 20191121
Copyright (C) 1985-2019 Intel Corporation.  All rights reserved.


C:\Temp>link p.obj m.obj c.obj /subsystem:console /out:p.exe
Microsoft (R) Incremental Linker Version 14.24.28316.0
Copyright (C) Microsoft Corporation.  All rights reserved.


C:\Temp>p.exe
In Cfunc: x = 0
forrtl: severe (157): Program Exception - access violation
Image              PC                Routine            Line        Source
p.exe              00007FF7F6F11060  Unknown               Unknown  Unknown
p.exe              00007FF7F6F4066F  Unknown               Unknown  Unknown
p.exe              00007FF7F6F1103A  Unknown               Unknown  Unknown
p.exe              00007FF7F6F4049E  Unknown               Unknown  Unknown
p.exe              00007FF7F6F40948  Unknown               Unknown  Unknown
KERNEL32.DLL       00007FFFAD4237E4  Unknown               Unknown  Unknown
ntdll.dll          00007FFFAFC9CB81  Unknown               Unknown  Unknown

C:\Temp>

FortranFan · ‎01-30-2020

For the scenario in Quote #15, if you use the TYPE(C_FUNPTR) approach, you can 'handle the exception' rather than allow to program crash i.e., if you so choose.

C:\Temp>type c.c
// C library

#include <stdio.h>

// Function pointer prototype for callback
typedef void (*CallbackFunc)(const int);

// Function prototypes
void Clibfunc(int*);
extern Fsub(const int, CallbackFunc);
void Cb(const int);

CallbackFunc CB = NULL;

void Clibfunc(int *x) {
   printf("In Cfunc: x = %d\n", *x);
   (*x)++;
   Fsub(*x, CB); //<-- Note mistaken reference to CB instead of Cb
   return;
}

// Implementation of callback function
void Cb(const int x) {
   printf("In C callback function Cb: x = %d\n", x);
   return;
}

C:\Temp>cl /c /W3 /EHsc c.c
Microsoft (R) C/C++ Optimizing Compiler Version 19.24.28316 for x64
Copyright (C) Microsoft Corporation.  All rights reserved.

c.c

C:\Temp>type m.f90
module m

   use, intrinsic :: iso_c_binding, only : c_int, c_funptr, c_associated, c_f_procpointer

   abstract interface
      subroutine ICallBack( x ) bind(C)
         import :: c_int
         integer(c_int), intent(in), value :: x
      end subroutine
   end interface

   interface
      subroutine Clibfunc(n) bind(C, name="Clibfunc")
         import :: c_int
         integer(c_int), intent(inout) :: n
      end subroutine
   end interface

contains

   subroutine Fsub(a, pcb) bind(C, name="Fsub")

      ! Argument list
      integer(c_int), intent(in), value :: a
      type(c_funptr), intent(in), value :: pcb

      ! Local variables
      procedure(ICallBack), pointer :: cb

      print *, "In Fsub"
      if ( .not. c_associated(pcb) ) then
         print *, "callback function is not associated with a valid target"
         return
      end if
      call c_f_procpointer( pcb, cb )
      call cb(a)

   end subroutine

end module

C:\Temp>ifort /c /standard-semantics /warn:all /stand:f18 m.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.0.166 Build 20191121
Copyright (C) 1985-2019 Intel Corporation.  All rights reserved.


C:\Temp>ifort /c /standard-semantics /warn:all /stand:f18 p.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.0.166 Build 20191121
Copyright (C) 1985-2019 Intel Corporation.  All rights reserved.


C:\Temp>link p.obj m.obj c.obj /subsystem:console /out:p.exe
Microsoft (R) Incremental Linker Version 14.24.28316.0
Copyright (C) Microsoft Corporation.  All rights reserved.


C:\Temp>p.exe
In Cfunc: x = 0
 In Fsub
 callback function is not associated with a valid target

C:\Temp>

Brian_Murphy · ‎01-31-2020

Thanks to everyone for the posts. It's going to take me at least a few days to digest it all.

I am not converting older code, I am adding something new to existing code. The existing code uses modern interfaces to call routines in a third party C DLL. I do not have the C source code. A couple of recent threads helped me with setting up interfaces to call C routines. What's new this time (for me) is the need to pass the name of a subroutine. That was the purpose of the OP. The subroutine being passed is a dummy subroutine in the sense that it doesn't actually need to do anything in my current situation, but I still have to pass it because it is not optional.

Brian_Murphy · ‎02-06-2020

The code samples posted in quotes 14,15,16 are beyond what I can understand. I might say too abstract. BTW, I am passing a fortran subroutine name to C, not to another fortran routine.

My main goal is to have something that works, and the two approaches I described in quotes 5,7,9 do work.

Method 1 use C_FUNPTR. The following interface block is in a module file so fortran can call the C routine named TF_SetLeaseCallback.

interface
        function TF_SetLeaseCallback(handle, callback) bind(c, name = 'TF_SetLeaseCallback') result(retval) 
            import 
            integer(c_int32_t), value :: handle
            TYPE(C_FUNPTR), INTENT(IN), VALUE :: callback 
            integer(c_long) :: retval ! HRESULT is typedef long 
        end function 
end interface

The above is utilized in the main program with the following statements, and this compiles, links and runs just as it should.

    integer(c_long) tfHandle, hr
    TYPE(C_FUNPTR) :: tfcallback

    hr = TF_SetLeaseCallback(tfHandle, tfcallback)

Method 2 is as follows. It also compiles, links and runs just like it should.

ABSTRACT INTERFACE
          subroutine callback_int(status) bind(C)
            import
            integer(c_int32_t), value :: status
          end subroutine callback_int
END INTERFACE
interface
        function TF_SetLeaseCallback(handle, callback) bind(c, name = 'TF_SetLeaseCallback') result(retval) 
            import 
            integer(c_int32_t), value :: handle 
            procedure(callback_int) :: callback 
            integer(c_long) :: retval
        end function 
end interface

The code in the main program is:

    procedure() :: tfcallback
    integer(c_long) tfhandle, hr

    hr = TF_SetLeaseCallback(tfHandle, tfcallback)

Both of the above described methods use identical code for fortran subroutine tfcallback.

subroutine tfcallback
	return
end

In the main program I'm surprised that procedure() :: tfcallback worked and procedure(callback_int) :: tfcallback would compile but not link. The following linker errors occurred.

Severity	Code	Description	Project	File	Line	Suppression State
Error		fatal error LNK1120: 1 unresolved externals		Debug\LimeTest.exe		
Severity	Code	Description	Project	File	Line	Suppression State
Error		error LNK2019: unresolved external symbol _tfcallback referenced in function _MAIN__		LimeTest.obj

FortranFan · ‎02-06-2020

Brian Murphy wrote:
The code samples posted in quotes 14,15,16 are beyond what I can understand. I might say too abstract. ..

Thanks for the putdown.

Perhaps you will try out what is shown below and take note that to interoperate Fortran with C, the basic thing is to match the data types, the calling mechanism (e.g., by value or not), and the function names (hence the name attribute with BIND statement in Fortran).

And that if you need assistance online, you'll share basic details like C function prototype exactly as-is rather than your take on it via your interface.

The commentary for the example below will be about the same as in Quote #14.

C:\Temp>type c.c
// C library

#include <stdint.h>
#include <stdio.h>

// Function pointer prototype for callback
typedef void (*CallbackFunc)( int32_t );

// Function prototypes
long TF_SetLeaseCallback(int32_t, CallbackFunc);

long TF_SetLeaseCallback(int32_t handle, CallbackFunc callback) {
   printf("In TF_SetLeaseCallback: handle = %d\n", handle);
   int32_t stat = 42;
   callback(stat);
   return(1);
}

C:\Temp>cl /c /W3 /EHsc c.c
Microsoft (R) C/C++ Optimizing Compiler Version 19.24.28316 for x64
Copyright (C) Microsoft Corporation.  All rights reserved.

c.c

C:\Temp>type m.f90
module m

   use, intrinsic :: iso_c_binding, only : c_int32_t, c_long

   abstract interface
      subroutine ICallBack( status ) bind(C)
         import :: c_int32_t
         integer(c_int32_t), intent(in), value :: status
      end subroutine
   end interface

   interface
      function TF_SetLeaseCallback(handle, callback) result(retval) bind(C, name = 'TF_SetLeaseCallback')
         import :: c_int32_t, c_long, ICallBack
         ! Argument list
         integer(c_int32_t), value :: handle
         procedure(ICallBack) :: callback
         ! Function result
         integer(c_long) :: retval
      end function
   end interface

contains

   subroutine tfcallback( status ) bind(C, name="tfcallback")

      integer(c_int32_t), intent(in), value :: status

      print *, "In tfcallback"
      print *, "status = ", status, "; expected is 42"

      return

   end subroutine

end module

C:\Temp>ifort /c /standard-semantics /warn:all /stand:f18 m.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.0.166 Build 20191121
Copyright (C) 1985-2019 Intel Corporation.  All rights reserved.


C:\Temp>type p.f90
   use, intrinsic :: iso_c_binding, only : c_int32_t, c_long
   use m, only : TF_SetLeaseCallback, tfcallback

   integer(c_int32_t) :: tfhandle
   integer(c_long) :: hr

   tfhandle = 100
   hr = TF_SetLeaseCallback( tfhandle, tfcallback )

   print *, "Back in Fortran main: hr = ", hr, "; expected is 1."
   stop

end

C:\Temp>ifort /c /standard-semantics /warn:all /stand:f18 p.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 19.1.0.166 Build 20191121
Copyright (C) 1985-2019 Intel Corporation.  All rights reserved.


C:\Temp>link p.obj m.obj c.obj /subsystem:console /out:p.exe
Microsoft (R) Incremental Linker Version 14.24.28316.0
Copyright (C) Microsoft Corporation.  All rights reserved.


C:\Temp>p.exe
In TF_SetLeaseCallback: handle = 100
 In tfcallback
 status =  42 ; expected is 42
 Back in Fortran main: hr =  1 ; expected is 1.

C:\Temp>

jimdempseyatthecove · ‎02-07-2020

CAUTION

Do not use c_int32_t or c_long as a handle argument. Use the Windows (IFWINTY.MOD) data type HANDLE instead. This is generally a c_intptr_t type. IOW an integer type that is the bit size of an address pointer. c_int32_t and c_long may work in a Win32 build but not work in an x64 build.

Jim Dempsey

FortranFan · ‎02-07-2020

jimdempseyatthecove (Blackbelt) wrote:
CAUTION
Do not use c_int32_t or c_long as a handle argument. Use the Windows (IFWINTY.MOD) data type HANDLE instead. This is generally a c_intptr_t type. IOW an integer type that is the bit size of an address pointer. c_int32_t and c_long may work in a Win32 build but not work in an x64 build.
Jim Dempsey

Good point.

Except that the actual listing of the prototype for the C function 'TF_SetLeaseCallback' is not shared here so readers can't know the formal parameters and return type of that C function. One then has to presume based on OP's attempt that the data types might be int32_t or that the return type is long, etc.

Regardless, the issue with OP appears to be the linker and perhaps that is due to some missing directives (if 32-bit platform) or settings or obj/lib files or may be, as I show in Quote #18, with missing BIND attribute with NAME specifier on the implementation of the callback function in OP's Fortran code.

Bottom-line: OP doesn't share full details, so one has to guess as to the issues and suggest solutions for them.