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

cobol: Eliminate check-cobol -Os failure in EVALUATE testcase

Browse source 
The coding error was the lack of a necessary cast from unsigned
char to int.

gcc/cobol

	* genapi.cc: (create_and_call): cast unsigned char to int

gcc/testsuite

	* cobol.dg/group2/Complex_EVALUATE__1_.cob: New EVALUTE testcase.
	* cobol.dg/group2/Complex_EVALUATE__2_.cob: Likewise.
	* cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.cob: Likewise.
	* cobol.dg/group2/EVALUATE_condition__2_.cob: Likewise.
	* cobol.dg/group2/EVALUATE_doubled_WHEN.cob: Likewise.
	* cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.cob: Likewise.
	* cobol.dg/group2/Complex_EVALUATE__1_.out: Known-good data for testcase.
	* cobol.dg/group2/Complex_EVALUATE__2_.out: Likewise.
	* cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.out: Likewise.
	* cobol.dg/group2/EVALUATE_condition__2_.out: Likewise.
	* cobol.dg/group2/EVALUATE_doubled_WHEN.out: Likewise.
	* cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.out: Likewise.
This commit is contained in:
Bob Dubner 2025-03-28 08:57:24 -04:00 • committed by Robert Dubner
parent 8b4a84388c
commit ae2f951cc2
13 changed files with 236 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
gcc/cobol/genapi.cc
View file

