diff --git a/src/julienne/julienne_test_description_m.f90 b/src/julienne/julienne_test_description_m.f90 index 8cb9b6e95..a6fe014f6 100644 --- a/src/julienne/julienne_test_description_m.f90 +++ b/src/julienne/julienne_test_description_m.f90 @@ -33,14 +33,6 @@ module julienne_test_description_m interface test_description_t - module function construct_from_string(description, diagnosis_function) result(test_description) - !! The result is a test_description_t object with the components defined by the dummy arguments - implicit none - type(string_t), intent(in) :: description - procedure(diagnosis_function_i), intent(in), pointer, optional :: diagnosis_function - type(test_description_t) test_description - end function - module function construct_from_string_funloc(description, diagnosis_function) result(test_description) !! The result is a test_description_t object with the components defined by the dummy arguments implicit none @@ -57,10 +49,10 @@ module function construct_from_string_bless(description, diagnosis_function) res type(test_description_t) test_description end function - module function construct_from_characters(description, diagnosis_function) result(test_description) + module function construct_from_string(description, diagnosis_function) result(test_description) !! The result is a test_description_t object with the components defined by the dummy arguments implicit none - character(len=*), intent(in) :: description + type(string_t), intent(in) :: description procedure(diagnosis_function_i), intent(in), pointer, optional :: diagnosis_function type(test_description_t) test_description end function @@ -81,6 +73,14 @@ module function construct_from_characters_bless(description, diagnosis_function) type(test_description_t) test_description end function + module function construct_from_characters(description, diagnosis_function) result(test_description) + !! The result is a test_description_t object with the components defined by the dummy arguments + implicit none + character(len=*), intent(in) :: description + procedure(diagnosis_function_i), intent(in), pointer, optional :: diagnosis_function + type(test_description_t) test_description + end function + end interface interface diff --git a/test/modules/test_description_test_m.F90 b/test/modules/test_description_test_m.F90 index 5b9c85e93..574c4ecbd 100644 --- a/test/modules/test_description_test_m.F90 +++ b/test/modules/test_description_test_m.F90 @@ -5,12 +5,15 @@ module test_description_test_m !! Verify test_description_t object behavior + use iso_c_binding, only : c_funloc use julienne_m, only : & string_t & + ,diagnosis_function_i & ,test_result_t & ,test_description_t & ,test_diagnosis_t & ,bless & + ,operator(.also.) & ,test_t implicit none @@ -36,17 +39,46 @@ function results() result(test_results) type(test_description_test_t) test_description_test test_descriptions = [ & - test_description_t("identical construction from string_t or character argument", bless(check_constructors_match)) & + test_description_t("identical construction from equivalent arguments", bless(check_constructors_match)) & ] test_results = test_description_test%run(test_descriptions) end function function check_constructors_match() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis - test_diagnosis = test_diagnosis_t( & - test_passed = test_description_t("foo", bless(tautology)) == test_description_t(string_t("foo"), bless(tautology)) & + procedure(diagnosis_function_i), pointer :: tautology_ptr + tautology_ptr => tautology + + test_diagnosis = test_diagnosis_t( & + test_passed = test_description_t("foo", tautology_ptr) == test_description_t(string_t("foo"), tautology_ptr) & + ,diagnostics_string= 'test_description_t("foo", tautology_ptr) /= test_description_t(string_t("foo"), tautology_ptr)'& + ) +#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + test_diagnosis = test_diagnosis .also. test_diagnosis_t( & + test_passed = test_description_t("foo", tautology) == test_description_t(string_t("foo"), tautology) & ,diagnostics_string = 'test_description_t("foo", tautology) /= test_description_t(string_t("foo"), tautology)' & ) + test_diagnosis = test_diagnosis .also. test_diagnosis_t( & + test_passed = test_description_t("foo", tautology) == test_description_t("foo", tautology_ptr) & + ,diagnostics_string = 'test_description_t("foo", tautology) /= test_description_t("foo", tautology_ptr)' & + ) +#endif + test_diagnosis = test_diagnosis .also. test_diagnosis_t( & + test_passed = test_description_t("foo", tautology_ptr) == test_description_t("foo", bless(tautology)) & + ,diagnostics_string= 'test_description_t("foo", tautology_ptr) /= test_description_t("foo", bless(tautology))'& + ) + test_diagnosis = test_diagnosis .also. test_diagnosis_t( & + test_passed = test_description_t("foo", tautology_ptr) == test_description_t("foo", c_funloc(tautology)) & + ,diagnostics_string= 'test_description_t("foo", tautology_ptr) /= test_description_t("foo", c_funloc(tautology))'& + ) + test_diagnosis = test_diagnosis .also. test_diagnosis_t( & + test_passed = test_description_t(string_t("foo"), tautology_ptr) == test_description_t(string_t("foo"), bless(tautology)) & + ,diagnostics_string= 'test_description_t(string_t("foo"), tautology_ptr) /= test_description_t(string_t("foo"), bless(tautology))'& + ) + test_diagnosis = test_diagnosis .also. test_diagnosis_t( & + test_passed = test_description_t(string_t("foo"), tautology_ptr) == test_description_t(string_t("foo"), c_funloc(tautology)) & + ,diagnostics_string= 'test_description_t(string_t("foo"), tautology_ptr) /= test_description_t(string_t("foo"), c_funloc(tautology))'& + ) contains type(test_diagnosis_t) function tautology() tautology = test_diagnosis_t(.true.,"")