Add Fortran 90

CMakeLists.txt

@@ -20,6 +20,14 @@ endif()
 set(CMAKE_CXX_STANDARD 11)
 set(CMAKE_CXX_STANDARD_REQUIRED True)
 
+set(PAPYRUS_USE_FORTRAN ON CACHE BOOL "Enable support for Fortran 90")
+MESSAGE (STATUS "PAPYRUS_USE_FORTRAN ${PAPYRUS_USE_FORTRAN}")
+
+if(PAPYRUS_USE_FORTRAN)
+    enable_language(Fortran)
+    MESSAGE (STATUS "CMAKE_Fortran_COMPILER ${CMAKE_Fortran_COMPILER}")
+endif()
+
 include(CTest)
 
 add_subdirectory(include)

include/papyrus/kv.h

@@ -53,7 +53,7 @@ extern int papyruskv_put(int db, const char* key, size_t keylen, const char* val
 extern int papyruskv_get(int db, const char* key, size_t keylen, char** val, size_t* vallen);
 extern int papyruskv_get_pos(int db, const char* key, size_t keylen, char** val, size_t* vallen, papyruskv_pos_t* pos);
 extern int papyruskv_delete(int db, const char* key, size_t keylen);
-extern int papyruskv_free(void* val);
+extern int papyruskv_free(char** val);
 extern int papyruskv_fence(int db, int level);
 extern int papyruskv_barrier(int db, int level);
 extern int papyruskv_signal_notify(int signum, int* ranks, int count);

kv/src/CAPI.cpp

@@ -36,7 +36,7 @@ int papyruskv_delete(int db, const char* key, size_t keylen) {
     return Platform::GetPlatform()->Delete(db, key, keylen);
 }
 
-int papyruskv_free(void* val) {
+int papyruskv_free(char** val) {
     return Platform::GetPlatform()->Free(val);
 }
 

kv/src/CMakeLists.txt

 include_directories(${PROJECT_SOURCE_DIR}/include)
 
-add_library(papyruskv
+set(PAPYRUSKV_SOURCES
     Bloom.cpp
     CAPI.cpp
     Cache.cpp
@@ -22,4 +22,17 @@ add_library(papyruskv
     Timer.cpp
     )
 
+if(PAPYRUS_USE_FORTRAN)
+   set(PAPYRUSKV_SOURCES ${PAPYRUSKV_SOURCES}
+        C_Binding.f90
+       )
+   set(CMAKE_Fortran_MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/include)
+endif()
+
+add_library(papyruskv ${PAPYRUSKV_SOURCES})
+
 install(TARGETS papyruskv DESTINATION lib)
+
+if(PAPYRUS_USE_FORTRAN)
+   install(FILES ${PROJECT_BINARY_DIR}/include/papyrus.mod DESTINATION include)
+endif()

kv/src/Platform.cpp

@@ -156,7 +156,7 @@ int Platform::Delete(int dbid, const char* key, size_t keylen) {
     return GetDB(dbid)->Delete(key, keylen);
 }
 
-int Platform::Free(void* val) {
+int Platform::Free(char** val) {
     pool_->FreeVal(val);
     return PAPYRUSKV_OK;
 }

kv/src/Platform.h

@@ -26,7 +26,7 @@ public:
     int Put(int dbid, const char* key, size_t keylen, const char* val, size_t vallen);
     int Get(int dbid, const char* key, size_t keylen, char** val, size_t* vallen, papyruskv_pos_t* pos);
     int Delete(int dbid, const char* key, size_t keylen);
-    int Free(void* val);
+    int Free(char** val);
     int Fence(int dbid, int level);
     int Barrier(int dbid, int level);
     int SignalNotify(int signum, int* ranks, int count);

kv/src/Pool.cpp

@@ -14,8 +14,9 @@ char* Pool::AllocVal(size_t vallen) {
     return new char[vallen];
 }
 
-void Pool::FreeVal(void* val) {
-    delete[] reinterpret_cast<char *>(val);
+void Pool::FreeVal(char** val) {
+    delete[] *val;
+    *val = NULL;
 }
 
 } /* namespace papyruskv */

kv/src/Pool.h

@@ -13,7 +13,7 @@ public:
     ~Pool();
 
     char* AllocVal(size_t vallen);
-    void FreeVal(void* val);
+    void FreeVal(char** val);
 
 private:
     Platform* platform_;

kv/tests/12_free/test12_free.c

@@ -49,7 +49,7 @@ int main(int argc, char** argv) {
         else printf("[%s:%d] GET:rank[%d] peer[%d] key[%s] value[%s] vallen[%lu]\n", __FILE__, __LINE__, rank, peer, k[peer], val, vallen);
     }
 
-    if (val) ret = papyruskv_free(val);
+    if (val) ret = papyruskv_free(&val);
     if (ret != PAPYRUSKV_OK) printf("[%s:%d] ERROR:ret[%d] val[%p]\n", __FILE__, __LINE__, ret, val);
 
     ret = papyruskv_close(db);

kv/tests/14_fortran/CMakeLists.txt

+papyruskv_test_fortran(test14_fortran)

kv/tests/14_fortran/test14_fortran.f90

+PROGRAM TEST14_FORTRAN
+    USE MPI
+    USE PAPYRUS
+    IMPLICIT NONE
+    
+    INTEGER :: RANK, NRANKS, IERROR, PROVIDED, PEER, DB
+    CHARACTER, DIMENSION(4) :: KEY * 32
+    CHARACTER, DIMENSION(4) :: VAL * 256
+    CHARACTER, POINTER :: VAL1(:)
+    CHARACTER, POINTER :: VAL2(:)
+    INTEGER(KIND=8) :: KEYLEN, VALLEN
+
+    CALL MPI_INIT_THREAD(MPI_THREAD_MULTIPLE, PROVIDED, IERROR)
+    CALL PAPYRUSKV_INIT('./pkv_repo', IERROR)
+    IF (IERROR /= PAPYRUSKV_OK) THEN
+        PRINT*, 'FAILED'
+    ENDIF
+    CALL MPI_COMM_RANK(MPI_COMM_WORLD, RANK, IERROR)
+    CALL MPI_COMM_SIZE(MPI_COMM_WORLD, NRANKS, IERROR)
+
+    KEY(1) = 'GOOGLE'
+    KEY(2) = 'FACEBOOK'
+    KEY(3) = 'TWITTER'
+    KEY(4) = 'PAPYRUS'
+
+    VAL(1) = 'https://google.com'
+    VAL(2) = 'https://facebook.com'
+    VAL(3) = 'https://twitter.com'
+    VAL(4) = 'https://code.ornl.gov/eck/papyrus'
+
+    ALLOCATE(VAL1(256))
+    NULLIFY(VAL2)
+
+    IF (RANK == NRANKS - 1) THEN
+        PEER = 0
+    ELSE
+        PEER = RANK + 1
+    ENDIF
+
+    CALL PAPYRUSKV_OPEN('TEST_DB', PAPYRUSKV_CREATE .OR. PAPYRUSKV_RDWR, DB, IERROR)
+    IF (IERROR /= PAPYRUSKV_OK) THEN
+        PRINT*, 'FAILED'
+    ENDIF
+
+    IF (RANK < SIZE(KEY)) THEN
+        PRINT*, 'PUT --> RANK', RANK, 'KEY:', TRIM(KEY(RANK + 1)), ' VAL:', TRIM(VAL(RANK + 1))
+        KEYLEN = LEN(TRIM(KEY(RANK + 1)), KIND = 8)
+        VALLEN = LEN(TRIM(VAL(RANK + 1)), KIND = 8)
+        CALL PAPYRUSKV_PUT(DB, TRIM(KEY(RANK + 1)), KEYLEN, TRIM(VAL(RANK + 1)), VALLEN, IERROR)
+        IF (IERROR /= PAPYRUSKV_OK) THEN
+            PRINT*, 'FAILED'
+        ENDIF
+    END IF
+
+    CALL PAPYRUSKV_BARRIER(DB, PAPYRUSKV_MEMTABLE, IERROR)
+    IF (IERROR /= PAPYRUSKV_OK) THEN
+        PRINT*, 'FAILED'
+    ENDIF
+
+    IF (RANK < SIZE(KEY)) THEN
+        CALL PAPYRUSKV_GET(DB, TRIM(KEY(RANK + 1)), KEYLEN, VAL1, VALLEN, IERROR)
+        IF (IERROR /= PAPYRUSKV_OK) THEN
+            PRINT*, 'FAILED'
+        ENDIF
+        PRINT*, 'GET--> RANK', RANK, 'KEY:', TRIM(KEY(RANK + 1)), ' VAL:', VAL1(1: VALLEN)
+
+        CALL PAPYRUSKV_GET(DB, TRIM(KEY(RANK + 1)), KEYLEN, VAL2, VALLEN, IERROR)
+        IF (IERROR /= PAPYRUSKV_OK) THEN
+            PRINT*, 'FAILED'
+        ENDIF
+        PRINT*, 'GET--> RANK', RANK, 'KEY:', TRIM(KEY(RANK + 1)), ' VAL:', VAL2(1: VALLEN)
+        CALL PAPYRUSKV_FREE(VAL2, IERROR)
+        IF (IERROR /= PAPYRUSKV_OK) THEN
+            PRINT*, 'FAILED'
+        ENDIF
+
+        KEYLEN = LEN(TRIM(KEY(PEER + 1)), KIND = 8)
+        CALL PAPYRUSKV_GET(DB, TRIM(KEY(PEER + 1)), KEYLEN, VAL1, VALLEN, IERROR)
+        IF (IERROR /= PAPYRUSKV_OK) THEN
+            PRINT*, 'FAILED'
+        ENDIF
+        PRINT*, 'GET--> RANK', RANK, 'KEY:', TRIM(KEY(PEER + 1)), ' VAL:', VAL1(1: VALLEN)
+        
+        KEYLEN = LEN(TRIM(KEY(PEER + 1)), KIND = 8)
+        CALL PAPYRUSKV_GET(DB, TRIM(KEY(PEER + 1)), KEYLEN, VAL2, VALLEN, IERROR)
+        IF (IERROR /= PAPYRUSKV_OK) THEN
+            PRINT*, 'FAILED'
+        ENDIF
+        PRINT*, 'GET--> RANK', RANK, 'KEY:', TRIM(KEY(PEER + 1)), ' VAL:', VAL2(1: VALLEN)
+        CALL PAPYRUSKV_FREE(VAL2, IERROR)
+        IF (IERROR /= PAPYRUSKV_OK) THEN
+            PRINT*, 'FAILED'
+        ENDIF
+    END IF
+
+    CALL PAPYRUSKV_CLOSE(DB, IERROR)
+    IF (IERROR /= PAPYRUSKV_OK) THEN
+        PRINT*, 'FAILED'
+    ENDIF
+
+    DEALLOCATE(VAL1)
+
+    CALL PAPYRUSKV_FINALIZE(IERROR)
+    IF (IERROR /= PAPYRUSKV_OK) THEN
+        PRINT*, 'FAILED'
+    ENDIF
+    CALL MPI_FINALIZE(IERROR)
+END PROGRAM TEST14_FORTRAN

kv/tests/CMakeLists.txt

@@ -7,6 +7,14 @@ macro(papyruskv_test arg)
     set_tests_properties(kv.${arg} PROPERTIES FAIL_REGULAR_EXPRESSION "FAILED")
 endmacro(papyruskv_test)
 
+macro(papyruskv_test_fortran arg)
+    include_directories(${PROJECT_BINARY_DIR}/include)
+    add_executable(kv.${arg} ${arg}.f90)
+    target_link_libraries(kv.${arg} papyruskv pthread stdc++)
+    add_test(kv.${arg} ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./kv.${arg})
+    set_tests_properties(kv.${arg} PROPERTIES FAIL_REGULAR_EXPRESSION "FAILED")
+endmacro(papyruskv_test_fortran)
+
 add_subdirectory(01_open_close)
 add_subdirectory(02_put_get)
 add_subdirectory(03_barrier)
@@ -20,3 +28,6 @@ add_subdirectory(10_checkpoint)
 add_subdirectory(11_restart)
 add_subdirectory(12_free)
 #add_subdirectory(13_upc)
+if(PAPYRUS_USE_FORTRAN)
+add_subdirectory(14_fortran)
+endif()