Commit 9954e63a authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Fix Fortran 2003 interface.

* Add proper formatting of example program output.
* Add test to ensure the examples are working.
* Add better handling of Pointer arguments.
* Add better handling of C char * return values.
* Add helper function for C character length.
* Test that the compiler properly support Fortran/C interop at configure
  time.
parent caff9549
......@@ -161,6 +161,7 @@ interfaces/testdata/gridTest.nc -text
interfaces/testdata/mulval.grb -text
interfaces/testdata/mulval.nc -text
m4/acx_assert_lang_is_fortran_variant.m4 -text
m4/acx_check_strptr_convert.m4 -text
m4/acx_lang_other_suffix_conftest.m4 -text
m4/acx_options.m4 -text
m4/acx_sl_fc_mod_path_flag.m4 -text
......@@ -364,6 +365,7 @@ tests/test_cksum_nc.in -text
tests/test_cksum_nc2.in -text
tests/test_cksum_nc4.in -text
tests/test_cksum_service.in -text
tests/test_f2003.in -text
tests/test_grib.c -text
tests/test_grib.sh -text
tests/test_resource_copy.c -text
......
......@@ -96,6 +96,7 @@ DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = \
$(top_srcdir)/m4/acx_assert_lang_is_fortran_variant.m4 \
$(top_srcdir)/m4/acx_check_strptr_convert.m4 \
$(top_srcdir)/m4/acx_lang_other_suffix_conftest.m4 \
$(top_srcdir)/m4/acx_options.m4 \
$(top_srcdir)/m4/acx_sl_fc_mod_path_flag.m4 \
......
......@@ -1184,6 +1184,7 @@ AC_SUBST([am__untar])
]) # _AM_PROG_TAR
m4_include([m4/acx_assert_lang_is_fortran_variant.m4])
m4_include([m4/acx_check_strptr_convert.m4])
m4_include([m4/acx_lang_other_suffix_conftest.m4])
m4_include([m4/acx_options.m4])
m4_include([m4/acx_sl_fc_mod_path_flag.m4])
......
......@@ -89,6 +89,7 @@ DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = \
$(top_srcdir)/m4/acx_assert_lang_is_fortran_variant.m4 \
$(top_srcdir)/m4/acx_check_strptr_convert.m4 \
$(top_srcdir)/m4/acx_lang_other_suffix_conftest.m4 \
$(top_srcdir)/m4/acx_options.m4 \
$(top_srcdir)/m4/acx_sl_fc_mod_path_flag.m4 \
......
......@@ -643,6 +643,7 @@ FCMODCASE
FCMODEXT
CDI_F90_INTERFACE_FCFLAGS
FC_MOD_FLAG
ENABLE_F2003_ISOC
CREATE_ISOC_FALSE
CREATE_ISOC_TRUE
USE_MPI
......@@ -1548,7 +1549,6 @@ Optional Features:
--enable-iso-c-interface
Create Fortran Interface via iso_c_bindings facility
of F2003 [default=no].
--enable-swig use swig to create extra bindings [default=no]
(EXPERIMENTAL)
--enable-ruby ruby language bindings [default=no] (EXPERIMENTAL)
......@@ -27363,6 +27363,79 @@ else
enable_isoc=no
fi
 
if test x"$enable_isoc" = xyes; then :
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if Fortran compiler can handle complex CHARACTER interoperability" >&5
$as_echo_n "checking if Fortran compiler can handle complex CHARACTER interoperability... " >&6; }
cat > conftest.$ac_ext <<_ACEOF
module conftest_mod
use iso_c_binding
implicit none
private
public :: errstr
contains
function errstr(errno)
integer, intent(in) :: errno
interface
function strerror(errno) bind(c, name='strerror')
import :: c_int, c_ptr
integer(c_int), value, intent(in) :: errno
type(c_ptr) :: strerror
end function strerror
function strlen(s) bind(c, name='strlen')
import :: c_ptr, c_size_t
type(c_ptr), value, intent(in) :: s
integer(c_size_t) :: strlen
end function strlen
end interface
type(c_ptr) :: cptr
character(len=:, kind=c_char), pointer :: errstr
cptr = strerror(int(errno, c_int))
errstr => c2f_string(cptr, int(strlen(cptr)))
end function errstr
function c2f_string(s, slen)
type(c_ptr), intent(in) :: s
integer, intent(in) :: slen
CHARACTER(len=slen, kind=c_char), POINTER :: c2f_string
c2f_string => NULL()
call c_f_pointer(s, c2f_string)
end function c2f_string
end module conftest_mod
program conftest
use iso_c_binding
use conftest_mod, only: errstr
implicit none
character(kind=c_char, len=:), pointer :: msg
msg => errstr(42)
write (0, '(a)') msg
end program conftest
_ACEOF
if ac_fn_fc_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
else
enable_isoc=no
fi
if test $enable_isoc = 'yes'; then
CREATE_ISOC_TRUE=
CREATE_ISOC_FALSE='#'
......@@ -27371,6 +27444,9 @@ else
CREATE_ISOC_FALSE=
fi
 
