From 3ebcc6dde824180a83e4d9dcbd3cb798d6cf53f8 Mon Sep 17 00:00:00 2001 From: JHenneberg Date: Thu, 27 May 2021 13:05:34 +0200 Subject: [PATCH 1/3] fix: mismatch in array/vec sizes let test pass --- src/assert_mod.F90 | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/src/assert_mod.F90 b/src/assert_mod.F90 index ebce016..5f64852 100644 --- a/src/assert_mod.F90 +++ b/src/assert_mod.F90 @@ -398,6 +398,8 @@ subroutine assert_equal_integer1_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('==', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -430,6 +432,8 @@ subroutine assert_equal_integer2_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('==', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -462,6 +466,8 @@ subroutine assert_equal_integer4_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('==', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -494,6 +500,8 @@ subroutine assert_equal_integer8_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('==', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -526,6 +534,8 @@ subroutine assert_equal_real4_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('==', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -558,6 +568,8 @@ subroutine assert_equal_real8_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('==', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -590,6 +602,8 @@ subroutine assert_equal_string_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('==', passed, x(loc_i, loc_j), y(loc_i, loc_j), file_name, line_number, suite) @@ -688,6 +702,8 @@ subroutine assert_approximate_real4_vec(x, y, z, file_name, line_number, eps, su end if end if end do + else + passed = .false. end if call test_case_append_assert('=~', passed, to_string(x(loc)), to_string(y(loc)), file_name, line_number, suite) @@ -754,6 +770,8 @@ subroutine assert_approximate_real8_vec(x, y, z, file_name, line_number, eps, su end if end if end do + else + passed = .false. end if call test_case_append_assert('=~', passed, to_string(x(loc)), to_string(y(loc)), file_name, line_number, suite) @@ -826,6 +844,8 @@ subroutine assert_approximate_real4_array(x, y, z, file_name, line_number, eps, end if end do end do + else + passed = .false. end if call test_case_append_assert('=~', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -898,6 +918,8 @@ subroutine assert_approximate_real8_array(x, y, z, file_name, line_number, eps, end if end do end do + else + passed = .false. end if call test_case_append_assert('=~', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) From 50bbe3b865ac64a81cce5e520c3feeffd6c96e91 Mon Sep 17 00:00:00 2001 From: JHenneberg Date: Thu, 27 May 2021 15:23:23 +0200 Subject: [PATCH 2/3] added unit tests for `shape mismatch` --- src/assert_mod.F90 | 275 ++++++++++++++++++++++++++------------------ src/assert_test.F90 | 134 ++++++++++++++++++++- 2 files changed, 298 insertions(+), 111 deletions(-) diff --git a/src/assert_mod.F90 b/src/assert_mod.F90 index 5f64852..d622586 100644 --- a/src/assert_mod.F90 +++ b/src/assert_mod.F90 @@ -173,12 +173,14 @@ subroutine assert_equal_integer1_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if(all(x == y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if(all(x == y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) == y(i)) then loc = i @@ -203,12 +205,14 @@ subroutine assert_equal_integer2_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if(all(x == y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if(all(x == y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) == y(i)) then loc = i @@ -233,12 +237,14 @@ subroutine assert_equal_integer4_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if(all(x == y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if(all(x == y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) == y(i)) then loc = i @@ -263,12 +269,14 @@ subroutine assert_equal_integer8_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if(all(x == y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if(all(x == y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) == y(i)) then loc = i @@ -293,12 +301,14 @@ subroutine assert_equal_real4_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if (all(x == y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if (all(x == y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) == y(i)) then loc = i @@ -323,12 +333,14 @@ subroutine assert_equal_real8_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if (all(x == y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if (all(x == y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) == y(i)) then loc = i @@ -353,12 +365,14 @@ subroutine assert_equal_string_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if (all(x == y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if (all(x == y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) == y(i)) then loc = i @@ -383,9 +397,10 @@ subroutine assert_equal_integer1_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -417,9 +432,10 @@ subroutine assert_equal_integer2_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -451,9 +467,10 @@ subroutine assert_equal_integer4_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -485,9 +502,10 @@ subroutine assert_equal_integer8_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -519,9 +537,10 @@ subroutine assert_equal_real4_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -553,9 +572,10 @@ subroutine assert_equal_real8_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -587,9 +607,10 @@ subroutine assert_equal_string_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -678,8 +699,9 @@ subroutine assert_approximate_real4_vec(x, y, z, file_name, line_number, eps, su eps_ = merge(eps, eps_default_kind4, present(eps)) - passed = .true. loc = lbound(x, 1) + passed = .true. + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then do i = lbound(x, 1), ubound(x, 1) if (x(i) == y(i)) then @@ -726,8 +748,9 @@ subroutine assert_approximate_real8_vec(x, y, z, file_name, line_number, eps, su eps_ = merge(eps, eps_default_kind8, present(eps)) - passed = .true. loc = lbound(x, 1) + passed = .true. + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then do i = lbound(x, 1), ubound(x, 1) if (x(i) == y(i)) then @@ -794,9 +817,10 @@ subroutine assert_approximate_real4_array(x, y, z, file_name, line_number, eps, eps_ = merge(eps, eps_default_kind4, present(eps)) + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -868,9 +892,10 @@ subroutine assert_approximate_real8_array(x, y, z, file_name, line_number, eps, eps_ = merge(eps, eps_default_kind8, present(eps)) + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -1009,12 +1034,14 @@ subroutine assert_great_than_integer1_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if(all(x > y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if(all(x > y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) > y(i)) then loc = i @@ -1039,12 +1066,14 @@ subroutine assert_great_than_integer2_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if(all(x > y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if(all(x > y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) > y(i)) then loc = i @@ -1069,12 +1098,14 @@ subroutine assert_great_than_integer4_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if(all(x > y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if(all(x > y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) > y(i)) then loc = i @@ -1099,12 +1130,14 @@ subroutine assert_great_than_integer8_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if(all(x > y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if(all(x > y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) > y(i)) then loc = i @@ -1129,12 +1162,14 @@ subroutine assert_great_than_real4_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if(all(x > y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if(all(x > y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) > y(i)) then loc = i @@ -1159,12 +1194,14 @@ subroutine assert_great_than_real8_vec(x, y, file_name, line_number, suite) logical :: passed integer :: loc, i - if(all(x > y)) then - passed = .true. - loc = lbound(x, 1) - else - passed = .false. - if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + loc = min(lbound(x, 1), lbound(y, 1)) + passed = .false. + + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1)) then + if(all(x > y)) then + passed = .true. + loc = lbound(x, 1) + else do i = lbound(x, 1), ubound(x, 1) if(.not. x(i) > y(i)) then loc = i @@ -1189,9 +1226,10 @@ subroutine assert_great_than_integer1_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -1204,6 +1242,8 @@ subroutine assert_great_than_integer1_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('>', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -1221,9 +1261,10 @@ subroutine assert_great_than_integer2_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -1236,6 +1277,8 @@ subroutine assert_great_than_integer2_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('>', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -1253,9 +1296,10 @@ subroutine assert_great_than_integer4_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -1268,6 +1312,8 @@ subroutine assert_great_than_integer4_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('>', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -1285,9 +1331,10 @@ subroutine assert_great_than_integer8_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -1300,6 +1347,8 @@ subroutine assert_great_than_integer8_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('>', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -1317,9 +1366,10 @@ subroutine assert_great_than_real4_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -1332,6 +1382,8 @@ subroutine assert_great_than_real4_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('>', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) @@ -1349,9 +1401,10 @@ subroutine assert_great_than_real8_array(x, y, file_name, line_number, suite) logical :: passed integer :: loc_i, loc_j, i, j + loc_i = min(lbound(x, 1), lbound(y, 1)) + loc_j = min(lbound(x, 2), lbound(y, 2)) passed = .true. - loc_i = lbound(x, 1) - loc_j = lbound(x, 2) + if (lbound(x, 1) == lbound(y, 1) .and. ubound(x, 1) == ubound(y, 1) .and. & lbound(x, 2) == lbound(y, 2) .and. ubound(x, 2) == ubound(y, 2)) then do i = lbound(x, 1), ubound(x, 1) @@ -1364,6 +1417,8 @@ subroutine assert_great_than_real8_array(x, y, file_name, line_number, suite) end if end do end do + else + passed = .false. end if call test_case_append_assert('>', passed, to_string(x(loc_i, loc_j)), to_string(y(loc_i, loc_j)), file_name, line_number, suite) diff --git a/src/assert_test.F90 b/src/assert_test.F90 index bf17fc2..2545c5a 100644 --- a/src/assert_test.F90 +++ b/src/assert_test.F90 @@ -8,6 +8,7 @@ program test_assert type(test_suite_type) :: test_suite_boolean type(test_suite_type) :: test_suite_equal type(test_suite_type) :: test_suite_great_than + type(test_suite_type) :: test_suite_shape_mismatch logical, allocatable :: test_suite_assert_results(:) logical, allocatable :: test_case_assert_results(:) @@ -15,30 +16,37 @@ program test_assert ! test assert_approximate routines call test_suite_init('Approximate', test_suite_approximate) - ! -> real + ! -> real (real4, real8) call test_case_create('real', test_suite_approximate) + + ! single values call assert_approximate(1.0, 2.0, suite=test_suite_approximate) call assert_approximate(1.0, 1.0, suite=test_suite_approximate) call assert_approximate(1.0, 1.10, eps=0.01, suite=test_suite_approximate) call assert_approximate(1.0, 1.01, eps=0.01, suite=test_suite_approximate) + call assert_approximate(1.0D0, 1.1D0, suite=test_suite_approximate) call assert_approximate(1.0D0, 1.00000000001D0, suite=test_suite_approximate) call assert_approximate(1.0D0, 1.1D0, eps=0.01D0, suite=test_suite_approximate) call assert_approximate(1.0D0, 1.00000000001D0, eps=0.01D0, suite=test_suite_approximate) + ! vector call assert_approximate([1.0, 1.0], [1.0, 1.10], suite=test_suite_approximate) call assert_approximate([1.0, 1.0], [1.0, 1.00000000001], suite=test_suite_approximate) call assert_approximate([1.0, 1.0], [1.0, 1.10], eps=0.01, suite=test_suite_approximate) call assert_approximate([1.0, 1.0], [1.0, 1.01], eps=0.01, suite=test_suite_approximate) + call assert_approximate([1.0D0, 1.0D0], [1.0D0, 1.1D0], suite=test_suite_approximate) call assert_approximate([1.0D0, 1.0D0], [1.0D0, 1.00000000001D0], suite=test_suite_approximate) call assert_approximate([1.0D0, 1.0D0], [1.0D0, 1.1D0], eps=0.01D0, suite=test_suite_approximate) call assert_approximate([1.0D0, 1.0D0], [1.0D0, 1.01D0], eps=0.01D0, suite=test_suite_approximate) + ! array call assert_approximate(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([1.0, 1.1, 1.0, 1.0], [2, 2]), suite=test_suite_approximate) call assert_approximate(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([1.0, 1.00000000001, 1.0, 1.0], [2, 2]), suite=test_suite_approximate) call assert_approximate(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([1.0, 1.10, 1.0, 1.0], [2, 2]), eps=0.01, suite=test_suite_approximate) call assert_approximate(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([1.0, 1.01, 1.0, 1.0], [2, 2]), eps=0.01, suite=test_suite_approximate) + call assert_approximate(reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), reshape([1.0D0, 1.1D0, 1.0D0, 1.0D0], [2, 2]), suite=test_suite_approximate) call assert_approximate(reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), reshape([1.0D0, 1.000000000001D0, 1.0D0, 1.0D0], [2, 2]), suite=test_suite_approximate) call assert_approximate(reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), reshape([1.0D0, 1.10D0, 1.0D0, 1.0D0], [2, 2]), eps=0.01D0, suite=test_suite_approximate) @@ -68,47 +76,64 @@ program test_assert ! -> string call test_case_create('string', test_suite_equal) + + ! single value call assert_equal('abc', 'abcd', __FILE__, __LINE__, test_suite_equal) call assert_equal('abc', 'abc', __FILE__, __LINE__, test_suite_equal) + ! vector call assert_equal(['abc', 'abc'], ['abc', 'abd'], __FILE__, __LINE__, test_suite_equal) call assert_equal(['abc', 'abc'], ['abc', 'abc'], __FILE__, __LINE__, test_suite_equal) + ! array call assert_equal(reshape(['abc', 'abc', 'abc', 'abc'], [2, 2]), reshape(['abc', 'abd', 'abc', 'abd'], [2, 2]), __FILE__, __LINE__, test_suite_equal) call assert_equal(reshape(['abc', 'abc', 'abc', 'abc'], [2, 2]), reshape(['abc', 'abc', 'abc', 'abc'], [2, 2]), __FILE__, __LINE__, test_suite_equal) ! -> integer (int8->kind=1, int16->kind=2, int32->kind=4, int64->kind=8) call test_case_create('integer', test_suite_equal) + + ! single value call assert_equal(int(1, 1), int(2, 1), __FILE__, __LINE__, test_suite_equal) call assert_equal(int(3, 1), int(3, 1), __FILE__, __LINE__, test_suite_equal) + call assert_equal(int(1, 2), int(2, 2), __FILE__, __LINE__, test_suite_equal) call assert_equal(int(3, 2), int(3, 2), __FILE__, __LINE__, test_suite_equal) + call assert_equal(int(1, 4), int(2, 4), __FILE__, __LINE__, test_suite_equal) call assert_equal(int(3, 4), int(3, 4), __FILE__, __LINE__, test_suite_equal) + call assert_equal(int(1, 8), int(2, 8), __FILE__, __LINE__, test_suite_equal) call assert_equal(int(3, 8), int(3, 8), __FILE__, __LINE__, test_suite_equal) + ! vector call assert_equal([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [int(1, 1), int(2, 1), int(1, 1), int(1, 1)], __FILE__, __LINE__, test_suite_equal) call assert_equal([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [int(1, 1), int(1, 1), int(1, 1), int(1, 1)], __FILE__, __LINE__, test_suite_equal) + call assert_equal([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [int(1, 2), int(2, 2), int(1, 2), int(1, 2)], __FILE__, __LINE__, test_suite_equal) call assert_equal([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [int(1, 2), int(1, 2), int(1, 2), int(1, 2)], __FILE__, __LINE__, test_suite_equal) + call assert_equal([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [int(1, 4), int(2, 4), int(1, 4), int(1, 4)], __FILE__, __LINE__, test_suite_equal) call assert_equal([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [int(1, 4), int(1, 4), int(1, 4), int(1, 4)], __FILE__, __LINE__, test_suite_equal) + call assert_equal([int(1, 8), int(1, 8), int(1, 8), int(1, 8)], [int(1, 8), int(2, 8), int(1, 8), int(1, 8)], __FILE__, __LINE__, test_suite_equal) call assert_equal([int(1, 8), int(1, 8), int(1, 8), int(1, 8)], [int(1, 8), int(1, 8), int(1, 8), int(1, 8)], __FILE__, __LINE__, test_suite_equal) + ! array call assert_equal(reshape([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [2, 2]), & & reshape([int(1, 1), int(2, 1), int(1, 1), int(1, 1)], [2, 2]), __FILE__, __LINE__, test_suite_equal) call assert_equal(reshape([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [2, 2]), & & reshape([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [2, 2]), __FILE__, __LINE__, test_suite_equal) + call assert_equal(reshape([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [2, 2]), & & reshape([int(1, 2), int(2, 2), int(1, 2), int(1, 2)], [2, 2]), __FILE__, __LINE__, test_suite_equal) call assert_equal(reshape([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [2, 2]), & & reshape([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [2, 2]), __FILE__, __LINE__, test_suite_equal) + call assert_equal(reshape([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [2, 2]), & & reshape([int(1, 4), int(2, 4), int(1, 4), int(1, 4)], [2, 2]), __FILE__, __LINE__, test_suite_equal) call assert_equal(reshape([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [2, 2]), & & reshape([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [2, 2]), __FILE__, __LINE__, test_suite_equal) + call assert_equal(reshape([int(1, 8), int(1, 8), int(1, 8), int(1, 8)], [2, 2]), & & reshape([int(1, 8), int(2, 8), int(1, 8), int(1, 8)], [2, 2]), __FILE__, __LINE__, test_suite_equal) call assert_equal(reshape([int(1, 8), int(1, 8), int(1, 8), int(1, 8)], [2, 2]), & @@ -116,18 +141,25 @@ program test_assert ! -> real (real4, real8) call test_case_create('real', test_suite_equal) + + ! single value call assert_equal(1.0, 2.0, __FILE__, __LINE__, test_suite_equal) call assert_equal(3.0, 3.0, __FILE__, __LINE__, test_suite_equal) + call assert_equal(1.0D0, 2.0D0, __FILE__, __LINE__, test_suite_equal) call assert_equal(3.0D0, 3.0D0, __FILE__, __LINE__, test_suite_equal) + ! vector call assert_equal([1.0, 1.0], [1.0, 2.0], __FILE__, __LINE__, test_suite_equal) call assert_equal([1.0, 1.0], [1.0, 1.0], __FILE__, __LINE__, test_suite_equal) + call assert_equal([1.0D0, 1.0D0], [1.0D0, 2.0D0], __FILE__, __LINE__, test_suite_equal) call assert_equal([1.0D0, 1.0D0], [1.0D0, 1.0D0], __FILE__, __LINE__, test_suite_equal) + ! array call assert_equal(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([1.0, 2.0, 1.0, 1.0], [2, 2]), __FILE__, __LINE__, test_suite_equal) call assert_equal(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), __FILE__, __LINE__, test_suite_equal) + call assert_equal(reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), reshape([1.0D0, 2.0D0, 1.0D0, 1.0D0], [2, 2]), __FILE__, __LINE__, test_suite_equal) call assert_equal(reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), __FILE__, __LINE__, test_suite_equal) @@ -139,24 +171,34 @@ program test_assert ! -> integer (int8->kind=1, int16->kind=2, int32->kind=4, int64->kind=8) call test_case_create('integer', test_suite_great_than) + + ! single value call assert_great_than(int(1, 1), int(1, 1), __FILE__, __LINE__, test_suite_great_than) call assert_great_than(int(2, 1), int(1, 1), __FILE__, __LINE__, test_suite_great_than) + call assert_great_than(int(1, 2), int(1, 2), __FILE__, __LINE__, test_suite_great_than) call assert_great_than(int(2, 2), int(1, 2), __FILE__, __LINE__, test_suite_great_than) + call assert_great_than(int(1, 4), int(1, 4), __FILE__, __LINE__, test_suite_great_than) call assert_great_than(int(2, 4), int(1, 4), __FILE__, __LINE__, test_suite_great_than) + call assert_great_than(int(1, 8), int(1, 8), __FILE__, __LINE__, test_suite_great_than) call assert_great_than(int(2, 8), int(1, 8), __FILE__, __LINE__, test_suite_great_than) + ! vector call assert_great_than([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [int(0, 1), int(2, 1), int(0, 1), int(0, 1)], __FILE__, __LINE__, test_suite_great_than) call assert_great_than([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [int(0, 1), int(0, 1), int(0, 1), int(0, 1)], __FILE__, __LINE__, test_suite_great_than) + call assert_great_than([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [int(0, 2), int(2, 2), int(0, 2), int(0, 2)], __FILE__, __LINE__, test_suite_great_than) call assert_great_than([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [int(0, 2), int(0, 2), int(0, 2), int(0, 2)], __FILE__, __LINE__, test_suite_great_than) + call assert_great_than([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [int(0, 4), int(2, 4), int(0, 4), int(0, 4)], __FILE__, __LINE__, test_suite_great_than) call assert_great_than([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [int(0, 4), int(0, 4), int(0, 4), int(0, 4)], __FILE__, __LINE__, test_suite_great_than) + call assert_great_than([int(1, 8), int(1, 8), int(1, 8), int(1, 8)], [int(0, 8), int(2, 8), int(0, 8), int(0, 8)], __FILE__, __LINE__, test_suite_great_than) call assert_great_than([int(1, 8), int(1, 8), int(1, 8), int(1, 8)], [int(0, 8), int(0, 8), int(0, 8), int(0, 8)], __FILE__, __LINE__, test_suite_great_than) + ! array call assert_great_than(reshape([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [2, 2]), & & reshape([int(0, 1), int(2, 1), int(0, 1), int(0, 1)], [2, 2]), __FILE__, __LINE__, test_suite_great_than) call assert_great_than(reshape([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [2, 2]), & @@ -179,18 +221,25 @@ program test_assert ! -> real (real4, real8) call test_case_create('real', test_suite_great_than) + + ! singe value call assert_great_than(1.0, 1.0, __FILE__, __LINE__, test_suite_great_than) call assert_great_than(2.0, 1.0, __FILE__, __LINE__, test_suite_great_than) + call assert_great_than(1.0D0, 1.0D0, __FILE__, __LINE__, test_suite_great_than) call assert_great_than(2.0D0, 1.0D0, __FILE__, __LINE__, test_suite_great_than) + ! vector call assert_great_than([1.0, 1.0], [0.0, 2.0], __FILE__, __LINE__, test_suite_great_than) call assert_great_than([1.0, 1.0], [0.0, 0.0], __FILE__, __LINE__, test_suite_great_than) + call assert_great_than([1.0D0, 1.0D0], [0.0D0, 2.0D0], __FILE__, __LINE__, test_suite_great_than) call assert_great_than([1.0D0, 1.0D0], [0.0D0, 0.0D0], __FILE__, __LINE__, test_suite_great_than) + ! array call assert_great_than(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([0.0, 2.0, 0.0, 0.0], [2, 2]), __FILE__, __LINE__, test_suite_great_than) call assert_great_than(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([0.0, 0.0, 0.0, 0.0], [2, 2]), __FILE__, __LINE__, test_suite_great_than) + call assert_great_than(reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), reshape([0.0D0, 2.0D0, 0.0D0, 0.0D0], [2, 2]), __FILE__, __LINE__, test_suite_great_than) call assert_great_than(reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), reshape([0.0D0, 0.0D0, 0.0D0, 0.0D0], [2, 2]), __FILE__, __LINE__, test_suite_great_than) @@ -205,4 +254,87 @@ program test_assert call test_suite_report(test_suite_great_than) call test_suite_final(test_suite_great_than) + + ! in test_suite_shape_mismatch all asserts should be false + call test_suite_init('Shape mismatch', test_suite_shape_mismatch) + + ! test assert_approximate routines + call test_case_create('approximate', test_suite_shape_mismatch) + + ! -> real (real4, real8) + ! vector + call assert_approximate([1.0, 1.0], [1.0], eps=0.01, suite=test_suite_shape_mismatch) + call assert_approximate([1.0D0, 1.0D0], [1.0D0], eps=0.01D0, suite=test_suite_shape_mismatch) + + ! array + call assert_approximate(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([1.0, 1.0], [2, 1]), eps=0.01, suite=test_suite_shape_mismatch) + call assert_approximate(reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), reshape([1.0D0, 1.0D0], [2, 1]), eps=0.01D0, suite=test_suite_shape_mismatch) + + ! test assert_equal routines + call test_case_create('equal', test_suite_shape_mismatch) + + ! string + ! vector + call assert_equal(['abc', 'abc'], ['abc'], __FILE__, __LINE__, test_suite_shape_mismatch) + + ! array + call assert_equal(reshape(['abc', 'abc', 'abc', 'abc'], [2, 2]), reshape(['abc', 'abc'], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + + ! -> integer (int8->kind=1, int16->kind=2, int32->kind=4, int64->kind=8) + ! vector + call assert_equal([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [int(1, 1), int(1, 1), int(1, 1)], __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_equal([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [int(1, 2), int(1, 2), int(1, 2)], __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_equal([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [int(1, 4), int(1, 4), int(1, 4)], __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_equal([int(1, 8), int(1, 8), int(1, 8), int(1, 8)], [int(1, 8), int(1, 8), int(1, 8)], __FILE__, __LINE__, test_suite_shape_mismatch) + + ! array + call assert_equal(reshape([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [2, 2]), & + & reshape([int(1, 1), int(1, 1)], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_equal(reshape([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [2, 2]), & + & reshape([int(1, 2), int(1, 2)], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_equal(reshape([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [2, 2]), & + & reshape([int(1, 4), int(1, 4)], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_equal(reshape([int(1, 8), int(1, 8), int(1, 8), int(1, 8)], [2, 2]), & + & reshape([int(1, 8), int(1, 8)], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + + ! -> real (real4, real8) + ! vector + call assert_equal([1.0, 1.0], [1.0], __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_equal([1.0D0, 1.0D0], [1.0D0], __FILE__, __LINE__, test_suite_shape_mismatch) + + ! array + call assert_equal(reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), reshape([1.0D0, 1.0D0], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_equal(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([1.0, 1.0], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + + ! test assert_great_than routines + call test_case_create('great_than', test_suite_shape_mismatch) + + ! -> integer (int8->kind=1, int16->kind=2, int32->kind=4, int64->kind=8) + ! vector + call assert_great_than([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [int(1, 1), int(1, 1), int(1, 1)], __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_great_than([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [int(1, 2), int(1, 2), int(1, 2)], __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_great_than([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [int(1, 4), int(1, 4), int(1, 4)], __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_great_than([int(1, 8), int(1, 8), int(1, 8), int(1, 8)], [int(1, 8), int(1, 8), int(1, 8)], __FILE__, __LINE__, test_suite_shape_mismatch) + + ! array + call assert_great_than(reshape([int(1, 1), int(1, 1), int(1, 1), int(1, 1)], [2, 2]), & + & reshape([int(1, 1), int(1, 1)], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_great_than(reshape([int(1, 2), int(1, 2), int(1, 2), int(1, 2)], [2, 2]), & + & reshape([int(1, 2), int(1, 2)], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_great_than(reshape([int(1, 4), int(1, 4), int(1, 4), int(1, 4)], [2, 2]), & + & reshape([int(1, 4), int(1, 4)], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_great_than(reshape([int(1, 8), int(1, 8), int(1, 8), int(1, 8)], [2, 2]), & + & reshape([int(1, 8), int(1, 8)], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + + ! -> real (real4, real8) + ! vector + call assert_great_than([1.0, 1.0], [1.0], __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_great_than([1.0D0, 1.0D0], [1.0D0], __FILE__, __LINE__, test_suite_shape_mismatch) + + ! array + call assert_great_than(reshape([1.0, 1.0, 1.0, 1.0], [2, 2]), reshape([1.0, 1.0], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + call assert_great_than(reshape([1.0D0, 1.0D0, 1.0D0, 1.0D0], [2, 2]), reshape([1.0D0, 1.0D0], [2, 1]), __FILE__, __LINE__, test_suite_shape_mismatch) + + call test_suite_report(test_suite_shape_mismatch) + call test_suite_final(test_suite_shape_mismatch) end program test_assert From ec9f3fa22d17c9306a0d89fc819cae6f64e18d86 Mon Sep 17 00:00:00 2001 From: JHenneberg Date: Mon, 29 Jul 2024 12:21:53 +0200 Subject: [PATCH 3/3] merge can evaluate all its arguments. The behavior is not specified in the standard. To avoid undefined behavior this is fixed https://fortran-lang.discourse.group/t/is-there-another-function-in-fortran-like-merge-that-does-not-evaluate-its-arguments/7414/6 --- src/assert_mod.F90 | 56 +++++++++++++++++++++++++++++++++++++++------- 1 file changed, 48 insertions(+), 8 deletions(-) diff --git a/src/assert_mod.F90 b/src/assert_mod.F90 index d622586..8afdd41 100644 --- a/src/assert_mod.F90 +++ b/src/assert_mod.F90 @@ -643,7 +643,11 @@ subroutine assert_approximate_real4(x, y, file_name, line_number, eps, suite) logical :: passed real(4) :: eps_ - eps_ = merge(eps, eps_default_kind4, present(eps)) + if (present(eps)) then + eps_ = eps + else + eps_ = eps_default_kind4 + end if if (x == y) then passed = .true. @@ -669,7 +673,11 @@ subroutine assert_approximate_real8(x, y, file_name, line_number, eps, suite) logical :: passed real(8) :: eps_ - eps_ = merge(eps, eps_default_kind8, present(eps)) + if (present(eps)) then + eps_ = eps + else + eps_ = eps_default_kind8 + end if if (x == y) then passed = .true. @@ -697,7 +705,11 @@ subroutine assert_approximate_real4_vec(x, y, z, file_name, line_number, eps, su integer :: loc, i real(4) :: eps_ - eps_ = merge(eps, eps_default_kind4, present(eps)) + if (present(eps)) then + eps_ = eps + else + eps_ = eps_default_kind4 + end if loc = lbound(x, 1) passed = .true. @@ -746,7 +758,11 @@ subroutine assert_approximate_real8_vec(x, y, z, file_name, line_number, eps, su integer :: loc, i real(8) :: eps_ - eps_ = merge(eps, eps_default_kind8, present(eps)) + if (present(eps)) then + eps_ = eps + else + eps_ = eps_default_kind8 + end if loc = lbound(x, 1) passed = .true. @@ -815,7 +831,11 @@ subroutine assert_approximate_real4_array(x, y, z, file_name, line_number, eps, integer :: loc_i, loc_j, i, j real(4) :: eps_ - eps_ = merge(eps, eps_default_kind4, present(eps)) + if (present(eps)) then + eps_ = eps + else + eps_ = eps_default_kind4 + end if loc_i = min(lbound(x, 1), lbound(y, 1)) loc_j = min(lbound(x, 2), lbound(y, 2)) @@ -890,7 +910,11 @@ subroutine assert_approximate_real8_array(x, y, z, file_name, line_number, eps, integer :: loc_i, loc_j, i, j real(8) :: eps_ - eps_ = merge(eps, eps_default_kind8, present(eps)) + if (present(eps)) then + eps_ = eps + else + eps_ = eps_default_kind8 + end if loc_i = min(lbound(x, 1), lbound(y, 1)) loc_j = min(lbound(x, 2), lbound(y, 2)) @@ -1463,7 +1487,15 @@ real(4) function get_relative_difference_real4(x, y, case) real(4), intent(in) :: y integer, optional, intent(in) :: case - select case (merge(case, 1, present(case))) + integer :: case_ + + if (present(case)) then + case_ = case + else + case_ = 1 + end if + + select case (case_) case (1) get_relative_difference_real4 = abs(max(abs(x), abs(y))) @@ -1493,7 +1525,15 @@ real(8) function get_relative_difference_real8(x, y, case) real(8), intent(in) :: y integer, optional, intent(in) :: case - select case (merge(case, 1, present(case))) + integer :: case_ + + if (present(case)) then + case_ = case + else + case_ = 1 + end if + + select case (case_) case (1) get_relative_difference_real8 = abs(max(abs(x), abs(y)))