# FortranCInterface.cmake
#
# This file defines the function create_fortran_c_interface.
# this function is used to create a configured header file 
# that contains a mapping from C to a Fortran function using
# the correct name mangling scheme as defined by the current 
# fortran compiler.  
#
# The function tags a list of functions and the name of 
# a header file to configure.  
#
# This file also defines some helper functions that are used
# to detect the fortran name mangling scheme used by the 
# current Fortran compiler.
#  test_fortran_mangling - test a single fortran mangling 
#  discover_fortran_mangling - loop over all combos of fortran
#   name mangling and call test_fortran_mangling until one of them
#   works.
#  discover_fortran_module_mangling - try different types of 
#  fortran modle name mangling to find one that works
#
#
#
# this function tests a single fortran mangling.  
# CODE - test code to try should define a subroutine called "sub"
# PREFIX - string to put in front of sub
# POSTFIX - string to put after sub
# ISUPPER - if TRUE then sub will be called as SUB
# DOC - string used in status checking Fortran ${DOC} linkage
# SUB - the name of the SUB to call
# RESULT place to store result TRUE if this linkage works, FALSE
#        if not.
#
function(test_fortran_mangling CODE PREFIX ISUPPER POSTFIX DOC SUB RESULT)
  if(ISUPPER)
    string(TOUPPER "${SUB}" sub)
  else(ISUPPER) 
    string(TOLOWER "${SUB}" sub)
  endif(ISUPPER)
  set(FUNCTION "${PREFIX}${sub}${POSTFIX}")
  # create a fortran file with sub called sub
  # 
  set(TMP_DIR
    "${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/CheckFortranLink")
  file(REMOVE_RECURSE "${TMP_DIR}")
  file(WRITE "${TMP_DIR}/test.f" "${CODE}"    )
  message(STATUS "checking Fortran ${DOC} linkage: ${FUNCTION}")
  file(WRITE "${TMP_DIR}/ctof.c"
    "
      extern ${FUNCTION}();
      int main() { ${FUNCTION}(); return 0;}
    "
    )
  file(WRITE "${TMP_DIR}/CMakeLists.txt"
    "
     project(testf C Fortran)
     add_library(flib test.f)
     add_executable(ctof ctof.c)
     target_link_libraries(ctof flib)
    "
    )
  set(FORTRAN_NAME_MANGLE_TEST FALSE)
  try_compile(FORTRAN_NAME_MANGLE_TEST "${TMP_DIR}" "${TMP_DIR}"
    testf
    OUTPUT_VARIABLE output)
  if(FORTRAN_NAME_MANGLE_TEST)
    set(${RESULT} TRUE PARENT_SCOPE)
  else()
    set(${RESULT} FALSE PARENT_SCOPE)
  endif()
endfunction(test_fortran_mangling)

function(test_fortran_mangling_from_library LIBNAME PREFIX ISUPPER POSTFIX DOC SUB RESULT)
  if(ISUPPER)
    string(TOUPPER "${SUB}" sub)
  else(ISUPPER) 
    string(TOLOWER "${SUB}" sub)
  endif(ISUPPER)
  set(FUNCTION "${PREFIX}${sub}${POSTFIX}")
  message(STATUS "checking Fortran ${DOC} linkage: ${FUNCTION}")
  INCLUDE (CheckLibraryExists)
  CHECK_LIBRARY_EXISTS(${LIBNAME} ${FUNCTION} "/usr/lib64" FORTRAN_NAME_MANGLE_TEST)
  set(${RESULT} ${FORTRAN_NAME_MANGLE_TEST} PARENT_SCOPE)
endfunction()

