File Coverage: t/05-lvalue.t

# File Coverage

File: | t/05-lvalue.t
Coverage: | 98.2%

line | stmt | bran | cond | sub | pod | time | code
--- | --- | --- | --- | --- | --- | --- | ---
1 | 1 1 1 |  |  | 1 |  | 3459 2 30 | use strict;
2 | 1 1 1 |  |  | 1 |  | 4 1 39 | use warnings;
3 |
4 | 1 1 1 |  |  | 1 |  | 432 83219 6 | use Test::More;
5 | 1 1 1 |  |  | 1 |  | 637 2 2 | use OpenMP::Environment;
6 |
7 | 1 |  |  |  |  | 67110 | my $env = OpenMP::Environment->new;
8 | 1 |  |  |  |  | 2 | my @vars = $env->vars;
9 | 1 |  |  |  |  | 42 | delete @ENV{@vars};
10 |
11 | 1 |  |  |  |  | 15 | my @lvalue_cases = (
12 |  |  |  |  |  |  | [ omp_allocator => unset_omp_allocator => OMP_ALLOCATOR => q{omp_high_bw_mem_alloc} => q{omp_high_bw_mem_alloc} ],
13 |  |  |  |  |  |  | [ omp_affinity_format => unset_omp_affinity_format => OMP_AFFINITY_FORMAT => q{thread %n affinity %A} => q{thread %n affinity %A} ],
14 |  |  |  |  |  |  | [ omp_cancellation => unset_omp_cancellation => OMP_CANCELLATION => q{true} => q{TRUE} ],
15 |  |  |  |  |  |  | [ omp_display_affinity => unset_omp_display_affinity => OMP_DISPLAY_AFFINITY => q{true} => q{TRUE} ],
16 |  |  |  |  |  |  | [ omp_display_env => unset_omp_display_env => OMP_DISPLAY_ENV => q{verbose} => q{VERBOSE} ],
17 |  |  |  |  |  |  | [ omp_default_device => unset_omp_default_device => OMP_DEFAULT_DEVICE => 0 => 0 ],
18 |  |  |  |  |  |  | [ omp_dynamic => unset_omp_dynamic => OMP_DYNAMIC => q{true} => q{true} ],
19 |  |  |  |  |  |  | [ omp_max_active_levels => unset_omp_max_active_levels => OMP_MAX_ACTIVE_LEVELS => 2 => 2 ],
20 |  |  |  |  |  |  | [ omp_max_task_priority => unset_omp_max_task_priority => OMP_MAX_TASK_PRIORITY => 0 => 0 ],
21 |  |  |  |  |  |  | [ omp_nested => unset_omp_nested => OMP_NESTED => q{true} => q{TRUE} ],
22 |  |  |  |  |  |  | [ omp_num_threads => unset_omp_num_threads => OMP_NUM_THREADS => q{8,4,2} => q{8,4,2} ],
23 |  |  |  |  |  |  | [ omp_num_teams => unset_omp_num_teams => OMP_NUM_TEAMS => 2 => 2 ],
24 |  |  |  |  |  |  | [ omp_proc_bind => unset_omp_proc_bind => OMP_PROC_BIND => q{spread} => q{spread} ],
25 |  |  |  |  |  |  | [ omp_places => unset_omp_places => OMP_PLACES => q{cores} => q{cores} ],
26 |  |  |  |  |  |  | [ omp_stacksize => unset_omp_stacksize => OMP_STACKSIZE => q{64M} => q{64M} ],
27 |  |  |  |  |  |  | [ omp_schedule => unset_omp_schedule => OMP_SCHEDULE => q{dynamic,4} => q{dynamic,4} ],
28 |  |  |  |  |  |  | [ omp_target_offload => unset_omp_target_offload => OMP_TARGET_OFFLOAD => q{default} => q{DEFAULT} ],
29 |  |  |  |  |  |  | [ omp_thread_limit => unset_omp_thread_limit => OMP_THREAD_LIMIT => 8 => 8 ],
30 |  |  |  |  |  |  | [ omp_teams_thread_limit => unset_omp_teams_thread_limit => OMP_TEAMS_THREAD_LIMIT => 4 => 4 ],
31 |  |  |  |  |  |  | [ omp_wait_policy => unset_omp_wait_policy => OMP_WAIT_POLICY => q{passive} => q{PASSIVE} ],
32 |  |  |  |  |  |  | [ gomp_cpu_affinity => unset_gomp_cpu_affinity => GOMP_CPU_AFFINITY => q{0-7} => q{0-7} ],
33 |  |  |  |  |  |  | [ gomp_debug => unset_gomp_debug => GOMP_DEBUG => 1 => 1 ],
34 |  |  |  |  |  |  | [ gomp_stacksize => unset_gomp_stacksize => GOMP_STACKSIZE => q{65536} => q{65536} ],
35 |  |  |  |  |  |  | [ gomp_spincount => unset_gomp_spincount => GOMP_SPINCOUNT => q{300000} => q{300000} ],
36 |  |  |  |  |  |  | [ gomp_rtems_thread_pools => unset_gomp_rtems_thread_pools => GOMP_RTEMS_THREAD_POOLS => q{1@WRK0} => q{1@WRK0} ],
37 |  |  |  |  |  |  | );
38 |
39 | 1 |  |  |  |  | 1 | for my $case (@lvalue_cases) {
40 | 25 |  |  |  |  | 4837 | my ( $accessor, $unsetter, $variable, $input, $expected ) = @$case;
41 |
42 | 25 |  |  |  |  | 53 | $env->$accessor = $input;
43 |
44 | 25 |  |  |  |  | 76 | is $ENV{$variable}, $expected, qq{$accessor lvalue assignment updates $variable};
45 | 25 |  |  |  |  | 5141 | is $env->$accessor, $expected, qq{$accessor remains a getter after lvalue assignment};
46 | 25 |  |  |  |  | 5097 | is $env->$unsetter(), $expected, qq{$unsetter still removes lvalue-assigned $variable};
47 |  |  |  |  |  |  | }
48 |
49 |  |  |  |  |  |  | # Compound lvalue operations must route their STORE back through validation.
50 | 1 |  |  |  |  | 201 | $env->omp_num_threads = 3;
51 | 1 |  |  |  |  | 3 | $env->omp_num_threads++;
52 | 1 |  |  |  |  | 4 | is $ENV{OMP_NUM_THREADS}, 4, q{post-increment works through a validated lvalue};
53 |
54 | 1 |  |  |  |  | 211 | $env->gomp_spincount = 100;
55 | 1 |  |  |  |  | 7 | $env->gomp_spincount += 50;
56 | 1 |  |  |  |  | 3 | is $ENV{GOMP_SPINCOUNT}, 150, q{numeric compound assignment works through an lvalue};
57 |
58 | 1 |  |  |  |  | 203 | $env->omp_affinity_format = q{thread};
59 | 1 |  |  |  |  | 2 | $env->omp_affinity_format .= q{ %n};
60 | 1 |  |  |  |  | 3 | is $ENV{OMP_AFFINITY_FORMAT}, q{thread %n}, q{string compound assignment works through an lvalue};
61 |
62 |  |  |  |  |  |  | # A failed lvalue STORE must not replace a previously valid environment value.
63 | 1 |  |  |  |  | 201 | $env->omp_num_threads = 4;
64 | 1 1 0 |  |  |  |  | 2 2 0 | my $ok = eval { $env->omp_num_threads = q{invalid}; 1 };
65 | 1 |  |  |  |  | 4 | ok !$ok, q{invalid lvalue assignment dies};
66 | 1 |  |  |  |  | 196 | like $@, qr/OMP_NUM_THREADS/, q{invalid lvalue assignment reports the variable};
67 | 1 |  |  |  |  | 189 | is $ENV{OMP_NUM_THREADS}, 4, q{invalid lvalue assignment preserves the previous value};
68 |
69 |  |  |  |  |  |  | # Preserve the historical false-value-means-unset behavior through lvalues.
70 | 1 |  |  |  |  | 201 | $env->omp_dynamic = q{true};
71 | 1 |  |  |  |  | 3 | $env->omp_dynamic = 0;
72 | 1 |  |  |  |  | 3 | ok !exists $ENV{OMP_DYNAMIC}, q{OMP_DYNAMIC lvalue false value retains historical unset behavior};
73 |
74 | 1 |  |  |  |  | 193 | $env->omp_nested = q{true};
75 | 1 |  |  |  |  | 3 | $env->omp_nested = q{false};
76 | 1 |  |  |  |  | 3 | ok !exists $ENV{OMP_NESTED}, q{OMP_NESTED lvalue false value retains historical unset behavior};
77 |
78 |  |  |  |  |  |  | # Traditional call-style setters remain fully supported alongside lvalues.
79 | 1 |  |  |  |  | 193 | is $env->omp_num_threads(6), 6, q{traditional setter syntax remains supported};
80 | 1 |  |  |  |  | 215 | is $env->omp_num_threads(), 6, q{traditional getter syntax remains supported};
81 | 1 |  |  |  |  | 202 | is $env->unset_omp_num_threads(), 6, q{traditional unsetter syntax remains supported};
82 |
83 |  |  |  |  |  |  | # Explicit undef retains the established getter/no-op behavior for ordinary
84 |  |  |  |  |  |  | # accessors; callers should continue to use the explicit unsetter to delete.
85 | 1 |  |  |  |  | 209 | $env->omp_num_threads = 8;
86 | 1 |  |  |  |  | 3 | $env->omp_num_threads = undef;
87 | 1 |  |  |  |  | 3 | is $ENV{OMP_NUM_THREADS}, 8, q{undef lvalue assignment retains ordinary accessor compatibility semantics};
88 | 1 |  |  |  |  | 204 | $env->unset_omp_num_threads;
89 |
90 | 1 |  |  |  |  | 21 | delete @ENV{@vars};
91 |
92 | 1 |  |  |  |  | 3 | done_testing;
93 |