--- /dev/null
+*> { dg-do run }
+*> { dg-output {\-><\-(\n|\r\n|\r)} }
+*> { dg-output {\-> <\-(\n|\r\n|\r)} }
+*> { dg-output {\->"""<\-(\n|\r\n|\r)} }
+*> { dg-output {\->000<\-(\n|\r\n|\r)} }
+*> { dg-output {\->ÿÿÿ<\-(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {\-><\-(\n|\r\n|\r)} }
+*> { dg-output {\-> <\-(\n|\r\n|\r)} }
+*> { dg-output {\->""""<\-(\n|\r\n|\r)} }
+*> { dg-output {\->0000<\-(\n|\r\n|\r)} }
+*> { dg-output {\->ÿÿÿÿ<\-(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {There should be no garbage after character 32(\n|\r\n|\r)} }
+*> { dg-output {\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\*\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-(\n|\r\n|\r)} }
+*> { dg-output {üüüüüüüüüüüüüüüüüüü Bundesstraße (\n|\r\n|\r)} }
+*> { dg-output {üüüüüüüüüüüüüüüüüüü Bundesstraße (\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {There should be no spaces before the final quote(\n|\r\n|\r)} }
+*> { dg-output {"üüüüüüüüüüüüüüüüüüü Bundesstraße"(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output { IsLow ""(\n|\r\n|\r)} }
+*> { dg-output { IsZero "000"(\n|\r\n|\r)} }
+*> { dg-output { IsHi "ÿÿÿ"(\n|\r\n|\r)} }
+*> { dg-output { IsBob "bob"(\n|\r\n|\r)} }
+*> { dg-output { IsQuote """""(\n|\r\n|\r)} }
+*> { dg-output { IsSpace " "(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {CheckBinary Properly True(\n|\r\n|\r)} }
+*> { dg-output {CheckBinary Properly False} }
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. check88.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Check88 PIC XXX VALUE SPACE.
+ 88 CheckSpace VALUE SPACE.
+ 88 CheckHi VALUE HIGH-VALUES.
+ 88 CheckLo VALUE LOW-VALUES.
+ 88 CheckZero VALUE ZERO.
+ 88 CheckQuotes VALUE QUOTE.
+ 88 CheckBob VALUE "bob".
+ 88 CheckBinary VALUE X"000102". *> { dg-warning embedded }
+ 01 000VARL PIC XXX VALUE LOW-VALUE.
+ 01 000VARS PIC XXX VALUE SPACE.
+ 01 000VARQ PIC XXX VALUE QUOTE.
+ 01 000VARZ PIC XXX VALUE ZERO.
+ 01 000VARH PIC XXX VALUE HIGH-VALUE.
+ 01 MOVE-TARGET PIC XXXX.
+ 01 VAR-UTF8 PIC X(64) VALUE "üüüüüüüüüüüüüüüüüüü Bundesstraße".
+ *> 01 VAR20 PIC 9V9(20) value "1.1".
+ 01 VAR99 PIC 999 VALUE ZERO.
+ PROCEDURE DIVISION.
+ DISPLAY "->" 000VARL "<-"
+ DISPLAY "->" 000VARS "<-"
+ DISPLAY "->" 000VARQ "<-"
+ DISPLAY "->" 000VARZ "<-"
+ DISPLAY "->" 000VARH "<-"
+ DISPLAY SPACE
+ MOVE LOW-VALUE TO MOVE-TARGET DISPLAY "->" MOVE-TARGET "<-"
+ MOVE SPACE TO MOVE-TARGET DISPLAY "->" MOVE-TARGET "<-"
+ MOVE QUOTE TO MOVE-TARGET DISPLAY "->" MOVE-TARGET "<-"
+ MOVE ZERO TO MOVE-TARGET DISPLAY "->" MOVE-TARGET "<-"
+ MOVE HIGH-VALUE TO MOVE-TARGET DISPLAY "->" MOVE-TARGET "<-"
+ DISPLAY SPACE
+ DISPLAY "There should be no garbage after character 32"
+ DISPLAY "-------------------------------*"
+ "--------------------------------"
+ DISPLAY VAR-UTF8
+ MOVE "üüüüüüüüüüüüüüüüüüü Bundesstraße" TO VAR-UTF8
+ DISPLAY VAR-UTF8
+ DISPLAY SPACE
+ DISPLAY "There should be no spaces before the final quote"
+ DISPLAY """" "üüüüüüüüüüüüüüüüüüü Bundesstraße" """"
+ DISPLAY SPACE
+ SET CheckLo to TRUE PERFORM Checker DISPLAY """" Check88 """"
+ SET CheckZero to TRUE PERFORM Checker DISPLAY """" Check88 """"
+ SET CheckHi to TRUE PERFORM Checker DISPLAY """" Check88 """"
+ SET CheckBob to TRUE PERFORM Checker DISPLAY """" Check88 """"
+ SET CheckQuotes to TRUE PERFORM Checker DISPLAY """" Check88 """"
+ SET CheckSpace to TRUE PERFORM Checker DISPLAY """" Check88 """"
+ DISPLAY SPACE
+ MOVE X"000102" TO Check88
+ IF CheckBinary
+ DISPLAY "CheckBinary Properly True"
+ else
+ DISPLAY "CheckBinary IMPROPERLY False".
+ MOVE X"030102" TO Check88
+ IF CheckBinary
+ DISPLAY "CheckBinary IMPROPERLY True"
+ else
+ DISPLAY "CheckBinary Properly False".
+ STOP RUN.
+ Checker.
+ *>DISPLAY "Checking '" Check88 "'"
+ IF CheckHi DISPLAY " IsHi " NO ADVANCING END-IF
+ IF CheckLo DISPLAY " IsLow " NO ADVANCING END-IF
+ IF CheckZero DISPLAY " IsZero " NO ADVANCING END-IF
+ IF CheckBob DISPLAY " IsBob " NO ADVANCING END-IF
+ IF CheckQuotes DISPLAY " IsQuote " NO ADVANCING END-IF
+ IF CheckSpace DISPLAY " IsSpace " NO ADVANCING END-IF
+ .
--- /dev/null
+*> { dg-do run }
+*> { dg-output {0x0000000000000000 Should be 0x0000000000000000(\n|\r\n|\r)} }
+*> { dg-output {0x0000000020202020 Should be 0x0000000020202020(\n|\r\n|\r)} }
+*> { dg-output {0x0000000030303030 Should be 0x0000000030303030(\n|\r\n|\r)} }
+*> { dg-output {0x0000000022222222 Should be 0x0000000022222222(\n|\r\n|\r)} }
+*> { dg-output {0x00000000ffffffff Should be 0x00000000ffffffff} }
+ *> This program is a sanity check of COMP-5 moves and addition.
+ program-id. comp5.
+ data division.
+ working-storage section.
+ 77 var PIC 999V999 COMP-5 .
+ 77 var1 PIC 999V9(1) COMP-5 .
+ 77 var2 PIC 999V9(2) COMP-5 .
+ 77 var3 PIC 999V9(3) COMP-5 .
+ 77 var4 PIC 999V9(4) COMP-5 .
+ 77 var5 PIC 999V9(5) COMP-5 .
+ 77 var6 PIC 999V9(6) COMP-5 .
+ 77 var7 PIC 999V9(7) COMP-5 .
+ 77 var8 PIC 999V9(8) COMP-5 .
+ 77 var555 PIC 999V99999999 COMP-5 VALUE 555.55555555.
+ 01 C-5A PIC X(4) VALUE LOW-VALUE.
+ 01 C-5B PIC X(4) VALUE SPACE.
+ 01 C-5C PIC X(4) VALUE ZERO.
+ 01 C-5D PIC X(4) VALUE QUOTE.
+ 01 C-5E PIC X(4) VALUE HIGH-VALUE.
+ 01 PTR POINTER.
+ 01 PC REDEFINES PTR PIC X(4).
+ procedure division.
+ move 111.111 to var.
+ if var not equal to 111.111 display var " should be 111.111".
+ add 000.001 to var.
+ if var not equal to 111.112 display var " should be 111.112".
+ add 000.01 to var.
+ if var not equal to 111.122 display var " should be 111.122".
+ add 000.1 to var.
+ if var not equal to 111.222 display var " should be 111.222".
+ add 1 to var.
+ if var not equal to 112.222 display var " should be 112.222".
+ add 10 to var.
+ if var not equal to 122.222 display var " should be 122.222".
+ add 100 to var.
+ if var not equal to 222.222 display var " should be 222.222".
+ move 555.55555555 to var1
+ move 555.55555555 to var2
+ move 555.55555555 to var3
+ move 555.55555555 to var4
+ move 555.55555555 to var5
+ move 555.55555555 to var6
+ move 555.55555555 to var7
+ move 555.55555555 to var8
+ add 0.00000001 TO var555 giving var1 rounded
+ add 0.00000001 TO var555 giving var2 rounded
+ add 0.00000001 TO var555 giving var3 rounded
+ add 0.00000001 TO var555 giving var4 rounded
+ add 0.00000001 TO var555 giving var5 rounded
+ add 0.00000001 TO var555 giving var6 rounded
+ add 0.00000001 TO var555 giving var7 rounded
+ add 0.00000001 TO var555 giving var8 rounded
+ if var1 not equal to 555.6 display var1 " should be 555.6".
+ if var2 not equal to 555.56 display var2 " should be 555.56".
+ if var3 not equal to 555.556 display var3 " should be 555.556".
+ if var4 not equal to 555.5556 display var4 " should be 555.5556".
+ if var5 not equal to 555.55556 display var5 " should be 555.55556".
+ if var6 not equal to 555.555556 display var6 " should be 555.555556".
+ if var7 not equal to 555.5555556 display var7 " should be 555.5555556".
+ if var8 not equal to 555.55555556 display var8 " should be 555.55555556".
+ MOVE C-5A TO PC DISPLAY PTR " Should be 0x0000000000000000".
+ MOVE C-5B TO PC DISPLAY PTR " Should be 0x0000000020202020".
+ MOVE C-5C TO PC DISPLAY PTR " Should be 0x0000000030303030".
+ MOVE C-5D TO PC DISPLAY PTR " Should be 0x0000000022222222".
+ MOVE C-5E TO PC DISPLAY PTR " Should be 0x00000000ffffffff".
+ stop run.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {Turning EC\-ALL CHECKING OFF \-\- Expecting \+00\.00 from ACOS\(\-3\)(\n|\r\n|\r)} }
+*> { dg-output { \+00\.00 TABL\(VSIX\) is 6(\n|\r\n|\r)} }
+*> { dg-output {Turning EC\-ARGUMENT\-FUNCTION CHECKING ON(\n|\r\n|\r)} }
+*> { dg-output { Expecting \+0\.00 and DECLARATIVE FOR EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
+*> { dg-output { DECLARATIVE FOR EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
+*> { dg-output { \+00\.00 TABL\(VSIX\) is 6(\n|\r\n|\r)} }
+*> { dg-output {Turning EC\-ARGUMENT CHECKING ON(\n|\r\n|\r)} }
+*> { dg-output { Expecting \+0\.00 and DECLARATIVE FOR EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
+*> { dg-output { DECLARATIVE FOR EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
+*> { dg-output { \+00\.00 TABL\(VSIX\) is 6(\n|\r\n|\r)} }
+*> { dg-output {Turning EC\-ALL CHECKING ON(\n|\r\n|\r)} }
+*> { dg-output { Expecting \+0\.00 and DECLARATIVE EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
+*> { dg-output { Followed by DECLARATIVE EC\-ALL for TABL\(6\) access(\n|\r\n|\r)} }
+*> { dg-output { DECLARATIVE FOR EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
+*> { dg-output { \+00\.00 TABL\(VSIX\) is 1(\n|\r\n|\r)} }
+*> { dg-output { DECLARATIVE FOR EC\-ALL} }
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 VAL PIC S99V99.
+ 01 FILLER VALUE "1234567890".
+ 05 TABL PIC X OCCURS 5.
+ 05 TABL2 PIC X OCCURS 5.
+ 01 VSIX PIC 9 VALUE 6.
+ PROCEDURE DIVISION.
+ DECLARATIVES.
+ DECLARATIVES-EC-ARGUMENT-FUNCTION SECTION.
+ USE AFTER EXCEPTION CONDITION EC-ARGUMENT-FUNCTION.
+ DISPLAY " DECLARATIVE FOR EC-ARGUMENT-FUNCTION".
+ RESUME NEXT STATEMENT.
+ DECLARATIVES-EC-ARGUMENT SECTION.
+ USE AFTER EXCEPTION CONDITION EC-ARGUMENT.
+ DISPLAY " DECLARATIVE FOR EC-ARGUMENT".
+ RESUME NEXT STATEMENT.
+ DECLARATIVES-EC-ALL SECTION.
+ USE AFTER EXCEPTION CONDITION EC-ALL.
+ DISPLAY " DECLARATIVE FOR EC-ALL".
+ RESUME NEXT STATEMENT.
+ END DECLARATIVES.
+ *> END DECLARATIVES must be followed by an explicit section.
+ *> See ISO 2014 section 14.2.1
+ *> READ ISO 2023 section 14.2.1 Format 2 (without sections) and
+ *> you will note that they forgot to isolate the declaratives from
+ *> the rest of the PROCEDURE DIVISION. So NO an explicit section
+ *> IS NOT REQUIRED.
+ *> See below that the >>TURN-EC-ALL CHECKING OFF statements at the end
+ *> of paragraphs are commented out. As of this writing, GCOBOL improperly
+ *> treats that as a syntax error. This is a known problem.
+ MAIN-SECTION SECTION.
+ PERFORM TEST1.
+ PERFORM TEST2.
+ PERFORM TEST3.
+ PERFORM TEST4.
+ *> PERFORM TEST5
+ GOBACK.
+ TEST1.
+ DISPLAY "Turning EC-ALL CHECKING OFF -- Expecting +00.00 from ACOS(-3)"
+ >>TURN EC-ALL CHECKING OFF
+ *> The assumption that ACOS should return an invalid response is
+ *> in violation of the definition of ACOS in the standard. Furthermore,
+ *> EC-ARGUMENT-FUNCTION is marked FATAL and elsewhere in the standard
+ *> it says the implementor has the option to continue (scary) or fail.
+ *> By fail I think that means perform the declarative and then, if
+ *> the declarative section does not issue a RESUME ... "the run unit is
+ *> terminated abnormally as specified in 14.6.12, Abnormal run unit
+ *> termination." Not a segfault, ever. Jim mentioned he was looking for
+ *> a solution for RESUME but terminating as specified is not a
+ *> segfault.
+ MOVE FUNCTION ACOS(-3) TO VAL.
+ DISPLAY " " VAL WITH NO ADVANCING.
+ DISPLAY " TABL(VSIX) is " TABL(VSIX).
+ *> >>TURN EC-ALL CHECKING OFF
+ TEST2.
+ >>TURN EC-ALL CHECKING OFF
+ DISPLAY "Turning EC-ARGUMENT-FUNCTION CHECKING ON"
+ DISPLAY " " "Expecting +0.00 and DECLARATIVE FOR EC-ARGUMENT-FUNCTION"
+ >>TURN EC-ARGUMENT-FUNCTION CHECKING ON
+ MOVE FUNCTION ACOS(-3) TO VAL.
+ DISPLAY " " VAL WITH NO ADVANCING.
+ DISPLAY " TABL(VSIX) is " TABL(VSIX).
+ *> >>TURN EC-ALL CHECKING OFF
+ TEST3.
+ >>TURN EC-ALL CHECKING OFF
+ DISPLAY "Turning EC-ARGUMENT CHECKING ON"
+ DISPLAY " " "Expecting +0.00 and DECLARATIVE FOR EC-ARGUMENT-FUNCTION"
+ >>TURN EC-ARGUMENT CHECKING ON
+ *> Since there is a declarative for EC-ARGUMENT-FUNCTION, per Jim
+ *> that section will be used in this case and the higher-level
+ *> exception section will not. If that has changed, then the notion
+ *> of hierarchic response is different than we agreed.
+ MOVE FUNCTION ACOS(-3) TO VAL.
+ DISPLAY " " VAL WITH NO ADVANCING.
+ DISPLAY " TABL(VSIX) is " TABL(VSIX).
+ *> >>TURN EC-ALL CHECKING OFF
+ TEST4.
+ >>TURN EC-ALL CHECKING OFF
+ *> Same as previous.
+ DISPLAY "Turning EC-ALL CHECKING ON"
+ DISPLAY " " "Expecting +0.00 and DECLARATIVE EC-ARGUMENT-FUNCTION"
+ DISPLAY " " "Followed by DECLARATIVE EC-ALL for TABL(6) access"
+ >>TURN EC-ALL CHECKING ON
+ MOVE FUNCTION ACOS(-3) TO VAL.
+ DISPLAY " " VAL WITH NO ADVANCING.
+ DISPLAY " TABL(VSIX) is " TABL(VSIX).
+ *> >>TURN EC-ALL CHECKING OFF
+ TEST5.
+ >>TURN EC-ALL CHECKING OFF
+ DISPLAY "Turning EC-BOUND-SUBSCRIPT CHECKING ON - expecting default termination"
+ >>TURN EC-BOUND-SUBSCRIPT CHECKING ON
+ MOVE FUNCTION ACOS(-3) TO VAL.
+ DISPLAY " " VAL WITH NO ADVANCING.
+ DISPLAY " TABL(VSIX) is " TABL(VSIX).
+ *> >>TURN EC-ALL CHECKING OFF
+ END PROGRAM prog.
--- /dev/null
+*> { dg-do run }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {" Marty "(\n|\r\n|\r)} }
+*> { dg-output {"Marty"} }
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. disp.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 VAR PIC X(30) VALUE " Marty ".
+ PROCEDURE DIVISION.
+ DISPLAY SPACE
+ DISPLAY """" VAR """"
+ DISPLAY """" FUNCTION TRIM(VAR) """"
+ STOP RUN.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {1 2} }
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. disp2.
+ PROCEDURE DIVISION.
+ DISPLAY 1 SPACE 2
+ STOP RUN.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {we saw 09 records; there should have been 09} }
+ identification division.
+ program-id. line-seq.
+ environment division.
+ input-output section.
+ file-control.
+ select data-file
+ assign to
+ "data.tab" organization line sequential.
+ data division.
+ file section.
+ fd data-file.
+ 01 data-record pic x(80).
+ working-storage section.
+ 01 record-count pic 99 value zero.
+ procedure division.
+ move "I am a line" to data-record
+ open output data-file.
+ perform 9 times
+ write data-record
+ end-perform
+ close data-file
+ open input data-file.
+ read-loop.
+ read data-file
+ at end
+ display "we saw " record-count " records; there should"
+ " have been 09"
+ close data-file
+ stop run.
+ add 1 to record-count
+ go to read-loop.
+ end program line-seq.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {D9 is 002(\n|\r\n|\r)} }
+*> { dg-output {B9 is 002(\n|\r\n|\r)} }
+*> { dg-output {X1 is '2'(\n|\r\n|\r)} }
+*> { dg-output {X2 is ' 2'(\n|\r\n|\r)} }
+*> { dg-output {X3 is ' 2'(\n|\r\n|\r)} }
+*> { dg-output {X4 is '2'(\n|\r\n|\r)} }
+*> { dg-output {X5 is '02'(\n|\r\n|\r)} }
+*> { dg-output {X6 is '002'(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {D9 EQUAL TO D9 (\n|\r\n|\r)} }
+*> { dg-output {D9 EQUAL TO B9 (\n|\r\n|\r)} }
+*> { dg-output {D9 EQUAL TO X1 NOT(\n|\r\n|\r)} }
+*> { dg-output {D9 EQUAL TO X2 NOT(\n|\r\n|\r)} }
+*> { dg-output {D9 EQUAL TO X3 NOT(\n|\r\n|\r)} }
+*> { dg-output {D9 EQUAL TO X4 NOT(\n|\r\n|\r)} }
+*> { dg-output {D9 EQUAL TO X5 NOT(\n|\r\n|\r)} }
+*> { dg-output {D9 EQUAL TO X6 (\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO D9 (\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO B9 (\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO X1 NOT(\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO X2 NOT(\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO X3 NOT(\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO X4 NOT(\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO X5 NOT(\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO X6 (\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO 2 (\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO 002 (\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO '2' NOT(\n|\r\n|\r)} }
+*> { dg-output {B9 EQUAL TO '002' (\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output { 2 EQUAL TO B9 (\n|\r\n|\r)} }
+*> { dg-output {'2' EQUAL TO B9 NOT(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output { 002 EQUAL TO B9 (\n|\r\n|\r)} }
+*> { dg-output {'002' EQUAL TO B9 (\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output { 2 EQUAL TO 2 (\n|\r\n|\r)} }
+*> { dg-output { 2 EQUAL TO '2' (\n|\r\n|\r)} }
+*> { dg-output {'2' EQUAL TO 2 (\n|\r\n|\r)} }
+*> { dg-output {'2' EQUAL TO '2' (\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output { 2 EQUAL TO 002 (\n|\r\n|\r)} }
+*> { dg-output { 2 EQUAL TO '002' NOT(\n|\r\n|\r)} }
+*> { dg-output {'2' EQUAL TO 002 NOT(\n|\r\n|\r)} }
+*> { dg-output {'2' EQUAL TO '002' NOT(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output { 002 EQUAL TO 2 (\n|\r\n|\r)} }
+*> { dg-output { 002 EQUAL TO '2' NOT(\n|\r\n|\r)} }
+*> { dg-output {'002' EQUAL TO 2 NOT(\n|\r\n|\r)} }
+*> { dg-output {'002' EQUAL TO '2' NOT(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output { 002 EQUAL TO 002 (\n|\r\n|\r)} }
+*> { dg-output { 002 EQUAL TO '002' (\n|\r\n|\r)} }
+*> { dg-output {'002' EQUAL TO 002 (\n|\r\n|\r)} }
+*> { dg-output {'002' EQUAL TO '002' (\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output { 1000 EQUAL TO 999PPP (\n|\r\n|\r)} }
+*> { dg-output { 0\.0001 EQUAL TO PPP999 } }
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. bigif.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 D9 PICTURE 999 . *>DISPLAY.
+ 01 B9 PICTURE 999 BINARY.
+ 01 X1 PICTURE X .
+ 01 X2 PICTURE XX .
+ 01 X3 PICTURE XXX .
+ 01 X4 PICTURE X .
+ 01 X5 PICTURE XX .
+ 01 X6 PICTURE XXX.
+ 01 AAA PICTURE 999.
+ 01 999PPP PIC 999PPP BINARY.
+ 01 PPP999 PIC PPP999 BINARY.
+ 01 MSG PIC X(24).
+ PROCEDURE DIVISION.
+ MOVE 2 TO D9
+ MOVE 2 TO B9
+ MOVE "2" TO X1
+ MOVE " 2" TO X2
+ MOVE " 2" TO X3
+ MOVE "2" TO X4
+ MOVE "02" TO X5
+ MOVE "002" TO X6
+ DISPLAY "D9 is " D9
+ DISPLAY "B9 is " B9
+ DISPLAY "X1 is '" X1 "'"
+ DISPLAY "X2 is '" X2 "'"
+ DISPLAY "X3 is '" X3 "'"
+ DISPLAY "X4 is '" X4 "'"
+ DISPLAY "X5 is '" X5 "'"
+ DISPLAY "X6 is '" X6 "'"
+ DISPLAY " "
+ MOVE "D9 EQUAL TO D9" TO MSG
+ IF D9 EQUAL TO D9 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "D9 EQUAL TO B9" TO MSG
+ IF D9 EQUAL TO B9 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "D9 EQUAL TO X1" TO MSG
+ IF D9 EQUAL TO X1 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "D9 EQUAL TO X2" TO MSG
+ IF D9 EQUAL TO X2 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "D9 EQUAL TO X3" TO MSG
+ IF D9 EQUAL TO X3 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "D9 EQUAL TO X4" TO MSG
+ IF D9 EQUAL TO X4 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "D9 EQUAL TO X5" TO MSG
+ IF D9 EQUAL TO X5 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "D9 EQUAL TO X6" TO MSG
+ IF D9 EQUAL TO X6 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ DISPLAY " "
+ MOVE "B9 EQUAL TO D9" TO MSG
+ IF B9 EQUAL TO D9 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "B9 EQUAL TO B9" TO MSG
+ IF B9 EQUAL TO B9 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "B9 EQUAL TO X1" TO MSG
+ IF B9 EQUAL TO X1 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "B9 EQUAL TO X2" TO MSG
+ IF B9 EQUAL TO X2 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "B9 EQUAL TO X3" TO MSG
+ IF B9 EQUAL TO X3 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "B9 EQUAL TO X4" TO MSG
+ IF B9 EQUAL TO X4 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "B9 EQUAL TO X5" TO MSG
+ IF B9 EQUAL TO X5 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "B9 EQUAL TO X6" TO MSG
+ IF B9 EQUAL TO X6 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ DISPLAY " "
+ MOVE "B9 EQUAL TO 2" TO MSG
+ IF B9 EQUAL TO 2 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "B9 EQUAL TO 002" TO MSG
+ IF B9 EQUAL TO 002 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "B9 EQUAL TO '2'" TO MSG
+ IF B9 EQUAL TO '2' THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "B9 EQUAL TO '002'" TO MSG
+ IF B9 EQUAL TO '002' THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ DISPLAY " "
+ MOVE " 2 EQUAL TO B9" TO MSG
+ IF 2 EQUAL TO B9 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "'2' EQUAL TO B9" TO MSG
+ IF '2' EQUAL TO B9 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ DISPLAY " "
+ MOVE " 002 EQUAL TO B9" TO MSG
+ IF 002 EQUAL TO B9 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "'002' EQUAL TO B9" TO MSG
+ IF '002' EQUAL TO B9 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ DISPLAY " "
+ MOVE " 2 EQUAL TO 2" TO MSG
+ IF 2 EQUAL TO 2 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE " 2 EQUAL TO '2'" TO MSG
+ IF 2 EQUAL TO '2' THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "'2' EQUAL TO 2" TO MSG
+ IF '2' EQUAL TO 2 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "'2' EQUAL TO '2'" TO MSG
+ IF '2' EQUAL TO '2' THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ DISPLAY " "
+ MOVE " 2 EQUAL TO 002" TO MSG
+ IF 2 EQUAL TO 002 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE " 2 EQUAL TO '002'" TO MSG
+ IF 2 EQUAL TO '002' THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "'2' EQUAL TO 002" TO MSG
+ IF '2' EQUAL TO 002 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "'2' EQUAL TO '002'" TO MSG
+ IF '2' EQUAL TO '002' THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ DISPLAY " "
+ MOVE " 002 EQUAL TO 2" TO MSG
+ IF 002 EQUAL TO 2 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE " 002 EQUAL TO '2'" TO MSG
+ IF 002 EQUAL TO '2' THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "'002' EQUAL TO 2" TO MSG
+ IF '002' EQUAL TO 2 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "'002' EQUAL TO '2'" TO MSG
+ IF '002' EQUAL TO '2' THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ DISPLAY " "
+ MOVE " 002 EQUAL TO 002" TO MSG
+ IF 002 EQUAL TO 002 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE " 002 EQUAL TO '002'" TO MSG
+ IF 002 EQUAL TO '002' THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "'002' EQUAL TO 002" TO MSG
+ IF '002' EQUAL TO 002 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE "'002' EQUAL TO '002'" TO MSG
+ IF '002' EQUAL TO '002' THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ DISPLAY " "
+ MOVE " 1000 EQUAL TO 999PPP" TO MSG
+ MOVE 1000 TO 999PPP.
+ IF 1000 EQUAL TO 999PPP THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ MOVE " 0.0001 EQUAL TO PPP999" TO MSG
+ MOVE 0.0001 TO PPP999.
+ IF 0.0001 EQUAL TO PPP999 THEN DISPLAY MSG ELSE DISPLAY MSG " NOT" END-IF
+ STOP RUN.
+ END PROGRAM bigif.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {Test of MULTIPLY\. All results should be 20(\n|\r\n|\r)} }
+*> { dg-output {TEST01\-1 20 20 20(\n|\r\n|\r)} }
+*> { dg-output {TEST01\-2 20 20 20(\n|\r\n|\r)} }
+*> { dg-output {TEST02\-1 20(\n|\r\n|\r)} }
+*> { dg-output {TEST02\-2 20(\n|\r\n|\r)} }
+*> { dg-output {TEST02\-3 20(\n|\r\n|\r)} }
+*> { dg-output {TEST02\-4 20(\n|\r\n|\r)} }
+*> { dg-output {TEST02\-5 20 20 20(\n|\r\n|\r)} }
+*> { dg-output {TEST02\-6 20 20 20(\n|\r\n|\r)} }
+*> { dg-output {TEST02\-7 20 20 20(\n|\r\n|\r)} }
+*> { dg-output {TEST02\-8 20 20 20(\n|\r\n|\r)} }
+*> { dg-output {Thank you for running the MULTIPLY test\.} }
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. mult.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 A PIC 9 VALUE 4.
+ 01 B PIC 9 VALUE 5.
+ 01 X PIC 99 VALUE ZEROS.
+ 01 Y PIC 99 VALUE ZEROS.
+ 01 Z PIC 99 VALUE ZEROS.
+ PROCEDURE DIVISION.
+ DISPLAY "Test of MULTIPLY. All results should be 20"
+ *> Two cases of FORMAT 1
+ PERFORM SET5.
+ MULTIPLY 4 BY X Y Z.
+ DISPLAY "TEST01-1 " X " " Y " " Z
+ PERFORM SET5.
+ MULTIPLY A BY X Y Z.
+ DISPLAY "TEST01-2 " X " " Y " " Z.
+ *> Eight cases of FORMAT2 2
+ PERFORM CLEAR
+ MULTIPLY 4 BY 5 GIVING X
+ DISPLAY "TEST02-1 " X
+ PERFORM CLEAR
+ MULTIPLY A BY 5 GIVING X
+ DISPLAY "TEST02-2 " X
+ PERFORM CLEAR
+ MULTIPLY 4 BY B GIVING X
+ DISPLAY "TEST02-3 " X
+ PERFORM CLEAR
+ MULTIPLY A BY B GIVING X
+ DISPLAY "TEST02-4 " X
+ PERFORM CLEAR
+ MULTIPLY 4 BY 5 GIVING X Y Z
+ DISPLAY "TEST02-5 " X " " Y " " Z
+ PERFORM CLEAR
+ MULTIPLY A BY 5 GIVING X Y Z
+ DISPLAY "TEST02-6 " X " " Y " " Z
+ PERFORM CLEAR
+ MULTIPLY 4 BY B GIVING X Y Z
+ DISPLAY "TEST02-7 " X " " Y " " Z
+ PERFORM CLEAR
+ MULTIPLY A BY B GIVING X Y Z
+ DISPLAY "TEST02-8 " X " " Y " " Z
+ DISPLAY "Thank you for running the MULTIPLY test."
+ STOP RUN.
+ CLEAR.
+ MOVE 0 TO X
+ MOVE 0 TO Y
+ MOVE 0 TO Z.
+ SET5.
+ MOVE 5 TO X
+ MOVE 5 TO Y
+ MOVE 5 TO Z.
+ LAST-PARAGRAPH.
+ END PROGRAM mult.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {123(\n|\r\n|\r)} }
+*> { dg-output {16146(\n|\r\n|\r)} }
+*> { dg-output {0x0000000000003f12(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {123(\n|\r\n|\r)} }
+*> { dg-output {16146(\n|\r\n|\r)} }
+*> { dg-output {0x0000000000003f12(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {\+123(\n|\r\n|\r)} }
+*> { dg-output {15378(\n|\r\n|\r)} }
+*> { dg-output {0x0000000000003c12(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {\-123(\n|\r\n|\r)} }
+*> { dg-output {15634(\n|\r\n|\r)} }
+*> { dg-output {0x0000000000003d12(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {properly FALSE(\n|\r\n|\r)} }
+*> { dg-output {properly TRUE(\n|\r\n|\r)} }
+*> { dg-output {properly FALSE} }
+ identification division.
+ program-id. packed.
+ data division.
+ working-storage section.
+ 01 filler.
+ 02 as-num binary-double unsigned.
+ 02 as-hex redefines as-num pointer.
+ 01 filler.
+ 02 p1 pic 999 comp-3 value 1.
+ 02 dp1 redefines p1 binary-short unsigned.
+ 01 filler.
+ 02 sp1 pic s999 comp-3 value 1.
+ 02 sdp1 redefines sp1 binary-short unsigned.
+ procedure division.
+ move 123 to p1
+ display p1
+ display dp1
+ move dp1 to as-num.
+ display as-hex.
+ display space
+ move -123 to p1
+ display p1
+ display dp1
+ move dp1 to as-num.
+ display as-hex.
+ display space
+ move 123 to sp1
+ display sp1
+ display sdp1
+ move sdp1 to as-num.
+ display as-hex.
+ display space
+ move -123 to sp1
+ display sp1
+ display sdp1
+ move sdp1 to as-num.
+ display as-hex.
+ display space
+ move 2 to p1
+ move 2 to sp1
+ if p1 < sp1
+ DISPLAY "improperly TRUE"
+ else
+ DISPLAY "properly FALSE".
+ if p1 = sp1
+ DISPLAY "properly TRUE"
+ else
+ DISPLAY "improperly FALSE".
+ if p1 > sp1
+ DISPLAY "improperly TRUE"
+ else
+ DISPLAY "properly FALSE".
+ stop run.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {00 About to start\.\.\.(\n|\r\n|\r)} }
+*> { dg-output {01 I am a(\n|\r\n|\r)} }
+*> { dg-output {02 I am b(\n|\r\n|\r)} }
+*> { dg-output {03 I am c(\n|\r\n|\r)} }
+*> { dg-output {04 I am d(\n|\r\n|\r)} }
+*> { dg-output {04 fall through to z(\n|\r\n|\r)} }
+*> { dg-output {04 I am z(\n|\r\n|\r)} }
+*> { dg-output {03 back from d through z; fall through to d(\n|\r\n|\r)} }
+*> { dg-output {03 I am d(\n|\r\n|\r)} }
+*> { dg-output {03 fall through to z(\n|\r\n|\r)} }
+*> { dg-output {03 I am z(\n|\r\n|\r)} }
+*> { dg-output {02 back from c through z; fall through to c(\n|\r\n|\r)} }
+*> { dg-output {02 I am c(\n|\r\n|\r)} }
+*> { dg-output {03 I am d(\n|\r\n|\r)} }
+*> { dg-output {03 fall through to z(\n|\r\n|\r)} }
+*> { dg-output {03 I am z(\n|\r\n|\r)} }
+*> { dg-output {02 back from d through z; fall through to d(\n|\r\n|\r)} }
+*> { dg-output {02 I am d(\n|\r\n|\r)} }
+*> { dg-output {02 fall through to z(\n|\r\n|\r)} }
+*> { dg-output {02 I am z(\n|\r\n|\r)} }
+*> { dg-output {01 back from b through z; fall through to b(\n|\r\n|\r)} }
+*> { dg-output {01 I am b(\n|\r\n|\r)} }
+*> { dg-output {02 I am c(\n|\r\n|\r)} }
+*> { dg-output {03 I am d(\n|\r\n|\r)} }
+*> { dg-output {03 fall through to z(\n|\r\n|\r)} }
+*> { dg-output {03 I am z(\n|\r\n|\r)} }
+*> { dg-output {02 back from d through z; fall through to d(\n|\r\n|\r)} }
+*> { dg-output {02 I am d(\n|\r\n|\r)} }
+*> { dg-output {02 fall through to z(\n|\r\n|\r)} }
+*> { dg-output {02 I am z(\n|\r\n|\r)} }
+*> { dg-output {01 back from c through z; fall through to c(\n|\r\n|\r)} }
+*> { dg-output {01 I am c(\n|\r\n|\r)} }
+*> { dg-output {02 I am d(\n|\r\n|\r)} }
+*> { dg-output {02 fall through to z(\n|\r\n|\r)} }
+*> { dg-output {02 I am z(\n|\r\n|\r)} }
+*> { dg-output {01 back from d through z; fall through to d(\n|\r\n|\r)} }
+*> { dg-output {01 I am d(\n|\r\n|\r)} }
+*> { dg-output {01 fall through to z(\n|\r\n|\r)} }
+*> { dg-output {01 I am z(\n|\r\n|\r)} }
+*> { dg-output {00 back from a through z} }
+ ID DIVISION.
+ PROGRAM-ID. playpen.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 dummy pic x.
+ 01 level pic 99 value 0.
+ PROCEDURE DIVISION.
+ display level " About to start...".
+ add 1 to level
+ perform a through z.
+ subtract 1 from level
+ display level " back from a through z".
+ STOP RUN.
+ a.
+ display level " I am a"
+ add 1 to level
+ perform b through z
+ subtract 1 from level
+ display level
+ " back from b through z; fall through to b".
+ b.
+ display level " I am b"
+ add 1 to level
+ perform c through z
+ subtract 1 from level
+ display level
+ " back from c through z; fall through to c".
+ c.
+ display level " I am c"
+ add 1 to level
+ perform d through z.
+ subtract 1 from level
+ display level
+ " back from d through z; fall through to d".
+ d.
+ display level " I am d"
+ display level
+ " fall through to z".
+ z.
+ display level " I am z".
+ zzz.
+ display level " I am zzz".
+ END PROGRAM playpen.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {000000259(\n|\r\n|\r)} }
+*> { dg-output {0x0000000000000103(\n|\r\n|\r)} }
+*> { dg-output {Faith (\n|\r\n|\r)} }
+*> { dg-output {Hope (\n|\r\n|\r)} }
+*> { dg-output {Charity (\n|\r\n|\r)} }
+*> { dg-output {Pointers are correctly equal (\n|\r\n|\r)} }
+*> { dg-output {Pointers are correctly different(\n|\r\n|\r)} }
+*> { dg-output {Pointers are correctly different(\n|\r\n|\r)} }
+*> { dg-output {Pointers are correctly different(\n|\r\n|\r)} }
+*> { dg-output {Pointers are correctly different(\n|\r\n|\r)} }
+*> { dg-output {Pointers are correctly equal (\n|\r\n|\r)} }
+*> { dg-output {Pointers are correctly equal (\n|\r\n|\r)} }
+*> { dg-output {Pointers are correctly equal (\n|\r\n|\r)} }
+*> { dg-output {NOT EQUAL is correctly FALSE } }
+ ID DIVISION.
+ PROGRAM-ID. pointers.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 WS-POINTER USAGE IS POINTER .
+ 01 WS-PVALUE REDEFINES WS-POINTER PIC 9(9) COMP-5.
+ 01 WS-POINTER2 USAGE IS POINTER .
+ 01 WS-PVALUE2 REDEFINES WS-POINTER2 PIC 9(9) COMP-5.
+ 01 VALUE-SOURCE1 PIC X(12).
+ 01 VALUE-SOURCE2 PIC X(12).
+ 01 VALUE-SOURCE3 PIC X(12).
+ 01 VALUE-DEST PIC X(12).
+ LINKAGE SECTION.
+ 01 DEREFERENCER PIC X(12).
+ PROCEDURE DIVISION.
+ MOVE 259 TO WS-PVALUE
+ DISPLAY WS-PVALUE
+ DISPLAY WS-POINTER
+ *> Pointer manipulation: ADDRESS OF to ADDRESS OF
+ MOVE "Faith" TO VALUE-SOURCE1
+ SET ADDRESS OF DEREFERENCER TO ADDRESS OF VALUE-SOURCE1
+ MOVE DEREFERENCER TO VALUE-DEST
+ DISPLAY VALUE-DEST
+ *> Pointer manipulation: POINTER to ADDRESS OF
+ *> ADDRESS OF to POINTER
+ MOVE "Hope" TO VALUE-SOURCE2
+ SET WS-POINTER TO ADDRESS OF VALUE-SOURCE2
+ SET ADDRESS OF DEREFERENCER TO WS-POINTER
+ DISPLAY DEREFERENCER
+ *> Pointer manipulation: Pointer to pointer:
+ MOVE "Charity" TO VALUE-SOURCE3
+ SET WS-POINTER2 TO ADDRESS OF VALUE-SOURCE3
+ SET WS-POINTER TO WS-POINTER2
+ SET ADDRESS OF DEREFERENCER TO WS-POINTER
+ DISPLAY DEREFERENCER
+ IF WS-POINTER EQUAL TO WS-POINTER2
+ DISPLAY "Pointers are correctly equal "
+ ELSE
+ DISPLAY "Pointers are incorrectly different".
+ SET WS-POINTER2 TO ADDRESS OF VALUE-DEST
+ IF WS-POINTER EQUAL TO WS-POINTER2
+ DISPLAY "Pointers are incorrectly equal"
+ ELSE
+ DISPLAY "Pointers are correctly different"
+ SET WS-POINTER TO NULL
+ IF WS-POINTER EQUAL TO WS-POINTER2
+ DISPLAY "Pointers are incorrectly equal"
+ ELSE
+ DISPLAY "Pointers are correctly different"
+ IF NULL EQUAL TO WS-POINTER2
+ DISPLAY "Pointers are incorrectly equal"
+ ELSE
+ DISPLAY "Pointers are correctly different"
+ IF WS-POINTER2 EQUAL TO NULL
+ DISPLAY "Pointers are incorrectly equal"
+ ELSE
+ DISPLAY "Pointers are correctly different"
+ SET WS-POINTER2 TO NULL
+ IF WS-POINTER EQUAL TO WS-POINTER2
+ DISPLAY "Pointers are correctly equal "
+ ELSE
+ DISPLAY "Pointers are incorrectly different".
+ IF WS-POINTER EQUAL TO NULL
+ DISPLAY "Pointers are correctly equal "
+ ELSE
+ DISPLAY "Pointers are incorrectly different".
+ IF WS-POINTER EQUAL TO NULL
+ DISPLAY "Pointers are correctly equal "
+ ELSE
+ DISPLAY "Pointers are incorrectly different".
+ PERFORM one-last-dance
+ STOP RUN.
+ one-last-dance.
+ IF WS-POINTER NOT EQUAL TO NULL
+ *>Making sure comments don't cause trouble
+ DISPLAY "Pointers are incorrectly EQUAL "
+ ELSE
+ *>Making sure comments don't cause trouble
+ DISPLAY "NOT EQUAL is correctly FALSE "
+ END-IF.
+ one-last-dance-end.
+ DISPLAY "We should never get here".
+ END PROGRAM pointers.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {Numeric Display arithmetic(\n|\r\n|\r)} }
+*> { dg-output {Num1 is \+5; Num2 is \+4(\n|\r\n|\r)} }
+*> { dg-output {Product should be \+20, is = \+20(\n|\r\n|\r)} }
+*> { dg-output {Sum should be \+09, is = \+09(\n|\r\n|\r)} }
+*> { dg-output {Difference should be \-01, is = \-01(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {COMP\-5 Arithmetic(\n|\r\n|\r)} }
+*> { dg-output {Num1_5 is \+0000000000005; Num2_5 is \+0000000000004(\n|\r\n|\r)} }
+*> { dg-output {Product should be \+0000000000020, is = \+0000000000020(\n|\r\n|\r)} }
+*> { dg-output {Sum should be \+0000000000009, is = \+0000000000009(\n|\r\n|\r)} }
+*> { dg-output {Difference should be \-0000000000001, is = \-0000000000001(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {COMP\-3 Arithmetic(\n|\r\n|\r)} }
+*> { dg-output {Num1_3 is \+0000000000005; Num2_3 is \+0000000000004(\n|\r\n|\r)} }
+*> { dg-output {Product should be \+0000000000020, is = \+0000000000020(\n|\r\n|\r)} }
+*> { dg-output {Sum should be \+0000000000009, is = \+0000000000009(\n|\r\n|\r)} }
+*> { dg-output {Difference should be \-0000000000001, is = \-0000000000001(\n|\r\n|\r)} }
+*> { dg-output { } }
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. math.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Num1 PIC S9 VALUE 5.
+ 01 Num2 PIC S9 VALUE 4.
+ 01 Result PIC S99 VALUE ZEROS.
+ 01 Num1_5 PIC S9999999999999 COMP-5 VALUE 5.
+ 01 Num2_5 PIC S9999999999999 COMP-5 VALUE 4.
+ 01 Result_5 PIC S9999999999999 COMP-5 VALUE ZEROS.
+ 01 Num1_3 PIC S9999999999999 COMP-3 VALUE 5.
+ 01 Num2_3 PIC S9999999999999 COMP-3 VALUE 4.
+ 01 Result_3 PIC S9999999999999 COMP-3 VALUE ZEROS.
+ PROCEDURE DIVISION.
+ DISPLAY "Numeric Display arithmetic"
+ DISPLAY "Num1 is " Num1 "; Num2 is " Num2
+ MULTIPLY Num1 BY Num2 GIVING Result
+ DISPLAY "Product should be +20, is = ", Result
+ ADD Num1 TO Num2 GIVING Result
+ DISPLAY "Sum should be +09, is = ", Result
+ SUBTRACT Num1 FROM Num2 GIVING Result
+ DISPLAY "Difference should be -01, is = ", Result
+ DISPLAY " "
+ DISPLAY "COMP-5 Arithmetic"
+ DISPLAY "Num1_5 is " Num1_5 "; Num2_5 is " Num2_5
+ MULTIPLY Num1_5 BY Num2_5 GIVING Result_5
+ DISPLAY "Product should be +0000000000020, is = ", Result_5
+ ADD Num1_5 TO Num2_5 GIVING Result_5
+ DISPLAY "Sum should be +0000000000009, is = ", Result_5
+ SUBTRACT Num1_5 FROM Num2_5 GIVING Result_5
+ DISPLAY "Difference should be -0000000000001, is = ", Result_5
+ DISPLAY " "
+ DISPLAY "COMP-3 Arithmetic"
+ DISPLAY "Num1_3 is " Num1_3 "; Num2_3 is " Num2_3
+ MULTIPLY Num1_3 BY Num2_3 GIVING Result_3
+ DISPLAY "Product should be +0000000000020, is = ", Result_3
+ ADD Num1_3 TO Num2_3 GIVING Result_3
+ DISPLAY "Sum should be +0000000000009, is = ", Result_3
+ SUBTRACT Num1_3 FROM Num2_3 GIVING Result_3
+ DISPLAY "Difference should be -0000000000001, is = ", Result_3
+ DISPLAY " "
+ STOP RUN.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {0 is a hexadecimal number(\n|\r\n|\r)} }
+*> { dg-output {Dead is a hexadecimal number(\n|\r\n|\r)} }
+*> { dg-output {Fred is not a hexadecimal number(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {0 is not a real name(\n|\r\n|\r)} }
+*> { dg-output {Dead is a real name(\n|\r\n|\r)} }
+*> { dg-output {Fred is a real name(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {0 is not alphabetic(\n|\r\n|\r)} }
+*> { dg-output {Dead is alphabetic(\n|\r\n|\r)} }
+*> { dg-output {Fred is alphabetic(\n|\r\n|\r)} }
+*> { dg-output { } }
+IDENTIFICATION DIVISION.
+PROGRAM-ID. test.
+AUTHOR. Michael Coughlan.
+*> This routine is based on Listing-5-1
+ENVIRONMENT DIVISION.
+CONFIGURATION SECTION.
+SPECIAL-NAMES.
+ CLASS HexNumber IS "0" THRU "9", "A" THRU "F", "a" THRU "f", SPACE
+ CLASS RealName IS "A" THRU "Z", "a" THRU "z", "'", SPACE.
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+01 NumIn PIC X(4).
+01 NameIn PIC X(15).
+PROCEDURE DIVISION.
+ MOVE "0" TO NumIn
+ PERFORM TestHex.
+ MOVE "Dead" TO NumIn
+ PERFORM TestHex.
+ MOVE "Fred" TO NumIn
+ PERFORM TestHex.
+ DISPLAY " "
+ MOVE "0" TO NameIn
+ PERFORM TestRealname
+ MOVE "Dead" TO NameIn
+ PERFORM TestRealname
+ MOVE "Fred" TO NameIn
+ PERFORM TestRealname
+ DISPLAY " "
+ MOVE "0" TO NameIn
+ PERFORM TestAlphabetic
+ MOVE "Dead" TO NameIn
+ PERFORM TestAlphabetic
+ MOVE "Fred" TO NameIn
+ PERFORM TestAlphabetic
+ DISPLAY " "
+ STOP RUN.
+TestRealname.
+ IF NameIn IS RealName THEN
+ DISPLAY NameIn " is a real name"
+ ELSE
+ DISPLAY NameIn " is not a real name"
+ END-IF.
+TestHex.
+ IF NumIn IS HexNumber THEN
+ DISPLAY NumIn " is a hexadecimal number"
+ ELSE
+ DISPLAY NumIn " is not a hexadecimal number"
+ END-IF.
+TestAlphabetic.
+ IF NameIn IS ALPHABETIC
+ DISPLAY NameIn " is alphabetic"
+ ELSE
+ DISPLAY NameIn " is not alphabetic"
+ END-IF.
+ END PROGRAM test.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {A_4 is 0005(\n|\r\n|\r)} }
+*> { dg-output {B_4 is 0007(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {VALID: A_4 < B_4(\n|\r\n|\r)} }
+*> { dg-output {VALID: A_4 <= B_4(\n|\r\n|\r)} }
+*> { dg-output {VALID: A_4 <> B_4(\n|\r\n|\r)} }
+*> { dg-output {VALID: A_4 NOT = B_4(\n|\r\n|\r)} }
+*> { dg-output {VALID: A_4 NOT > B_4(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {CORRECTLY_TRUE: A_4 < B_4(\n|\r\n|\r)} }
+*> { dg-output {CORRECTLY_TRUE: A_4 <= B_4(\n|\r\n|\r)} }
+*> { dg-output {CORRECTLY_ELSE: A_4 = B_4(\n|\r\n|\r)} }
+*> { dg-output {CORRECTLY_TRUE: A_4 <> B_4(\n|\r\n|\r)} }
+*> { dg-output {CORRECTLY_ELSE: A_4 >= B_4(\n|\r\n|\r)} }
+*> { dg-output {CORRECTLY_ELSE: A_4 > B_4(\n|\r\n|\r)} }
+*> { dg-output { (\n|\r\n|\r)} }
+*> { dg-output {CORRECTLY_ELSE: A_4 NOT < B_4(\n|\r\n|\r)} }
+*> { dg-output {CORRECTLY_TRUE: A_4 NOT = B_4(\n|\r\n|\r)} }
+*> { dg-output {CORRECTLY_ELSE: A_4 NOT > B_4(\n|\r\n|\r)} }
+*> { dg-output { } }
+* Not strictly Reference Format
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. test.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 A_4 PIC 9999 VALUE 5.
+ 01 B_4 PIC 9999 VALUE 7.
+ PROCEDURE DIVISION.
+ DISPLAY "A_4 is " A_4
+ DISPLAY "B_4 is " B_4
+ DISPLAY " "
+*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ IF A_4 < B_4 THEN
+ DISPLAY "VALID: A_4 < B_4"
+ END-IF
+ IF A_4 <= B_4 THEN
+ DISPLAY "VALID: A_4 <= B_4"
+ END-IF
+ IF A_4 = B_4 THEN
+ DISPLAY "FALSE: A_4 = B_4"
+ END-IF
+ IF A_4 <> B_4 THEN
+ DISPLAY "VALID: A_4 <> B_4"
+ END-IF
+ IF A_4 >= B_4 THEN
+ DISPLAY "FALSE: A_4 >= B_4"
+ END-IF
+ IF A_4 > B_4 THEN
+ DISPLAY "FALSE: A_4 > B_4"
+ END-IF
+*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ IF A_4 NOT < B_4 THEN
+ DISPLAY "FALSE: A_4 NOT < B_4"
+ END-IF
+* This test works when compiled with GnuCOBOL
+* IF A_4 NOT <= B_4 THEN
+* DISPLAY "FALSE: A_4 NOT <= B_4"
+* END-IF
+ IF A_4 NOT = B_4 THEN
+ DISPLAY "VALID: A_4 NOT = B_4"
+ END-IF
+* This test works when compiled with GnuCOBOL
+* IF A_4 NOT <> B_4 THEN
+* DISPLAY "FALSE: A_4 NOT <> B_4"
+* END-IF
+* This test works when compiled with GnuCOBOL
+* IF A_4 NOT >= B_4 THEN
+* DISPLAY "VALID: A_4 NOT >= B_4"
+* END-IF
+ IF A_4 NOT > B_4 THEN
+ DISPLAY "VALID: A_4 NOT > B_4"
+ END-IF
+ DISPLAY " "
+*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ IF A_4 < B_4 THEN
+ DISPLAY "CORRECTLY_TRUE: A_4 < B_4"
+ ELSE
+ DISPLAY "INCORRECT: A_4 < B_4"
+ END-IF
+ IF A_4 <= B_4 THEN
+ DISPLAY "CORRECTLY_TRUE: A_4 <= B_4"
+ ELSE
+ DISPLAY "INCORRECT: A_4 <= B_4"
+ END-IF
+ IF A_4 = B_4 THEN
+ DISPLAY "INCORRECT: A_4 = B_4"
+ ELSE
+ DISPLAY "CORRECTLY_ELSE: A_4 = B_4"
+ END-IF
+ IF A_4 <> B_4 THEN
+ DISPLAY "CORRECTLY_TRUE: A_4 <> B_4"
+ ELSE
+ DISPLAY "INCORRECT: A_4 <> B_4"
+ END-IF
+ IF A_4 >= B_4 THEN
+ DISPLAY "INCORRECT: A_4 >= B_4"
+ ELSE
+ DISPLAY "CORRECTLY_ELSE: A_4 >= B_4"
+ END-IF
+ IF A_4 > B_4 THEN
+ DISPLAY "INCORRECT: A_4 > B_4"
+ ELSE
+ DISPLAY "CORRECTLY_ELSE: A_4 > B_4"
+ END-IF
+ DISPLAY " "
+*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ IF A_4 NOT < B_4 THEN
+ DISPLAY "INCORRECT: A_4 NOT < B_4"
+ ELSE
+ DISPLAY "CORRECTLY_ELSE: A_4 NOT < B_4"
+ END-IF
+* This test works when compiled with GnuCOBOL
+* IF A_4 NOT <= B_4 THEN
+* DISPLAY "INCORRECT: A_4 NOT <= B_4"
+* ELSE
+* DISPLAY "CORRECTLY_ELSE: A_4 NOT <= B_4"
+* END-IF
+ IF A_4 NOT = B_4 THEN
+ DISPLAY "CORRECTLY_TRUE: A_4 NOT = B_4"
+ ELSE
+ DISPLAY "INCORRECT: A_4 NOT = B_4"
+ END-IF
+* This test works when compiled with GnuCOBOL
+* IF A_4 NOT <> B_4 THEN
+* DISPLAY "INCORRECT: A_4 NOT <> B_4"
+* ELSE
+* DISPLAY "CORRECTLY_ELSE: A_4 NOT <> B_4"
+* END-IF
+* This test works when compiled with GnuCOBOL
+* IF A_4 NOT >= B_4 THEN
+* DISPLAY "CORRECTLY_TRUE: A_4 NOT >= B_4"
+* ELSE
+* DISPLAY "INCORRECT: A_4 NOT >= B_4"
+* END-IF
+ IF A_4 NOT > B_4 THEN
+ DISPLAY "CORRECTLY_ELSE: A_4 NOT > B_4"
+ ELSE
+ DISPLAY "INCORRECT: A_4 NOT > B_4"
+ END-IF
+ DISPLAY " "
+*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ STOP RUN.
--- /dev/null
+*> { dg-do run }
+*> { dg-output {Do a forward\-reference PERFORM para_CCC(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_CCC(\n|\r\n|\r)} }
+*> { dg-output {We are about to fall through the para_AAA, para_BBB, and para_CCC definitions(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_AAA(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_BBB(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_CCC(\n|\r\n|\r)} }
+*> { dg-output {We are about to PERFORM para_AAA(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_AAA(\n|\r\n|\r)} }
+*> { dg-output {We are about to PERFORM para_BBB three times(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_BBB(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_BBB(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_BBB(\n|\r\n|\r)} }
+*> { dg-output {We are about to PERFORM para_BBB through para_CCC(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_BBB(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_CCC(\n|\r\n|\r)} }
+*> { dg-output {We are about to PERFORM para_BBB through para_CCC another five times(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_BBB(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_CCC(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_BBB(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_CCC(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_BBB(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_CCC(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_BBB(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_CCC(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_BBB(\n|\r\n|\r)} }
+*> { dg-output { We are inside para_CCC(\n|\r\n|\r)} }
+*> { dg-output {Thank you for visiting the PERFORM PARAGRAPH demo} }
+IDENTIFICATION DIVISION.
+PROGRAM-ID. PerformParagraphs.
+PROCEDURE DIVISION.
+ DISPLAY "Do a forward-reference PERFORM para_CCC"
+ PERFORM para_CCC
+ DISPLAY "We are about to fall through the para_AAA, para_BBB, and para_CCC definitions".
+para_AAA.
+ DISPLAY " We are inside para_AAA".
+para_BBB.
+ DISPLAY " We are inside para_BBB".
+para_CCC.
+ DISPLAY " We are inside para_CCC".
+para_DDD.
+ DISPLAY "We are about to PERFORM para_AAA"
+ PERFORM para_AAA
+ DISPLAY "We are about to PERFORM para_BBB three times"
+ PERFORM para_BBB 3 times
+ DISPLAY "We are about to PERFORM para_BBB through para_CCC"
+ PERFORM para_BBB through para_CCC
+ DISPLAY "We are about to PERFORM para_BBB through para_CCC another five times"
+ PERFORM para_BBB through para_CCC 5 times
+ DISPLAY "Thank you for visiting the PERFORM PARAGRAPH demo"
+ STOP RUN.
+ END PROGRAM PerformParagraphs.
projects / thirdparty / gcc.git / commitdiff
