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.

diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index bc91533815882c2a2ce974e0afe8f653121f1473..8adc07ec57fa187154111e5b3ff159e383b0dcf9 100644 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
index 0000000..3043bcc
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.out
@@ -0,0 +1,2 @@
+not
+