The Backdoor Initializer in FORTRAN 77

In FORTRAN 77, using the Backdoor Initializer is similar to using it in C. There is a special new constructor named _wrapObj that takes the private data pointer.

Of course, dynamically allocating data in FORTRAN 77 is tricky, and requires very close cooperation with the Impl class that uses the data. Most of the complexity of this example code is caused by those problems, not so much the Backdoor Initializer itself.

Since we need to store 2 strings and an integer, we create 3 sidl arrays to hold the private data. We create an opaque array of 2 elements called pdata to hold the other two arrays. Then we create a string array of 2 elements called a_string, and an integer array of 1 element called a_int. d_string is element 0 of the string array, and d_ctortest is element 1. We then place a_string into pdata as element 0, and a_int in pdata as element 1. We then call _wrapObj, which takes pdata as an in argument as the first argument, and the object we are creating, data, as an out argument as the second argument.

Notice that we don't have to include an Impl files to FORTRAN 77, since, there aren't actually any types.

Fairly complex, but here's the client code from wraptest.f:

      program wraptest
      implicit none
      integer*8 data, user, pdata, backup, throwaway
      integer*8 a_string, a_int
      integer*4 d_int
      character*80 d_string
      character*80 d_ctortest
      character*80 d_silly

c     pdata is the internal data, and holds two arrays, string an int.
      call sidl_opaque__array_create1d_f(2, pdata)
      call sidl_string__array_create1d_f(2, a_string)
      call sidl_int__array_create1d_f(1, a_int)

c     initialize the data arrays
      call sidl_string__array_set1_f(a_string, 0, d_string)
      call sidl_string__array_set1_f(a_string, 1, d_ctortest)
      call sidl_int__array_set1_f(a_int, 0, d_int)

c     initilize pdata
      call sidl_opaque__array_set1_f(pdata, 0, a_string)
      call sidl_opaque__array_set1_f(pdata, 1, a_int)

      call wrapper_User__create_f(user, throwaway)

c     private data first, then the object being created
      call wrapper_Data__wrapObj_f(pdata, data, throwaway)

      call sidl_opaque__array_get1_f(pdata, 0, a_string)
      call sidl_string__array_get1_f(a_string, 1, d_ctortest)

      print *, d_ctortest

      call wrapper_User_accept_f(user, data, throwaway)

      call sidl_string__array_get1_f(a_string, 0, d_string)
      call sidl_int__array_get1_f(a_int, 0, d_int)

      print *, d_string, ' ', d_int

      call wrapper_User_deleteRef_f(user, throwaway)
      call wrapper_Data_deleteRef_f(data, throwaway)
      end

and the Impl side code from wrapper_Data_Impl.f

        subroutine wrapper_Data__ctor2_fi(self, private_data, exception)
        implicit none
        integer*8 self
        integer*8 private_data
        integer*8 exception

C       DO-NOT-DELETE splicer.begin(wrapper.Data._ctor2)
        integer*8 a_string, pdata
        character*80 d_string, d_ctortest
        call sidl_opaque__array_get1_f(private_data, 0, a_string)
        call sidl_string__array_set1_f(a_string, 1, 'ctor was run') 
C       DO-NOT-DELETE splicer.end(wrapper.Data._ctor2)
        end

        subroutine wrapper_Data_setString_fi(self, s, exception)
        implicit none
        integer*8 self
        character*(*) s
        integer*8 exception

C       DO-NOT-DELETE splicer.begin(wrapper.Data.setString)
        integer*8 data, a_string
        call wrapper_Data__get_data_f(self, data)
        if (data .ne. 0) then
           call sidl_opaque__array_get1_f(data, 0, a_string)
           call sidl_string__array_set1_f(a_string, 0, s)
        endif
C       DO-NOT-DELETE splicer.end(wrapper.Data.setString)
        end

        subroutine wrapper_Data_setInt_fi(self, i, exception)
        implicit none
        integer*8 self
        integer*4 i
        integer*8 exception

C       DO-NOT-DELETE splicer.begin(wrapper.Data.setInt)
        integer*8 data, a_int
        call wrapper_Data__get_data_f(self, data)
        if (data .ne. 0) then
           call sidl_opaque__array_get1_f(data, 1, a_int)
           call sidl_int__array_set1_f(a_int, 0, i)
        endif
C       DO-NOT-DELETE splicer.end(wrapper.Data.setInt)
        end



babel-1.4.0
users_guide Last Modified 2008-10-16

http://www.llnl.gov/CASC/components
components@llnl.gov