Merge pull request #38 from SINTEF/fortran-bindings

Fortran bindings

.devcontainer/devcontainer.json

@@ -19,7 +19,12 @@
 	},
 
 	// Add the IDs of extensions you want installed when the container is created.
-	"extensions": []
+	"extensions": [
+		"ms-vscode.cpptools",
+		"ms-vscode.cmake-tools",
+		"hansec.fortran-ls",
+		"krvajalm.linter-gfortran"
+	]
 
 	// Use 'forwardPorts' to make a list of ports inside the container available locally.
 	// "forwardPorts": [],

CMakeLists.txt

@@ -13,6 +13,7 @@ project(dlite
 
 # Options
 option(WITH_PYTHON      "Whether to build Python 3 bindings"             ON)
+option(WITH_FORTRAN     "Whether to build Fortran bindings"              OFF)
 option(WITH_HDF5        "Whether to build with HDF5 support"             ON)
 option(WITH_JSON        "Whether to build with JSON support"             ON)
 option(WITH_DOC         "Whether to build documentation using doxygen"   ON)
@@ -315,6 +316,21 @@ else()
 endif()
 
 
+#
+# Fortran
+# =======
+if(WITH_FORTRAN)
+  enable_language(Fortran)
+
+  enable_fortran_compiler_flag_if_supported("-std=f2008")
+
+  enable_fortran_compiler_flag_if_supported("-Wall")
+  enable_fortran_compiler_flag_if_supported("-Wextra")
+  enable_fortran_compiler_flag_if_supported("-Wpedantic")
+  enable_fortran_compiler_flag_if_supported("-Werror")
+endif()
+
+
 # Testing
 # -------
 include(CTest)
@@ -579,6 +595,9 @@ add_subdirectory(tools)
 if(WITH_PYTHON)
   add_subdirectory(bindings/python)
 endif()
+if(WITH_FORTRAN)
+  add_subdirectory(bindings/fortran)
+endif()
 
 # Storage plugins
 if(WITH_HDF5)

Dockerfile

@@ -10,7 +10,7 @@
 
 FROM ubuntu:18.04 AS dependencies
 
-RUN apt-get update
+RUN apt-get update --fix-missing
 
 # Default cmake is 3.10.2. We need at least 3.11...
 # Install tools for adding cmake
@@ -49,10 +49,14 @@ RUN apt-get install -y \
     python3-pip \
     swig3.0 \
     cppcheck \
-    gfortran
+    gfortran \
+    gdb \
+    cmake-curses-gui
 
 # Install Python packages
-RUN pip3 install ipython
+RUN pip3 install --trusted-host files.pythonhosted.org \
+    ipython \
+    fortran-language-server
 
 # The following section performs the build
 FROM dependencies AS build

README.md

@@ -26,7 +26,7 @@ Main features
   - Code generation
   - Plugin API for data storages
   - Plugin API for mapping between metadata
-  - Bindings to C, Python (Fortran is in progress)
+  - Bindings to C, Python and Fortran
 
 More detailed features
 ----------------------
@@ -51,13 +51,11 @@ More detailed features
   - Memory for metadata and instances is reference counted
   - Lookup of metadata and instances at pre-defined locations (initiated
     from the DLITE_STORAGES environment variable)
-  - Template-based code generation (includes templates for C, Fortran
-    templates are planned)
+  - Template-based code generation (includes templates for C and Fortran)
   - Plugin system for mappings that maps instances of a set of input metadata
     to an output instance
   - Python bindings
   - Storage and mapping plugins written in Python
-  - Fortran bindings (work in progress...)
 
 
 Short vocabulary

bindings/fortran/CMakeLists.txt

@@ -0,0 +1,21 @@
+project(dlite-bindings-fortran Fortran)
+
+configure_file(dlite_config.f90.in dlite_config.f90)
+
+set(sources
+  c_interface.f90
+  ${CMAKE_CURRENT_BINARY_DIR}/dlite_config.f90
+  dlite.f90
+  )
+
+add_library(dlite-fortran SHARED ${sources})
+
+target_link_libraries(dlite-fortran
+  dlite
+  dlite-utils
+  )
+
+
+
+
+add_subdirectory(tests)

bindings/fortran/c_interface.f90

@@ -0,0 +1,132 @@
+!
+! file   : c_interface.f90
+! purpose: copy string from C to Fortran and copy string from Fortran to C
+! origin : http://fortranwiki.org/fortran/show/c_interface_module
+!
+module c_interface
+  use iso_c_binding, only : c_ptr, c_int, c_size_t, c_char, c_null_char, &
+                            c_associated, c_f_pointer
+
+  implicit none
+
+  public :: c_strlen_safe
+
+  interface c_f_string
+      module procedure c_f_string_ptr
+      module procedure c_f_string_chars
+  end interface c_f_string
+
+  interface f_c_string
+      module procedure f_c_string_ptr
+      module procedure f_c_string_chars
+  end interface f_c_string
+
+  interface
+
+  ! Return the length of S.
+  ! extern size_t strlen (const char *s)
+  function c_strlen(s) result(result) bind(C,name="strlen")
+    import c_ptr, c_size_t
+    integer(c_size_t) :: result
+    type(c_ptr), value, intent(in) :: s
+  end function c_strlen
+
+  end interface
+
+  contains
+
+  function c_strlen_safe(s) result(length)
+    integer(c_size_t) :: length
+    type(c_ptr), value, intent(in) :: s
+    if (.not. c_associated(s)) then
+      length = 0
+    else
+      length = c_strlen(s)
+    end if
+  end function c_strlen_safe
+
+  ! Copy a C string, passed by pointer, to a Fortran string.
+  ! If the C pointer is NULL, the Fortran string is blanked.
+  ! C_string must be NUL terminated, or at least as long as F_string.
+  ! If C_string is longer, it is truncated. Otherwise, F_string is
+  ! blank-padded at the end.
+  subroutine c_f_string_ptr(c_string, f_string)
+    type(c_ptr), intent(in)                             :: c_string
+    character(len=*), intent(out)                       :: f_string
+    character(len=1,kind=c_char), dimension(:), pointer :: p_chars
+    integer                                             :: i
+    if (.not. c_associated(c_string)) then
+      f_string = ' '
+    else      
+      call c_f_pointer(c_string, p_chars, [len(f_string) + 1])
+      print *, "c_f_string_ptr: len(f_string)=", len(f_string)
+      print *, "c_f_string_ptr: p_chars      =", p_chars 
+      i = 1
+      do while((p_chars(i).ne.c_null_char) .and. (i.le.len(f_string)))
+        f_string(i:i) = p_chars(i)
+        i = i + 1
+      end do
+      if (i .lt. len(f_string)) f_string(i:) = ' '
+    end if
+  end subroutine c_f_string_ptr
+
+  ! Copy a C string, passed as a char-array reference, to a Fortran string.
+  subroutine c_f_string_chars(c_string, f_string)
+    character(len=1,kind=c_char), intent(in) :: c_string(*)
+    character(len=*), intent(out)            :: f_string
+    integer                                  :: i
+    i=1
+    do while(c_string(i)/=c_null_char .and. i<=len(f_string))
+      f_string(i:i) = c_string(i)
+      i=i+1
+    end do
+    if (i<len(f_string)) f_string(i:) = ' '
+  end subroutine c_f_string_chars
+
+  ! Copy a Fortran string to an allocated C string pointer.
+  ! If the C pointer is NULL, no action is taken. (Maybe auto allocate via libc call?)
+  ! If the length is not passed, the C string must be at least: len(F_string)+1
+  ! If the length is passed and F_string is too long, it is truncated.
+  subroutine f_c_string_ptr(f_string, c_string, c_string_len)
+    character(len=*), intent(in)                        :: f_string
+    type(c_ptr), intent(in)                             :: c_string
+    integer, intent(in), optional                       :: c_string_len
+    character(len=1,kind=c_char), dimension(:), pointer :: p_chars
+    integer                                             :: i, strlen
+    strlen = len_trim(f_string)
+    if (present(c_string_len)) then
+      if (c_string_len <= 0) return
+      strlen = min(strlen,c_string_len-1)
+    end if
+    if (.not. c_associated(c_string)) then
+      return
+    end if
+    call c_f_pointer(c_string,p_chars,[strlen+1])
+    forall (i=1:strlen)
+      p_chars(i) = f_string(i:i)
+    end forall
+    p_chars(strlen+1) = c_null_char
+    end subroutine f_c_string_ptr
+
+  ! Copy a Fortran string to a C string passed by char-array reference.
+  ! If the length is not passed, the C string must be at least: len(F_string)+1
+  ! If the length is passed and F_string is too long, it is truncated.
+  subroutine f_c_string_chars(f_string, c_string, c_string_len)
+    character(len=*), intent(in)                            :: f_string
+    character(len=1,kind=C_char), dimension(*), intent(out) :: c_string
+    ! Max string length, INCLUDING THE TERMINAL NULL CHAR
+    integer, intent(in), optional                           :: c_string_len
+    integer                                                 :: i
+    integer                                                 :: strlen
+    strlen = len_trim(f_string)
+    if (present(c_string_len)) then
+      if (c_string_len <= 0) return
+      strlen = min(strlen,c_string_len-1)
+    end if
+    forall (i=1:strlen)
+      c_string(i) = f_string(i:i)
+    end forall
+    c_string(strlen+1) = c_null_char
+  end subroutine f_c_string_chars
+
+end module c_interface