@@ -5,18 +5,19 @@ program simple_test_sigma2_state
55use simple_syslib, only: del_file, file_exists
66use simple_sigma2_state_file, only: sigma2_state_header, sigma2_state_init_header, &
77 &sigma2_state_create_candidate, sigma2_state_write_local_range, sigma2_state_read_header, &
8- &sigma2_state_validate_file, SIGMA2_GROUP_GLOBAL, SIGMA2_GROUP_STACK, SIGMA2_PROV_PSPEC , &
9- &SIGMA2_PROV_RESIDUAL, SIGMA2_STATE_COMMITTED
8+ &sigma2_state_read_groups, sigma2_state_validate_file, SIGMA2_GROUP_GLOBAL, SIGMA2_GROUP_STACK, &
9+ &SIGMA2_PROV_PSPEC, SIGMA2_PROV_RESIDUAL, SIGMA2_STATE_COMMITTED
1010use simple_sigma2_state, only: sigma2_state_layout_digest, sigma2_state_merge_local_ranges, &
1111 &sigma2_state_reduce_groups, sigma2_state_validate_identity, sigma2_state_validate_science, &
1212 &sigma2_state_candidate_path, sigma2_state_commit, sigma2_state_prepare_update, &
13- &sigma2_state_range_path
13+ &sigma2_state_range_path, sigma2_state_next_generation
1414implicit none
1515
1616call exercise_policy(' global' , SIGMA2_GROUP_GLOBAL, 1 , 4 )
1717call exercise_policy(' group' , SIGMA2_GROUP_STACK, 2 , 8 )
1818call exercise_recovery_guards()
1919call exercise_update_preparation()
20+ call exercise_invalid_record_skip()
2021write (* ,' (A)' ) ' SIMPLE_TEST_SIGMA2_STATE NORMAL STOP'
2122
2223contains
@@ -171,13 +172,15 @@ subroutine exercise_update_preparation()
171172 logical :: active(4 )
172173 integer :: eo(4 ), groups(4 ), status
173174 integer (int64), parameter :: DIGEST = 991_int64
175+ integer (int64) :: next_gen
174176 character (len= 128 ) :: message
175177 character (len=* ), parameter :: COMMITTED = ' sigma2_state.bin'
176- candidate_path = sigma2_state_candidate_path(COMMITTED)
177- range_path = sigma2_state_range_path(COMMITTED, 2 , 3 )
178+ candidate_path = sigma2_state_candidate_path(COMMITTED, 1_int64 )
179+ range_path = sigma2_state_range_path(COMMITTED, 1_int64 , 2 , 3 )
178180 call del_file(COMMITTED)
179181 call del_file(candidate_path)
180182 call del_file(range_path)
183+ call del_file(sigma2_state_candidate_path(COMMITTED, 2_int64 ))
181184 spectra(:,1 ) = [1.0 ,2.0 ,3.0 ]
182185 spectra(:,2 ) = [2.0 ,3.0 ,4.0 ]
183186 spectra(:,3 ) = [3.0 ,4.0 ,5.0 ]
@@ -197,19 +200,80 @@ subroutine exercise_update_preparation()
197200 call require_ok(status, message)
198201 call sigma2_state_commit(candidate_path% to_char(), COMMITTED, active, eo, groups, status, message)
199202 call require_ok(status, message)
203+ call require(index (candidate_path% to_char(), ' sigma2_state.g1.next' ) > 0 , &
204+ &' candidate path is scoped to the generation it commits' )
205+ call require(index (range_path% to_char(), ' sigma2_state.g1.part002.range' ) > 0 , &
206+ &' canonical range path is scoped to the generation and includes the padded partition' )
207+ ! the next transaction is named for the generation it will commit
208+ call sigma2_state_next_generation(COMMITTED, next_gen, status, message)
209+ call require_ok(status, message)
210+ call require(next_gen == 2_int64 , ' next generation follows the committed one' )
211+ candidate_path = sigma2_state_candidate_path(COMMITTED, next_gen)
212+ call require(index (candidate_path% to_char(), ' sigma2_state.g2.next' ) > 0 , &
213+ &' next candidate path is scoped to the next generation' )
200214 call sigma2_state_prepare_update(COMMITTED, candidate_path% to_char(), status, message)
201215 call require_ok(status, message)
202216 call sigma2_state_read_header(candidate_path% to_char(), header, status, message)
203217 call require_ok(status, message)
204218 call require(header% generation == 2_int64 , ' prepared update advances the generation' )
205219 call require(header% provenance == SIGMA2_PROV_RESIDUAL, ' prepared update records residual provenance' )
206- call require(index (range_path% to_char(), ' sigma2_state_range_part002.bin' ) > 0 , &
207- &' canonical range path includes the padded partition' )
208220 call del_file(COMMITTED)
209221 call del_file(candidate_path)
210222 call del_file(range_path)
211223 end subroutine exercise_update_preparation
212224
225+ ! > an active record with a non-positive shell is skipped by the
226+ ! ! reduction (with a warning) instead of aborting; the grouped model
227+ ! ! is the mean of the valid records and commit-time validation agrees
228+ subroutine exercise_invalid_record_skip ()
229+ type (sigma2_state_header) :: header
230+ type (string) :: candidate_path, range_path
231+ real (real32), allocatable :: stored(:,:,:)
232+ real (real32) :: spectra(3 ,4 ), expected_even(3 ), expected_odd(3 )
233+ logical :: active(4 )
234+ integer :: eo(4 ), groups(4 ), status
235+ integer (int64), parameter :: DIGEST = 1231_int64
236+ character (len= 128 ) :: message
237+ character (len=* ), parameter :: COMMITTED = ' skip_sigma2_state.bin'
238+ candidate_path = sigma2_state_candidate_path(COMMITTED, 1_int64 )
239+ range_path = sigma2_state_range_path(COMMITTED, 1_int64 , 1 , 1 )
240+ call del_file(COMMITTED)
241+ call del_file(candidate_path)
242+ call del_file(range_path)
243+ spectra(:,1 ) = [1.0 ,2.0 ,3.0 ]
244+ spectra(:,2 ) = [2.0 ,3.0 ,4.0 ]
245+ spectra(:,3 ) = [3.0 ,0.0 ,5.0 ] ! invalid: a non-positive shell
246+ spectra(:,4 ) = [4.0 ,5.0 ,6.0 ]
247+ active = .true. ; eo = [0 ,1 ,0 ,1 ]; groups = 1
248+ expected_even = spectra(:,1 )
249+ expected_odd = 0.5 * (spectra(:,2 )+ spectra(:,4 ))
250+ call sigma2_state_init_header(header, 1 , 3 , 4 , 8 , 1.5 , 1 , SIGMA2_GROUP_GLOBAL, &
251+ &1_int64 , DIGEST, SIGMA2_PROV_PSPEC)
252+ call sigma2_state_create_candidate(candidate_path% to_char(), header, status, message)
253+ call require_ok(status, message)
254+ call sigma2_state_write_local_range(range_path% to_char(), 1_int64 , DIGEST, 1 , spectra, &
255+ &1 , 3 , status, message)
256+ call require_ok(status, message)
257+ call sigma2_state_merge_local_ranges(candidate_path% to_char(), [range_path], &
258+ &[.true. ,.true. ,.true. ,.true. ], status, message)
259+ call require_ok(status, message)
260+ call sigma2_state_reduce_groups(candidate_path% to_char(), active, eo, groups, status, message)
261+ call require(status == 0 , ' invalid record is skipped, not fatal' )
262+ call sigma2_state_read_groups(candidate_path% to_char(), stored, status, message)
263+ call require_ok(status, message)
264+ call require(all (abs (stored(:,1 ,1 )- expected_even) <= 1.e-6 * expected_even), &
265+ &' even group mean excludes the invalid record' )
266+ call require(all (abs (stored(:,2 ,1 )- expected_odd) <= 1.e-6 * expected_odd), &
267+ &' odd group mean is the mean of the valid records' )
268+ call sigma2_state_validate_science(candidate_path% to_char(), active, eo, groups, status, message)
269+ call require(status == 0 , ' commit-time validation applies the same skip rule' )
270+ call sigma2_state_commit(candidate_path% to_char(), COMMITTED, active, eo, groups, status, message)
271+ call require_ok(status, message)
272+ call del_file(COMMITTED)
273+ call del_file(candidate_path)
274+ call del_file(range_path)
275+ end subroutine exercise_invalid_record_skip
276+
213277 subroutine assert_committed_generation (path , expected )
214278 character (len=* ), intent (in ) :: path
215279 integer (int64), intent (in ) :: expected
0 commit comments