NB-076
180 lines
6.3 KiB
COBOL
180 lines
6.3 KiB
COBOL
*> ============================================================
|
||
*> 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.
|