tinycobol/test.code/t15/test15k.cob

84 lines
2.6 KiB
COBOL

IDENTIFICATION DIVISION.
PROGRAM-ID. TEST15k.
AUTHOR. David Essex.
INSTALLATION. TinyCOBOL.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-PARM-1.
05 WS-PARM-1W PIC X(10) value "WS-PARM-1".
05 FILLER PIC X VALUE x"00".
01 WS-PARM-2.
05 WS-PARM-2W PIC X(10) value "WS-PARM-2".
05 FILLER PIC X VALUE x"00".
01 WS-PARM-3.
05 WS-PARM-3W PIC X(10) value "WS-PARM-3".
05 FILLER PIC X VALUE x"00".
01 WS-PARM-4.
05 FILLER PIC X VALUE x"00".
01 WS-PARM.
05 WS-PARM-1S.
10 WS-PARM-1S1 OCCURS 3 TIMES PIC X(15).
* 05 WS-PARM-1S PIC X(15) value "WS-PARM-1S :".
* 05 WS-PARM-2S PIC X(15) value "WS-PARM-2S :".
* 05 WS-PARM-3S PIC X(15) value "WS-PARM-3S :".
05 FILLER PIC X VALUE x"00".
01 WS-NUM PIC 9(9) COMP-5 VALUE ZERO.
01 WS-RCODE PIC Z(4)9 VALUE ZERO.
01 wsWorkareas.
05 wsStructWorkarea.
* 10 filler pointer value x"00".
* 10 filler pointer value x"00".
* 10 filler pointer value x"00".
10 wsStruct-n PIC 9(4) COMP-5 VALUE 56.
10 wsStruct-ch PIC X(09) VALUE "123456789".
10 filler PIC X value x"00".
10 wsStruct-num PIC 9(9) COMP-5 VALUE 324.
PROCEDURE DIVISION.
DISPLAY "--------------------------------------------------".
DISPLAY "main (test15k) COB before call".
CALL "STEST1902" USING BY REFERENCE WS-PARM-1.
DISPLAY "main (test15k) COB after call".
DISPLAY "--------------------------------------------------".
MOVE 3 TO WS-NUM.
DISPLAY "main (test15k) COB before call".
CALL "STEST1901" USING
BY VALUE WS-NUM
BY REFERENCE WS-PARM-1
BY REFERENCE WS-PARM-2
BY REFERENCE WS-PARM-3
BY REFERENCE WS-PARM-4
END-CALL.
DISPLAY "main (test15k) COB after call".
DISPLAY "--------------------------------------------------".
MOVE "WS-PARM-1S :WS-PARM-3S :WS-PARM-3S :" TO WS-PARM-1S.
DISPLAY "main (test15k) COB before call".
CALL "STEST1903" USING BY REFERENCE WS-PARM.
DISPLAY "main (test15k) COB after call".
DISPLAY "--------------------------------------------------".
DISPLAY "main (test15k) COB before call".
CALL "STEST1904" USING BY REFERENCE wsStructWorkarea.
DISPLAY "main (test15k) COB after call".
DISPLAY "main (test15k) COB wsStruct-n=" wsStruct-n.
DISPLAY "--------------------------------------------------".
MOVE RETURN-CODE TO WS-RCODE.
DISPLAY "WS-RCODE=" WS-RCODE.
STOP RUN.