Skip to content

Commit e767015

Browse files
rousonrouson
committed
refac(string_test): enable selective testing
1 parent 58d18b5 commit e767015

File tree

1 file changed

+85
-22
lines changed

1 file changed

+85
-22
lines changed

‎test/string_test.F90‎

Lines changed: 85 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
module string_test_m
2-
use sourcery_m, only : test_t, test_result_t, string_t, operator(.cat.)
2+
use sourcery_m, only : &
3+
test_t, test_result_t, string_t, operator(.cat.), test_description_t, test_function_i, test_description_substring
34
implicit none
45

56
private
@@ -20,27 +21,89 @@ pure function subject() result(specimen)
2021

2122
function results() result(test_results)
2223
type(test_result_t), allocatable :: test_results(:)
23-
24-
test_results = [ &
25-
test_result_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated", check_allocation()), &
26-
test_result_t('supporting operator(==) for string_t and character operands', supports_equivalence_operator()), &
27-
test_result_t('supporting operator(/=) for string_t and character operands', supports_non_equivalence_operator()), &
28-
test_result_t('supporting operator(//) for string_t and character operands', supports_concatenation_operator()), &
29-
test_result_t('assigning a string_t object to a character variable', assigns_string_t_to_character()), &
30-
test_result_t('assigning a character variable to a string_t object', assigns_character_to_string_t()), &
31-
test_result_t('constructing from a default integer', constructs_from_default_integer()), &
32-
test_result_t('constructing from a real value', constructs_from_real()), &
33-
test_result_t('supporting unary operator(.cat.) for array arguments', concatenates_elements()), &
34-
test_result_t("extracting a key string from a colon-separated key/value pair", extracts_key()), &
35-
test_result_t("extracting a real value from a colon-separated key/value pair", extracts_real_value()), &
36-
test_result_t("extracting a string value from a colon-separated key/value pair", extracts_string_value()), &
37-
test_result_t("extracting a logical value from a colon-separated key/value pair", extracts_logical_value()), &
38-
test_result_t("extracting an integer array value from a colon-separated key/value pair", extracts_integer_array_value()), &
39-
test_result_t("extracting an real array value from a colon-separated key/value pair", extracts_real_array_value()), &
40-
test_result_t("extracting an integer value from a colon-separated key/value pair", extracts_integer_value()), &
41-
test_result_t('extracting a file base name', extracts_file_base_name()), &
42-
test_result_t('extracting a file name extension', extracts_file_name_extension()) &
43-
]
24+
type(test_description_t), allocatable :: test_descriptions(:)
25+
26+
#ifndef __GFORTRAN__
27+
test_descriptions = [ &
28+
test_description_t( &
29+
string_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated"), check_allocation), &
30+
test_description_t(string_t('supporting operator(==) for string_t and character operands'), supports_equivalence_operator), &
31+
test_description_t( &
32+
string_t('supporting operator(/=) for string_t and character operands'), supports_non_equivalence_operator), &
33+
test_description_t( &
34+
string_t('supporting operator(//) for string_t and character operands'), supports_concatenation_operator), &
35+
test_description_t(string_t('assigning a string_t object to a character variable'), assigns_string_t_to_character), &
36+
test_description_t(string_t('assigning a character variable to a string_t object'), assigns_character_to_string_t), &
37+
test_description_t(string_t('constructing from a default integer'), constructs_from_default_integer), &
38+
test_description_t(string_t('constructing from a real value'), constructs_from_real), &
39+
test_description_t(string_t('supporting unary operator(.cat.) for array arguments'), concatenates_elements), &
40+
test_description_t(string_t("extracting a key string from a colon-separated key/value pair"), extracts_key), &
41+
test_description_t(string_t("extracting a real value from a colon-separated key/value pair"), extracts_real_value), &
42+
test_description_t(string_t("extracting a string value from a colon-separated key/value pair"), extracts_string_value), &
43+
test_description_t(string_t("extracting a logical value from a colon-separated key/value pair"), extracts_logical_value), &
44+
test_description_t( &
45+
string_t("extracting an integer array value from a colon-separated key/value pair"), extracts_integer_array_value), &
46+
test_description_t( &
47+
string_t("extracting an real array value from a colon-separated key/value pair"), extracts_real_array_value), &
48+
test_description_t(string_t("extracting an integer value from a colon-separated key/value pair"), extracts_integer_value), &
49+
test_description_t(string_t('extracting a file base name'), extracts_file_base_name()), &
50+
test_description_t(string_t('extracting a file name extension'), extracts_file_name_extension()) &
51+
]
52+
#else
53+
! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument:
54+
procedure(test_function_i), pointer :: &
55+
check_allocation_ptr, supports_equivalence_ptr, supports_non_equivalence_ptr, supports_concatenation_ptr, &
56+
assigns_string_ptr, assigns_character_ptr, constructs_from_integer_ptr, constructs_from_real_ptr, concatenates_ptr, &
57+
extracts_key_ptr, extracts_real_ptr, extracts_string_ptr, extracts_logical_ptr, extracts_integer_array_ptr, &
58+
extracts_real_array_ptr, extracts_integer_ptr, extracts_file_base_ptr, extracts_file_name_ptr
59+
60+
check_allocation_ptr => check_allocation
61+
supports_equivalence_ptr => supports_equivalence_operator
62+
supports_non_equivalence_ptr => supports_non_equivalence_operator
63+
supports_concatenation_ptr => supports_concatenation_operator
64+
assigns_string_ptr => assigns_string_t_to_character
65+
assigns_character_ptr => assigns_character_to_string_t
66+
constructs_from_integer_ptr => constructs_from_default_integer
67+
constructs_from_real_ptr => constructs_from_real
68+
concatenates_ptr => concatenates_elements
69+
extracts_key_ptr => extracts_key
70+
extracts_real_ptr => extracts_real_value
71+
extracts_string_ptr => extracts_string_value
72+
extracts_logical_ptr => extracts_logical_value
73+
extracts_integer_array_ptr => extracts_integer_array_value
74+
extracts_real_array_ptr => extracts_real_array_value
75+
extracts_integer_ptr => extracts_integer_value
76+
extracts_file_base_ptr => extracts_file_base_name
77+
extracts_file_name_ptr => extracts_file_name_extension
78+
79+
test_descriptions = [ &
80+
test_description_t( &
81+
string_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated"), check_allocation_ptr), &
82+
test_description_t(string_t('supporting operator(==) for string_t and character operands'), supports_equivalence_ptr), &
83+
test_description_t( &
84+
string_t('supporting operator(/=) for string_t and character operands'), supports_non_equivalence_ptr), &
85+
test_description_t( &
86+
string_t('supporting operator(//) for string_t and character operands'), supports_concatenation_ptr), &
87+
test_description_t(string_t('assigning a string_t object to a character variable'), assigns_string_ptr), &
88+
test_description_t(string_t('assigning a character variable to a string_t object'), assigns_character_ptr), &
89+
test_description_t(string_t('constructing from a default integer'), constructs_from_integer_ptr), &
90+
test_description_t(string_t('constructing from a real value'), constructs_from_real_ptr), &
91+
test_description_t(string_t('supporting unary operator(.cat.) for array arguments'), concatenates_ptr), &
92+
test_description_t(string_t("extracting a key string from a colon-separated key/value pair"), extracts_key_ptr), &
93+
test_description_t(string_t("extracting a real value from a colon-separated key/value pair"), extracts_real_ptr), &
94+
test_description_t(string_t("extracting a string value from a colon-separated key/value pair"), extracts_string_ptr), &
95+
test_description_t(string_t("extracting a logical value from a colon-separated key/value pair"), extracts_logical_ptr), &
96+
test_description_t( &
97+
string_t("extracting an integer array value from a colon-separated key/value pair"), extracts_integer_array_ptr), &
98+
test_description_t( &
99+
string_t("extracting an real array value from a colon-separated key/value pair"), extracts_real_array_ptr), &
100+
test_description_t(string_t("extracting an integer value from a colon-separated key/value pair"), extracts_integer_ptr), &
101+
test_description_t(string_t('extracting a file base name'), extracts_file_base_ptr), &
102+
test_description_t(string_t('extracting a file name extension'), extracts_file_name_ptr) &
103+
]
104+
#endif
105+
test_descriptions = pack(test_descriptions, test_descriptions%contains_text(string_t(test_description_substring)))
106+
test_results = test_descriptions%run()
44107
end function
45108

46109
pure function check_allocation() result(passed)

0 commit comments

Comments
 (0)