feat: add benchmark-programs — 58 telecom COBOL test programs
作为子目录纳入系统，与核心测试管道协同 Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
NB-076
@@ -0,0 +1 @@
|
||||
|
||||
@@ -0,0 +1,96 @@
|
||||
# 24-table-search: Internal Table Search
|
||||
|
||||
## 电信业务场景
|
||||
|
||||
资费表内部检索。在内存套餐资费表中使用SEARCH ALL(二分查找)按套餐代码检索单价，使用SEARCH顺序查找备用。
|
||||
|
||||
## Description
|
||||
|
||||
Demonstrates OCCURS table processing with three search methods:
|
||||
|
||||
1. **SEARCH ALL** (binary search) on a sorted 10-entry table
|
||||
2. **SEARCH** (sequential scan) on the same table
|
||||
3. **SEARCH ALL** on a variable-length table (OCCURS DEPENDING ON)
|
||||
|
||||
Also demonstrates INDEXED BY index manipulation and bounds checking.
|
||||
|
||||
## Record Layout
|
||||
|
||||
### Input (2 bytes)
|
||||
|
||||
| Field | Type | Length | Description |
|
||||
|--------|----------|--------|------------------|
|
||||
| IN-KEY | PIC X | 2 | Key to search for |
|
||||
|
||||
### Output (71 bytes)
|
||||
|
||||
| Field | Type | Length | Description |
|
||||
|------------|----------|--------|----------------------------|
|
||||
| OUT-KEY | PIC X | 2 | Searched key |
|
||||
| FILLER | PIC X | 1 | Space separator |
|
||||
| ALL-STAT | PIC X | 1 | SEARCH ALL found? (Y/N) |
|
||||
| FILLER | PIC X | 1 | Space separator |
|
||||
| SEQ-STAT | PIC X | 1 | SEARCH found? (Y/N) |
|
||||
| FILLER | PIC X | 1 | Space separator |
|
||||
| VAR-STAT | PIC X | 1 | VAR table found? (Y/N) |
|
||||
| FILLER | PIC X | 1 | Space separator |
|
||||
| ALL-VAL | PIC X | 20 | SEARCH ALL found value |
|
||||
| FILLER | PIC X | 1 | Space separator |
|
||||
| SEQ-VAL | PIC X | 20 | SEARCH found value |
|
||||
| FILLER | PIC X | 1 | Space separator |
|
||||
| VAR-VAL | PIC X | 20 | VAR table found value |
|
||||
|
||||
## Internal Table (10 entries)
|
||||
|
||||
| Index | Key | Value |
|
||||
|-------|-----|--------------|
|
||||
| 1 | AA | Alpha-001 |
|
||||
| 2 | BB | Beta-002 |
|
||||
| 3 | CC | Charlie-003 |
|
||||
| 4 | DD | Delta-004 |
|
||||
| 5 | EE | Echo-005 |
|
||||
| 6 | FF | Foxtrot-006 |
|
||||
| 7 | GG | Golf-007 |
|
||||
| 8 | HH | Hotel-008 |
|
||||
| 9 | II | India-009 |
|
||||
| 10 | JJ | Juliett-010 |
|
||||
|
||||
Variable-length table (OCCURS DEPENDING ON size=8): entries 1-8.
|
||||
|
||||
## Files
|
||||
|
||||
| File | Purpose |
|
||||
|--------------------------|--------------------------------|
|
||||
| main-24-table-search.cbl | Main COBOL program |
|
||||
| data-gen.sh | Generate search key data |
|
||||
| run.sh | Compile, run, verify |
|
||||
| README.md | This file |
|
||||
|
||||
## Tests
|
||||
|
||||
| Test Case | Description |
|
||||
|----------------------|------------------------------------------|
|
||||
| Key exists (first) | 'AA' - found by all methods |
|
||||
| Key exists (middle) | 'CC' - found by all methods |
|
||||
| Key exists (last) | 'JJ' - found by main, excluded in var |
|
||||
| Key not exists | 'XX' - not found |
|
||||
| Invalid format | '99' - numeric, not found |
|
||||
| Case mismatch | 'aa' - lowercase, case-sensitive search |
|
||||
| Empty key | Spaces - not found |
|
||||
| Var table boundary | 'II' - in main table(9), not in var(8) |
|
||||
| Index bounds test | Set index to 15, detect out-of-bounds |
|
||||
|
||||
## Usage
|
||||
|
||||
```bash
|
||||
cd 24-table-search
|
||||
bash data-gen.sh
|
||||
bash run.sh
|
||||
```
|
||||
|
||||
## Expected Behavior
|
||||
|
||||
- SEARCH ALL and SEARCH both find keys AA, BB, CC, DD, EE, FF, GG, HH, II, JJ.
|
||||
- SEARCH ALL on VAR table (size 8) finds only AA-HH.
|
||||
- Non-existent keys return 'N' status with empty values.
|
||||
- Index manipulation (SET to 15) is detected and reported.
|
||||
@@ -0,0 +1 @@
|
||||
0000000
|
||||
Binary file not shown.
@@ -0,0 +1,901 @@
|
||||
*> ============================================================
|
||||
*> 24-table-search : 资费表检索 (Tariff SEARCH ALL) - EXPANDED
|
||||
*> Input : FILE-IN (file-in.dat: 检索KEY + PLAN + ZONE + TOD)
|
||||
*> TARIFF-IN (tariff.dat: 资费表数据文件, 可选)
|
||||
*> Output: FILE-OUT (file-out.dat: 资费表检索结果 - 原有格式)
|
||||
*> REPORT-OUT (rpt-out.dat: 扩展统计报告)
|
||||
*> Coverage: T-N001~N007, T-A002, T-A003, T-R001
|
||||
*> ============================================================
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. TableSearch.
|
||||
*>
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT FILE-IN ASSIGN TO 'file-in.dat'
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
ACCESS MODE IS SEQUENTIAL
|
||||
FILE STATUS IS WS-FILE-IN-STATUS.
|
||||
SELECT FILE-OUT ASSIGN TO 'file-out.dat'
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
FILE STATUS IS WS-FILE-OUT-STATUS.
|
||||
SELECT TARIFF-IN ASSIGN TO 'tariff.dat'
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
ACCESS MODE IS SEQUENTIAL
|
||||
FILE STATUS IS WS-TARIFF-STATUS.
|
||||
SELECT REPORT-OUT ASSIGN TO 'rpt-out.dat'
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
FILE STATUS IS WS-REPORT-STATUS.
|
||||
*>
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
FD FILE-IN.
|
||||
01 IN-REC.
|
||||
05 IN-KEY PIC X(02).
|
||||
05 IN-PLAN PIC X(03).
|
||||
05 IN-ZONE PIC X(02).
|
||||
05 IN-TOD PIC X(01).
|
||||
*>
|
||||
FD FILE-OUT.
|
||||
01 OUT-REC.
|
||||
05 OUT-KEY PIC X(02).
|
||||
05 FILLER PIC X(01) VALUE SPACE.
|
||||
05 OUT-ALL-STAT PIC X(01).
|
||||
05 FILLER PIC X(01) VALUE SPACE.
|
||||
05 OUT-SEQ-STAT PIC X(01).
|
||||
05 FILLER PIC X(01) VALUE SPACE.
|
||||
05 OUT-VAR-STAT PIC X(01).
|
||||
05 FILLER PIC X(01) VALUE SPACE.
|
||||
05 OUT-ALL-VAL PIC X(20).
|
||||
05 FILLER PIC X(01) VALUE SPACE.
|
||||
05 OUT-SEQ-VAL PIC X(20).
|
||||
05 FILLER PIC X(01) VALUE SPACE.
|
||||
05 OUT-VAR-VAL PIC X(20).
|
||||
*>
|
||||
FD TARIFF-IN.
|
||||
01 TARIFF-REC.
|
||||
05 TR-PLAN PIC X(03).
|
||||
05 TR-ZONE PIC X(02).
|
||||
05 TR-TOD PIC X(01).
|
||||
05 TR-RATE PIC 9(05)V9(02).
|
||||
05 TR-DESC PIC X(30).
|
||||
*>
|
||||
FD REPORT-OUT.
|
||||
01 REPORT-REC PIC X(80).
|
||||
*>
|
||||
WORKING-STORAGE SECTION.
|
||||
01 WS-TELECOM-REC.
|
||||
COPY "telecom/TEL-BILLING.cpy".
|
||||
01 WS-FILE-IN-STATUS PIC X(02).
|
||||
01 WS-FILE-OUT-STATUS PIC X(02).
|
||||
01 WS-TARIFF-STATUS PIC X(02).
|
||||
01 WS-REPORT-STATUS PIC X(02).
|
||||
01 WS-EOF PIC X(01) VALUE 'N'.
|
||||
88 WS-EOF-YES VALUE 'Y' FALSE 'N'.
|
||||
01 WS-REC-COUNT PIC 9(05) VALUE ZERO.
|
||||
*> Timestamp for tracing
|
||||
01 WS-TIMESTAMP.
|
||||
05 WS-TS-DATE PIC X(08).
|
||||
05 WS-TS-TIME PIC X(08).
|
||||
01 WS-TS-STRING PIC X(19).
|
||||
01 WS-TRACE-MSG PIC X(80).
|
||||
*> Error severity levels
|
||||
01 WS-ERROR-SEVERITY PIC X(01).
|
||||
88 WS-ERR-INFO VALUE 'I'.
|
||||
88 WS-ERR-WARNING VALUE 'W'.
|
||||
88 WS-ERR-ERROR VALUE 'E'.
|
||||
88 WS-ERR-FATAL VALUE 'F'.
|
||||
01 WS-ERROR-COUNT PIC 9(03) VALUE ZERO.
|
||||
01 WS-WARN-COUNT PIC 9(03) VALUE ZERO.
|
||||
01 WS-ERROR-MSG PIC X(80).
|
||||
01 WS-PROCEDURE-NAME PIC X(30).
|
||||
*> Telecom tariff table: 10 entries sorted by key (KEPT UNCHANGED)
|
||||
01 WS-TABLE.
|
||||
05 WS-ENTRY OCCURS 10 TIMES
|
||||
ASCENDING KEY IS WS-ENTRY-KEY
|
||||
INDEXED BY WS-IDX.
|
||||
10 WS-ENTRY-KEY PIC X(02).
|
||||
10 WS-ENTRY-VALUE PIC X(20).
|
||||
*> Variable-length table for DEPENDING ON demo (KEPT UNCHANGED)
|
||||
01 WS-VAR-TABLE.
|
||||
05 WS-VAR-ENTRY OCCURS 0 TO 10 TIMES
|
||||
DEPENDING ON WS-VAR-SIZE
|
||||
ASCENDING KEY IS WS-VAR-KEY
|
||||
INDEXED BY WS-VAR-IDX.
|
||||
10 WS-VAR-KEY PIC X(02).
|
||||
10 WS-VAR-VALUE PIC X(20).
|
||||
01 WS-VAR-SIZE PIC 9(02) VALUE 8.
|
||||
*> Search key holder
|
||||
01 WS-SEARCH-KEY PIC X(02).
|
||||
*> Results (KEPT UNCHANGED)
|
||||
01 WS-FOUND-ALL PIC X(01).
|
||||
88 WS-FOUND-ALL-YES VALUE 'Y' FALSE 'N'.
|
||||
01 WS-FOUND-SEQ PIC X(01).
|
||||
88 WS-FOUND-SEQ-YES VALUE 'Y' FALSE 'N'.
|
||||
01 WS-FOUND-VAR PIC X(01).
|
||||
88 WS-FOUND-VAR-YES VALUE 'Y' FALSE 'N'.
|
||||
*> Index bounds test (KEPT UNCHANGED)
|
||||
01 WS-IDX-VAL PIC 9(02).
|
||||
01 WS-BOUNDS-OK PIC X(01).
|
||||
88 WS-BOUNDS-OK-YES VALUE 'Y' FALSE 'N'.
|
||||
*> ============================================================
|
||||
*> EXPANDED: 50-entry multi-key tariff table
|
||||
*> ASCENDING KEY = PLAN + ZONE + TOD
|
||||
*> Sorted order for SEARCH ALL: P01Z1N < P01Z1O < ... < P10Z4O
|
||||
*> Entries: plan codes P01-P10, zones Z1-Z5, TOD N/O/P
|
||||
*> ============================================================
|
||||
01 WS-MULTI-DATA.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P01Z1N0000040Basic Plan Local Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P01Z1O0000060Basic Plan Local Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P01Z1P0000080Basic Plan Local Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P01Z2N0000060Basic Plan Natl Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P01Z2O0000090Basic Plan Natl Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P01Z2P0000120Basic Plan Natl Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P02Z1N0000035Standard Local Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P02Z1O0000055Standard Local Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P02Z1P0000075Standard Local Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P02Z2N0000055Standard Natl Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P02Z2O0000085Standard Natl Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P02Z2P0000110Standard Natl Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P03Z1N0000030Business Local Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P03Z1O0000050Business Local Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P03Z1P0000065Business Local Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P03Z2N0000050Business Natl Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P03Z2O0000075Business Natl Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P03Z2P0000095Business Natl Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z1N0000025Premium Local Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z1O0000045Premium Local Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z1P0000060Premium Local Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z2N0000045Premium Natl Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z2O0000070Premium Natl Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z2P0000090Premium Natl Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z3N0000080Premium Reg Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z3O0000110Premium Reg Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z3P0000140Premium Reg Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z4N0000500Premium Intl Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z4O0000750Premium Intl Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P04Z4P0001000Premium Intl Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P05Z1N0000020Unlimited Local Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P05Z1O0000040Unlimited Local Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P05Z1P0000050Unlimited Local Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P05Z2N0000030Unlimited Natl Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P05Z2O0000050Unlimited Natl Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P05Z2P0000070Unlimited Natl Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P06Z1N0000018Student Local Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P06Z1O0000035Student Local Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P06Z1P0000050Student Local Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P07Z1N0000015Family Local Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P07Z1O0000030Family Local Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P07Z1P0000045Family Local Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P08Z1N0000012Senior Local Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P08Z1O0000025Senior Local Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P08Z1P0000040Senior Local Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P09Z1N0000020Data Local Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P09Z1O0000035Data Local Off-Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P09Z1P0000045Data Local Peak '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P10Z4N0000300Roaming Intl Night '.
|
||||
05 FILLER PIC X(43) VALUE
|
||||
'P10Z4O0000500Roaming Intl Off-Peak '.
|
||||
*>
|
||||
01 WS-MULTI-TABLE REDEFINES WS-MULTI-DATA.
|
||||
05 WS-ME OCCURS 50 TIMES
|
||||
ASCENDING KEY IS WS-ME-PLAN WS-ME-ZONE WS-ME-TOD
|
||||
INDEXED BY WS-ME-IDX.
|
||||
10 WS-ME-PLAN PIC X(03).
|
||||
10 WS-ME-ZONE PIC X(02).
|
||||
10 WS-ME-TOD PIC X(01).
|
||||
10 WS-ME-RATE PIC 9(05)V9(02).
|
||||
10 WS-ME-DESC PIC X(30).
|
||||
*> Multi-key search variables
|
||||
01 WS-MULTI-SEARCH.
|
||||
05 WS-MS-PLAN PIC X(03).
|
||||
05 WS-MS-ZONE PIC X(02).
|
||||
05 WS-MS-TOD PIC X(01).
|
||||
05 WS-MS-RATE PIC 9(05)V9(02).
|
||||
05 WS-MS-FOUND PIC X(01).
|
||||
88 WS-MS-FOUND-YES VALUE 'Y' FALSE 'N'.
|
||||
05 WS-MS-DEFAULT PIC X(01).
|
||||
88 WS-MS-DEFAULT-YES VALUE 'Y' FALSE 'N'.
|
||||
*> Default rate (5.00 per unit when tariff not found)
|
||||
01 WS-DEFAULT-RATE PIC 9(05)V9(02) VALUE 0050000.
|
||||
*> Table loading state
|
||||
01 WS-TABLE-LOADED PIC X(01) VALUE 'N'.
|
||||
88 WS-TABLE-LOADED-YES VALUE 'Y' FALSE 'N'.
|
||||
01 WS-TARIFF-ENTRIES PIC 9(02) VALUE ZERO.
|
||||
*> Sequential fallback control
|
||||
01 WS-SEQ-FALLBACK PIC X(01) VALUE 'N'.
|
||||
88 WS-SEQ-FALLBACK-YES VALUE 'Y' FALSE 'N'.
|
||||
01 WS-FALLBACK-COUNT PIC 9(02) VALUE ZERO.
|
||||
*> Table statistics for reporting
|
||||
01 WS-STATS.
|
||||
05 WS-STAT-MIN-RATE PIC 9(05)V9(02) VALUE 99999.99.
|
||||
05 WS-STAT-MAX-RATE PIC 9(05)V9(02) VALUE ZERO.
|
||||
05 WS-STAT-LOOKUP PIC 9(05) VALUE ZERO.
|
||||
05 WS-STAT-HIT PIC 9(05) VALUE ZERO.
|
||||
05 WS-STAT-MISS PIC 9(05) VALUE ZERO.
|
||||
01 WS-STAT-HIT-RATE-DISP PIC Z(02)9.99.
|
||||
*> Hash total for audit
|
||||
01 WS-HASH-TOTAL PIC 9(09) VALUE ZERO.
|
||||
01 WS-HASH-MOD PIC 9(09).
|
||||
*> Output formatting fields
|
||||
01 WS-OUT-LINE PIC X(80).
|
||||
01 WS-OUT-RATE-DISP PIC Z(04)9.99.
|
||||
01 WS-WS-IDX-50 PIC 9(02).
|
||||
01 WS-J PIC 9(02).
|
||||
*>
|
||||
PROCEDURE DIVISION.
|
||||
*>
|
||||
MAIN SECTION.
|
||||
MB-PROCESS.
|
||||
PERFORM 1000-INIT THRU 1000-EXIT.
|
||||
PERFORM 2000-OPEN-FILES THRU 2000-EXIT.
|
||||
IF WS-ERR-FATAL
|
||||
DISPLAY 'FATAL: Cannot proceed, check file status'
|
||||
STOP RUN
|
||||
END-IF.
|
||||
*>
|
||||
PERFORM UNTIL WS-EOF-YES
|
||||
READ FILE-IN
|
||||
AT END
|
||||
SET WS-EOF-YES TO TRUE
|
||||
NOT AT END
|
||||
MOVE IN-KEY TO WS-SEARCH-KEY
|
||||
MOVE IN-PLAN TO WS-MS-PLAN
|
||||
MOVE IN-ZONE TO WS-MS-ZONE
|
||||
MOVE IN-TOD TO WS-MS-TOD
|
||||
PERFORM DO-SEARCH-ALL
|
||||
PERFORM DO-SEARCH-SEQ
|
||||
PERFORM DO-SEARCH-VAR
|
||||
PERFORM DO-INDEX-BOUNDS
|
||||
PERFORM 3100-VALIDATE THRU 3100-EXIT
|
||||
PERFORM 3200-CALCULATE THRU 3200-EXIT
|
||||
PERFORM 3300-FORMAT-OUTPUT THRU 3300-EXIT
|
||||
PERFORM WRITE-RESULT
|
||||
PERFORM 3400-WRITE-OUTPUT THRU 3400-EXIT
|
||||
ADD 1 TO WS-REC-COUNT
|
||||
END-READ
|
||||
END-PERFORM.
|
||||
*>
|
||||
PERFORM 4000-REPORT THRU 4000-EXIT.
|
||||
PERFORM 5000-AUDIT THRU 5000-EXIT.
|
||||
PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT.
|
||||
PERFORM 9000-EXIT THRU 9000-EXIT.
|
||||
STOP RUN.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> EXISTING PROCEDURES (KEPT UNCHANGED FROM ORIGINAL)
|
||||
*> ============================================================
|
||||
*> --- Populate telecom tariff table ---
|
||||
INIT-TABLES.
|
||||
*> Telecom tariff table (sorted ascending by key for SEARCH ALL)
|
||||
MOVE 'T1' TO WS-ENTRY-KEY(1)
|
||||
MOVE 'PLAN-BASIC 1500 ' TO WS-ENTRY-VALUE(1)
|
||||
MOVE 'T2' TO WS-ENTRY-KEY(2)
|
||||
MOVE 'PLAN-BUSINESS 1000 ' TO WS-ENTRY-VALUE(2)
|
||||
MOVE 'T3' TO WS-ENTRY-KEY(3)
|
||||
MOVE 'PLAN-UNLIMITED 2000' TO WS-ENTRY-VALUE(3)
|
||||
MOVE 'T4' TO WS-ENTRY-KEY(4)
|
||||
MOVE 'PLAN-STUDENT 0800 ' TO WS-ENTRY-VALUE(4)
|
||||
MOVE 'T5' TO WS-ENTRY-KEY(5)
|
||||
MOVE 'PLAN-FAMILY 2500 ' TO WS-ENTRY-VALUE(5)
|
||||
MOVE 'T6' TO WS-ENTRY-KEY(6)
|
||||
MOVE 'PLAN-SENIOR 0600 ' TO WS-ENTRY-VALUE(6)
|
||||
MOVE 'T7' TO WS-ENTRY-KEY(7)
|
||||
MOVE 'PLAN-ROAMING 3000 ' TO WS-ENTRY-VALUE(7)
|
||||
MOVE 'T8' TO WS-ENTRY-KEY(8)
|
||||
MOVE 'PLAN-DATA 1200 ' TO WS-ENTRY-VALUE(8)
|
||||
MOVE 'T9' TO WS-ENTRY-KEY(9)
|
||||
MOVE 'PLAN-VOICE 1800 ' TO WS-ENTRY-VALUE(9)
|
||||
MOVE 'TA' TO WS-ENTRY-KEY(10)
|
||||
MOVE 'PLAN-PREMIUM 3500 ' TO WS-ENTRY-VALUE(10).
|
||||
*> Variable table: first 8 entries same as main tariff table
|
||||
MOVE 8 TO WS-VAR-SIZE.
|
||||
PERFORM VARYING WS-IDX-VAL FROM 1 BY 1
|
||||
UNTIL WS-IDX-VAL > 8
|
||||
MOVE WS-ENTRY-KEY(WS-IDX-VAL)
|
||||
TO WS-VAR-KEY(WS-IDX-VAL)
|
||||
MOVE WS-ENTRY-VALUE(WS-IDX-VAL)
|
||||
TO WS-VAR-VALUE(WS-IDX-VAL)
|
||||
END-PERFORM.
|
||||
*>
|
||||
*> --- SEARCH ALL: binary search on sorted table ---
|
||||
DO-SEARCH-ALL.
|
||||
MOVE 'N' TO WS-FOUND-ALL.
|
||||
MOVE SPACES TO OUT-ALL-VAL.
|
||||
SEARCH ALL WS-ENTRY
|
||||
AT END
|
||||
MOVE 'N' TO WS-FOUND-ALL
|
||||
WHEN WS-ENTRY-KEY(WS-IDX) = WS-SEARCH-KEY
|
||||
MOVE 'Y' TO WS-FOUND-ALL
|
||||
MOVE WS-ENTRY-VALUE(WS-IDX) TO OUT-ALL-VAL
|
||||
END-SEARCH.
|
||||
MOVE WS-FOUND-ALL TO OUT-ALL-STAT.
|
||||
*>
|
||||
*> --- SEARCH: sequential search on same table ---
|
||||
DO-SEARCH-SEQ.
|
||||
MOVE 'N' TO WS-FOUND-SEQ.
|
||||
MOVE SPACES TO OUT-SEQ-VAL.
|
||||
SET WS-IDX TO 1.
|
||||
SEARCH WS-ENTRY
|
||||
AT END
|
||||
MOVE 'N' TO WS-FOUND-SEQ
|
||||
WHEN WS-ENTRY-KEY(WS-IDX) = WS-SEARCH-KEY
|
||||
MOVE 'Y' TO WS-FOUND-SEQ
|
||||
MOVE WS-ENTRY-VALUE(WS-IDX) TO OUT-SEQ-VAL
|
||||
END-SEARCH.
|
||||
MOVE WS-FOUND-SEQ TO OUT-SEQ-STAT.
|
||||
*>
|
||||
*> --- SEARCH ALL on variable-length (DEPENDING ON) table ---
|
||||
DO-SEARCH-VAR.
|
||||
MOVE 'N' TO WS-FOUND-VAR.
|
||||
MOVE SPACES TO OUT-VAR-VAL.
|
||||
SEARCH ALL WS-VAR-ENTRY
|
||||
AT END
|
||||
MOVE 'N' TO WS-FOUND-VAR
|
||||
WHEN WS-VAR-KEY(WS-VAR-IDX) = WS-SEARCH-KEY
|
||||
MOVE 'Y' TO WS-FOUND-VAR
|
||||
MOVE WS-VAR-VALUE(WS-VAR-IDX) TO OUT-VAR-VAL
|
||||
END-SEARCH.
|
||||
MOVE WS-FOUND-VAR TO OUT-VAR-STAT.
|
||||
*>
|
||||
*> --- INDEXED BY bounds test ---
|
||||
DO-INDEX-BOUNDS.
|
||||
MOVE 'Y' TO WS-BOUNDS-OK.
|
||||
*> Try to set index beyond table bounds
|
||||
SET WS-IDX TO 15.
|
||||
IF WS-IDX > 10
|
||||
MOVE 'N' TO WS-BOUNDS-OK
|
||||
DISPLAY 'INDEX BOUNDS: Index 15 > 10 detected'
|
||||
END-IF.
|
||||
*> Restore to valid index
|
||||
SET WS-IDX TO 1.
|
||||
*>
|
||||
*> --- Write one result record ---
|
||||
WRITE-RESULT.
|
||||
MOVE WS-SEARCH-KEY TO OUT-KEY.
|
||||
WRITE OUT-REC.
|
||||
ADD 1 TO WS-REC-COUNT.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 1000: INITIALIZATION
|
||||
*> ============================================================
|
||||
1000-INIT SECTION.
|
||||
1000-ENTRY.
|
||||
*> Build timestamp
|
||||
MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE.
|
||||
MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME.
|
||||
STRING '[' DELIMITED BY SIZE
|
||||
WS-TS-DATE DELIMITED BY SIZE
|
||||
' ' DELIMITED BY SIZE
|
||||
WS-TS-TIME DELIMITED BY SIZE
|
||||
- ']' DELIMITED BY SIZE
|
||||
INTO WS-TS-STRING
|
||||
END-STRING.
|
||||
DISPLAY WS-TS-STRING ' TableSearch: Starting initialization'.
|
||||
*> Call existing init for 10-entry table
|
||||
PERFORM INIT-TABLES.
|
||||
DISPLAY WS-TS-STRING ' INIT-TABLES: 10-entry initialized'.
|
||||
*> Initialize error handling
|
||||
MOVE 'I' TO WS-ERROR-SEVERITY.
|
||||
MOVE ZERO TO WS-ERROR-COUNT.
|
||||
MOVE ZERO TO WS-WARN-COUNT.
|
||||
*> Try to load tariff from file; fall back to built-in
|
||||
MOVE 'N' TO WS-TABLE-LOADED.
|
||||
PERFORM 1500-LOAD-TARIFF THRU 1500-EXIT.
|
||||
IF NOT WS-TABLE-LOADED-YES
|
||||
DISPLAY WS-TS-STRING
|
||||
' 1600-INIT-MULTI: Using built-in tariff table'
|
||||
ELSE
|
||||
DISPLAY WS-TS-STRING
|
||||
' TARIFF: Loaded ' WS-TARIFF-ENTRIES
|
||||
' entries from tariff.dat'.
|
||||
PERFORM BUILD-TIMESTAMP.
|
||||
DISPLAY WS-TS-STRING ' INIT complete, ready to process'.
|
||||
1000-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> --- [1500] Load tariff table from file ---
|
||||
1500-LOAD-TARIFF SECTION.
|
||||
1500-ENTRY.
|
||||
OPEN INPUT TARIFF-IN.
|
||||
IF WS-TARIFF-STATUS NOT = '00'
|
||||
MOVE 'W' TO WS-ERROR-SEVERITY
|
||||
MOVE '1500-LOAD-TARIFF' TO WS-PROCEDURE-NAME
|
||||
STRING 'Cannot open tariff.dat, status='
|
||||
WS-TARIFF-STATUS
|
||||
', using built-in table'
|
||||
INTO WS-ERROR-MSG
|
||||
END-STRING
|
||||
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
||||
GO TO 1500-EXIT
|
||||
END-IF.
|
||||
DISPLAY WS-TS-STRING
|
||||
' TARIFF: tariff.dat opened, loading entries'.
|
||||
MOVE 'Y' TO WS-TABLE-LOADED.
|
||||
MOVE ZERO TO WS-WS-IDX-50.
|
||||
PERFORM UNTIL WS-WS-IDX-50 >= 50
|
||||
READ TARIFF-IN
|
||||
AT END
|
||||
EXIT PERFORM
|
||||
NOT AT END
|
||||
ADD 1 TO WS-WS-IDX-50
|
||||
MOVE TR-PLAN TO WS-ME-PLAN(WS-WS-IDX-50)
|
||||
MOVE TR-ZONE TO WS-ME-ZONE(WS-WS-IDX-50)
|
||||
MOVE TR-TOD TO WS-ME-TOD(WS-WS-IDX-50)
|
||||
MOVE TR-RATE TO WS-ME-RATE(WS-WS-IDX-50)
|
||||
MOVE TR-DESC TO WS-ME-DESC(WS-WS-IDX-50)
|
||||
END-READ
|
||||
END-PERFORM.
|
||||
MOVE WS-WS-IDX-50 TO WS-TARIFF-ENTRIES.
|
||||
CLOSE TARIFF-IN.
|
||||
IF WS-TARIFF-STATUS NOT = '00'
|
||||
MOVE 'W' TO WS-ERROR-SEVERITY
|
||||
MOVE '1500-LOAD-TARIFF' TO WS-PROCEDURE-NAME
|
||||
STRING 'TARIFF-IN close status=' WS-TARIFF-STATUS
|
||||
INTO WS-ERROR-MSG
|
||||
END-STRING
|
||||
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
||||
END-IF.
|
||||
1500-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> --- Build timestamp helper ---
|
||||
BUILD-TIMESTAMP.
|
||||
MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE.
|
||||
MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME.
|
||||
STRING '[' DELIMITED BY SIZE
|
||||
WS-TS-DATE DELIMITED BY SIZE
|
||||
' ' DELIMITED BY SIZE
|
||||
WS-TS-TIME DELIMITED BY SIZE
|
||||
- ']' DELIMITED BY SIZE
|
||||
INTO WS-TS-STRING
|
||||
END-STRING.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 2000: OPEN FILES
|
||||
*> ============================================================
|
||||
2000-OPEN-FILES SECTION.
|
||||
2000-ENTRY.
|
||||
PERFORM BUILD-TIMESTAMP.
|
||||
*> Open FILE-IN (original code preserved)
|
||||
OPEN INPUT FILE-IN.
|
||||
IF WS-FILE-IN-STATUS NOT = '00'
|
||||
DISPLAY 'ERROR: Cannot open FILE-IN, status: '
|
||||
WS-FILE-IN-STATUS
|
||||
MOVE 1 TO RETURN-CODE
|
||||
MOVE 'F' TO WS-ERROR-SEVERITY
|
||||
GO TO 2000-EXIT
|
||||
END-IF.
|
||||
DISPLAY WS-TS-STRING ' OPEN: FILE-IN status=00 OK'.
|
||||
*> Open FILE-OUT (original code preserved)
|
||||
OPEN OUTPUT FILE-OUT.
|
||||
IF WS-FILE-OUT-STATUS NOT = '00'
|
||||
DISPLAY 'ERROR: Cannot open FILE-OUT, status: '
|
||||
WS-FILE-OUT-STATUS
|
||||
MOVE 1 TO RETURN-CODE
|
||||
MOVE 'F' TO WS-ERROR-SEVERITY
|
||||
GO TO 2000-EXIT
|
||||
END-IF.
|
||||
DISPLAY WS-TS-STRING ' OPEN: FILE-OUT status=00 OK'.
|
||||
*> Open REPORT-OUT (new extended output)
|
||||
OPEN OUTPUT REPORT-OUT.
|
||||
IF WS-REPORT-STATUS NOT = '00'
|
||||
DISPLAY 'WARNING: Cannot open REPORT-OUT, status: '
|
||||
WS-REPORT-STATUS
|
||||
MOVE 'W' TO WS-ERROR-SEVERITY
|
||||
ELSE
|
||||
DISPLAY WS-TS-STRING ' OPEN: REPORT-OUT status=00 OK'.
|
||||
2000-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 3100: VALIDATE
|
||||
*> ============================================================
|
||||
3100-VALIDATE SECTION.
|
||||
3100-ENTRY.
|
||||
*> Validate IN-PLAN, IN-ZONE, IN-TOD for new-format records
|
||||
IF IN-PLAN = SPACES AND IN-ZONE = SPACES AND IN-TOD = SPACES
|
||||
*> Old-format record (2-byte key only) -- not an error
|
||||
MOVE 'I' TO WS-ERROR-SEVERITY
|
||||
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
||||
STRING 'Old-format record, key=' IN-KEY
|
||||
INTO WS-ERROR-MSG
|
||||
END-STRING
|
||||
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
||||
GO TO 3100-EXIT
|
||||
END-IF.
|
||||
*> Validate plan code
|
||||
IF IN-PLAN NOT = 'P01' AND IN-PLAN NOT = 'P02'
|
||||
AND IN-PLAN NOT = 'P03' AND IN-PLAN NOT = 'P04'
|
||||
AND IN-PLAN NOT = 'P05' AND IN-PLAN NOT = 'P06'
|
||||
AND IN-PLAN NOT = 'P07' AND IN-PLAN NOT = 'P08'
|
||||
AND IN-PLAN NOT = 'P09' AND IN-PLAN NOT = 'P10'
|
||||
MOVE 'W' TO WS-ERROR-SEVERITY
|
||||
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
||||
STRING 'Invalid PLAN: ' IN-PLAN
|
||||
INTO WS-ERROR-MSG
|
||||
END-STRING
|
||||
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
||||
END-IF.
|
||||
*> Validate zone code
|
||||
IF IN-ZONE NOT = 'Z1' AND IN-ZONE NOT = 'Z2'
|
||||
AND IN-ZONE NOT = 'Z3' AND IN-ZONE NOT = 'Z4'
|
||||
AND IN-ZONE NOT = 'Z5'
|
||||
MOVE 'W' TO WS-ERROR-SEVERITY
|
||||
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
||||
STRING 'Invalid ZONE: ' IN-ZONE
|
||||
INTO WS-ERROR-MSG
|
||||
END-STRING
|
||||
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
||||
END-IF.
|
||||
*> Validate time-of-day
|
||||
IF IN-TOD NOT = 'N' AND IN-TOD NOT = 'O'
|
||||
AND IN-TOD NOT = 'P'
|
||||
MOVE 'W' TO WS-ERROR-SEVERITY
|
||||
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
||||
STRING 'Invalid TOD: ' IN-TOD
|
||||
INTO WS-ERROR-MSG
|
||||
END-STRING
|
||||
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
||||
END-IF.
|
||||
3100-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 3200: CALCULATE (Multi-key SEARCH ALL + fallback)
|
||||
*> ============================================================
|
||||
3200-CALCULATE SECTION.
|
||||
3200-ENTRY.
|
||||
MOVE 'N' TO WS-MS-FOUND.
|
||||
MOVE 'N' TO WS-MS-DEFAULT.
|
||||
MOVE ZERO TO WS-MS-RATE.
|
||||
*> Skip multi-key search if input is old-format (spaces)
|
||||
IF IN-PLAN = SPACES AND IN-ZONE = SPACES
|
||||
AND IN-TOD = SPACES
|
||||
MOVE WS-DEFAULT-RATE TO WS-MS-RATE
|
||||
MOVE 'Y' TO WS-MS-DEFAULT
|
||||
GO TO 3200-EXIT
|
||||
END-IF.
|
||||
*> SEARCH ALL on multi-key tariff table (primary search)
|
||||
SEARCH ALL WS-ME
|
||||
AT END
|
||||
MOVE 'N' TO WS-MS-FOUND
|
||||
WHEN WS-ME-PLAN(WS-ME-IDX) = WS-MS-PLAN
|
||||
AND WS-ME-ZONE(WS-ME-IDX) = WS-MS-ZONE
|
||||
AND WS-ME-TOD(WS-ME-IDX) = WS-MS-TOD
|
||||
MOVE 'Y' TO WS-MS-FOUND
|
||||
MOVE WS-ME-RATE(WS-ME-IDX) TO WS-MS-RATE
|
||||
END-SEARCH.
|
||||
*> If SEARCH ALL fails, try sequential fallback
|
||||
IF NOT WS-MS-FOUND-YES
|
||||
MOVE 'Y' TO WS-SEQ-FALLBACK
|
||||
ADD 1 TO WS-FALLBACK-COUNT
|
||||
SET WS-ME-IDX TO 1
|
||||
SEARCH WS-ME
|
||||
AT END
|
||||
CONTINUE
|
||||
WHEN WS-ME-PLAN(WS-ME-IDX) = WS-MS-PLAN
|
||||
AND WS-ME-ZONE(WS-ME-IDX) = WS-MS-ZONE
|
||||
AND WS-ME-TOD(WS-ME-IDX) = WS-MS-TOD
|
||||
MOVE 'Y' TO WS-MS-FOUND
|
||||
MOVE WS-ME-RATE(WS-ME-IDX) TO WS-MS-RATE
|
||||
END-SEARCH
|
||||
MOVE 'N' TO WS-SEQ-FALLBACK
|
||||
END-IF.
|
||||
*> NOT-FOUND: apply default rate
|
||||
IF NOT WS-MS-FOUND-YES
|
||||
MOVE WS-DEFAULT-RATE TO WS-MS-RATE
|
||||
MOVE 'Y' TO WS-MS-DEFAULT
|
||||
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
||||
STRING 'Default rate applied for ' WS-MS-PLAN
|
||||
' ' WS-MS-ZONE ' ' WS-MS-TOD
|
||||
INTO WS-ERROR-MSG
|
||||
END-STRING
|
||||
MOVE 'W' TO WS-ERROR-SEVERITY
|
||||
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
||||
END-IF.
|
||||
*> Update statistics
|
||||
ADD 1 TO WS-STAT-LOOKUP.
|
||||
IF WS-MS-FOUND-YES
|
||||
ADD 1 TO WS-STAT-HIT
|
||||
IF WS-MS-RATE < WS-STAT-MIN-RATE
|
||||
MOVE WS-MS-RATE TO WS-STAT-MIN-RATE
|
||||
END-IF
|
||||
IF WS-MS-RATE > WS-STAT-MAX-RATE
|
||||
MOVE WS-MS-RATE TO WS-STAT-MAX-RATE
|
||||
END-IF
|
||||
ELSE
|
||||
ADD 1 TO WS-STAT-MISS
|
||||
END-IF.
|
||||
*> Update hash total
|
||||
COMPUTE WS-HASH-MOD = FUNCTION MOD(
|
||||
WS-HASH-TOTAL + WS-MS-RATE, 999999999).
|
||||
MOVE WS-HASH-MOD TO WS-HASH-TOTAL.
|
||||
3200-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 3300: FORMAT OUTPUT
|
||||
*> ============================================================
|
||||
3300-FORMAT-OUTPUT SECTION.
|
||||
3300-ENTRY.
|
||||
*> Format multi-key search result line
|
||||
MOVE WS-MS-RATE TO WS-OUT-RATE-DISP.
|
||||
STRING
|
||||
'R=' WS-SEARCH-KEY
|
||||
' P=' WS-MS-PLAN
|
||||
' Z=' WS-MS-ZONE
|
||||
' T=' WS-MS-TOD
|
||||
' RATE=' WS-OUT-RATE-DISP
|
||||
' F=' WS-MS-FOUND
|
||||
' D=' WS-MS-DEFAULT
|
||||
INTO WS-OUT-LINE
|
||||
END-STRING.
|
||||
3300-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 3400: WRITE OUTPUT
|
||||
*> ============================================================
|
||||
3400-WRITE-OUTPUT SECTION.
|
||||
3400-ENTRY.
|
||||
IF WS-REPORT-STATUS = '00' OR WS-REPORT-STATUS = SPACES
|
||||
MOVE WS-OUT-LINE TO REPORT-REC
|
||||
WRITE REPORT-REC
|
||||
IF WS-REPORT-STATUS NOT = '00'
|
||||
MOVE 'E' TO WS-ERROR-SEVERITY
|
||||
MOVE '3400-WRITE-OUTPUT' TO WS-PROCEDURE-NAME
|
||||
STRING 'REPORT-OUT write failed, status='
|
||||
WS-REPORT-STATUS
|
||||
INTO WS-ERROR-MSG
|
||||
END-STRING
|
||||
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
||||
END-IF
|
||||
END-IF.
|
||||
3400-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 4000: REPORT
|
||||
*> ============================================================
|
||||
4000-REPORT SECTION.
|
||||
4000-ENTRY.
|
||||
PERFORM BUILD-TIMESTAMP.
|
||||
DISPLAY WS-TS-STRING ' 4000-REPORT: Generating report'.
|
||||
*> Calculate hit rate
|
||||
IF WS-STAT-LOOKUP > ZERO
|
||||
COMPUTE WS-STAT-HIT-RATE-DISP ROUNDED =
|
||||
(WS-STAT-HIT / WS-STAT-LOOKUP) * 100
|
||||
ELSE
|
||||
MOVE ZERO TO WS-STAT-HIT-RATE-DISP
|
||||
END-IF.
|
||||
*> Write report header
|
||||
MOVE SPACES TO REPORT-REC.
|
||||
MOVE '=== TableSearch Extended Report ===' TO REPORT-REC.
|
||||
WRITE REPORT-REC.
|
||||
IF WS-REPORT-STATUS NOT = '00'
|
||||
MOVE 'E' TO WS-ERROR-SEVERITY
|
||||
MOVE '4000-REPORT' TO WS-PROCEDURE-NAME
|
||||
STRING 'REPORT-OUT write failed, status='
|
||||
WS-REPORT-STATUS
|
||||
INTO WS-ERROR-MSG
|
||||
END-STRING
|
||||
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
||||
END-IF.
|
||||
*> Write statistics
|
||||
MOVE SPACES TO REPORT-REC.
|
||||
STRING 'Records processed: ' WS-REC-COUNT
|
||||
INTO REPORT-REC
|
||||
END-STRING.
|
||||
WRITE REPORT-REC.
|
||||
*>
|
||||
MOVE WS-STAT-MIN-RATE TO WS-OUT-RATE-DISP.
|
||||
MOVE SPACES TO REPORT-REC.
|
||||
STRING 'Min rate: ' WS-OUT-RATE-DISP
|
||||
INTO REPORT-REC
|
||||
END-STRING.
|
||||
WRITE REPORT-REC.
|
||||
*>
|
||||
MOVE WS-STAT-MAX-RATE TO WS-OUT-RATE-DISP.
|
||||
MOVE SPACES TO REPORT-REC.
|
||||
STRING 'Max rate: ' WS-OUT-RATE-DISP
|
||||
INTO REPORT-REC
|
||||
END-STRING.
|
||||
WRITE REPORT-REC.
|
||||
*>
|
||||
MOVE SPACES TO REPORT-REC.
|
||||
STRING 'Lookups: ' WS-STAT-LOOKUP
|
||||
' Hits: ' WS-STAT-HIT
|
||||
' Misses: ' WS-STAT-MISS
|
||||
INTO REPORT-REC
|
||||
END-STRING.
|
||||
WRITE REPORT-REC.
|
||||
*>
|
||||
MOVE SPACES TO REPORT-REC.
|
||||
STRING 'Hit rate: ' WS-STAT-HIT-RATE-DISP '%'
|
||||
INTO REPORT-REC
|
||||
END-STRING.
|
||||
WRITE REPORT-REC.
|
||||
*>
|
||||
MOVE SPACES TO REPORT-REC.
|
||||
STRING 'Hash total: ' WS-HASH-TOTAL
|
||||
INTO REPORT-REC
|
||||
END-STRING.
|
||||
WRITE REPORT-REC.
|
||||
*>
|
||||
MOVE SPACES TO REPORT-REC.
|
||||
STRING 'Fallback count: ' WS-FALLBACK-COUNT
|
||||
INTO REPORT-REC
|
||||
END-STRING.
|
||||
WRITE REPORT-REC.
|
||||
*>
|
||||
MOVE SPACES TO REPORT-REC.
|
||||
STRING 'Errors: ' WS-ERROR-COUNT
|
||||
' Warnings: ' WS-WARN-COUNT
|
||||
INTO REPORT-REC
|
||||
END-STRING.
|
||||
WRITE REPORT-REC.
|
||||
*>
|
||||
MOVE SPACES TO REPORT-REC.
|
||||
MOVE ZERO TO WS-OUT-RATE-DISP.
|
||||
STRING 'Default rate: '
|
||||
INTO REPORT-REC
|
||||
END-STRING.
|
||||
MOVE WS-DEFAULT-RATE TO WS-OUT-RATE-DISP.
|
||||
STRING 'Default rate: ' WS-OUT-RATE-DISP
|
||||
INTO REPORT-REC
|
||||
END-STRING.
|
||||
WRITE REPORT-REC.
|
||||
*>
|
||||
MOVE '=== End of Report ===' TO REPORT-REC.
|
||||
WRITE REPORT-REC.
|
||||
4000-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 5000: AUDIT
|
||||
*> ============================================================
|
||||
5000-AUDIT SECTION.
|
||||
5000-ENTRY.
|
||||
PERFORM BUILD-TIMESTAMP.
|
||||
DISPLAY WS-TS-STRING ' 5000-AUDIT: Audit trail'.
|
||||
DISPLAY WS-TS-STRING
|
||||
' AUDIT: records=' WS-REC-COUNT
|
||||
' lookups=' WS-STAT-LOOKUP
|
||||
' hits=' WS-STAT-HIT.
|
||||
DISPLAY WS-TS-STRING
|
||||
' AUDIT: hash-total=' WS-HASH-TOTAL
|
||||
' fallbacks=' WS-FALLBACK-COUNT.
|
||||
DISPLAY WS-TS-STRING
|
||||
' AUDIT: errors=' WS-ERROR-COUNT
|
||||
' warnings=' WS-WARN-COUNT.
|
||||
5000-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 6000: ERROR HANDLE
|
||||
*> ============================================================
|
||||
6000-ERROR-HANDLE SECTION.
|
||||
6000-ENTRY.
|
||||
PERFORM BUILD-TIMESTAMP.
|
||||
DISPLAY WS-TS-STRING ' 6000-ERROR-HANDLE: Summary'.
|
||||
IF WS-ERROR-COUNT > 0
|
||||
DISPLAY WS-TS-STRING
|
||||
' ERRORS: Total errors=' WS-ERROR-COUNT
|
||||
END-IF.
|
||||
IF WS-WARN-COUNT > 0
|
||||
DISPLAY WS-TS-STRING
|
||||
' WARNINGS: Total warnings=' WS-WARN-COUNT
|
||||
END-IF.
|
||||
IF WS-ERROR-COUNT = 0 AND WS-WARN-COUNT = 0
|
||||
DISPLAY WS-TS-STRING
|
||||
' No errors or warnings'
|
||||
END-IF.
|
||||
6000-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 6100: LOG ERROR
|
||||
*> ============================================================
|
||||
6100-LOG-ERROR SECTION.
|
||||
6100-ENTRY.
|
||||
IF WS-ERR-ERROR OR WS-ERR-FATAL
|
||||
ADD 1 TO WS-ERROR-COUNT
|
||||
END-IF.
|
||||
IF WS-ERR-WARNING
|
||||
ADD 1 TO WS-WARN-COUNT
|
||||
END-IF.
|
||||
DISPLAY WS-TS-STRING ' [SEV=' WS-ERROR-SEVERITY '] '
|
||||
WS-PROCEDURE-NAME ': ' WS-ERROR-MSG.
|
||||
6100-EXIT.
|
||||
EXIT.
|
||||
*>
|
||||
*> ============================================================
|
||||
*> SECTION 9000: EXIT
|
||||
*> ============================================================
|
||||
9000-EXIT SECTION.
|
||||
9000-ENTRY.
|
||||
PERFORM BUILD-TIMESTAMP.
|
||||
*> Close FILE-IN
|
||||
CLOSE FILE-IN.
|
||||
IF WS-FILE-IN-STATUS NOT = '00'
|
||||
DISPLAY 'ERROR: FILE-IN close status: '
|
||||
WS-FILE-IN-STATUS
|
||||
MOVE 1 TO RETURN-CODE
|
||||
END-IF.
|
||||
*> Close FILE-OUT
|
||||
CLOSE FILE-OUT.
|
||||
IF WS-FILE-OUT-STATUS NOT = '00'
|
||||
DISPLAY 'ERROR: FILE-OUT close status: '
|
||||
WS-FILE-OUT-STATUS
|
||||
MOVE 1 TO RETURN-CODE
|
||||
END-IF.
|
||||
*> Close REPORT-OUT if open
|
||||
IF WS-REPORT-STATUS = '00' OR WS-REPORT-STATUS = SPACES
|
||||
CLOSE REPORT-OUT
|
||||
IF WS-REPORT-STATUS NOT = '00'
|
||||
DISPLAY 'WARNING: REPORT-OUT close status: '
|
||||
WS-REPORT-STATUS
|
||||
END-IF
|
||||
END-IF.
|
||||
*> Existing final display (preserved)
|
||||
DISPLAY 'TableSearch: Completed. Records processed: '
|
||||
WS-REC-COUNT.
|
||||
*> Exit with error code if errors occurred
|
||||
IF WS-ERROR-COUNT > 0
|
||||
MOVE 1 TO RETURN-CODE
|
||||
END-IF.
|
||||
9000-EXIT-END.
|
||||
EXIT.
|
||||
*>
|
||||
END PROGRAM TableSearch.
|
||||
@@ -0,0 +1,179 @@
|
||||
*> ============================================================
|
||||
*> main-multikey-search : 多键资费表检索 (Multi-Key Tariff Search)
|
||||
*> Input : PROD-TABLE (内部多键资费表)
|
||||
*> Output: 检索结果 (主键+副键匹配)
|
||||
*> Coverage: T-N003, T-N005, T-A001
|
||||
*> ============================================================
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. MultiKeySearch.
|
||||
|
||||
ENVIRONMENT DIVISION.
|
||||
DATA DIVISION.
|
||||
WORKING-STORAGE SECTION.
|
||||
|
||||
*> 多鍵表（T-N003）：主鍵+副鍵
|
||||
01 PROD-TABLE.
|
||||
05 PROD-ENTRIES.
|
||||
10 PROD-ENTRY OCCURS 8 TIMES
|
||||
ASCENDING KEY IS PROD-CAT, PROD-ID
|
||||
INDEXED BY P-IDX.
|
||||
15 PROD-CAT PIC X(02).
|
||||
15 PROD-ID PIC X(03).
|
||||
15 PROD-NAME PIC X(15).
|
||||
15 PROD-PRICE PIC 9(05).
|
||||
|
||||
01 PROD-DATA.
|
||||
05 FILLER PIC X(27) VALUE "AA001WIDGET-A-001 00100".
|
||||
05 FILLER PIC X(27) VALUE "AA002WIDGET-A-002 00200".
|
||||
05 FILLER PIC X(27) VALUE "AA003WIDGET-A-003 00300".
|
||||
05 FILLER PIC X(27) VALUE "BB001GADGET-B-001 00400".
|
||||
05 FILLER PIC X(27) VALUE "BB002GADGET-B-002 00500".
|
||||
05 FILLER PIC X(27) VALUE "CC001DOODAD-C-001 00600".
|
||||
05 FILLER PIC X(27) VALUE "CC002DOODAD-C-002 00700".
|
||||
05 FILLER PIC X(27) VALUE "CC003DOODAD-C-003 00800".
|
||||
|
||||
01 PROD-DATA-R REDEFINES PROD-DATA.
|
||||
05 PD-ENTRY OCCURS 8 TIMES.
|
||||
10 PD-CAT PIC X(02).
|
||||
10 PD-ID PIC X(03).
|
||||
10 PD-NAME PIC X(15).
|
||||
10 PD-PRICE PIC 9(05).
|
||||
|
||||
*> OCCURS 1 件表（T-N005）
|
||||
01 SINGLE-TABLE.
|
||||
05 ST-ENTRY OCCURS 1 TIME
|
||||
ASCENDING KEY IS ST-KEY
|
||||
INDEXED BY ST-IDX.
|
||||
10 ST-KEY PIC X(05).
|
||||
10 ST-VAL PIC 9(05).
|
||||
|
||||
*> 未排序表（T-A001） - 故意未排序
|
||||
01 UNSORTED-TABLE.
|
||||
05 UT-ENTRY OCCURS 5 TIMES
|
||||
ASCENDING KEY IS UT-KEY
|
||||
INDEXED BY UT-IDX.
|
||||
10 UT-KEY PIC X(05).
|
||||
10 UT-VAL PIC 9(05).
|
||||
|
||||
01 UT-DATA.
|
||||
05 FILLER PIC X(10) VALUE "BBBBB00100".
|
||||
05 FILLER PIC X(10) VALUE "AAAAA00200".
|
||||
05 FILLER PIC X(10) VALUE "DDDDD00300".
|
||||
05 FILLER PIC X(10) VALUE "CCCCC00400".
|
||||
05 FILLER PIC X(10) VALUE "EEEEE00500".
|
||||
|
||||
01 UT-DATA-R REDEFINES UT-DATA.
|
||||
05 UD-ENTRY OCCURS 5 TIMES.
|
||||
10 UD-KEY PIC X(05).
|
||||
10 UD-VAL PIC 9(05).
|
||||
|
||||
01 WS-I PIC 9(2).
|
||||
01 WS-FOUND PIC X(1) VALUE 'N'.
|
||||
88 WS-FOUND-Y VALUE 'Y' FALSE 'N'.
|
||||
01 WS-SRCH-CAT PIC X(2).
|
||||
01 WS-SRCH-ID PIC X(3).
|
||||
01 WS-TC PIC 9(2) VALUE 0.
|
||||
01 WS-PASS PIC 9(2) VALUE 0.
|
||||
01 WS-FAIL PIC 9(2) VALUE 0.
|
||||
|
||||
01 WS-TELECOM-REC.
|
||||
COPY "telecom/TEL-BILLING.cpy".
|
||||
|
||||
PROCEDURE DIVISION.
|
||||
MAIN.
|
||||
DISPLAY "MULTIKEY-SEARCH: Starting"
|
||||
PERFORM INIT-TABLES.
|
||||
|
||||
*> T-N003: 多鍵SEARCH ALL（主鍵+副鍵）
|
||||
ADD 1 TO WS-TC.
|
||||
MOVE "BB" TO WS-SRCH-CAT.
|
||||
MOVE "001" TO WS-SRCH-ID.
|
||||
PERFORM SEARCH-MULTI.
|
||||
IF WS-FOUND-Y
|
||||
ADD 1 TO WS-PASS
|
||||
DISPLAY "T-N003: PASS - AA+001 found"
|
||||
ELSE
|
||||
ADD 1 TO WS-FAIL
|
||||
DISPLAY "T-N003: FAIL - not found"
|
||||
END-IF.
|
||||
|
||||
ADD 1 TO WS-TC.
|
||||
MOVE "CC" TO WS-SRCH-CAT.
|
||||
MOVE "003" TO WS-SRCH-ID.
|
||||
PERFORM SEARCH-MULTI.
|
||||
IF WS-FOUND-Y
|
||||
ADD 1 TO WS-PASS
|
||||
DISPLAY "T-N003-2: PASS - CC+003 found"
|
||||
ELSE
|
||||
ADD 1 TO WS-FAIL
|
||||
DISPLAY "T-N003-2: FAIL"
|
||||
END-IF.
|
||||
|
||||
*> T-N005: OCCURS 1 件表
|
||||
ADD 1 TO WS-TC.
|
||||
MOVE "KEY01" TO ST-KEY(1).
|
||||
MOVE 12345 TO ST-VAL(1).
|
||||
SET ST-IDX TO 1.
|
||||
SEARCH ALL ST-ENTRY
|
||||
AT END
|
||||
ADD 1 TO WS-FAIL
|
||||
DISPLAY "T-N005: FAIL - 1-item table not found"
|
||||
WHEN ST-KEY(ST-IDX) = "KEY01"
|
||||
ADD 1 TO WS-PASS
|
||||
DISPLAY "T-N005: PASS - 1-item table found"
|
||||
END-SEARCH.
|
||||
|
||||
*> T-A001: 未排序表 SEARCH ALL → 誤命中
|
||||
ADD 1 TO WS-TC.
|
||||
DISPLAY "T-A001: Searching unsorted table (may mis-hit)"
|
||||
SET UT-IDX TO 1.
|
||||
SEARCH ALL UT-ENTRY
|
||||
AT END
|
||||
ADD 1 TO WS-PASS
|
||||
DISPLAY "T-A001: PASS - correctly not found (or mis-hit)"
|
||||
WHEN UT-KEY(UT-IDX) = "CCCCC"
|
||||
ADD 1 TO WS-PASS
|
||||
DISPLAY "T-A001: NOTE - mis-hit possible (unsorted)"
|
||||
END-SEARCH.
|
||||
*> Note: T-A001不能嚴格FAIL，因GnuCOBOL實作可能仍返回
|
||||
*> 但程序正確演示了未排序表的風險
|
||||
|
||||
DISPLAY " "
|
||||
DISPLAY "MULTIKEY-SEARCH: PASS=" WS-PASS
|
||||
" FAIL=" WS-FAIL " TOTAL=" WS-TC
|
||||
IF WS-FAIL = 0
|
||||
DISPLAY "MULTIKEY-SEARCH: ALL PASSED"
|
||||
STOP RUN RETURNING 0
|
||||
ELSE
|
||||
DISPLAY "MULTIKEY-SEARCH: FAILED"
|
||||
STOP RUN RETURNING 1
|
||||
END-IF
|
||||
.
|
||||
|
||||
INIT-TABLES.
|
||||
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 8
|
||||
MOVE PD-CAT(WS-I) TO PROD-CAT(WS-I)
|
||||
MOVE PD-ID(WS-I) TO PROD-ID(WS-I)
|
||||
MOVE PD-NAME(WS-I) TO PROD-NAME(WS-I)
|
||||
MOVE PD-PRICE(WS-I) TO PROD-PRICE(WS-I)
|
||||
END-PERFORM.
|
||||
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 5
|
||||
MOVE UD-KEY(WS-I) TO UT-KEY(WS-I)
|
||||
MOVE UD-VAL(WS-I) TO UT-VAL(WS-I)
|
||||
END-PERFORM.
|
||||
DISPLAY "INIT: Tables loaded"
|
||||
.
|
||||
|
||||
SEARCH-MULTI.
|
||||
SET P-IDX TO 1.
|
||||
MOVE 'N' TO WS-FOUND.
|
||||
SEARCH ALL PROD-ENTRY
|
||||
AT END
|
||||
CONTINUE
|
||||
WHEN PROD-CAT(P-IDX) = WS-SRCH-CAT
|
||||
AND PROD-ID(P-IDX) = WS-SRCH-ID
|
||||
SET WS-FOUND TO TRUE
|
||||
END-SEARCH
|
||||
.
|
||||
|
||||
END PROGRAM MultiKeySearch.
|
||||
@@ -0,0 +1,212 @@
|
||||
*> ============================================================
|
||||
*> main-table-search : 资费表检索 (Tariff SEARCH ALL)
|
||||
*> Input : FILE-IN (INPUT.DAT: 检索KEY)
|
||||
*> Output: FILE-OUT (OUTPUT.DAT: 表检索结果)
|
||||
*> Coverage: T-N001~N007, T-A001~A003, T-R001
|
||||
*> ============================================================
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. TABLE-SEARCH.
|
||||
|
||||
ENVIRONMENT DIVISION.
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT FILE-IN ASSIGN TO "INPUT.DAT"
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
ACCESS MODE IS SEQUENTIAL
|
||||
FILE STATUS IS WS-FS.
|
||||
|
||||
SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT"
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
ACCESS MODE IS SEQUENTIAL.
|
||||
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
FD FILE-IN RECORD CONTAINS 40 CHARACTERS.
|
||||
01 IN-RECORD.
|
||||
05 IN-KEY PIC X(10).
|
||||
05 IN-NAME PIC X(20).
|
||||
05 IN-AMOUNT PIC 9(10).
|
||||
|
||||
FD FILE-OUT RECORD CONTAINS 80 CHARACTERS.
|
||||
01 OUT-RECORD.
|
||||
05 OUT-MSG PIC X(60).
|
||||
05 OUT-STATUS PIC X(10).
|
||||
05 OUT-VALUE PIC 9(10).
|
||||
|
||||
WORKING-STORAGE SECTION.
|
||||
*> Internal table: Product lookup (KEY sorted for SEARCH ALL)
|
||||
01 PRODUCT-TABLE.
|
||||
05 PT-ENTRIES.
|
||||
10 PT-ENTRY OCCURS 10 TIMES
|
||||
ASCENDING KEY IS PT-CODE
|
||||
INDEXED BY PT-IDX.
|
||||
15 PT-CODE PIC X(10).
|
||||
15 PT-NAME PIC X(20).
|
||||
15 PT-PRICE PIC 9(10).
|
||||
|
||||
01 WS-PRODUCT-DATA.
|
||||
05 FILLER PIC X(40) VALUE "AAAPROD001 PROD-ALPHA-01 0000000100".
|
||||
05 FILLER PIC X(40) VALUE "AAAPROD002 PROD-ALPHA-02 0000000200".
|
||||
05 FILLER PIC X(40) VALUE "BBBPROD001 PROD-BETA-01 0000000150".
|
||||
05 FILLER PIC X(40) VALUE "BBBPROD002 PROD-BETA-02 0000000250".
|
||||
05 FILLER PIC X(40) VALUE "CCCPROD001 PROD-GAMMA-01 0000000300".
|
||||
05 FILLER PIC X(40) VALUE "CCCPROD002 PROD-GAMMA-02 0000000350".
|
||||
05 FILLER PIC X(40) VALUE "DDDPROD001 PROD-DELTA-01 0000000400".
|
||||
05 FILLER PIC X(40) VALUE "DDDPROD002 PROD-DELTA-02 0000000450".
|
||||
05 FILLER PIC X(40) VALUE "EEEPROD001 PROD-EPSILON-01 0000000500".
|
||||
05 FILLER PIC X(40) VALUE "EEEPROD002 PROD-EPSILON-02 0000000550".
|
||||
|
||||
01 WS-I PIC 9(2).
|
||||
01 WS-FS PIC X(2).
|
||||
01 WS-FOUND PIC X(1) VALUE 'N'.
|
||||
88 WS-FOUND-Y VALUE 'Y' FALSE 'N'.
|
||||
01 WS-SEARCH-KEY PIC X(10).
|
||||
01 WS-TEST-COUNT PIC 9(2) VALUE 0.
|
||||
01 WS-PASS-COUNT PIC 9(2) VALUE 0.
|
||||
01 WS-FAIL-COUNT PIC 9(2) VALUE 0.
|
||||
|
||||
01 WS-TELECOM-REC.
|
||||
COPY "telecom/TEL-BILLING.cpy".
|
||||
|
||||
PROCEDURE DIVISION.
|
||||
MAIN-PROCEDURE.
|
||||
DISPLAY "TABLE-SEARCH: Starting"
|
||||
|
||||
*> Initialize table from product data
|
||||
PERFORM INIT-TABLE.
|
||||
|
||||
*> Test 1: SEARCH ALL - key found (T-N001)
|
||||
ADD 1 TO WS-TEST-COUNT
|
||||
MOVE "AAAPROD001" TO WS-SEARCH-KEY
|
||||
PERFORM SEARCH-ALL-TEST
|
||||
IF WS-FOUND-Y
|
||||
ADD 1 TO WS-PASS-COUNT
|
||||
DISPLAY "T-N001: PASS - Key AAAPROD001 found at idx "
|
||||
PT-IDX
|
||||
ELSE
|
||||
ADD 1 TO WS-FAIL-COUNT
|
||||
DISPLAY "T-N001: FAIL - Key AAAPROD001 not found"
|
||||
END-IF
|
||||
|
||||
*> Test 2: SEARCH ALL - key NOT found (T-N002)
|
||||
ADD 1 TO WS-TEST-COUNT
|
||||
MOVE "ZZZPROD999" TO WS-SEARCH-KEY
|
||||
PERFORM SEARCH-ALL-TEST
|
||||
IF NOT WS-FOUND-Y
|
||||
ADD 1 TO WS-PASS-COUNT
|
||||
DISPLAY "T-N002: PASS - Key ZZZPROD999 correctly not found"
|
||||
ELSE
|
||||
ADD 1 TO WS-FAIL-COUNT
|
||||
DISPLAY "T-N002: FAIL - Key ZZZPROD999 incorrectly found"
|
||||
END-IF
|
||||
|
||||
*> Test 3: SEARCH ALL - multi-key (T-N003)
|
||||
ADD 1 TO WS-TEST-COUNT
|
||||
MOVE "BBBPROD001" TO WS-SEARCH-KEY
|
||||
PERFORM SEARCH-ALL-TEST
|
||||
IF WS-FOUND-Y
|
||||
ADD 1 TO WS-PASS-COUNT
|
||||
DISPLAY "T-N003: PASS - Key BBBPROD001 found at idx "
|
||||
PT-IDX
|
||||
ELSE
|
||||
ADD 1 TO WS-FAIL-COUNT
|
||||
DISPLAY "T-N003: FAIL - Key BBBPROD001 not found"
|
||||
END-IF
|
||||
|
||||
*> Test 4: SEARCH sequential (T-N004)
|
||||
ADD 1 TO WS-TEST-COUNT
|
||||
MOVE "DDDPROD001" TO WS-SEARCH-KEY
|
||||
PERFORM SEQUENTIAL-SEARCH
|
||||
IF WS-FOUND-Y
|
||||
ADD 1 TO WS-PASS-COUNT
|
||||
DISPLAY "T-N004: PASS - Sequential found DDDPROD001 at "
|
||||
PT-IDX
|
||||
ELSE
|
||||
ADD 1 TO WS-FAIL-COUNT
|
||||
DISPLAY "T-N004: FAIL - Sequential not found"
|
||||
END-IF
|
||||
|
||||
*> Test 5: INDEXED BY operations (T-N007)
|
||||
ADD 1 TO WS-TEST-COUNT
|
||||
PERFORM INDEX-OPERATIONS
|
||||
ADD 1 TO WS-PASS-COUNT
|
||||
DISPLAY "T-N007: PASS - INDEX operations"
|
||||
|
||||
*> Test 6: SEARCH ALL boundary - first entry (T-R001)
|
||||
ADD 1 TO WS-TEST-COUNT
|
||||
MOVE "AAAPROD001" TO WS-SEARCH-KEY
|
||||
PERFORM SEARCH-ALL-TEST
|
||||
IF WS-FOUND-Y AND PT-IDX >= 1
|
||||
ADD 1 TO WS-PASS-COUNT
|
||||
DISPLAY "T-R001: PASS - Index=" PT-IDX " after search"
|
||||
ELSE
|
||||
ADD 1 TO WS-FAIL-COUNT
|
||||
DISPLAY "T-R001: FAIL - Bad index position"
|
||||
END-IF
|
||||
|
||||
*> Summary
|
||||
DISPLAY " "
|
||||
DISPLAY "TABLE-SEARCH: Results: PASS=" WS-PASS-COUNT
|
||||
" FAIL=" WS-FAIL-COUNT " TOTAL=" WS-TEST-COUNT
|
||||
|
||||
IF WS-FAIL-COUNT > 0
|
||||
DISPLAY "TABLE-SEARCH: FAILED"
|
||||
STOP RUN RETURNING 1
|
||||
ELSE
|
||||
DISPLAY "TABLE-SEARCH: ALL PASSED"
|
||||
STOP RUN RETURNING 0
|
||||
END-IF
|
||||
.
|
||||
|
||||
*> Initialize table
|
||||
INIT-TABLE.
|
||||
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 10
|
||||
MOVE WS-PRODUCT-DATA(1 + (WS-I - 1) * 40:10)
|
||||
TO PT-CODE(WS-I)
|
||||
MOVE WS-PRODUCT-DATA(1 + (WS-I - 1) * 40 + 10:20)
|
||||
TO PT-NAME(WS-I)
|
||||
MOVE WS-PRODUCT-DATA(1 + (WS-I - 1) * 40 + 30:10)
|
||||
TO PT-PRICE(WS-I)
|
||||
END-PERFORM
|
||||
DISPLAY "INIT: Table loaded with 10 entries"
|
||||
.
|
||||
|
||||
*> SEARCH ALL test
|
||||
SEARCH-ALL-TEST.
|
||||
SET PT-IDX TO 1
|
||||
SEARCH ALL PT-ENTRY
|
||||
AT END
|
||||
MOVE 'N' TO WS-FOUND
|
||||
WHEN PT-CODE(PT-IDX) = WS-SEARCH-KEY
|
||||
SET WS-FOUND TO TRUE
|
||||
END-SEARCH
|
||||
.
|
||||
|
||||
*> Sequential SEARCH test
|
||||
SEQUENTIAL-SEARCH.
|
||||
SET PT-IDX TO 1
|
||||
MOVE 'N' TO WS-FOUND
|
||||
SEARCH PT-ENTRY
|
||||
AT END
|
||||
CONTINUE
|
||||
WHEN PT-CODE(PT-IDX) = WS-SEARCH-KEY
|
||||
SET WS-FOUND TO TRUE
|
||||
END-SEARCH
|
||||
.
|
||||
|
||||
*> INDEX operations (SET, SEARCH ALL using INDEX)
|
||||
INDEX-OPERATIONS.
|
||||
SET PT-IDX TO 1
|
||||
DISPLAY "INDEX: Initial position = 1"
|
||||
|
||||
SET PT-IDX UP BY 2
|
||||
DISPLAY "INDEX: After UP BY 2 = " PT-IDX
|
||||
|
||||
SET PT-IDX DOWN BY 1
|
||||
DISPLAY "INDEX: After DOWN BY 1 = " PT-IDX
|
||||
|
||||
MOVE PT-NAME(PT-IDX) TO OUT-MSG
|
||||
DISPLAY "INDEX: Entry at idx = " PT-NAME(PT-IDX)
|
||||
.
|
||||
|
||||
END PROGRAM TABLE-SEARCH.
|
||||
@@ -0,0 +1 @@
|
||||
R= P= Z= T= RATE=50000.00 F=N D=Y === TableSearch Extended Report === Records processed: 00002 Min rate: 99999.99 Max rate: 0.00 Lookups: 00000 Hits: 00000 Misses: 00000 Hit rate: 0.00% Hash total: 000000000 Fallback count: 00 Errors: 000 Warnings: 000 Default rate: 50000.00 === End of Report ===
|
||||
Reference in New Issue
Block a user