C_associated

Is this included in iso_c_binding? https://gcc.gnu.org/onlinedocs/gfortran/C_005fASSOCIATED.html It is quite important because it checks the validity of C style pointers

StamK

C_ASSOCIATED is not currently implemented. I will add it to the wish list.

If you can post or send some sample code (in addition to that in your gcc link) that illustrates its use then that would be a great help.

Half the battle is in working out how these features might be used.

By the way, there is not much left in the 2003 Standard that is not already implemented by FTN95. For example, TYPE EXTENDS is almost ready for release.

We have an issue where a corrupt file causes an array to be populated with UNDEFINED via READ routines (as per other topic https://forums.silverfrost.com/Forum/Topic/4329&highlight=undefined) .

So we are hoping to catch it as follows, where c_associated checks the validity of C pointer p.

INTEGER FUNCTION CORE4_FTN95(IAD)
   use iso_c_binding
   USE clrwin$       
   IMPLICIT NONE   
   INTEGER(CW_HANDLE) :: IAD

   type(c_ptr) :: p
   INTEGER, pointer :: fp =>NULL()
   INTEGER :: I_OUT
   
   I_OUT = 0
   p = transfer(IAD, p)
   call c_f_pointer(p, fp)
   IF (c_associated(p)) THEN   
     IF (ASSOCIATED(fp)) THEN
        I_OUT = fp
     END IF   
    END IF  
   CORE4_FTN95 = I_OUT   
END FUNCTION    

StamK

C_ASSOCIATED has been implemented for the next release of FTN95.

I don't understand the sample code that you have posted so I don't know if this function will be of any help to you.

Here is a test program for C_ASSOCIATED that may help.

!$ extern 'C' void __c_f_pointer_test(float*& a)
!$ {
!$   a = (float*)malloc(12 * sizeof(float));
!$   float* b = a;
!$   for (int i = 1; i <= 12; ++i) *b++ = (float)i;
!$ }

subroutine association_test(a,b)
  use iso_c_binding, only: c_associated, c_loc, c_ptr
  implicit none
  type(c_ptr) :: a
  real, pointer :: b
  logical L
  L = c_associated(a, c_loc(b))
  if(.not.L) print*, 'a and b do not point to same target'
end subroutine association_test

program main
  use,intrinsic::iso_c_binding,only:c_ptr,c_loc,c_associated,c_f_pointer
  implicit none
  interface
    subroutine c_f_pointer_test(p) bind(c,name='__c_f_pointer_test')
      import :: c_ptr
      type(c_ptr), intent(out) :: p
    end subroutine
  end interface
  interface
    subroutine association_test(a,b)
      import :: c_ptr
      type(c_ptr) :: a
      real, pointer :: b
    end subroutine association_test
  end interface
  type(c_ptr) :: cptr
  real,pointer :: a(:)
  real,pointer :: b(:,:)
  real,pointer :: c
  logical L(7)
  L(7) = .not.associated(c)
  L(1) = .not.c_associated(cptr)
  call c_f_pointer_test(cptr)      ! Create cptr
  call c_f_pointer(cptr, a, [12])  ! 'a' points to cptr.
  call c_f_pointer(cptr, b, [3,4]) ! 'b' has the same target as 'a' but different shape.
  call c_f_pointer(cptr, c)        ! 'c' is just the first element of the cptr array.
  L(2) = (sum(a) == sum(b) .and. c == 1.0)
  L(3) = c_associated(cptr)
  L(4) = c_associated(cptr, c_loc(a))
  L(5) = c_associated(cptr, c_loc(b))
  L(6) = c_associated(cptr, c_loc(c))
  call association_test(cptr, c)
  if(all(L)) print*, 'Success'
end program main