This represents the first success due to converting tests to DejaGnu. One of these new tests passed everything except the -Os run.
With the patch, the changes have been demonstrated for proper behavior on x86_64 and aarch64. >From a369cc815a53659e5079a32091e02e0fecc84f28 Mon Sep 17 00:00:00 2001 From: Bob Dubner mailto:rdub...@symas.com Date: Fri, 28 Mar 2025 08:57:24 -0400 Subject: [PATCH] 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. --- gcc/cobol/genapi.cc | 3 +- .../cobol.dg/group2/Complex_EVALUATE__1_.cob | 46 ++++++++++++++++ .../cobol.dg/group2/Complex_EVALUATE__1_.out | 5 ++ .../cobol.dg/group2/Complex_EVALUATE__2_.cob | 52 +++++++++++++++++++ .../cobol.dg/group2/Complex_EVALUATE__2_.out | 15 ++++++ .../group2/EVALUATE_WHEN_NEGATIVE.cob | 16 ++++++ .../group2/EVALUATE_WHEN_NEGATIVE.out | 2 + .../group2/EVALUATE_condition__2_.cob | 38 ++++++++++++++ .../group2/EVALUATE_condition__2_.out | 5 ++ .../cobol.dg/group2/EVALUATE_doubled_WHEN.cob | 30 +++++++++++ .../cobol.dg/group2/EVALUATE_doubled_WHEN.out | 5 ++ .../EVALUATE_with_WHEN_using_condition-1.cob | 18 +++++++ .../EVALUATE_with_WHEN_using_condition-1.out | 2 + 13 files changed, 236 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.cob create mode 100644 gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__1_.out create mode 100644 gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.cob create mode 100644 gcc/testsuite/cobol.dg/group2/Complex_EVALUATE__2_.out create mode 100644 gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.cob create mode 100644 gcc/testsuite/cobol.dg/group2/EVALUATE_WHEN_NEGATIVE.out create mode 100644 gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.cob create mode 100644 gcc/testsuite/cobol.dg/group2/EVALUATE_condition__2_.out create mode 100644 gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.cob create mode 100644 gcc/testsuite/cobol.dg/group2/EVALUATE_doubled_WHEN.out create mode 100644 gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.cob create mode 100644 gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.out diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 032236b15dba..6ecdc159e4a3 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 000000000000..a070d16108e9 --- /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 000000000000..d634a794f0f3 --- /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 000000000000..0e88d74382ee --- /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 000000000000..b0e9bdb3f898 --- /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 000000000000..798f18b3580a --- /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 000000000000..126adb7fbf77 --- /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 000000000000..84bc885276fe --- /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 000000000000..adff5ca7e9d1 --- /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 000000000000..50ff9586eabb --- /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 000000000000..c4fa148b2a8c --- /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 000000000000..ed4c89a153f9 --- /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 000000000000..3043bcc5dfa3 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/EVALUATE_with_WHEN_using_condition-1.out @@ -0,0 +1,2 @@ +not + -- 2.34.1
