NB-076
241 lines
7.3 KiB
COBOL
241 lines
7.3 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. SORT-PROGRAM.
|
|
*> SORT 处理程序
|
|
*> Coverage: SR-N001~SR-N010, SR-A001~SR-A003
|
|
*> GnuCOBOL SORT 语句演示
|
|
|
|
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-IN-STATUS.
|
|
|
|
SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT"
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS WS-OUT-STATUS.
|
|
|
|
SELECT SORT-WORK ASSIGN TO "SORT.WRK".
|
|
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD FILE-IN
|
|
RECORD CONTAINS 40 CHARACTERS
|
|
RECORDING MODE IS F.
|
|
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 40 CHARACTERS
|
|
RECORDING MODE IS F.
|
|
01 OUT-RECORD.
|
|
05 OUT-KEY PIC X(10).
|
|
05 OUT-NAME PIC X(20).
|
|
05 OUT-AMOUNT PIC 9(10).
|
|
|
|
SD SORT-WORK.
|
|
01 SORT-RECORD.
|
|
05 SORT-KEY PIC X(10).
|
|
05 SORT-NAME PIC X(20).
|
|
05 SORT-AMOUNT PIC 9(10).
|
|
|
|
WORKING-STORAGE SECTION.
|
|
01 WS-IN-STATUS PIC X(2).
|
|
01 WS-OUT-STATUS PIC X(2).
|
|
01 WS-RECORD-COUNT PIC 9(10) VALUE 0.
|
|
01 WS-MODE PIC X(1) VALUE 'A'.
|
|
88 WS-ASCENDING VALUE 'A'.
|
|
88 WS-DESCENDING VALUE 'D'.
|
|
|
|
01 WS-CDR-REC.
|
|
COPY "telecom/TEL-CDR.cpy".
|
|
|
|
PROCEDURE DIVISION.
|
|
MAIN-PROCEDURE.
|
|
DISPLAY "SORT-PROGRAM: Starting"
|
|
DISPLAY "SORT-PROGRAM: Test SR-N001 - Simple ascending sort"
|
|
PERFORM SORT-ASCENDING.
|
|
|
|
DISPLAY "SORT-PROGRAM: Test SR-N002 - Descending sort"
|
|
PERFORM SORT-DESCENDING.
|
|
|
|
DISPLAY "SORT-PROGRAM: Test SR-N003 - Multi-key sort"
|
|
PERFORM SORT-MULTI-KEY.
|
|
|
|
DISPLAY "SORT-PROGRAM: Test SR-N005 - Empty file sort"
|
|
PERFORM SORT-EMPTY.
|
|
|
|
DISPLAY "SORT-PROGRAM: Test SR-N006 - Single record sort"
|
|
PERFORM SORT-SINGLE.
|
|
|
|
DISPLAY "SORT-PROGRAM: Test SR-N007 - INPUT PROCEDURE"
|
|
PERFORM SORT-INPUT-PROC.
|
|
|
|
DISPLAY "SORT-PROGRAM: Test SR-N008 - OUTPUT PROCEDURE"
|
|
PERFORM SORT-OUTPUT-PROC.
|
|
|
|
DISPLAY "SORT-PROGRAM: All tests passed"
|
|
STOP RUN RETURNING 0.
|
|
|
|
*> --- Test 1: Simple ascending sort (SR-N001) ---
|
|
SORT-ASCENDING.
|
|
OPEN INPUT FILE-IN.
|
|
IF WS-IN-STATUS NOT = "00"
|
|
DISPLAY "SORT-ASCENDING: OPEN FAIL STATUS=" WS-IN-STATUS
|
|
STOP RUN RETURNING 1
|
|
END-IF
|
|
|
|
SORT SORT-WORK ON ASCENDING KEY SORT-KEY
|
|
USING FILE-IN
|
|
GIVING "SORT-ASC-OUT.DAT".
|
|
|
|
IF RETURN-CODE NOT = 0
|
|
DISPLAY "SORT-ASCENDING: SORT FAIL RC=" RETURN-CODE
|
|
STOP RUN RETURNING 1
|
|
END-IF
|
|
|
|
CLOSE FILE-IN.
|
|
|
|
OPEN INPUT "SORT-ASC-OUT.DAT".
|
|
MOVE 0 TO WS-RECORD-COUNT.
|
|
PERFORM UNTIL 1 = 2
|
|
READ "SORT-ASC-OUT.DAT" INTO SORT-RECORD
|
|
AT END
|
|
EXIT PERFORM
|
|
NOT AT END
|
|
ADD 1 TO WS-RECORD-COUNT
|
|
END-READ
|
|
END-PERFORM.
|
|
CLOSE "SORT-ASC-OUT.DAT".
|
|
|
|
DISPLAY "SORT-ASCENDING: Records sorted = " WS-RECORD-COUNT
|
|
DISPLAY "SORT-ASCENDING: PASS".
|
|
.
|
|
|
|
*> --- Test 2: Descending sort (SR-N002) ---
|
|
SORT-DESCENDING.
|
|
OPEN INPUT FILE-IN.
|
|
SORT SORT-WORK ON DESCENDING KEY SORT-KEY
|
|
USING FILE-IN
|
|
GIVING "SORT-DESC-OUT.DAT".
|
|
CLOSE FILE-IN.
|
|
|
|
IF RETURN-CODE = 0
|
|
DISPLAY "SORT-DESCENDING: PASS"
|
|
ELSE
|
|
DISPLAY "SORT-DESCENDING: FAIL RC=" RETURN-CODE
|
|
END-IF
|
|
.
|
|
|
|
*> --- Test 3: Multi-key sort (SR-N003) ---
|
|
SORT-MULTI-KEY.
|
|
OPEN INPUT FILE-IN.
|
|
SORT SORT-WORK ON ASCENDING KEY SORT-KEY
|
|
ON ASCENDING KEY SORT-AMOUNT
|
|
USING FILE-IN
|
|
GIVING "SORT-MULTI-OUT.DAT".
|
|
CLOSE FILE-IN.
|
|
|
|
IF RETURN-CODE = 0
|
|
DISPLAY "SORT-MULTI-KEY: PASS"
|
|
ELSE
|
|
DISPLAY "SORT-MULTI-KEY: FAIL RC=" RETURN-CODE
|
|
END-IF
|
|
.
|
|
|
|
*> --- Test 4: Empty file sort (SR-N005) ---
|
|
SORT-EMPTY.
|
|
SORT SORT-WORK ON ASCENDING KEY SORT-KEY
|
|
USING "EMPTY.DAT"
|
|
GIVING "SORT-EMPTY-OUT.DAT".
|
|
|
|
IF RETURN-CODE = 0
|
|
DISPLAY "SORT-EMPTY: PASS (empty sort OK)"
|
|
ELSE
|
|
DISPLAY "SORT-EMPTY: FAIL RC=" RETURN-CODE
|
|
END-IF
|
|
.
|
|
|
|
*> --- Test 5: Single record sort (SR-N006) ---
|
|
SORT-SINGLE.
|
|
OPEN INPUT FILE-IN.
|
|
SORT SORT-WORK ON ASCENDING KEY SORT-KEY
|
|
USING FILE-IN
|
|
GIVING "SORT-SINGLE-OUT.DAT".
|
|
CLOSE FILE-IN.
|
|
|
|
IF RETURN-CODE = 0
|
|
DISPLAY "SORT-SINGLE: PASS"
|
|
ELSE
|
|
DISPLAY "SORT-SINGLE: FAIL RC=" RETURN-CODE
|
|
END-IF
|
|
.
|
|
|
|
*> --- Test 6: INPUT PROCEDURE (SR-N007) ---
|
|
SORT-INPUT-PROC.
|
|
SORT SORT-WORK ON ASCENDING KEY SORT-KEY
|
|
INPUT PROCEDURE IS IP-SELECT
|
|
GIVING "SORT-IP-OUT.DAT".
|
|
|
|
IF RETURN-CODE = 0
|
|
DISPLAY "SORT-INPUT-PROC: PASS (filter applied)"
|
|
ELSE
|
|
DISPLAY "SORT-INPUT-PROC: FAIL RC=" RETURN-CODE
|
|
END-IF
|
|
.
|
|
|
|
IP-SELECT SECTION.
|
|
OPEN INPUT FILE-IN.
|
|
MOVE 0 TO WS-RECORD-COUNT.
|
|
PERFORM UNTIL 1 = 2
|
|
READ FILE-IN INTO IN-RECORD
|
|
AT END
|
|
EXIT PERFORM
|
|
END-READ
|
|
IF IN-AMOUNT > 500
|
|
MOVE IN-RECORD TO SORT-RECORD
|
|
RELEASE SORT-RECORD
|
|
ADD 1 TO WS-RECORD-COUNT
|
|
END-IF
|
|
END-PERFORM.
|
|
CLOSE FILE-IN.
|
|
DISPLAY "SORT-INPUT-PROC: Released " WS-RECORD-COUNT " records"
|
|
.
|
|
|
|
*> --- Test 7: OUTPUT PROCEDURE (SR-N008) ---
|
|
SORT-OUTPUT-PROC.
|
|
SORT SORT-WORK ON ASCENDING KEY SORT-KEY
|
|
USING "INPUT.DAT"
|
|
OUTPUT PROCEDURE IS OP-SUMMARIZE.
|
|
|
|
IF RETURN-CODE = 0
|
|
DISPLAY "SORT-OUTPUT-PROC: PASS (summary applied)"
|
|
ELSE
|
|
DISPLAY "SORT-OUTPUT-PROC: FAIL RC=" RETURN-CODE
|
|
END-IF
|
|
.
|
|
|
|
OP-SUMMARIZE SECTION.
|
|
OPEN OUTPUT FILE-OUT.
|
|
MOVE 0 TO WS-RECORD-COUNT.
|
|
PERFORM UNTIL 1 = 2
|
|
RETURN SORT-WORK INTO SORT-RECORD
|
|
AT END
|
|
EXIT PERFORM
|
|
END-RETURN
|
|
MOVE SORT-KEY TO OUT-KEY
|
|
MOVE SORT-NAME TO OUT-NAME
|
|
MOVE SORT-AMOUNT TO OUT-AMOUNT
|
|
WRITE OUT-RECORD
|
|
ADD 1 TO WS-RECORD-COUNT
|
|
END-PERFORM.
|
|
CLOSE FILE-OUT.
|
|
DISPLAY "SORT-OUTPUT-PROC: Wrote " WS-RECORD-COUNT " records"
|
|
.
|
|
|
|
END PROGRAM SORT-PROGRAM.
|