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,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.
|
||||
Reference in New Issue
Block a user