ENABLE_F2003_ISOC=$enable_isoc
# in case the Fortran interface uses the more modern F90-style interface,
# the FCFLAGS for users of the library have to include a switch to use the
# .mod file
......@@ -27829,7 +27905,7 @@ cat >>confdefs.h <<_ACEOF
_ACEOF
 
 
ac_config_files="$ac_config_files tests/test_cksum_grib tests/test_cksum_nc tests/test_cksum_nc2 tests/test_cksum_nc4 tests/test_cksum_extra tests/test_cksum_service tests/test_cksum_ieg tests/test_chunk_cksum tests/pio_write_run tests/pio_write_deco2d_run tests/pio_cksum_mpinonb tests/pio_cksum_fpguard tests/pio_cksum_asynch tests/pio_cksum_writer tests/pio_cksum_cdf tests/test_resource_copy_mpi_run tables/gen_tableheaderfile util/serialrun"
ac_config_files="$ac_config_files tests/test_cksum_grib tests/test_cksum_nc tests/test_cksum_nc2 tests/test_cksum_nc4 tests/test_cksum_extra tests/test_cksum_service tests/test_cksum_ieg tests/test_chunk_cksum tests/test_f2003 tests/pio_write_run tests/pio_write_deco2d_run tests/pio_cksum_mpinonb tests/pio_cksum_fpguard tests/pio_cksum_asynch tests/pio_cksum_writer tests/pio_cksum_cdf tests/test_resource_copy_mpi_run tables/gen_tableheaderfile util/serialrun"
 
 
ac_config_files="$ac_config_files Makefile src/Makefile interfaces/Makefile app/Makefile tests/Makefile examples/Makefile cdi.settings examples/pio/Makefile src/pkgconfig/cdi.pc src/pkgconfig/cdipio.pc"
......@@ -29186,6 +29262,7 @@ do
"tests/test_cksum_service") CONFIG_FILES="$CONFIG_FILES tests/test_cksum_service" ;;
"tests/test_cksum_ieg") CONFIG_FILES="$CONFIG_FILES tests/test_cksum_ieg" ;;
"tests/test_chunk_cksum") CONFIG_FILES="$CONFIG_FILES tests/test_chunk_cksum" ;;
"tests/test_f2003") CONFIG_FILES="$CONFIG_FILES tests/test_f2003" ;;
"tests/pio_write_run") CONFIG_FILES="$CONFIG_FILES tests/pio_write_run" ;;
"tests/pio_write_deco2d_run") CONFIG_FILES="$CONFIG_FILES tests/pio_write_deco2d_run" ;;
"tests/pio_cksum_mpinonb") CONFIG_FILES="$CONFIG_FILES tests/pio_cksum_mpinonb" ;;
......@@ -31005,6 +31082,7 @@ _LT_EOF
"tests/test_cksum_service":F) chmod a+x "$ac_file" ;;
"tests/test_cksum_ieg":F) chmod a+x "$ac_file" ;;
"tests/test_chunk_cksum":F) chmod a+x "$ac_file" ;;
"tests/test_f2003":F) chmod a+x "$ac_file" ;;
"tests/pio_write_run":F) chmod a+x "$ac_file" ;;
"tests/pio_write_deco2d_run":F) chmod a+x "$ac_file" ;;
"tests/pio_cksum_mpinonb":F) chmod a+x "$ac_file" ;;
......
......@@ -209,11 +209,15 @@ AM_CONDITIONAL([USE_PPM_CORE],[test $enable_ppm = yes])
AC_SUBST([USE_MPI])
# ----------------------------------------------------------------------
# Create the Fortran Interface via iso_c_binding module (Fortran 2003 Standard)
AC_ARG_ENABLE(iso-c-interface,
AS_HELP_STRING([--enable-iso-c-interface],
[Create Fortran Interface via iso_c_bindings facility of F2003 [default=no]]).
,enable_isoc=${enableval},enable_isoc=no)
AC_ARG_ENABLE([iso-c-interface],
[AS_HELP_STRING([--enable-iso-c-interface],
[Create Fortran Interface via iso_c_bindings facility of F2003 [default=no].])],
[enable_isoc=${enableval}],[enable_isoc=no])
AS_IF([test x"$enable_isoc" = xyes],
[ACX_FC_CHECK_STRPTR_CONVERT],[enable_isoc=no])
AM_CONDITIONAL([CREATE_ISOC],[test $enable_isoc = 'yes'])
AC_SUBST([ENABLE_F2003_ISOC],[$enable_isoc])
AM_SUBST_NOTMAKE([ENABLE_F2003_ISOC])
# in case the Fortran interface uses the more modern F90-style interface,
# the FCFLAGS for users of the library have to include a switch to use the
# .mod file
......@@ -338,6 +342,7 @@ AC_CONFIG_FILES([tests/test_cksum_grib \
tests/test_cksum_service \
tests/test_cksum_ieg \
tests/test_chunk_cksum \
tests/test_f2003 \
tests/pio_write_run \
tests/pio_write_deco2d_run \
tests/pio_cksum_mpinonb \
......
......@@ -89,6 +89,7 @@ DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = \
$(top_srcdir)/m4/acx_assert_lang_is_fortran_variant.m4 \
$(top_srcdir)/m4/acx_check_strptr_convert.m4 \
$(top_srcdir)/m4/acx_lang_other_suffix_conftest.m4 \
$(top_srcdir)/m4/acx_options.m4 \
$(top_srcdir)/m4/acx_sl_fc_mod_path_flag.m4 \
......
......@@ -9,14 +9,22 @@ PROGRAM CDIREADF2003
INTEGER :: streamID, varID, gridID, zaxisID
INTEGER :: tsID, vlistID, taxisID
DOUBLE PRECISION, ALLOCATABLE :: field(:,:)
CHARACTER(kind=c_char,len=256) :: name, longname, units, msg
CHARACTER(kind=c_char), POINTER, DIMENSION(:) :: &
msg, cdi_version
CHARACTER(kind=c_char), DIMENSION(cdi_max_name + 1) :: &
name, longname, units
INTEGER :: name_c_len, longname_c_len, units_c_len
cdi_version => cdiLibraryVersion()
WRITE (0, '(a,132a)') 'cdi version: ', cdi_version
! Open the dataset
streamID = streamOpenRead(C_CHAR_"example.nc"//C_NULL_CHAR)
IF ( streamID < 0 ) THEN
PRINT *, 'Could not Read the file.'
msg = cdiStringError(streamID)
WRITE(0,*) msg
msg => cdiStringError(streamID)
WRITE(0,'(132a)') msg
STOP 1
END IF
......@@ -31,12 +39,16 @@ PROGRAM CDIREADF2003
CALL vlistInqVarLongname(vlistID, varID, longname)
CALL vlistInqVarUnits(vlistID, varID, units)
CALL ctrim(name)
CALL ctrim(longname)
CALL ctrim(units)
! CALL ctrim(name)
! CALL ctrim(longname)
! CALL ctrim(units)
WRITE(*,*) 'Parameter: ', varID+1, code,' ',trim(name),' ', &
trim(longname),' ',trim(units), ' |'
longname_c_len = c_len(longname)
name_c_len = c_len(name)
units_c_len = c_len(units)
PRINT '(a,2(i0,a),132a)', 'Parameter: ', varID+1, ' ', code, ' ', &
name(1:name_c_len), ' ', longname(1:longname_c_len), ' ', &
units(1:units_c_len), ' |'
END DO
......@@ -53,7 +65,7 @@ PROGRAM CDIREADF2003
vdate = taxisInqVdate(taxisID)
vtime = taxisInqVtime(taxisID)
WRITE(*,*) 'Timestep: ', tsID+1, vdate, vtime
PRINT '(a,i3,i10,i10)', 'Timestep: ', tsID+1, vdate, vtime
! Read the variables at the current timestep
DO varID = 0, nvars-1
......@@ -64,8 +76,9 @@ PROGRAM CDIREADF2003
ALLOCATE(field(gsize, nlevel))
CALL streamReadVar(streamID, varID, field, nmiss)
DO ilev = 1, nlevel
WRITE(*,*) ' var=', varID+1, ' level=', ilev, ':', &
MINVAL(field(:,ilev)), MAXVAL(field(:,ilev))
PRINT '(a,i3,a,i3,a,f10.5,1x,f10.5)', ' var=', varID+1, &
' level=', ilev, ':', &
MINVAL(field(:,ilev)), MAXVAL(field(:,ilev))
END DO
DEALLOCATE(field)
END DO
......
......@@ -16,8 +16,8 @@
INTEGER i, nmiss, status
DOUBLE PRECISION lons(nlon), lats(nlat), levs(nlev)
DOUBLE PRECISION var1(nlon*nlat), var2(nlon*nlat*nlev)
CHARACTER(len=256) :: varname
CHARACTER(kind=c_char,len=256) :: msg
CHARACTER(len=256, kind=c_char) :: varname
CHARACTER(kind=c_char,len=1), POINTER :: msg(:)
DATA lons /0, 30, 60, 90, 120, 150, 180, 210, 240, 270, 300, 330/
DATA lats /-75, -45, -15, 15, 45, 75/
......@@ -47,8 +47,8 @@
varID2 = vlistDefVar(vlistID, gridID, zaxisID2, TIME_VARIABLE)
! Define the variable names
varname = "varname1"
CALL vlistDefVarName(vlistID, varID1, TRIM(varname)//C_NULL_CHAR)
varname = "varname1" // c_null_char
CALL vlistDefVarName(vlistID, varID1, varname)
CALL vlistDefVarName(vlistID, varID2, C_CHAR_"varname2"//C_NULL_CHAR)
! Create a Time axis
......@@ -60,8 +60,8 @@
! Create a dataset in netCDF format
streamID = streamOpenWrite(C_CHAR_"example.nc"//C_NULL_CHAR, FILETYPE_NC)
IF ( streamID < 0 ) THEN
msg = cdiStringError(streamID)
WRITE(0,*) msg
msg => cdiStringError(streamID)
WRITE(0,'(132a)') msg
STOP 1
END IF
......
......@@ -90,6 +90,7 @@ DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = \
$(top_srcdir)/m4/acx_assert_lang_is_fortran_variant.m4 \
$(top_srcdir)/m4/acx_check_strptr_convert.m4 \
$(top_srcdir)/m4/acx_lang_other_suffix_conftest.m4 \
$(top_srcdir)/m4/acx_options.m4 \
$(top_srcdir)/m4/acx_sl_fc_mod_path_flag.m4 \
......
......@@ -96,6 +96,7 @@ DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = \
$(top_srcdir)/m4/acx_assert_lang_is_fortran_variant.m4 \
$(top_srcdir)/m4/acx_check_strptr_convert.m4 \
$(top_srcdir)/m4/acx_lang_other_suffix_conftest.m4 \
$(top_srcdir)/m4/acx_options.m4 \
$(top_srcdir)/m4/acx_sl_fc_mod_path_flag.m4 \
......
......@@ -125,9 +125,7 @@ module #{name}
"
end
def endMod(name)
"
end module #{name}
"
"\nend module #{name}\n"
end
def isBadFunction(returnType, returnPointer, paramList)
return true if (
......@@ -138,16 +136,17 @@ def isBadFunction(returnType, returnPointer, paramList)
)
paramList.each {|paramInfo|
next if paramInfo == ['void']
next if paramInfo[0] == 'void' and /^\*\w+$/.match(paramInfo[1])
ctype, param = paramInfo[-2,2]
# TJ: unnamed arguments shouldn't be matched at all but because
# pointer * is parsed as part of the name those need to be rejected here
return true if (
CFTypeInfo[ctype].nil? or # derived data type
CFTypeInfo[ctype].nil? or # derived data type
param == '*' or # unnamed pointer
param[0,2] == '**' or # pointer2pointer
(param[0,1] == '*' and /\w\[\d*\]/.match(param)) # array of pointers
)
}
}
return false
end
......@@ -176,12 +175,12 @@ def setFortranParams(paramswithtypes,fFuncname)
if ( md = /\w\[(\d*)\]/.match(param); not md.nil? )
isArray = true
arraySize = md[1] == '' ? '*' : md[1]
param.tr!("[#{md[1]}]",'')
param.tr!("[#{md[1]}]",'')
end
# change param name if it equals the funcname
if param == fFuncname or param.downcase == fFuncname.downcase
param += FParamExtension
param += FParamExtension
# but maybe the result is the name of another parameter. -> play it again sam...
param += FParamExtension while ( originalParameters.include?(param) )
end
......@@ -193,6 +192,30 @@ def setFortranParams(paramswithtypes,fFuncname)
}
end
def printParams(fParams, indent)
out = ''
fParams.each {|param,paramType,ftype,ispointer,isarray,arraysize,isconstant|
dimension = isarray ? "dimension(#{arraysize})" : ( (ispointer and hasDimension(param, ftype) ) ? 'dimension(*)' : nil)
intent, value = nil, nil
if (ispointer or isarray)
if not isconstant
intent = 'intent(out)'
else
intent = 'intent(in)'
end unless paramType == 'c_char'
else
#intent = 'intent(in)'
value = 'value'
end
typeinfo = [value,intent,dimension].select {|s| ! s.nil?}.join(',')
out << " #{indent}#{ftype}"
out << (paramType == 'c_ptr' ? '' : "(kind=#{paramType})")
out << ", #{typeinfo} :: #{param}\n"
}
return out
end
# creates the actual binding within the module for the given c function
# unsupported types of function a ignored, see RESTRICTIONS (top) for details
def genInterface(cFuncname, returnType, returnPointer, paramList)
......@@ -200,14 +223,16 @@ def genInterface(cFuncname, returnType, returnPointer, paramList)
# do not create interfaces for unsuppoerted function
if isBadFunction( returnType, returnPointer, paramList)
warn "parameterlist of '#{cFuncname}' is not supported -> function ignored."
return ['','']
return ['','']
end
return ['', ''] if (cFuncname[0] == '_')
# the void argument type can be left out: if 'void' occures in the
# parameterlist (which is only the case, if it is the only parameter
# information), it is simply removed and a empty paramter list is left.
paramList = [[],[]] if paramList.flatten.include?('void') or paramList.flatten.empty?
paramList = [[],[]] if paramList.flatten == [ 'void' ] or paramList.flatten.empty?
out = ''
isWrapper = false
# create new names for the fortran routines, see CONFIGURATION (top)
fFuncname = cFuncname.send(FNameMethod)
......@@ -220,7 +245,14 @@ def genInterface(cFuncname, returnType, returnPointer, paramList)
# collect information for setting the correct fortran type for each parameter
paramsWithTypes = paramList.collect {|paramInfo|
ctype, param = paramInfo[-2,2]
ftype, nc = CFTypeInfo[ctype][:ftype], CFTypeInfo[ctype][:namedConst]
ptr_match = /^\*(\w+)$/.match(param)
if (/^(:?const)? *void$/.match(ctype) and ptr_match)
param = ptr_match[1]
ftype = 'type(c_ptr)'
nc = 'c_ptr'
else
ftype, nc = CFTypeInfo[ctype][:ftype], CFTypeInfo[ctype][:namedConst]
end
# fortran parameters can be configured out of the c parameters
[param.send(FNameMethod),nc,ftype, paramInfo.include?('const')]
}
......@@ -232,46 +264,64 @@ def genInterface(cFuncname, returnType, returnPointer, paramList)
end
fReturnInfo = CFTypeInfo[returnType]
indent = ' '
if not fReturnInfo.nil?
fReturnString = "function"
fEndString = " #{fReturnInfo[:ftype]}(kind=#{fReturnInfo[:namedConst]}) :: #{fFuncname}
end function"
fEnd = ["#{fReturnInfo[:ftype]}(kind=#{fReturnInfo[:namedConst]}) :: #{fFuncname}\n", "end function" ]
fTypes4Import << fReturnInfo[:namedConst]
elsif returnType == 'void'
fReturnString = "subroutine"
fEndString = "end subroutine"
fEnd = ["end subroutine"]
end
fFuncname_suffix = ''
if (returnType == 'char' and returnPointer == '*')
out << "#{indent}function #{fFuncname}(#{fParams4Import.join(',')})\n"
out << printParams(fParams, indent)
fTypes4Import.unshift('c_ptr') unless fTypes4Import.include?('c_ptr')
isWrapper = true
fwEnd = [ "end function" ]
fFuncname_suffix = '_c'
indent = ' '
fEnd = [ "type(c_ptr) :: #{fFuncname}#{fFuncname_suffix}\n",
"end function" ]
end
out << "#{indent}interface
#{indent} #{fReturnString} #{fFuncname}#{fFuncname_suffix}(#{fParams4Import.join(',')}) bind(c,name='#{cFuncname}')\n"
out << "#{indent} import :: #{fTypes4Import.uniq.join(',')}\n" unless fTypes4Import.empty?
out << "
interface
#{fReturnString} #{fFuncname}(#{fParams4Import.join(',')}) bind(c,name='#{cFuncname}')
"
out << " import :: #{fTypes4Import.uniq.join(',')}
" unless fTypes4Import.empty?
out << printParams(fParams, indent + ' ')
fParams.each {|param,paramType,ftype,ispointer,isarray,arraysize,isconstant|
dimension = isarray ? "dimension(#{arraysize})" : ( (ispointer and hasDimension(param, ftype) ) ? 'dimension(*)' : nil)
intent, value = nil, nil
if (ispointer or isarray)
if not isconstant
intent = 'intent(out)'
else
intent = 'intent(in)'
end unless paramType == 'c_char'
else
#intent = 'intent(in)'
value = 'value'
fEnd.each_with_index do |line, i|
extra_indent = ' '
if i == fEnd.length - 1
extra_indent = ' '
end
typeinfo = [value,intent,dimension].select {|s| ! s.nil?}.join(',')
out << " #{ftype}(kind=#{paramType}), #{typeinfo} :: #{param}\n "
}
out <<
" #{fEndString} #{fFuncname}
end interface
"
[out, makePublic(fFuncname)]
out << indent + extra_indent + line
end
out << " #{fFuncname}#{fFuncname_suffix}\n#{indent}end interface\n"
if (returnType == 'char' and returnPointer == '*')
indent = ' '
out << "#{indent} character(len=1, kind=c_char), pointer :: #{fFuncname}(:)
#{indent} type(c_ptr) :: cptr
#{indent} integer :: slen(1)
#{indent} cptr = #{fFuncname}#{fFuncname_suffix}("
out << fParams4Import.join(",&
#{indent} ") << ")\n"
out << "#{indent} #{fFuncname} => null()\n"
out << "#{indent} slen(1) = int(strlen(cptr))\n"
out << "#{indent} call c_f_pointer(cptr, #{fFuncname}, slen)\n"
fwEnd.each_with_index do |line,i|
extra_indent = ' '
if i == fwEnd.length - 1
extra_indent = ''
end
out << indent + extra_indent + line
end
out << " #{fFuncname}\n"
end
[out, makePublic(fFuncname), isWrapper]
end
def makePublic(*fFuncnameList)
fFuncnameList.collect {|fname|
......@@ -281,21 +331,35 @@ end
def ctrim
"
subroutine ctrim(str)
use iso_c_binding
character(kind=c_char, len=*) :: str
character :: c
character(kind=c_char) :: str(:)
character(kind=c_char) :: c
integer :: i
do i=1,len(str)
c = str(i:i)
do i=1,size(str)
c = str(i)
if (c == c_null_char) then
str(i:len(str)) = ' '
str(i:size(str)) = ' '
exit
end if
end do
end subroutine ctrim
end subroutine ctrim\n"
end
def clen
"
function c_len(s) result(i)
character(kind=c_char), intent(in) :: s(:)
integer :: i
do i = 1, size(s)
if (s(i) == c_null_char) then
exit
end if
end do
i = i - 1
end function\n"
end
################################################################################
if __FILE__ == $0
require 'optparse'
......@@ -392,19 +456,26 @@ end.parse!
moduleVariables = genModParams(cDefines)
end
interfaces, makepublics, subroutines = '', '', ''
interfaces, makepublics, subroutines = '', '', "contains\n"
indent = ' '
getFuncInfo(ARGV[0]).each {| funcName, returnType, returnPointer, paramList|
funcdecls = [ [ 'strlen', 'size_t', '', [ [ 'void', '*s' ] ] ] ]
funcdecls.concat(getFuncInfo(ARGV[0]))
funcdecls.each {| funcName, returnType, returnPointer, paramList|
pp [funcName, returnType, returnPointer, paramList] if debug
interface, makepublic = genInterface(funcName,returnType, returnPointer, paramList)
interfaces << interface
interface, makepublic, isWrapper = genInterface(funcName,returnType, returnPointer, paramList)
if isWrapper
subroutines << interface
else
interfaces << interface
end
makepublics << makepublic
}
# add a specialized trim for wierd c strings
makepublics << makePublic('ctrim')
subroutines << "contains\n"
subroutines << ctrim
makepublics << makePublic('ctrim') << makePublic('c_len')
subroutines << ctrim << clen
File.open(ARGV[1],"w") {|f|
[ startMod(modname),
......
dnl acx_fc_check_strprt_convert.m4 --- unset a shell variable
dnl
dnl Copyright (C) 2010 Thomas Jahns <jahns@dkrz.de>
dnl
dnl Version: 1.0
dnl Keywords: