File Coverage: t/03-coverage.t

# File Coverage

File: | t/03-coverage.t
Coverage: | 95.3%

line | stmt | bran | cond | sub | pod | time | code
--- | --- | --- | --- | --- | --- | --- | ---
1 | 1 1 1 |  |  | 1 |  | 3924 2 24 | use strict;
2 | 1 1 1 |  |  | 1 |  | 3 1 34 | use warnings;
3 |
4 | 1 1 1 |  |  | 1 |  | 316 1144 143 | use FindBin qw/$Bin/;
5 | 1 1 1 |  |  | 1 |  | 315 688 5 | use lib qq{$Bin/../lib};
6 |
7 | 1 1 1 |  |  | 1 |  | 580 103985 7 | use Test::More;
8 | 1 1 1 |  |  | 1 |  | 816 3 2900 | use OpenMP::Environment ();
9 |
10 | 1 |  |  |  |  | 90492 | local %ENV = %ENV;
11 |
12 | 1 |  |  |  |  | 8 | my $env = OpenMP::Environment->new;
13 |
14 | 1 |  |  |  |  | 29 | my @legacy_vars = qw/
15 |  |  |  |  |  |  | OMP_CANCELLATION OMP_DISPLAY_ENV OMP_DEFAULT_DEVICE OMP_NUM_TEAMS
16 |  |  |  |  |  |  | OMP_DYNAMIC OMP_MAX_ACTIVE_LEVELS OMP_MAX_TASK_PRIORITY OMP_NESTED
17 |  |  |  |  |  |  | OMP_NUM_THREADS OMP_PROC_BIND OMP_PLACES OMP_STACKSIZE OMP_SCHEDULE
18 |  |  |  |  |  |  | OMP_TARGET_OFFLOAD OMP_THREAD_LIMIT OMP_WAIT_POLICY GOMP_CPU_AFFINITY
19 |  |  |  |  |  |  | GOMP_DEBUG GOMP_STACKSIZE GOMP_SPINCOUNT GOMP_RTEMS_THREAD_POOLS
20 |  |  |  |  |  |  | OMP_TEAMS_THREAD_LIMIT
21 |  |  |  |  |  |  | /;
22 |
23 | 1 |  |  |  |  | 3 | my @new_vars = qw/OMP_ALLOCATOR OMP_AFFINITY_FORMAT OMP_DISPLAY_AFFINITY/;
24 | 1 |  |  |  |  | 4 | my @vars = $env->vars;
25 |
26 | 1 |  |  |  |  | 6 | is_deeply(
27 |  |  |  |  |  |  | \@vars,
28 |  |  |  |  |  |  | [ @legacy_vars, @new_vars ],
29 |  |  |  |  |  |  | q{legacy vars ordering is preserved and GCC 16.2 variables are appended},
30 |  |  |  |  |  |  | );
31 |
32 |  |  |  |  |  |  | # Keep the test independent of the environment in which it is run.
33 | 1 |  |  |  |  | 1020 | delete @ENV{@vars};
34 |
35 | 1 |  |  |  |  | 18 | my @accessors = (
36 |  |  |  |  |  |  | [ omp_allocator => unset_omp_allocator => q{omp_high_bw_mem_alloc} ],
37 |  |  |  |  |  |  | [ omp_affinity_format => unset_omp_affinity_format => q{thread %n affinity %A} ],
38 |  |  |  |  |  |  | [ omp_cancellation => unset_omp_cancellation => q{TRUE} ],
39 |  |  |  |  |  |  | [ omp_display_affinity => unset_omp_display_affinity => q{TRUE} ],
40 |  |  |  |  |  |  | [ omp_display_env => unset_omp_display_env => q{VERBOSE} ],
41 |  |  |  |  |  |  | [ omp_default_device => unset_omp_default_device => 1 ],
42 |  |  |  |  |  |  | [ omp_dynamic => unset_omp_dynamic => q{true} ],
43 |  |  |  |  |  |  | [ omp_max_active_levels => unset_omp_max_active_levels => 2 ],
44 |  |  |  |  |  |  | [ omp_max_task_priority => unset_omp_max_task_priority => 1 ],
45 |  |  |  |  |  |  | [ omp_nested => unset_omp_nested => q{TRUE} ],
46 |  |  |  |  |  |  | [ omp_num_teams => unset_omp_num_teams => 2 ],
47 |  |  |  |  |  |  | [ omp_num_threads => unset_omp_num_threads => q{8,4,2} ],
48 |  |  |  |  |  |  | [ omp_proc_bind => unset_omp_proc_bind => q{CLOSE} ],
49 |  |  |  |  |  |  | [ omp_places => unset_omp_places => q{cores} ],
50 |  |  |  |  |  |  | [ omp_stacksize => unset_omp_stacksize => q{64M} ],
51 |  |  |  |  |  |  | [ omp_schedule => unset_omp_schedule => q{dynamic,4} ],
52 |  |  |  |  |  |  | [ omp_target_offload => unset_omp_target_offload => q{DEFAULT} ],
53 |  |  |  |  |  |  | [ omp_teams_thread_limit => unset_omp_teams_thread_limit => 2 ],
54 |  |  |  |  |  |  | [ omp_thread_limit => unset_omp_thread_limit => 8 ],
55 |  |  |  |  |  |  | [ omp_wait_policy => unset_omp_wait_policy => q{PASSIVE} ],
56 |  |  |  |  |  |  | [ gomp_cpu_affinity => unset_gomp_cpu_affinity => q{0-7} ],
57 |  |  |  |  |  |  | [ gomp_debug => unset_gomp_debug => 1 ],
58 |  |  |  |  |  |  | [ gomp_stacksize => unset_gomp_stacksize => 65536 ],
59 |  |  |  |  |  |  | [ gomp_spincount => unset_gomp_spincount => q{300000} ],
60 |  |  |  |  |  |  | [ gomp_rtems_thread_pools => unset_gomp_rtems_thread_pools => q{1@WRK0} ],
61 |  |  |  |  |  |  | );
62 |
63 | 1 |  |  |  |  | 3 | for my $case (@accessors) {
64 | 25 |  |  |  |  | 6533 | my ( $getter_setter, $unsetter, $value ) = @$case;
65 |
66 | 25 |  |  |  |  | 63 | is(
67 |  |  |  |  |  |  | $env->$getter_setter($value),
68 |  |  |  |  |  |  | $value,
69 |  |  |  |  |  |  | qq{$getter_setter sets and returns a value},
70 |  |  |  |  |  |  | );
71 | 25 |  |  |  |  | 5790 | is(
72 |  |  |  |  |  |  | $env->$getter_setter(),
73 |  |  |  |  |  |  | $value,
74 |  |  |  |  |  |  | qq{$getter_setter gets the current value},
75 |  |  |  |  |  |  | );
76 | 25 |  |  |  |  | 5766 | is(
77 |  |  |  |  |  |  | $env->$unsetter(),
78 |  |  |  |  |  |  | $value,
79 |  |  |  |  |  |  | qq{$unsetter returns the deleted value},
80 |  |  |  |  |  |  | );
81 | 25 |  |  |  |  | 5663 | is(
82 |  |  |  |  |  |  | $env->$getter_setter(),
83 |  |  |  |  |  |  | undef,
84 |  |  |  |  |  |  | qq{$getter_setter returns undef after unset},
85 |  |  |  |  |  |  | );
86 |  |  |  |  |  |  | }
87 |
88 |  |  |  |  |  |  | # Exercise each compatibility path in the special boolean accessors.
89 | 1 |  |  |  |  | 249 | is $env->omp_dynamic(q{true}), q{true}, q{OMP_DYNAMIC true path};
90 | 1 |  |  |  |  | 205 | is $env->omp_dynamic(q{false}), q{true}, q{OMP_DYNAMIC false string unsets and returns old value};
91 | 1 |  |  |  |  | 205 | is $env->omp_dynamic(q{TRUE}), q{TRUE}, q{OMP_DYNAMIC uppercase true path};
92 | 1 |  |  |  |  | 207 | is $env->omp_dynamic(q{FALSE}), q{TRUE}, q{OMP_DYNAMIC uppercase false unsets and returns old value};
93 | 1 |  |  |  |  | 206 | is $env->omp_dynamic(q{1}), q{1}, q{OMP_DYNAMIC numeric true path};
94 | 1 |  |  |  |  | 207 | is $env->omp_dynamic(q{0}), q{1}, q{OMP_DYNAMIC numeric false unsets and returns old value};
95 |
96 | 1 |  |  |  |  | 223 | is $env->omp_nested(q{true}), q{TRUE}, q{OMP_NESTED true path};
97 | 1 |  |  |  |  | 206 | is $env->omp_nested(q{false}), q{TRUE}, q{OMP_NESTED false string unsets and returns old value};
98 | 1 |  |  |  |  | 205 | is $env->omp_nested(q{TRUE}), q{TRUE}, q{OMP_NESTED uppercase true path};
99 | 1 |  |  |  |  | 205 | is $env->omp_nested(q{FALSE}), q{TRUE}, q{OMP_NESTED uppercase false unsets and returns old value};
100 | 1 |  |  |  |  | 207 | is $env->omp_nested(q{1}), q{1}, q{OMP_NESTED numeric true path};
101 | 1 |  |  |  |  | 205 | is $env->omp_nested(q{0}), q{1}, q{OMP_NESTED numeric false unsets and returns old value};
102 |
103 |  |  |  |  |  |  | # Direct validator coverage, including both sides of the short-circuit checks.
104 | 1 |  |  |  |  | 205 | is OpenMP::Environment::_is_ge_if_set( 1, undef ), undef, q{integer validator accepts undef};
105 | 1 |  |  |  |  | 253 | like OpenMP::Environment::_is_ge_if_set( 1, q{x} ), qr/integer/, q{integer validator rejects non-digits};
106 | 1 |  |  |  |  | 213 | like OpenMP::Environment::_is_ge_if_set( 1, 0 ), qr/integer/, q{integer validator rejects a digit below the minimum};
107 | 1 |  |  |  |  | 190 | is OpenMP::Environment::_is_ge_if_set( 1, 1 ), undef, q{integer validator accepts the minimum};
108 |
109 | 1 |  |  |  |  | 255 | is OpenMP::Environment::_is_positive_integer_list_if_set(undef), undef, q{thread-list validator accepts undef};
110 | 1 |  |  |  |  | 251 | is OpenMP::Environment::_is_positive_integer_list_if_set(q{8, 4, 2}), undef, q{thread-list validator accepts a positive integer list};
111 | 1 |  |  |  |  | 255 | like OpenMP::Environment::_is_positive_integer_list_if_set(q{8,0,2}), qr/comma-separated/, q{thread-list validator rejects zero};
112 |
113 | 1 |  |  |  |  | 189 | my $null_validator = OpenMP::Environment::_no_validate();
114 | 1 |  |  |  |  | 3 | is ref($null_validator), q{CODE}, q{null validator factory returns a coderef};
115 | 1 |  |  |  |  | 614 | is $null_validator->(q{anything}), undef, q{null validator accepts arbitrary input};
116 |
117 |  |  |  |  |  |  | # Summary branches when nothing is set.
118 | 1 |  |  |  |  | 315 | delete @ENV{@vars};
119 | 1 |  |  |  |  | 5 | is scalar($env->vars_set), 0, q{vars_set is empty when nothing is set};
120 | 1 |  |  |  |  | 248 | is scalar($env->vars_unset), scalar(@vars), q{vars_unset contains every supported variable when nothing is set};
121 | 1 |  |  |  |  | 262 | ok $env->assert_omp_environment, q{empty OpenMP environment validates};
122 |
123 | 1 |  |  |  |  | 228 | my $stdout = q{};
124 |  |  |  |  |  |  | {
125 | 1 1 | 50 |  |  |  | 2 13 | open my $capture, q{>}, \$stdout or die qq{open scalar handle: $!};
126 | 1 |  |  |  |  | 5 | local *STDOUT = $capture;
127 | 1 |  |  |  |  | 3 | my $summary = $env->_omp_summary_set;
128 | 1 |  |  |  |  | 5 | like $summary, qr/Summary of OpenMP Environmental SET/, q{set summary returns its heading};
129 |  |  |  |  |  |  | }
130 | 1 |  |  |  |  | 233 | like $stdout, qr/- none/, q{set summary prints the none marker when no supported variables are set};
131 |
132 | 1 |  |  |  |  | 224 | $stdout = q{};
133 |  |  |  |  |  |  | {
134 | 1 1 | 50 |  |  |  | 1 11 | open my $capture, q{>}, \$stdout or die qq{open scalar handle: $!};
135 | 1 |  |  |  |  | 2 | local *STDOUT = $capture;
136 | 1 |  |  |  |  | 4 | my $summary = $env->_omp_summary_unset;
137 | 1 |  |  |  |  | 5 | like $summary, qr/OMP_CANCELLATION/, q{unset summary includes supported variables};
138 |  |  |  |  |  |  | }
139 | 1 |  |  |  |  | 226 | unlike $stdout, qr/- none/, q{unset summary does not print none while variables are unset};
140 |
141 | 1 |  |  |  |  | 222 | like $env->_omp_summary, qr/<XXunsetXX>/, q{all-variable summary marks unset values};
142 |
143 |  |  |  |  |  |  | # Summary branches when everything is set. Direct assignment is deliberate: the
144 |  |  |  |  |  |  | # summary helpers report environment state and should not require revalidation.
145 | 1 |  |  |  |  | 230 | my %truthy_value = (
146 |  |  |  |  |  |  | OMP_CANCELLATION => q{TRUE},
147 |  |  |  |  |  |  | OMP_DISPLAY_ENV => q{TRUE},
148 |  |  |  |  |  |  | OMP_DEFAULT_DEVICE => 1,
149 |  |  |  |  |  |  | OMP_NUM_TEAMS => 1,
150 |  |  |  |  |  |  | OMP_DYNAMIC => q{true},
151 |  |  |  |  |  |  | OMP_MAX_ACTIVE_LEVELS => 1,
152 |  |  |  |  |  |  | OMP_MAX_TASK_PRIORITY => 1,
153 |  |  |  |  |  |  | OMP_NESTED => q{TRUE},
154 |  |  |  |  |  |  | OMP_NUM_THREADS => 1,
155 |  |  |  |  |  |  | OMP_PROC_BIND => q{CLOSE},
156 |  |  |  |  |  |  | OMP_PLACES => q{cores},
157 |  |  |  |  |  |  | OMP_STACKSIZE => q{64M},
158 |  |  |  |  |  |  | OMP_SCHEDULE => q{static},
159 |  |  |  |  |  |  | OMP_TARGET_OFFLOAD => q{DEFAULT},
160 |  |  |  |  |  |  | OMP_THREAD_LIMIT => 1,
161 |  |  |  |  |  |  | OMP_WAIT_POLICY => q{PASSIVE},
162 |  |  |  |  |  |  | GOMP_CPU_AFFINITY => q{0-7},
163 |  |  |  |  |  |  | GOMP_DEBUG => 1,
164 |  |  |  |  |  |  | GOMP_STACKSIZE => 65536,
165 |  |  |  |  |  |  | GOMP_SPINCOUNT => 300000,
166 |  |  |  |  |  |  | GOMP_RTEMS_THREAD_POOLS => q{1@WRK0},
167 |  |  |  |  |  |  | OMP_TEAMS_THREAD_LIMIT => 1,
168 |  |  |  |  |  |  | OMP_ALLOCATOR => q{omp_default_mem_alloc},
169 |  |  |  |  |  |  | OMP_AFFINITY_FORMAT => q{thread %n affinity %A},
170 |  |  |  |  |  |  | OMP_DISPLAY_AFFINITY => q{TRUE},
171 |  |  |  |  |  |  | );
172 |
173 | 1 |  |  |  |  | 4 | for my $var ( keys %truthy_value ) {
174 | 25 |  |  |  |  | 81 | $ENV{$var} = $truthy_value{$var};
175 |  |  |  |  |  |  | }
176 | 1 |  |  |  |  | 4 | is scalar($env->vars_unset), 0, q{vars_unset is empty when everything is set};
177 | 1 |  |  |  |  | 262 | is scalar($env->vars_set), scalar(@vars), q{vars_set contains every supported variable when everything is set};
178 | 1 |  |  |  |  | 239 | ok $env->assert_omp_environment, q{fully populated valid OpenMP environment validates};
179 |
180 | 1 |  |  |  |  | 256 | $stdout = q{};
181 |  |  |  |  |  |  | {
182 | 1 1 | 50 |  |  |  | 3 11 | open my $capture, q{>}, \$stdout or die qq{open scalar handle: $!};
183 | 1 |  |  |  |  | 3 | local *STDOUT = $capture;
184 | 1 |  |  |  |  | 2 | my $summary = $env->_omp_summary_unset;
185 | 1 |  |  |  |  | 6 | like $summary, qr/Summary of OpenMP Environmental UNSET/, q{unset summary returns its heading};
186 |  |  |  |  |  |  | }
187 | 1 |  |  |  |  | 238 | like $stdout, qr/- none/, q{unset summary prints none when everything is set};
188 |
189 | 1 |  |  |  |  | 225 | $stdout = q{};
190 |  |  |  |  |  |  | {
191 | 1 1 | 50 |  |  |  | 2 9 | open my $capture, q{>}, \$stdout or die qq{open scalar handle: $!};
192 | 1 |  |  |  |  | 3 | local *STDOUT = $capture;
193 | 1 |  |  |  |  | 3 | my $summary = $env->_omp_summary_set;
194 | 1 |  |  |  |  | 5 | like $summary, qr/OMP_ALLOCATOR/, q{set summary includes new GCC 16.2 variables};
195 |  |  |  |  |  |  | }
196 | 1 |  |  |  |  | 233 | unlike $stdout, qr/- none/, q{set summary does not print none when variables are set};
197 |
198 | 1 |  |  |  |  | 225 | like $env->_omp_summary, qr/OMP_DISPLAY_AFFINITY\s+TRUE/, q{all-variable summary shows new values};
199 |
200 |  |  |  |  |  |  | # Exercise all three public print wrappers while capturing their output.
201 | 1 |  |  |  |  | 224 | $stdout = q{};
202 |  |  |  |  |  |  | {
203 | 1 1 | 50 |  |  |  | 2 9 | open my $capture, q{>}, \$stdout or die qq{open scalar handle: $!};
204 | 1 |  |  |  |  | 3 | local *STDOUT = $capture;
205 | 1 |  |  |  |  | 4 | ok $env->print_omp_summary_set, q{print_omp_summary_set returns a true print result};
206 | 1 |  |  |  |  | 239 | ok $env->print_omp_summary_unset, q{print_omp_summary_unset returns a true print result};
207 | 1 |  |  |  |  | 230 | ok $env->print_omp_summary, q{print_omp_summary returns a true print result};
208 |  |  |  |  |  |  | }
209 | 1 |  |  |  |  | 228 | like $stdout, qr/Summary of OpenMP Environmental ALL/, q{public summary methods print to STDOUT};
210 |
211 |  |  |  |  |  |  | # Cover the error path and filtered-value return path explicitly.
212 | 1 1 |  |  |  |  | 221 2 | my $ok = eval { $env->_assert_valid( q{OMP_DISPLAY_AFFINITY}, q{true} ) };
213 | 1 |  |  |  |  | 2 | is $ok, q{TRUE}, q{_assert_valid returns the filtered value};
214 | 1 1 0 |  |  |  |  | 259 4 0 | my $died = !eval { $env->_assert_valid( q{OMP_DISPLAY_AFFINITY}, q{invalid} ); 1 };
215 | 1 |  |  |  |  | 5 | ok $died, q{_assert_valid dies on validation failure};
216 |
217 |  |  |  |  |  |  | # Finish with the environment clean so later tests are not influenced.
218 | 1 |  |  |  |  | 290 | delete @ENV{@vars};
219 |
220 | 1 |  |  |  |  | 4 | done_testing;
221 |