complete implementation of looking up last error message and include test

fortran/lammps.f90

@@ -1552,7 +1552,7 @@ CONTAINS
     TYPE(c_ptr) :: ptr
     INTEGER :: i
 
-    buffer = ''
+    buffer = ' '
     ptr = C_LOC(Cbuffer(1))
     buf_size = LEN(buffer)
     CALL lammps_get_os_info(ptr, buf_size)
@@ -1699,25 +1699,28 @@ CONTAINS
     CLASS(lammps), INTENT(IN) :: self
     CHARACTER(LEN=*), INTENT(OUT) :: buffer
     INTEGER, INTENT(OUT), OPTIONAL :: status
-    INTEGER(c_int) :: length, Cstatus, i
+    INTEGER(c_int) :: buflen, Cstatus, i
+    INTEGER(c_size_t) :: length
     TYPE(c_ptr) :: Cptr
-    CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Cbuffer
+    CHARACTER(LEN=1, KIND=c_char), POINTER :: c_string(:)
 
-    buffer = ''
+    buffer = ' '
     IF ( lmp_has_error(self) ) THEN
-      length = LEN(buffer)
+      buflen = LEN(buffer)
-      Cptr = f2c_string(buffer)
+      length = buflen
-      Cstatus = lammps_get_last_error_message(self%handle, Cptr, length)
+      Cptr = lammps_malloc(length)
-      length = MIN(LEN(buffer, c_size_t), c_strlen(Cptr))
+      Cstatus = lammps_get_last_error_message(self%handle, Cptr, buflen)
-      CALL C_F_POINTER(Cptr, Cbuffer, [length])
+      CALL C_F_POINTER(Cptr, c_string, [1])
-      FORALL ( i=1:length )
+      DO i=1, length
-        buffer(i:i) = Cbuffer(i)
+        buffer(i:i) = c_string(i)
-      END FORALL
+        IF (c_string(i) == c_null_char) EXIT
+      END DO
       IF ( PRESENT(status) ) THEN
         status = Cstatus
       END IF
+      CALL lammps_free(Cptr)
     ELSE
-      buffer = ''
+      buffer = ' '
       IF ( PRESENT(status) ) THEN
         status = 0
       END IF

unittest/fortran/CMakeLists.txt

@@ -50,7 +50,7 @@ if(CMAKE_Fortran_COMPILER)
   add_test(NAME FortranBox COMMAND test_fortran_box)
 
   add_executable(test_fortran_properties wrap_properties.cpp test_fortran_properties.f90 test_fortran_commands.f90)
-  target_link_libraries(test_fortran_properties PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain)
+  target_link_libraries(test_fortran_properties PRIVATE flammps lammps MPI::MPI_Fortran GTest::GMockMain)
   add_test(NAME FortranProperties COMMAND test_fortran_properties)
 
   add_executable(test_fortran_extract_global wrap_extract_global.cpp test_fortran_extract_global.f90)

unittest/fortran/test_fortran_properties.f90

@@ -64,3 +64,26 @@ FUNCTION f_lammps_has_error () BIND(C)
       f_lammps_has_error = 0_C_int
    END IF
 END FUNCTION f_lammps_has_error
+
+FUNCTION f_lammps_get_last_error_message(errmesg, errlen) BIND(C)
+   USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_char, C_ptr, C_F_POINTER
+   USE keepstuff, ONLY : lmp
+   USE LIBLAMMPS
+   IMPLICIT NONE
+   INTEGER(C_int) :: f_lammps_get_last_error_message
+   CHARACTER(KIND=c_char), DIMENSION(*) :: errmesg
+   INTEGER(C_int), VALUE, INTENT(IN) :: errlen
+   CHARACTER(LEN=:), ALLOCATABLE :: buffer
+   INTEGER :: status, i
+
+   ! copy error message to buffer
+   ALLOCATE(CHARACTER(errlen) :: buffer)
+   CALL lmp%get_last_error_message(buffer, status)
+   f_lammps_get_last_error_message = status
+   ! and copy to C style string
+   DO i=1, errlen
+      errmesg(i) = buffer(i:i)
+      IF (buffer(i:i) == ACHAR(0)) EXIT
+   END DO
+   DEALLOCATE(buffer)
+END FUNCTION f_lammps_get_last_error_message

unittest/fortran/wrap_properties.cpp

@@ -2,9 +2,10 @@
 
 #include "lammps.h"
 #include "library.h"
-#include <mpi.h>
+
 #include <string>
 
+#include "gmock/gmock.h"
 #include "gtest/gtest.h"
 
 // prototypes for fortran reverse wrapper functions
@@ -16,8 +17,13 @@ void f_lammps_memory_usage(double*);
 int f_lammps_get_mpi_comm();
 int f_lammps_extract_setting(const char*);
 int f_lammps_has_error();
+int f_lammps_get_last_error_message(char *, int);
 }
 
+namespace LAMMPS_NS {
+
+using ::testing::ContainsRegex;
+
 class LAMMPS_properties : public ::testing::Test {
 protected:
     LAMMPS_NS::LAMMPS *lmp;
@@ -105,11 +111,28 @@ TEST_F(LAMMPS_properties, extract_setting)
     EXPECT_EQ(f_lammps_extract_setting("mu_flag"), 0);
     EXPECT_EQ(f_lammps_extract_setting("rmass_flag"), 0);
     EXPECT_EQ(f_lammps_extract_setting("UNKNOWN"), -1);
-
 };
 
 TEST_F(LAMMPS_properties, has_error)
 {
-   EXPECT_EQ(f_lammps_has_error(), lammps_has_error(lmp));
+    // need errors to throw exceptions to be able to intercept them.
-   // TODO: How to test the error message itself?
+    if (!lammps_config_has_exceptions()) GTEST_SKIP();
+
+    EXPECT_EQ(f_lammps_has_error(), lammps_has_error(lmp));
+    EXPECT_EQ(f_lammps_has_error(), 0);
+
+    // trigger an error, but hide output
+    ::testing::internal::CaptureStdout();
+    lammps_command(lmp, "this_is_not_a_known_command");
+    ::testing::internal::GetCapturedStdout();
+
+    EXPECT_EQ(f_lammps_has_error(), lammps_has_error(lmp));
+    EXPECT_EQ(f_lammps_has_error(), 1);
+
+    // retrieve error message
+    char errmsg[1024];
+    int err = f_lammps_get_last_error_message(errmsg, 1023);
+    EXPECT_EQ(err, 1);
+    EXPECT_THAT(errmsg, ContainsRegex(".*ERRORx: Unknown command: this_is_not_a_known_command.*"));
 };
+} // namespace LAMMPS_NS