procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

cobol: Fifteen new cobol.dg testscases.

Browse source 
gcc/testsuite

	* cobol.dg/group1/check_88.cob: New testcase.
	* cobol.dg/group1/comp5.cob: Likewise.
	* cobol.dg/group1/declarative_1.cob: Likewise.
	* cobol.dg/group1/display.cob: Likewise.
	* cobol.dg/group1/display2.cob: Likewise.
	* cobol.dg/group1/line-sequential.cob: Likewise.
	* cobol.dg/group1/multiple-compares.cob: Likewise.
	* cobol.dg/group1/multiply2.cob: Likewise.
	* cobol.dg/group1/packed.cob: Likewise.
	* cobol.dg/group1/perform-nested-exit.cob: Likewise.
	* cobol.dg/group1/pointer1.cob: Likewise.
	* cobol.dg/group1/simple-arithmetic.cob: Likewise.
	* cobol.dg/group1/simple-classes.cob: Likewise.
	* cobol.dg/group1/simple-if.cob: Likewise.
	* cobol.dg/group1/simple-perform.cob: Likewise.
This commit is contained in:
Bob Dubner 2025-03-17 21:47:05 -04:00 • committed by Robert Dubner
parent 8333f1c7e6
commit 82bb1890ae
15 changed files with 1183 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

101
gcc/testsuite/cobol.dg/group1/check_88.cob Normal file
View file

@ -0,0 +1,101 @@
*> { 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
.

72
gcc/testsuite/cobol.dg/group1/comp5.cob Normal file
View file

@ -0,0 +1,72 @@
*> { 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.

116
gcc/testsuite/cobol.dg/group1/declarative_1.cob Normal file
View file

@ -0,0 +1,116 @@
*> { 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.

14
gcc/testsuite/cobol.dg/group1/display.cob Normal file
View file

@ -0,0 +1,14 @@
*> { 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.

7
gcc/testsuite/cobol.dg/group1/display2.cob Normal file
View file

@ -0,0 +1,7 @@
*> { dg-do run }
*> { dg-output {1 2} }
IDENTIFICATION DIVISION.
PROGRAM-ID. disp2.
PROCEDURE DIVISION.
DISPLAY 1 SPACE 2
STOP RUN.

34
gcc/testsuite/cobol.dg/group1/line-sequential.cob Normal file
View file

@ -0,0 +1,34 @@
*> { 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.

192
gcc/testsuite/cobol.dg/group1/multiple-compares.cob Normal file
View file

@ -0,0 +1,192 @@
*> { 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.

68
gcc/testsuite/cobol.dg/group1/multiply2.cob Normal file
View file

@ -0,0 +1,68 @@
*> { 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.

73
gcc/testsuite/cobol.dg/group1/packed.cob Normal file
View file

@ -0,0 +1,73 @@
*> { 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.

84
gcc/testsuite/cobol.dg/group1/perform-nested-exit.cob Normal file
View file

@ -0,0 +1,84 @@
*> { 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.

98
gcc/testsuite/cobol.dg/group1/pointer1.cob Normal file
View file

@ -0,0 +1,98 @@
*> { 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.

61
gcc/testsuite/cobol.dg/group1/simple-arithmetic.cob Normal file
View file

@ -0,0 +1,61 @@
*> { 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.

68
gcc/testsuite/cobol.dg/group1/simple-classes.cob Normal file
View file

@ -0,0 +1,68 @@
*> { 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.

143
gcc/testsuite/cobol.dg/group1/simple-if.cob Normal file
View file

@ -0,0 +1,143 @@
*> { 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.

52
gcc/testsuite/cobol.dg/group1/simple-perform.cob Normal file
View file

@ -0,0 +1,52 @@
*> { 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.