@ -12395,13 +12395,14 @@ create_and_call(size_t narg,
// We got back a 64-bit or 128-bit integer. The called and calling
// programs have to agree on size, but other than that, integer numeric
// types are converted one to the other.
gg_call(VOID,
"__gg__int128_to_qualified_field",
gg_get_address_of(returned.field->var_decl_node),
refer_offset_dest(returned),
refer_size_dest(returned),
gg_cast(INT128, returned_value),
member(returned.field->var_decl_node, "rdigits"),
gg_cast(INT, member(returned.field->var_decl_node, "rdigits")),
build_int_cst_type(INT, truncation_e),
null_pointer_node,
NULL_TREE );

46
gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.cob Normal file
View file

@ -0,0 +1,46 @@
*> { dg-do run }
*> { dg-output-file "group2/Complex_EVALUATE__1_.out" }
identification division.
function-id. bumper.
data division.
working-storage section.
77 bump pic 9999 value zero.
linkage section.
77 bumped pic 9999.
procedure division returning bumped.
add 1 to bump.
move bump to bumped.
goback.
end function bumper.
identification division.
program-id. prog.
environment division.
configuration section.
repository.
function bumper.
data division.
working-storage section.
77 bump pic 9999 value zero.
77 bump1 pic 9999 value zero.
77 bump2 pic 9999 value zero.
77 bump3 pic 9999 value zero.
procedure division.
move function bumper to bump
display bump
move function bumper to bump
display bump
move function bumper to bump
display bump
evaluate function bumper also function bumper also function bumper
when 4 also 5 also 6
display "properly 4 also 5 also 6"
when 7 also 8 also 9
display "IMPROPERLY 6 then 7 then 8"
when other
display "we don't know what's going on"
end-evaluate
goback.
end program prog.

5
gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.out Normal file
View file

@ -0,0 +1,5 @@
0001
0002
0003
properly 4 also 5 also 6

52
gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.cob Normal file
View file

@ -0,0 +1,52 @@
*> { dg-do run }
*> { dg-output-file "group2/Complex_EVALUATE__2_.out" }
identification division.
function-id. bumper.
data division.
working-storage section.
77 bump pic 9999 value zero.
linkage section.
77 bumped pic 9999.
procedure division returning bumped.
add 1 to bump.
move bump to bumped.
display " bumper is returning " bumped
goback.
end function bumper.
identification division.
program-id. prog.
environment division.
configuration section.
repository.
function bumper.
data division.
working-storage section.
77 bump pic 9999 value zero.
procedure division.
display " Prime the pump with three calls to bumper"
move function bumper to bump
move function bumper to bump
move function bumper to bump
display " Three calls to BUMPER should follow"
evaluate function bumper also function bumper also function bumper
when 4 also 5 also 6
display "properly 4 also 5 also 6"
when 7 also 8 also 9
display "IMPROPERLY 7 also 8 also 9"
when other
display "IMPROPERLY we don't know what's going on"
end-evaluate
display " Three more calls to BUMPER should follow"
evaluate function bumper also function bumper also function bumper
when 4 also 5 also 6
display "IMPROPERLY 4 also 5 also 6"
when 7 also 8 also 9
display "properly 7 also 8 also 9"
when other
display "IMPROPERLY we don't know what's going on"
end-evaluate
goback.
end program prog.

15
gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.out Normal file
View file

@ -0,0 +1,15 @@
Prime the pump with three calls to bumper
bumper is returning 0001
bumper is returning 0002
bumper is returning 0003
Three calls to BUMPER should follow
bumper is returning 0004
bumper is returning 0005
bumper is returning 0006
properly 4 also 5 also 6
Three more calls to BUMPER should follow
bumper is returning 0007
bumper is returning 0008
bumper is returning 0009
properly 7 also 8 also 9

16
gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.cob Normal file
View file

@ -0,0 +1,16 @@
*> { dg-do run }
*> { dg-output-file "group2/EVALUATE_WHEN_NEGATIVE.out" }
identification division.
program-id. prog.
data division.
working-storage section.
77 num pic s9.
procedure division.
move -1 to num
evaluate num
when negative
display "negative"
end-evaluate.
end program prog.

2
gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.out Normal file
View file

@ -0,0 +1,2 @@
negative

38
gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.cob Normal file
View file

@ -0,0 +1,38 @@
*> { dg-do run }
*> { dg-output-file "group2/EVALUATE_condition__2_.out" }
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 XVAL PIC X VALUE '_'.
88 UNDERSCORE VALUE '_'.
PROCEDURE DIVISION.
DISPLAY 'Next line should be "UNDERSCORE evaluates to TRUE"'
EVALUATE TRUE
WHEN NOT UNDERSCORE
DISPLAY
"***IMPROPERLY*** NOT UNDERSCORE evaluates to TRUE"
END-DISPLAY
END-EVALUATE.
EVALUATE TRUE
WHEN UNDERSCORE
DISPLAY "UNDERSCORE evaluates to TRUE"
END-DISPLAY
END-EVALUATE.
DISPLAY
'Next line should be "NOT UNDERSCORE evaluates to FALSE"'
EVALUATE FALSE
WHEN NOT UNDERSCORE
DISPLAY "NOT UNDERSCORE evaluates to FALSE"
END-DISPLAY
END-EVALUATE.
EVALUATE FALSE
WHEN UNDERSCORE
DISPLAY
"***IMPROPERLY*** UNDERSCORE evaluates to FALSE"
END-DISPLAY
END-EVALUATE.
STOP RUN.

5
gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.out Normal file
View file

@ -0,0 +1,5 @@
Next line should be "UNDERSCORE evaluates to TRUE"
UNDERSCORE evaluates to TRUE
Next line should be "NOT UNDERSCORE evaluates to FALSE"
NOT UNDERSCORE evaluates to FALSE

30
gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.cob Normal file
View file

@ -0,0 +1,30 @@
*> { dg-do run }
*> { dg-output-file "group2/EVALUATE_doubled_WHEN.out" }
identification division.
program-id. prog.
data division.
working-storage section.
77 eval pic x(4).
procedure division.
move "open" to eval
display "about to EVALUATE eval " """" eval """"
evaluate true
when eval = 'open'
when eval = 'OPEN'
display "Good: We got us an " """" eval """"
when other
display "BAD!!! It shoulda been " """" eval """"
end-evaluate
move "OPEN" to eval
display "about to EVALUATE eval " """" eval """"
evaluate true
when eval = 'open'
when eval = 'OPEN'
display "Good: We got us an " """" eval """"
when other
display "BAD!!! It shoulda been " """" eval """"
end-evaluate
goback.
end program prog.

5
gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.out Normal file
View file

@ -0,0 +1,5 @@
about to EVALUATE eval "open"
Good: We got us an "open"
about to EVALUATE eval "OPEN"
Good: We got us an "OPEN"

18
gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.cob Normal file
View file

@ -0,0 +1,18 @@
*> { dg-do run }
*> { dg-output-file "group2/EVALUATE_with_WHEN_using_condition-1.out" }
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 var-1 PIC 99V9.
88 var-1-big VALUE 20 THRU 40.
88 var-1-huge VALUE 40 THRU 99.
PROCEDURE DIVISION.
EVALUATE TRUE *> not: var-1
WHEN var-1-big DISPLAY "big"
WHEN var-1-huge DISPLAY "huge"
WHEN OTHER DISPLAY "not"
END-EVALUATE.
END PROGRAM prog.

2
gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.out Normal file
View file

@ -0,0 +1,2 @@
not