soccer jersey forums.silverfrost.com :: View topic - C_associated
forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

C_associated

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support
View previous topic :: View next topic  
Author Message
StamK



Joined: 12 Oct 2016
Posts: 162

PostPosted: Fri Jun 07, 2024 12:20 am    Post subject: C_associated Reply with quote

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
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7941
Location: Salford, UK

PostPosted: Fri Jun 07, 2024 7:23 am    Post subject: Reply with quote

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.
Back to top
View user's profile Send private message AIM Address
StamK



Joined: 12 Oct 2016
Posts: 162

PostPosted: Fri Jun 07, 2024 8:42 am    Post subject: Reply with quote

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/viewtopic.php?t=4825&highlight=undefined) .

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

Code:

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   
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7941
Location: Salford, UK

PostPosted: Wed Jun 12, 2024 3:36 pm    Post subject: Reply with quote

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.

Code:
!$ 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
Back to top
View user's profile Send private message AIM Address
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group