aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorBob Dubner <rdubner@symas.com>2025-03-28 08:57:24 -0400
committerRobert Dubner <rdubner@symas.com>2025-03-28 09:14:25 -0400
commitae2f951cc22ba9b0b1c8650d4de553344fc4fb95 (patch)
tree3767bd4adca3d0662908297257440f480700c4fa /gcc
parent8b4a84388c7ef9c441491b9c258212b3c2318ee3 (diff)
downloadgcc-ae2f951cc22ba9b0b1c8650d4de553344fc4fb95.zip
gcc-ae2f951cc22ba9b0b1c8650d4de553344fc4fb95.tar.gz
gcc-ae2f951cc22ba9b0b1c8650d4de553344fc4fb95.tar.bz2
cobol: Eliminate check-cobol -Os failure in EVALUATE testcase
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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/cobol/genapi.cc3
-rw-r--r--gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.cob46
-rw-r--r--gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.out5
-rw-r--r--gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.cob52
-rw-r--r--gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.out15
-rw-r--r--gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.cob16
-rw-r--r--gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.out2
-rw-r--r--gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.cob38
-rw-r--r--gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.out5
-rw-r--r--gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.cob30
-rw-r--r--gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.out5
-rw-r--r--gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.cob18
-rw-r--r--gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.out2
13 files changed, 236 insertions, 1 deletions
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index bc91533..8adc07e 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -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 );
diff --git a/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.cob b/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.cob
new file mode 100644
index 0000000..a070d16
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.cob
@@ -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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.out b/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.out
new file mode 100644
index 0000000..d634a79
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.out
@@ -0,0 +1,5 @@
+0001
+0002
+0003
+properly 4 also 5 also 6
+
diff --git a/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.cob b/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.cob
new file mode 100644
index 0000000..0e88d74
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.cob
@@ -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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.out b/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.out
new file mode 100644
index 0000000..b0e9bdb
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.out
@@ -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
+
diff --git a/gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.cob b/gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.cob
new file mode 100644
index 0000000..798f18b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.cob
@@ -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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.out b/gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.out
new file mode 100644
index 0000000..126adb7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.out
@@ -0,0 +1,2 @@
+negative
+
diff --git a/gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.cob b/gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.cob
new file mode 100644
index 0000000..84bc885
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.cob
@@ -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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.out b/gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.out
new file mode 100644
index 0000000..adff5ca
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.out
@@ -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
+
diff --git a/gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.cob b/gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.cob
new file mode 100644
index 0000000..50ff958
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.cob
@@ -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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.out b/gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.out
new file mode 100644
index 0000000..c4fa148
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.out
@@ -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"
+
diff --git a/gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.cob b/gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.cob
new file mode 100644
index 0000000..ed4c89a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.cob
@@ -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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.out b/gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.out
new file mode 100644
index 0000000..3043bcc
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.out
@@ -0,0 +1,2 @@
+not
+