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.