diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 2e552f22f0..2a4a16bdd0 100644 --- a/fortran/lammps.f90 +++ b/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) - Cptr = f2c_string(buffer) - Cstatus = lammps_get_last_error_message(self%handle, Cptr, length) - length = MIN(LEN(buffer, c_size_t), c_strlen(Cptr)) - CALL C_F_POINTER(Cptr, Cbuffer, [length]) - FORALL ( i=1:length ) - buffer(i:i) = Cbuffer(i) - END FORALL + buflen = LEN(buffer) + length = buflen + Cptr = lammps_malloc(length) + Cstatus = lammps_get_last_error_message(self%handle, Cptr, buflen) + CALL C_F_POINTER(Cptr, c_string, [1]) + DO i=1, length + buffer(i:i) = c_string(i) + 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 diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index d3c18c9941..70ab462053 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/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) diff --git a/unittest/fortran/test_fortran_properties.f90 b/unittest/fortran/test_fortran_properties.f90 index 153cab8c77..e8ea330bd6 100644 --- a/unittest/fortran/test_fortran_properties.f90 +++ b/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 diff --git a/unittest/fortran/wrap_properties.cpp b/unittest/fortran/wrap_properties.cpp index d53aabb8fa..21c953a514 100644 --- a/unittest/fortran/wrap_properties.cpp +++ b/unittest/fortran/wrap_properties.cpp @@ -2,9 +2,10 @@ #include "lammps.h" #include "library.h" -#include + #include +#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)); - // TODO: How to test the error message itself? + // need errors to throw exceptions to be able to intercept them. + 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