# this function discovers the name mangling scheme used
# for functions in a fortran module.  
function(discover_fortran_module_mangling prefix suffix found)
  set(CODE 
    "
      module test_interface
      interface dummy
         module procedure sub
      end interface
      contains
        subroutine sub
        end subroutine
      end module test_interface
    ")
  set(worked FALSE)
  foreach(interface 
      "test_interface$" 
      "TEST_INTERFACE_mp_" 
      "_test_interface__" 
      "__test_interface__" 
      "__test_interface_NMOD_" 
      "__test_interface_MOD_")
    test_fortran_mangling("${CODE}" "${interface}"
      ${FORTRAN_C_MANGLING_UPPERCASE} "" "module" "sub" worked)
    if(worked)
      # if this is the upper case module match then
      # lower case it for the extraction of pre and post strings
      if("${interface}" MATCHES "TEST_INTERFACE")
        string(TOLOWER "${interface}" interface)
      endif()
      string(REGEX REPLACE "(.*)test_interface(.*)" "\\1" pre "${interface}")
      string(REGEX REPLACE "(.*)test_interface(.*)" "\\2" post "${interface}")
      set(${prefix} "${pre}" PARENT_SCOPE)
      set(${suffix} "${post}" PARENT_SCOPE)
      set(${found} TRUE PARENT_SCOPE)
      return()
    endif(worked)
  endforeach(interface)
  if(NOT worked)
    message(STATUS "Failed to find C binding to Fortran module functions.")
    set(${prefix} "BROKEN_C_FORTRAN_MODULE_BINDING" PARENT_SCOPE)
    set(${suffix} "BROKEN_C_FORTRAN_MODULE_BINDING" PARENT_SCOPE)
    set(${found} FALSE PARENT_SCOPE)
  endif(NOT worked)
endfunction(discover_fortran_module_mangling)


function(discover_fortran_mangling prefix isupper suffix extra_under_score
    found )
  set(CODE 
    "
      subroutine sub
      end subroutine sub
    ")
  foreach(post "_" "")
    foreach(isup FALSE TRUE)
      foreach(pre "" "_" "__")
        set(worked FALSE)
        test_fortran_mangling("${CODE}" "${pre}" ${isup}
          "${post}" "function" sub worked )
        if(worked)
          message(STATUS "found Fortran function linkage")
          set(${isupper} "${isup}" PARENT_SCOPE)
          set(${prefix} "${pre}" PARENT_SCOPE)
          set(${suffix} "${post}" PARENT_SCOPE)
          set(${found} TRUE PARENT_SCOPE)
          set(CODE 
            "
      subroutine my_sub
      end subroutine my_sub
    ")
          set(worked FALSE)
          test_fortran_mangling("${CODE}" "${pre}" ${isup}
            "${post}" "function with _ " my_sub worked )
          if(worked)
            set(${extra_under_score} FALSE PARENT_SCOPE)
          else(worked)
            test_fortran_mangling("${CODE}" "${pre}" ${isup}
              "${post}_" "function with _ " my_sub worked )
            if(worked)
              set(${extra_under_score} TRUE PARENT_SCOPE)
            endif(worked)
          endif(worked)
        return()
        endif()
      endforeach()
    endforeach()
  endforeach()
  set(${found} FALSE PARENT_SCOPE)
endfunction(discover_fortran_mangling)

function(discover_fortran_mangling_from_library libname function prefix isupper suffix found )
  Find_Library(library ${libname})
  foreach(post "_" "")
    foreach(isup FALSE TRUE)
      foreach(pre "" "_" "__")
        set(worked FALSE)
        message("${libname}" "${library}" "${pre}" "${isup}" "${post}" "function" "${function}" worked )
        test_fortran_mangling_from_library("${libname}" "${pre}" "${isup}" "${post}" "function" "${function}" worked )
        if(worked)
          message(STATUS "found Fortran function linkage")
          set(${isupper} "${isup}" PARENT_SCOPE)
          set(${prefix} "${pre}" PARENT_SCOPE)
          set(${suffix} "${post}" PARENT_SCOPE)
          set(${found} TRUE PARENT_SCOPE)
          return()
        endif()
      endforeach()
    endforeach()
  endforeach()
  set(${found} FALSE PARENT_SCOPE)
endfunction()

function(is_language_available lang result)
  get_property(_LANGUAGES_ GLOBAL PROPERTY ENABLED_LANGUAGES)
  if(_LANGUAGES_ MATCHES "${lang}")
    SET(${result} TRUE PARENT_SCOPE)
    return()
  endif()
  SET(${result} FALSE PARENT_SCOPE)
endfunction()

# Parse arguments to create_fortran_c_interface and sets the variables
# with the corresponding parameters. variable names are those of named args
# or options prefixed with the given prefix. Arg names and options are
# given by the two lists arg_names and option_names.

function(PARSE_PARAMETERS prefix arg_names option_names)
  SET(DEFAULT_ARGS)
  FOREACH(name ${arg_names} ${option_names})
    SET(${prefix}_${name})
  ENDFOREACH()

  SET(current_arg_name DEFAULT_ARGS)
  SET(current_arg_list)
  FOREACH(arg ${ARGN})
    LIST(FIND ${arg_names} ${arg} is_arg_name)
    IF (is_arg_name NOT EQUAL -1)
      SET(${prefix}_${current_arg_name} ${current_arg_list})
      SET(current_arg_name ${arg})
      SET(current_arg_list)
    ELSE ()
      LIST(FIND ${option_names} ${arg} is_option)
      IF (is_option)
        SET(${prefix}_${arg} TRUE)
      ELSE ()
        SET(current_arg_list ${current_arg_list} ${arg})
      ENDIF ()
    ENDIF ()
  ENDFOREACH()
  SET(${prefix}_${current_arg_name} ${current_arg_list})
endfunction()

function(discover_fortran_c_interface)
  # find regular fortran function mangling
  SET(FORTRAN_MANGLING_NO_UNDERSCORE_ONLY FALSE)
  SET(FORTRAN_MANGLING_UNDERSCORE_ONLY FALSE)
  if (${ARGC} EQUAL 0)
    is_language_available(Fortran FORTRAN_AVAILABLE)
    if (NOT FORTRAN_AVAILABLE)
      message(SEND_ERROR "Cannot find fortran mangling without a fortran compiler or a fortran library.")
      return()
    endif()
    is_language_available(C C_AVAILABLE)
    if (NOT C_AVAILABLE)
      message(SEND_ERROR "Finding fortran mangling requires a C compiler.")
      return()
    endif()
    discover_fortran_mangling(prefix isupper suffix extra_under found)
    if(NOT found)
      message(SEND_ERROR "Could not find fortran c name mangling (probably no fortran compiler available).")
      return()
    endif()
    SET(FORTRAN_MANGLING_NO_UNDERSCORE_ONLY TRUE)
    SET(FORTRAN_MANGLING_UNDERSCORE_ONLY TRUE)
  else()
    LIST(GET ARGN 0 flibrary)
    LIST(REMOVE_AT ARGN 0)
    SET(name "")
    SET(name_ "")
    foreach (f ${ARGN})
      IF ("${f}" MATCHES "_")
        SET(name_ ${f})
      ELSE()
        IF ("${f}" MATCHES ":")
          MESSAGE(WARNING "Fortran C interface from library does not work yet for modules.")
        ELSE()
          SET(name ${f})
        ENDIF()
      ENDIF()
    endforeach()
    SET(extra_under FALSE)
    IF (name)
      discover_fortran_mangling_from_library(${flibrary} ${name} prefix isupper suffix found)
      IF (found AND name_)
        test_fortran_mangling_from_library(${flibrary} ${prefix} ${isupper} ${suffix} "function" ${name_} worked)
        IF (NOT worked)
          test_fortran_mangling_from_library(${flibrary} ${prefix} ${isupper} ${suffix} "function" ${name_}_ worked)
          IF (worked)
            SET(extra_under TRUE)
          ELSE()
            SET(FORTRAN_MANGLING_NO_UNDERSCORE_ONLY TRUE)
          ENDIF()
        ENDIF()
      ENDIF()
    ELSE()
      IF (name_)
        discover_fortran_mangling_from_library(${flibrary} ${name_} prefix isupper suffix extra_under found)
        IF (found)
          SET(FORTRAN_MANGLING_UNDERSCORE_ONLY TRUE)
        ENDIF()
      ELSE()
        MESSAGE(SEND_ERROR "No function name provided to ${ARGV[0]}")
        return()
      ENDIF()
    ENDIF()
    IF (NOT found)
      message(SEND_ERROR "Could not find fortran c name mangling (probably function is not in library).")
      return()
    ENDIF()
  endif()

  # find fortran module function mangling
  set(FORTRAN_C_PREFIX "${prefix}" CACHE INTERNAL
    "PREFIX for Fortran to c name mangling")
  set(FORTRAN_C_SUFFIX "${suffix}" CACHE INTERNAL
    "SUFFIX for Fortran to c name mangling")
  set(FORTRAN_C_MANGLING_UPPERCASE ${isupper} CACHE INTERNAL 
    "Was fortran to c mangling found" )
  set(FORTRAN_C_MANGLING_EXTRA_UNDERSCORE ${extra_under} CACHE INTERNAL 
    "If a function has a _ in the name does the compiler append an extra _" )
  set(FORTRAN_C_MANGLING_FOUND TRUE CACHE INTERNAL 
    "Was fortran to c mangling found" )
  set(prefix )
  set(suffix )
  set(found FALSE)
  # only try this if the compiler is F90 compatible
  if(CMAKE_Fortran_COMPILER_SUPPORTS_F90)
    discover_fortran_module_mangling(prefix suffix found)
  endif(CMAKE_Fortran_COMPILER_SUPPORTS_F90)
  if(found)
    message(STATUS "found Fortran module linkage")
  else(found)
    message(STATUS "Failed to find Fortran module linkage")
  endif(found)
  set(FORTRAN_C_MODULE_PREFIX "${prefix}" CACHE INTERNAL
    "PREFIX for Fortran to c name mangling")
  set(FORTRAN_C_MODULE_SUFFIX "${suffix}" CACHE INTERNAL
    "SUFFIX for Fortran to c name mangling")
  set(FORTRAN_C_MODULE_MANGLING_FOUND ${found} CACHE INTERNAL
    "Was for Fortran to c name mangling found for modules")
endfunction()

function(create_fortran_c_interface NAMESPACE FUNCTIONS HEADER)
  PARSE_PARAMETERS("FORTRAN_C_" "USE_LIBRARY" "APPEND" ${ARGN})
  if(NOT FORTRAN_C_MANGLING_FOUND)
    discover_fortran_c_interface()
  endif()
  if (NOT FUNCTIONS)
    set(fcase "x")
    if(FORTRAN_C_MANGLING_UPPERCASE)
      set(fcase "X")
    endif()
    if ( NOT ${FORTRAN_C_PREFIX} EQUAL "")
      set(fcase " ## ${fcase}")
    endif()
    if (NOT ${FORTRAN_C_SUFFIX} EQUAL "")
      set(fcase "${fcase} ## ")
    endif()
    set(HEADER_CONTENT "${HEADER_CONTENT}
#define Fortran_Function(x,X) ${FORTRAN_C_PREFIX}${fcase}${FORTRAN_C_SUFFIX}
")
    IF (FORTRAN_C_MANGLING_EXTRA_UNDERSCORE)
      set(HEADER_CONTENT "${HEADER_CONTENT}
#define Fortran_Function_With_Underscore(x,X) Fortran_Function(x,X) ## _
")
    ENDIF()
  else()
    foreach (f ${${FUNCTIONS}})
      if(FORTRAN_C_MANGLING_UPPERCASE)
        string(TOUPPER "${f}" fcase)
      else()
        string(TOLOWER "${f}" fcase)
      endif()
      if("${f}" MATCHES ":")
        string(REGEX REPLACE "(.*):(.*)" "\\1" module "${f}")
        string(REGEX REPLACE "(.*):(.*)" "\\2" function "${f}")
        string(REGEX REPLACE "(.*):(.*)" "\\1" module_case "${fcase}")
        string(REGEX REPLACE "(.*):(.*)" "\\2" function_case "${fcase}")
        set(HEADER_CONTENT "${HEADER_CONTENT}
#define ${NAMESPACE}${module}_${function} ${FORTRAN_C_MODULE_PREFIX}${module_case}${FORTRAN_C_MODULE_SUFFIX}${function_case}
")
      else("${f}" MATCHES ":")
        set(function "${FORTRAN_C_PREFIX}${fcase}${FORTRAN_C_SUFFIX}")
        if("${f}" MATCHES "_" AND FORTRAN_C_MANGLING_EXTRA_UNDERSCORE)
          set(function "${function}_")
        endif("${f}" MATCHES "_" AND FORTRAN_C_MANGLING_EXTRA_UNDERSCORE)
        set(HEADER_CONTENT "${HEADER_CONTENT}
#define ${NAMESPACE}${f} ${function}
")
      endif("${f}" MATCHES ":")
    endforeach(f)
  endif()
  configure_file(
    "${CMAKE_ROOT}/Modules/FortranCInterface.h.in"
    ${HEADER} @ONLY)
  message(STATUS "created ${HEADER}")
endfunction()