| File: | t/05-lvalue.t |
| Coverage: | 98.2% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | 1 1 1 | 6693 4 55 | use strict; | ||||
| 2 | 1 1 1 | 7 2 70 | use warnings; | ||||
| 3 | |||||||
| 4 | 1 1 1 | 878 105731 7 | use Test::More; | ||||
| 5 | 1 1 1 | 711 2 1416 | use OpenMP::Environment; | ||||
| 6 | |||||||
| 7 | 1 | 62871 | my $env = OpenMP::Environment->new; | ||||
| 8 | 1 | 2 | my @vars = $env->vars; | ||||
| 9 | 1 | 29 | delete @ENV{@vars}; | ||||
| 10 | |||||||
| 11 | 1 | 22 | 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 | 2 | for my $case (@lvalue_cases) { | ||||
| 40 | 25 | 5740 | my ( $accessor, $unsetter, $variable, $input, $expected ) = @$case; | ||||
| 41 | |||||||
| 42 | 25 | 91 | $env->$accessor = $input; | ||||
| 43 | |||||||
| 44 | 25 | 97 | is $ENV{$variable}, $expected, qq{$accessor lvalue assignment updates $variable}; | ||||
| 45 | 25 | 6069 | is $env->$accessor, $expected, qq{$accessor remains a getter after lvalue assignment}; | ||||
| 46 | 25 | 6044 | 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 | 227 | $env->omp_num_threads = 3; | ||||
| 51 | 1 | 8 | $env->omp_num_threads++; | ||||
| 52 | 1 | 4 | is $ENV{OMP_NUM_THREADS}, 4, q{post-increment works through a validated lvalue}; | ||||
| 53 | |||||||
| 54 | 1 | 225 | $env->gomp_spincount = 100; | ||||
| 55 | 1 | 3 | $env->gomp_spincount += 50; | ||||
| 56 | 1 | 5 | is $ENV{GOMP_SPINCOUNT}, 150, q{numeric compound assignment works through an lvalue}; | ||||
| 57 | |||||||
| 58 | 1 | 224 | $env->omp_affinity_format = q{thread}; | ||||
| 59 | 1 | 4 | $env->omp_affinity_format .= q{ %n}; | ||||
| 60 | 1 | 5 | 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 | 226 | $env->omp_num_threads = 4; | ||||
| 64 | 1 1 0 | 3 5 0 | my $ok = eval { $env->omp_num_threads = q{invalid}; 1 }; | ||||
| 65 | 1 | 5 | ok !$ok, q{invalid lvalue assignment dies}; | ||||
| 66 | 1 | 221 | like $@, qr/OMP_NUM_THREADS/, q{invalid lvalue assignment reports the variable}; | ||||
| 67 | 1 | 211 | 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 | 220 | $env->omp_dynamic = q{true}; | ||||
| 71 | 1 | 3 | $env->omp_dynamic = 0; | ||||
| 72 | 1 | 4 | ok !exists $ENV{OMP_DYNAMIC}, q{OMP_DYNAMIC lvalue false value retains historical unset behavior}; | ||||
| 73 | |||||||
| 74 | 1 | 201 | $env->omp_nested = q{true}; | ||||
| 75 | 1 | 8 | $env->omp_nested = q{false}; | ||||
| 76 | 1 | 5 | 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 | 200 | is $env->omp_num_threads(6), 6, q{traditional setter syntax remains supported}; | ||||
| 80 | 1 | 217 | is $env->omp_num_threads(), 6, q{traditional getter syntax remains supported}; | ||||
| 81 | 1 | 208 | 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 | 205 | $env->omp_num_threads = 8; | ||||
| 86 | 1 | 4 | $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 | 207 | $env->unset_omp_num_threads; | ||||
| 89 | |||||||
| 90 | 1 | 24 | delete @ENV{@vars}; | ||||
| 91 | |||||||
| 92 | 1 | 4 | done_testing; | ||||
| 93 | |||||||