| File: | t/03-coverage.t |
| Coverage: | 95.3% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | 1 1 1 | 2939 1 23 | use strict; | ||||
| 2 | 1 1 1 | 4 1 34 | use warnings; | ||||
| 3 | |||||||
| 4 | 1 1 1 | 250 846 83 | use FindBin qw/$Bin/; | ||||
| 5 | 1 1 1 | 229 475 6 | use lib qq{$Bin/../lib}; | ||||
| 6 | |||||||
| 7 | 1 1 1 | 402 67748 5 | use Test::More; | ||||
| 8 | 1 1 1 | 487 2 2468 | use OpenMP::Environment (); | ||||
| 9 | |||||||
| 10 | 1 | 68120 | local %ENV = %ENV; | ||||
| 11 | |||||||
| 12 | 1 | 6 | my $env = OpenMP::Environment->new; | ||||
| 13 | |||||||
| 14 | 1 | 6 | 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 | 3 | my @vars = $env->vars; | ||||
| 25 | |||||||
| 26 | 1 | 4 | 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 | 737 | delete @ENV{@vars}; | ||||
| 34 | |||||||
| 35 | 1 | 17 | 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 | 2 | for my $case (@accessors) { | ||||
| 64 | 25 | 5773 | my ( $getter_setter, $unsetter, $value ) = @$case; | ||||
| 65 | |||||||
| 66 | 25 | 65 | is( | ||||
| 67 | $env->$getter_setter($value), | ||||||
| 68 | $value, | ||||||
| 69 | qq{$getter_setter sets and returns a value}, | ||||||
| 70 | ); | ||||||
| 71 | 25 | 5204 | is( | ||||
| 72 | $env->$getter_setter(), | ||||||
| 73 | $value, | ||||||
| 74 | qq{$getter_setter gets the current value}, | ||||||
| 75 | ); | ||||||
| 76 | 25 | 5119 | is( | ||||
| 77 | $env->$unsetter(), | ||||||
| 78 | $value, | ||||||
| 79 | qq{$unsetter returns the deleted value}, | ||||||
| 80 | ); | ||||||
| 81 | 25 | 5054 | 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 | 241 | is $env->omp_dynamic(q{true}), q{true}, q{OMP_DYNAMIC true path}; | ||||
| 90 | 1 | 208 | 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 | 209 | is $env->omp_dynamic(q{FALSE}), q{TRUE}, q{OMP_DYNAMIC uppercase false unsets and returns old value}; | ||||
| 93 | 1 | 205 | is $env->omp_dynamic(q{1}), q{1}, q{OMP_DYNAMIC numeric true path}; | ||||
| 94 | 1 | 209 | is $env->omp_dynamic(q{0}), q{1}, q{OMP_DYNAMIC numeric false unsets and returns old value}; | ||||
| 95 | |||||||
| 96 | 1 | 204 | is $env->omp_nested(q{true}), q{TRUE}, q{OMP_NESTED true path}; | ||||
| 97 | 1 | 207 | is $env->omp_nested(q{false}), q{TRUE}, q{OMP_NESTED false string unsets and returns old value}; | ||||
| 98 | 1 | 204 | is $env->omp_nested(q{TRUE}), q{TRUE}, q{OMP_NESTED uppercase true path}; | ||||
| 99 | 1 | 219 | is $env->omp_nested(q{FALSE}), q{TRUE}, q{OMP_NESTED uppercase false unsets and returns old value}; | ||||
| 100 | 1 | 206 | is $env->omp_nested(q{1}), q{1}, q{OMP_NESTED numeric true path}; | ||||
| 101 | 1 | 217 | 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 | 251 | like OpenMP::Environment::_is_ge_if_set( 1, q{x} ), qr/integer/, q{integer validator rejects non-digits}; | ||||
| 106 | 1 | 190 | like OpenMP::Environment::_is_ge_if_set( 1, 0 ), qr/integer/, q{integer validator rejects a digit below the minimum}; | ||||
| 107 | 1 | 187 | is OpenMP::Environment::_is_ge_if_set( 1, 1 ), undef, q{integer validator accepts the minimum}; | ||||
| 108 | |||||||
| 109 | 1 | 254 | is OpenMP::Environment::_is_positive_integer_list_if_set(undef), undef, q{thread-list validator accepts undef}; | ||||
| 110 | 1 | 241 | 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 | 247 | 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 | 187 | 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 | 208 | is $null_validator->(q{anything}), undef, q{null validator accepts arbitrary input}; | ||||
| 116 | |||||||
| 117 | # Summary branches when nothing is set. | ||||||
| 118 | 1 | 274 | delete @ENV{@vars}; | ||||
| 119 | 1 | 4 | is scalar($env->vars_set), 0, q{vars_set is empty when nothing is set}; | ||||
| 120 | 1 | 211 | is scalar($env->vars_unset), scalar(@vars), q{vars_unset contains every supported variable when nothing is set}; | ||||
| 121 | 1 | 200 | ok $env->assert_omp_environment, q{empty OpenMP environment validates}; | ||||
| 122 | |||||||
| 123 | 1 | 188 | my $stdout = q{}; | ||||
| 124 | { | ||||||
| 125 | 1 1 | 3 19 | open my $capture, q{>}, \$stdout or die qq{open scalar handle: $!}; | ||||
| 126 | 1 | 3 | local *STDOUT = $capture; | ||||
| 127 | 1 | 3 | my $summary = $env->_omp_summary_set; | ||||
| 128 | 1 | 4 | like $summary, qr/Summary of OpenMP Environmental SET/, q{set summary returns its heading}; | ||||
| 129 | } | ||||||
| 130 | 1 | 194 | like $stdout, qr/- none/, q{set summary prints the none marker when no supported variables are set}; | ||||
| 131 | |||||||
| 132 | 1 | 185 | $stdout = q{}; | ||||
| 133 | { | ||||||
| 134 | 1 1 | 1 9 | 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 | 192 | unlike $stdout, qr/- none/, q{unset summary does not print none while variables are unset}; | ||||
| 140 | |||||||
| 141 | 1 | 195 | 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 | 200 | 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 | 3 | for my $var ( keys %truthy_value ) { | ||||
| 174 | 25 | 67 | $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 | 203 | is scalar($env->vars_set), scalar(@vars), q{vars_set contains every supported variable when everything is set}; | ||||
| 178 | 1 | 203 | ok $env->assert_omp_environment, q{fully populated valid OpenMP environment validates}; | ||||
| 179 | |||||||
| 180 | 1 | 210 | $stdout = q{}; | ||||
| 181 | { | ||||||
| 182 | 1 1 | 2 9 | 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 | 5 | like $summary, qr/Summary of OpenMP Environmental UNSET/, q{unset summary returns its heading}; | ||||
| 186 | } | ||||||
| 187 | 1 | 207 | like $stdout, qr/- none/, q{unset summary prints none when everything is set}; | ||||
| 188 | |||||||
| 189 | 1 | 190 | $stdout = q{}; | ||||
| 190 | { | ||||||
| 191 | 1 1 | 1 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 | 196 | unlike $stdout, qr/- none/, q{set summary does not print none when variables are set}; | ||||
| 197 | |||||||
| 198 | 1 | 190 | 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 | 187 | $stdout = q{}; | ||||
| 202 | { | ||||||
| 203 | 1 1 | 1 9 | open my $capture, q{>}, \$stdout or die qq{open scalar handle: $!}; | ||||
| 204 | 1 | 2 | local *STDOUT = $capture; | ||||
| 205 | 1 | 5 | ok $env->print_omp_summary_set, q{print_omp_summary_set returns a true print result}; | ||||
| 206 | 1 | 200 | ok $env->print_omp_summary_unset, q{print_omp_summary_unset returns a true print result}; | ||||
| 207 | 1 | 188 | ok $env->print_omp_summary, q{print_omp_summary returns a true print result}; | ||||
| 208 | } | ||||||
| 209 | 1 | 192 | 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 | 186 2 | my $ok = eval { $env->_assert_valid( q{OMP_DISPLAY_AFFINITY}, q{true} ) }; | ||||
| 213 | 1 | 3 | is $ok, q{TRUE}, q{_assert_valid returns the filtered value}; | ||||
| 214 | 1 1 0 | 209 2 0 | my $died = !eval { $env->_assert_valid( q{OMP_DISPLAY_AFFINITY}, q{invalid} ); 1 }; | ||||
| 215 | 1 | 3 | ok $died, q{_assert_valid dies on validation failure}; | ||||
| 216 | |||||||
| 217 | # Finish with the environment clean so later tests are not influenced. | ||||||
| 218 | 1 | 214 | delete @ENV{@vars}; | ||||
| 219 | |||||||
| 220 | 1 | 4 | done_testing; | ||||
| 221 | |||||||