192 lines
6.3 KiB
COBOL
192 lines
6.3 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. TEST05B.
|
|
AUTHOR. Bernard GIROUD.
|
|
*REMARKS. Value and Initialize statement
|
|
ENVIRONMENT DIVISION.
|
|
* INPUT-OUTPUT SECTION.
|
|
* FILE-CONTROL.
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
|
|
WORKING-STORAGE SECTION.
|
|
01 WS01 PIC X(3) VALUE "USD".
|
|
01 WS02 PIC 9(4) VALUE 321.
|
|
01 WS03 PIC S9(3) COMP-3 VALUE 635.
|
|
01 WS04 PIC S9(4) COMP VALUE -1.
|
|
*
|
|
01 WGTUVN01.
|
|
05 WGTUVN01-F1 PIC X(3) VALUE "EUR".
|
|
05 WGTUVN01-F2 PIC X(3) VALUE "GBP".
|
|
01 WGTUVN02.
|
|
05 WGTUVN02-F1 PIC 9(3) VALUE 123.
|
|
05 WGTUVN02-F2 PIC 9(3) VALUE 456.
|
|
01 WGTUVN03.
|
|
05 WGTUVN03-F1 PIC S9(3) COMP-3 VALUE 123.
|
|
05 WGTUVN03-F2 PIC S9(3) COMP-3 VALUE 456.
|
|
01 WGTUVN04.
|
|
05 WGTUVN04-F1 PIC S9(4) COMP VALUE 123.
|
|
05 WGTUVN04-F2 PIC S9(4) COMP VALUE 456.
|
|
*
|
|
01 WGTUVUX.
|
|
05 WGTUVUX-F1 PIC X(3) VALUE "TTT".
|
|
05 WGTUVUX-F2 PIC X(3) VALUE "TTT".
|
|
01 WGTUVU9.
|
|
05 WGTUVU9-F1 PIC 9(3) VALUE 0.
|
|
05 WGTUVU9-F2 PIC 9(3) VALUE 0.
|
|
01 WGTUVUC.
|
|
05 WGTUVUC-F1 PIC S9(3) COMP-3 VALUE 0.
|
|
05 WGTUVUC-F2 PIC S9(3) COMP-3 VALUE 0.
|
|
01 WGTUVUB.
|
|
05 WGTUVUB-F1 PIC S9(4) COMP VALUE 0.
|
|
05 WGTUVUB-F2 PIC S9(4) COMP VALUE 0.
|
|
*
|
|
01 WGTUVSX.
|
|
05 WGTUVSX-F1 PIC X(3) VALUE SPACE.
|
|
05 WGTUVSX-F2 PIC X(3) VALUE SPACE.
|
|
01 WGTUVS9.
|
|
05 WGTUVS9-F1 PIC 9(3) VALUE ZERO.
|
|
05 WGTUVS9-F2 PIC 9(3) VALUE ZERO.
|
|
01 WGTUVSC.
|
|
05 WGTUVSC-F1 PIC S9(3) COMP-3 VALUE ZERO.
|
|
05 WGTUVSC-F2 PIC S9(3) COMP-3 VALUE ZERO.
|
|
01 WGTUVSB.
|
|
05 WGTUVSB-F1 PIC S9(4) COMP VALUE ZERO.
|
|
05 WGTUVSB-F2 PIC S9(4) COMP VALUE ZERO.
|
|
*
|
|
01 WGTUVSOX.
|
|
05 WGTUVSOX-G1 OCCURS 3.
|
|
10 WGTUVSOX-F1 PIC X(3) VALUE SPACE.
|
|
01 WGTUVSO9.
|
|
05 WGTUVSO9-G1 OCCURS 3.
|
|
10 WGTUVSO9-F1 PIC 9(3) VALUE ZERO.
|
|
01 WGTUVSOC.
|
|
05 WGTUVSOC-G1 OCCURS 3.
|
|
10 WGTUVSOC-F1 PIC S9(3) COMP-3 VALUE ZERO.
|
|
01 WGTUVSOB.
|
|
05 WGTUVSOB-G1 OCCURS 3.
|
|
10 WGTUVSOB-F1 PIC S9(4) COMP VALUE ZERO.
|
|
|
|
01 WS-COMPLEX-GROUP.
|
|
05 WS-01-X2 PIC X(2).
|
|
05 WS-02-95 PIC 9(5).
|
|
05 WS-03-G.
|
|
10 WS-04-B4 PIC S9(4) COMP.
|
|
10 WS-05-X3 PIC X(3).
|
|
05 WS-06-C2 PIC S9(3) COMP-3.
|
|
|
|
01 WS-DUMP PIC X(32).
|
|
01 WS-DUMP2 REDEFINES WS-DUMP PIC X(2).
|
|
01 WS-DUMP4 REDEFINES WS-DUMP PIC X(4).
|
|
01 WS-DUMP8 REDEFINES WS-DUMP PIC X(8).
|
|
01 WS-DUMP12 REDEFINES WS-DUMP PIC X(12).
|
|
01 WS-DUMP28 REDEFINES WS-DUMP PIC X(28).
|
|
01 WS-DUMP-COUNT PIC 9(04).
|
|
|
|
|
|
PROCEDURE DIVISION.
|
|
0000-PROGRAM-ENTRY-POINT.
|
|
DISPLAY "TEST05B Value and Initialize statement."
|
|
|
|
PERFORM A000-VALUE-TESTS THRU A000-EXIT.
|
|
PERFORM B000-INITIALIZE-TESTS THRU B000-EXIT.
|
|
|
|
STOP RUN.
|
|
|
|
A000-VALUE-TESTS.
|
|
DISPLAY "VA01:(" WS01 "):(USD):"
|
|
"Value Elementary X(3) Field".
|
|
DISPLAY "VA02:(" WS02 "):(0321):"
|
|
"Value Elementary 9(4) Field".
|
|
MOVE 2 TO WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WS03 WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "VA03:(" WS-DUMP4 "):(635C):"
|
|
"Value Elementary C3 Field".
|
|
CALL "_DUMP_" USING WS04 WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "VA04:(" WS-DUMP4 "):(FFFF):"
|
|
"Value Elementary B4 Field".
|
|
|
|
DISPLAY "VA05:(" WGTUVN01 "):(EURGBP):"
|
|
"Value Group TUVN 2*X(3)".
|
|
DISPLAY "VA06:(" WGTUVN02 "):(123456):"
|
|
"Value Group TUVN 2*9(3)".
|
|
MOVE 4 TO WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WGTUVN03 WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "VA07:(" WS-DUMP8 "):(123C456C):"
|
|
"Value Group TUVN 2*C(3)".
|
|
MOVE 4 TO WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WGTUVN04 WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "VA08:(" WS-DUMP8 "):(7B00C801):"
|
|
"Value Group TUVN 2*B(4)".
|
|
|
|
DISPLAY "VA3X:(" WGTUVUX "):(TTTTTT):"
|
|
"Value Group TUVU 2*X(3)".
|
|
DISPLAY "VA39:(" WGTUVU9 "):(000000):"
|
|
"Value Group TUVU 2*9(3)".
|
|
MOVE 4 TO WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WGTUVUC WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "VA3C:(" WS-DUMP8 "):(000C000C):"
|
|
"Value Group TUVU 2*C(3)".
|
|
MOVE 4 TO WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WGTUVUB WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "VA3B:(" WS-DUMP8 "):(00000000):"
|
|
"Value Group TUVU 2*B(4)".
|
|
|
|
DISPLAY "VA4X:(" WGTUVSX "):( ):"
|
|
"Value Group TUVS 2*X(3)".
|
|
DISPLAY "VA49:(" WGTUVS9 "):(000000):"
|
|
"Value Group TUVS 2*9(3)".
|
|
MOVE 4 TO WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WGTUVSC WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "VA4C:(" WS-DUMP8 "):(000C000C):"
|
|
"Value Group TUVS 2*C(3)".
|
|
MOVE 4 TO WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WGTUVSB WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "VA4B:(" WS-DUMP8 "):(00000000):"
|
|
"Value Group TUVS 2*B(4)".
|
|
|
|
DISPLAY "VA5X:(" WGTUVSOX "):( ):"
|
|
"Value Group TUVSO 3*X(3)".
|
|
DISPLAY "VA59:(" WGTUVSO9 "):(000000000):"
|
|
"Value Group TUVSO 3*9(3)".
|
|
MOVE 6 TO WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WGTUVSOC WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "VA5C:(" WS-DUMP12 "):(000C000C000C):"
|
|
"Value Group TUVSO 2*C(3)".
|
|
MOVE 6 TO WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WGTUVSOB WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "VA5B:(" WS-DUMP12 "):(000000000000):"
|
|
"Value Group TUVSO 2*B(4)".
|
|
A000-EXIT.
|
|
EXIT.
|
|
B000-INITIALIZE-TESTS.
|
|
* Make sure that there is expected data in fields.
|
|
MOVE ALL "*" TO WS-COMPLEX-GROUP.
|
|
|
|
INITIALIZE WS-01-X2.
|
|
DISPLAY "IN01:(" WS-01-X2 "):( ):"
|
|
"INITIALIZE Elementary XX Field".
|
|
|
|
INITIALIZE WS-02-95.
|
|
DISPLAY "IN02:(" WS-02-95 "):(00000):"
|
|
"INITIALIZE Elementary 9(5) Field".
|
|
|
|
INITIALIZE WS-04-B4.
|
|
MOVE 2 to WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WS-04-B4 WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "IN03:(" WS-DUMP4 "):(0000):"
|
|
"INITIALIZE Elementary B(4) Field".
|
|
|
|
INITIALIZE WS-06-C2.
|
|
MOVE 2 to WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WS-06-C2 WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "IN04:(" WS-DUMP4 "):(000C):"
|
|
"INITIALIZE Elementary S9(3) C-3 Field".
|
|
|
|
INITIALIZE WS-COMPLEX-GROUP.
|
|
MOVE 14 to WS-DUMP-COUNT.
|
|
CALL "_DUMP_" USING WS-COMPLEX-GROUP WS-DUMP-COUNT WS-DUMP.
|
|
DISPLAY "IN05:(" WS-DUMP28 "):(202030303030300000202020000C):"
|
|
"INITIALIZE Complex Group".
|
|
B000-EXIT.
|
|
EXIT.
|