Files
cobol-java-v3/benchmark-programs/24-table-search/main-table-search.cbl
NB-076 94400d50d4 feat: add benchmark-programs — 58 telecom COBOL test programs
作为子目录纳入系统,与核心测试管道协同

Co-Authored-By: Claude <noreply@anthropic.com>
2026-06-25 09:53:21 +08:00

213 lines
7.4 KiB
COBOL

*> ============================================================
*> 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.