https://gcc.gnu.org/g:72ecfe355ad528e7e21d0c5ec24d33ae8cfc5b31
commit r15-8991-g72ecfe355ad528e7e21d0c5ec24d33ae8cfc5b31 Author: Bob Dubner <rdub...@symas.com> Date: Thu Mar 27 17:55:53 2025 -0400 cobol: Incorporate new testcases from the cobolworx UAT tests. The author notes that some of the file names are regrettably lengthy, which is because they are derived from the descriptive names of the autom4te tests. gcc/testsuite * cobol.dg/group2/ACCEPT_DATE___DAY_and_intrinsic_functions__1_.cob: New testcase. * cobol.dg/group2/ACCEPT_DATE___DAY_and_intrinsic_functions__2_.cob: Likewise. * cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__1_.cob: Likewise. * cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.cob: Likewise. * cobol.dg/group2/COMP-6_arithmetic.cob: Likewise. * cobol.dg/group2/COMP-6_numeric_test.cob: Likewise. * cobol.dg/group2/COMP-6_used_with_DISPLAY.cob: Likewise. * cobol.dg/group2/COMP-6_used_with_MOVE.cob: Likewise. * cobol.dg/group2/COMPUTE_multiplication_to_FIX4.cob: Likewise. * cobol.dg/group2/DISPLAY__Sign_ASCII__2_.cob: Likewise. * cobol.dg/group2/DISPLAY__Sign_ASCII.cob: Likewise. * cobol.dg/group2/Floating_continuation_indicator__1_.cob: Likewise. * cobol.dg/group2/floating-point_ADD_FORMAT_1.cob: Likewise. * cobol.dg/group2/floating-point_ADD_FORMAT_2.cob: Likewise. * cobol.dg/group2/floating-point_DIVIDE_FORMAT_1.cob: Likewise. * cobol.dg/group2/floating-point_DIVIDE_FORMAT_2.cob: Likewise. * cobol.dg/group2/floating-point_literals.cob: Likewise. * cobol.dg/group2/floating-point_MULTIPLY_FORMAT_1.cob: Likewise. * cobol.dg/group2/floating-point_MULTIPLY_FORMAT_2.cob: Likewise. * cobol.dg/group2/floating-point_SUBTRACT_FORMAT_1.cob: Likewise. * cobol.dg/group2/floating-point_SUBTRACT_FORMAT_2.cob: Likewise. * cobol.dg/group2/IBM_dialect_COMP_redefined_by_POINTER_as_64-bit.cob: Likewise. * cobol.dg/group2/Indicators_______________-____D__.cob: Likewise. * cobol.dg/group2/MULTIPLY_to_FIX4.cob: Likewise. * cobol.dg/group2/PACKED-DECIMAL_arithmetic.cob: Likewise. * cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__1_.cob: Likewise. * cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.cob: Likewise. * cobol.dg/group2/PACKED-DECIMAL_dump.cob: Likewise. * cobol.dg/group2/PACKED-DECIMAL_numeric_test__1_.cob: Likewise. * cobol.dg/group2/PACKED-DECIMAL_numeric_test__2_.cob: Likewise. * cobol.dg/group2/PACKED-DECIMAL_used_with_DISPLAY.cob: Likewise. * cobol.dg/group2/PACKED-DECIMAL_used_with_INITIALIZE.cob: Likewise. * cobol.dg/group2/PACKED-DECIMAL_used_with_MOVE.cob: Likewise. * cobol.dg/group2/POINTER__display.cob: Likewise. * cobol.dg/group2/Simple_floating-point_MOVE.cob: Likewise. * cobol.dg/group2/Simple_floating-point_VALUE_and_MOVE.cob: Likewise. * cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.out: Known-good result. * cobol.dg/group2/COMP-6_arithmetic.out: Likewise. * cobol.dg/group2/COMP-6_numeric_test.out: Likewise. * cobol.dg/group2/COMP-6_used_with_DISPLAY.out: Likewise. * cobol.dg/group2/COMP-6_used_with_MOVE.out: Likewise. * cobol.dg/group2/COMPUTE_multiplication_to_FIX4.out: Likewise. * cobol.dg/group2/DISPLAY__Sign_ASCII__2_.out: Likewise. * cobol.dg/group2/DISPLAY__Sign_ASCII.out: Likewise. * cobol.dg/group2/Floating_continuation_indicator__1_.out: Likewise. * cobol.dg/group2/floating-point_ADD_FORMAT_1.out: Likewise. * cobol.dg/group2/floating-point_ADD_FORMAT_2.out: Likewise. * cobol.dg/group2/floating-point_DIVIDE_FORMAT_1.out: Likewise. * cobol.dg/group2/floating-point_DIVIDE_FORMAT_2.out: Likewise. * cobol.dg/group2/floating-point_literals.out: Likewise. * cobol.dg/group2/floating-point_MULTIPLY_FORMAT_1.out: Likewise. * cobol.dg/group2/floating-point_MULTIPLY_FORMAT_2.out: Likewise. * cobol.dg/group2/floating-point_SUBTRACT_FORMAT_1.out: Likewise. * cobol.dg/group2/floating-point_SUBTRACT_FORMAT_2.out: Likewise. * cobol.dg/group2/IBM_dialect_COMP_redefined_by_POINTER_as_64-bit.out: Likewise. * cobol.dg/group2/Indicators_______________-____D__.out: Likewise. * cobol.dg/group2/MULTIPLY_to_FIX4.out: Likewise. * cobol.dg/group2/PACKED-DECIMAL_arithmetic.out: Likewise. * cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__1_.out: Likewise. * cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.out: Likewise. * cobol.dg/group2/PACKED-DECIMAL_dump.out: Likewise. * cobol.dg/group2/PACKED-DECIMAL_numeric_test__1_.out: Likewise. * cobol.dg/group2/PACKED-DECIMAL_numeric_test__2_.out: Likewise. * cobol.dg/group2/PACKED-DECIMAL_used_with_DISPLAY.out: Likewise. * cobol.dg/group2/PACKED-DECIMAL_used_with_INITIALIZE.out: Likewise. * cobol.dg/group2/PACKED-DECIMAL_used_with_MOVE.out: Likewise. * cobol.dg/group2/POINTER__display.out: Likewise. * cobol.dg/group2/Simple_floating-point_MOVE.out: Likewise. * cobol.dg/group2/Simple_floating-point_VALUE_and_MOVE.out: Likewise. Diff: --- ...CEPT_DATE___DAY_and_intrinsic_functions__1_.cob | 30 ++ ...CEPT_DATE___DAY_and_intrinsic_functions__2_.cob | 31 ++ ...PT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__1_.cob | 58 +++ ...PT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.cob | 74 ++++ ...PT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.out | 5 + .../cobol.dg/group2/COMP-6_arithmetic.cob | 23 + .../cobol.dg/group2/COMP-6_arithmetic.out | 2 + .../cobol.dg/group2/COMP-6_numeric_test.cob | 75 ++++ .../cobol.dg/group2/COMP-6_numeric_test.out | 9 + .../cobol.dg/group2/COMP-6_used_with_DISPLAY.cob | 25 ++ .../cobol.dg/group2/COMP-6_used_with_DISPLAY.out | 5 + .../cobol.dg/group2/COMP-6_used_with_MOVE.cob | 34 ++ .../cobol.dg/group2/COMP-6_used_with_MOVE.out | 6 + .../group2/COMPUTE_multiplication_to_FIX4.cob | 154 +++++++ .../group2/COMPUTE_multiplication_to_FIX4.out | 64 +++ .../cobol.dg/group2/DISPLAY__Sign_ASCII.cob | 40 ++ .../cobol.dg/group2/DISPLAY__Sign_ASCII.out | 12 + .../cobol.dg/group2/DISPLAY__Sign_ASCII__2_.cob | 38 ++ .../cobol.dg/group2/DISPLAY__Sign_ASCII__2_.out | 1 + .../group2/Floating_continuation_indicator__1_.cob | 21 + .../group2/Floating_continuation_indicator__1_.out | 5 + ...dialect_COMP_redefined_by_POINTER_as_64-bit.cob | 34 ++ ...dialect_COMP_redefined_by_POINTER_as_64-bit.out | 7 + .../group2/Indicators_______________-____D__.cob | 26 ++ .../group2/Indicators_______________-____D__.out | 3 + gcc/testsuite/cobol.dg/group2/MULTIPLY_to_FIX4.cob | 101 +++++ gcc/testsuite/cobol.dg/group2/MULTIPLY_to_FIX4.out | 58 +++ .../cobol.dg/group2/PACKED-DECIMAL_arithmetic.cob | 24 + .../cobol.dg/group2/PACKED-DECIMAL_arithmetic.out | 4 + .../PACKED-DECIMAL_basic_comp-3_comp-6__1_.cob | 52 +++ .../PACKED-DECIMAL_basic_comp-3_comp-6__1_.out | 29 ++ .../PACKED-DECIMAL_basic_comp-3_comp-6__2_.cob | 41 ++ .../PACKED-DECIMAL_basic_comp-3_comp-6__2_.out | 9 + .../cobol.dg/group2/PACKED-DECIMAL_dump.cob | 486 +++++++++++++++++++++ .../cobol.dg/group2/PACKED-DECIMAL_dump.out | 109 +++++ .../group2/PACKED-DECIMAL_numeric_test__1_.cob | 119 +++++ .../group2/PACKED-DECIMAL_numeric_test__1_.out | 15 + .../group2/PACKED-DECIMAL_numeric_test__2_.cob | 91 ++++ .../group2/PACKED-DECIMAL_numeric_test__2_.out | 15 + .../group2/PACKED-DECIMAL_used_with_DISPLAY.cob | 38 ++ .../group2/PACKED-DECIMAL_used_with_DISPLAY.out | 9 + .../group2/PACKED-DECIMAL_used_with_INITIALIZE.cob | 26 ++ .../group2/PACKED-DECIMAL_used_with_INITIALIZE.out | 5 + .../group2/PACKED-DECIMAL_used_with_MOVE.cob | 40 ++ .../group2/PACKED-DECIMAL_used_with_MOVE.out | 9 + gcc/testsuite/cobol.dg/group2/POINTER__display.cob | 18 + gcc/testsuite/cobol.dg/group2/POINTER__display.out | 4 + .../cobol.dg/group2/Simple_floating-point_MOVE.cob | 48 ++ .../cobol.dg/group2/Simple_floating-point_MOVE.out | 8 + .../Simple_floating-point_VALUE_and_MOVE.cob | 176 ++++++++ .../Simple_floating-point_VALUE_and_MOVE.out | 61 +++ .../group2/floating-point_ADD_FORMAT_1.cob | 90 ++++ .../group2/floating-point_ADD_FORMAT_1.out | 8 + .../group2/floating-point_ADD_FORMAT_2.cob | 96 ++++ .../group2/floating-point_ADD_FORMAT_2.out | 8 + .../group2/floating-point_DIVIDE_FORMAT_1.cob | 90 ++++ .../group2/floating-point_DIVIDE_FORMAT_1.out | 8 + .../group2/floating-point_DIVIDE_FORMAT_2.cob | 96 ++++ .../group2/floating-point_DIVIDE_FORMAT_2.out | 8 + .../group2/floating-point_MULTIPLY_FORMAT_1.cob | 90 ++++ .../group2/floating-point_MULTIPLY_FORMAT_1.out | 8 + .../group2/floating-point_MULTIPLY_FORMAT_2.cob | 96 ++++ .../group2/floating-point_MULTIPLY_FORMAT_2.out | 8 + .../group2/floating-point_SUBTRACT_FORMAT_1.cob | 90 ++++ .../group2/floating-point_SUBTRACT_FORMAT_1.out | 8 + .../group2/floating-point_SUBTRACT_FORMAT_2.cob | 96 ++++ .../group2/floating-point_SUBTRACT_FORMAT_2.out | 8 + .../cobol.dg/group2/floating-point_literals.cob | 48 ++ .../cobol.dg/group2/floating-point_literals.out | 9 + 69 files changed, 3242 insertions(+) diff --git a/gcc/testsuite/cobol.dg/group2/ACCEPT_DATE___DAY_and_intrinsic_functions__1_.cob b/gcc/testsuite/cobol.dg/group2/ACCEPT_DATE___DAY_and_intrinsic_functions__1_.cob new file mode 100644 index 000000000000..69eb283d70a5 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ACCEPT_DATE___DAY_and_intrinsic_functions__1_.cob @@ -0,0 +1,30 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + *> one byte longer to make sure there is no garbage in + 01 WS-YYYYMMDD PIC 9(9). + 01 WS-YYYYDDD PIC 9(8). + PROCEDURE DIVISION. + ACCEPT WS-YYYYMMDD FROM DATE YYYYMMDD + END-ACCEPT + ACCEPT WS-YYYYDDD FROM DAY YYYYDDD + END-ACCEPT + IF FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) + NOT = FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) + DISPLAY "DIFFERENCES FOUND!" + END-DISPLAY + DISPLAY "YYYYMMDD = " WS-YYYYMMDD ", " + "YYYYDDD = " WS-YYYYDDD + END-DISPLAY + DISPLAY "INTEGER-OF-DATE = " + FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) ", " + "INTEGER-OF-DAY = " + FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) + END-DISPLAY + MOVE 1 TO RETURN-CODE + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ACCEPT_DATE___DAY_and_intrinsic_functions__2_.cob b/gcc/testsuite/cobol.dg/group2/ACCEPT_DATE___DAY_and_intrinsic_functions__2_.cob new file mode 100644 index 000000000000..7a404fd4f53b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ACCEPT_DATE___DAY_and_intrinsic_functions__2_.cob @@ -0,0 +1,31 @@ + *> { dg-do run } + *> { dg-set-target-env-var COB_CURRENT_DATE "2020/06/12 18:45:22" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + *> one byte longer to make sure there is no garbage in + 01 WS-YYYYMMDD PIC 9(9). + 01 WS-YYYYDDD PIC 9(8). + PROCEDURE DIVISION. + ACCEPT WS-YYYYMMDD FROM DATE YYYYMMDD + END-ACCEPT + ACCEPT WS-YYYYDDD FROM DAY YYYYDDD + END-ACCEPT + IF FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) + NOT = FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) + DISPLAY "DIFFERENCES FOUND!" + END-DISPLAY + DISPLAY "YYYYMMDD = " WS-YYYYMMDD ", " + "YYYYDDD = " WS-YYYYDDD + END-DISPLAY + DISPLAY "INTEGER-OF-DATE = " + FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) ", " + "INTEGER-OF-DAY = " + FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) + END-DISPLAY + MOVE 1 TO RETURN-CODE + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__1_.cob b/gcc/testsuite/cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__1_.cob new file mode 100644 index 000000000000..6c1e4793031f --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__1_.cob @@ -0,0 +1,58 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + *> one byte longer to make sure there is no garbage in + 01 X PIC X(9). + PROCEDURE DIVISION. + ACCEPT X FROM TIME + END-ACCEPT + IF X (1:2) >= "00" AND <= "23" AND + X (3:2) >= "00" AND <= "59" AND + X (5:2) >= "00" AND <= "60" AND + X (7:2) >= "00" AND <= "99" AND + X (9: ) = SPACE + CONTINUE + ELSE + DISPLAY "TIME " X "!" + END-DISPLAY + END-IF + ACCEPT X FROM DATE + END-ACCEPT + INSPECT X CONVERTING "012345678" TO "999999999" + IF X NOT = "999999" + DISPLAY "DATE " X "!" + END-DISPLAY + END-IF + ACCEPT X FROM DATE YYYYMMDD + END-ACCEPT + INSPECT X CONVERTING "012345678" TO "999999999" + IF X NOT = "99999999" + DISPLAY "YYYYMMDD " X "!" + END-DISPLAY + END-IF + ACCEPT X FROM DAY + END-ACCEPT + INSPECT X CONVERTING "012345678" TO "999999999" + IF X NOT = "99999" + DISPLAY "DAY " X "!" + END-DISPLAY + END-IF + ACCEPT X FROM DAY YYYYDDD + END-ACCEPT + INSPECT X CONVERTING "012345678" TO "999999999" + IF X NOT = "9999999" + DISPLAY "YYYYDDD " X "!" + END-DISPLAY + END-IF + ACCEPT X FROM DAY-OF-WEEK + END-ACCEPT + INSPECT X CONVERTING "1234567" TO "9999999" + IF X NOT = "9" + DISPLAY "DAY-OF-WEEK " X "!" + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.cob b/gcc/testsuite/cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.cob new file mode 100644 index 000000000000..601422043b72 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.cob @@ -0,0 +1,74 @@ + *> { dg-do run } + *> { dg-set-target-env-var COB_CURRENT_DATE "2015/04/05 18:45:22" } + *> { dg-output-file "group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + *> one byte longer to make sure there is no garbage in + 01 WS-YYYYMMDD PIC X(9). + 01 WS-YYYYDDD PIC X(8). + 01 WS-DAYOFWEEK PIC X(2). + 01 WS-DATE-TODAY. + 05 WS-TODAYS-YY PIC 9(02) VALUE 0. + 05 WS-TODAYS-MM PIC 9(02) VALUE 0. + 05 WS-TODAYS-DD PIC 9(02) VALUE 0. + + 01 WS-DATE. + 05 WS-DATE-MM PIC 9(02) VALUE 0. + 05 FILLER PIC X(01) VALUE '/'. + 05 WS-DATE-DD PIC 9(02) VALUE 0. + 05 FILLER PIC X(01) VALUE '/'. + 05 WS-DATE-YY PIC 9(02) VALUE 0. + + 01 WS-TIME-NOW. + 05 WS-NOW-HH PIC 9(02) VALUE 0. + 05 WS-NOW-MM PIC 9(02) VALUE 0. + 05 WS-NOW-SS PIC 9(02) VALUE 0. + 05 WS-NOW-HS PIC 9(02) VALUE 0. + + 01 WS-TIME. + 05 WS-TIME-HH PIC 9(02) VALUE 0. + 05 FILLER PIC X(01) VALUE ':'. + 05 WS-TIME-MM PIC 9(02) VALUE 0. + 05 FILLER PIC X(01) VALUE ':'. + 05 WS-TIME-SS PIC 9(02) VALUE 0. + + PROCEDURE DIVISION. + ACCEPT WS-DATE-TODAY FROM DATE + ACCEPT WS-TIME-NOW FROM TIME + MOVE WS-TODAYS-YY TO WS-DATE-YY + MOVE WS-TODAYS-MM TO WS-DATE-MM + MOVE WS-TODAYS-DD TO WS-DATE-DD + MOVE WS-NOW-HH TO WS-TIME-HH + MOVE WS-NOW-MM TO WS-TIME-MM + MOVE WS-NOW-SS TO WS-TIME-SS + DISPLAY 'PROCESS DATE/TIME : ' WS-DATE SPACE WS-TIME + END-DISPLAY + ACCEPT WS-YYYYMMDD FROM DATE YYYYMMDD + DISPLAY WS-YYYYMMDD(1:8) + IF WS-YYYYMMDD not = "20150405" + DISPLAY 'Wrong date DATE YYYYMMDD: ' WS-YYYYMMDD + ' expected: 20150405' + UPON STDERR + END-DISPLAY + END-IF + ACCEPT WS-YYYYDDD FROM DAY YYYYDDD + DISPLAY WS-YYYYDDD(1:7) + IF WS-YYYYDDD not = "2015095" + DISPLAY 'Wrong date YYYYDDD: ' WS-YYYYDDD + ' expected: 2015095' + UPON STDERR + END-DISPLAY + END-IF + ACCEPT WS-DAYOFWEEK FROM DAY-OF-WEEK + DISPLAY WS-DAYOFWEEK(1:1) + IF WS-DAYOFWEEK not = "7" + DISPLAY 'Wrong date DAYOFWEEK: ' WS-DAYOFWEEK + ' expected: 7' + UPON STDERR + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.out b/gcc/testsuite/cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.out new file mode 100644 index 000000000000..a6ac8c4a70fa --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.out @@ -0,0 +1,5 @@ +PROCESS DATE/TIME : 04/05/15 18:45:22 +20150405 +2015095 +7 + diff --git a/gcc/testsuite/cobol.dg/group2/COMP-6_arithmetic.cob b/gcc/testsuite/cobol.dg/group2/COMP-6_arithmetic.cob new file mode 100644 index 000000000000..6e8dc5c3011a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/COMP-6_arithmetic.cob @@ -0,0 +1,23 @@ + *> { dg-do run } + *> { dg-options "-dialect mf" } + *> { dg-output-file "group2/COMP-6_arithmetic.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X-99 PIC 99 USAGE COMP-6. + 01 X-999 PIC 999 USAGE COMP-6. + 01 B-99 USAGE BINARY-LONG UNSIGNED. + 01 B-999 USAGE BINARY-LONG UNSIGNED. + PROCEDURE DIVISION. + MOVE 99 TO B-99 + MOVE B-99 TO X-99 + MOVE 123 TO B-999 + MOVE B-999 TO X-999 + ADD X-99 X-999 GIVING B-99 + END-ADD + DISPLAY B-99 + END-DISPLAY + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/COMP-6_arithmetic.out b/gcc/testsuite/cobol.dg/group2/COMP-6_arithmetic.out new file mode 100644 index 000000000000..fce98b0eee59 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/COMP-6_arithmetic.out @@ -0,0 +1,2 @@ +0000000222 + diff --git a/gcc/testsuite/cobol.dg/group2/COMP-6_numeric_test.cob b/gcc/testsuite/cobol.dg/group2/COMP-6_numeric_test.cob new file mode 100644 index 000000000000..3628628fc087 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/COMP-6_numeric_test.cob @@ -0,0 +1,75 @@ + *> { dg-do run } + *> { dg-options "-dialect mf" } + *> { dg-output-file "group2/COMP-6_numeric_test.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 G. + 02 X-2 PIC X(2). + 02 N-3 REDEFINES X-2 PIC 999 USAGE COMP-6. + 02 N-4 REDEFINES X-2 PIC 9999 USAGE COMP-6. + PROCEDURE DIVISION. + MOVE X"0000" TO X-2. + IF N-3 IS NUMERIC + DISPLAY "OK" + END-DISPLAY + ELSE + DISPLAY "1 NG" + END-DISPLAY + END-IF. + IF N-4 IS NUMERIC + DISPLAY "OK" + END-DISPLAY + ELSE + DISPLAY "2 NG" + END-DISPLAY + END-IF. + MOVE X"000c" TO X-2. + IF N-3 IS NUMERIC + DISPLAY "3 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + IF N-4 IS NUMERIC + DISPLAY "4 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + MOVE X"1234" TO X-2. + IF N-3 IS NUMERIC + DISPLAY "5 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + IF N-4 IS NUMERIC + DISPLAY "OK" + END-DISPLAY + ELSE + DISPLAY "6 NG" + END-DISPLAY + END-IF. + MOVE X"ffff" TO X-2. + IF N-3 IS NUMERIC + DISPLAY "7 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + IF N-4 IS NUMERIC + DISPLAY "7 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/COMP-6_numeric_test.out b/gcc/testsuite/cobol.dg/group2/COMP-6_numeric_test.out new file mode 100644 index 000000000000..09117b65b461 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/COMP-6_numeric_test.out @@ -0,0 +1,9 @@ +OK +OK +OK +OK +OK +OK +OK +OK + diff --git a/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_DISPLAY.cob b/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_DISPLAY.cob new file mode 100644 index 000000000000..33d048e62328 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_DISPLAY.cob @@ -0,0 +1,25 @@ + *> { dg-do run } + *> { dg-options "-dialect mf" } + *> { dg-output-file "group2/COMP-6_used_with_DISPLAY.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X-99 PIC 99 USAGE COMP-6. + 01 X-999 PIC 999 USAGE COMP-6. + PROCEDURE DIVISION. + MOVE 0 TO X-99. + DISPLAY X-99 + END-DISPLAY. + MOVE 99 TO X-99. + DISPLAY X-99 + END-DISPLAY. + MOVE 0 TO X-999. + DISPLAY X-999 + END-DISPLAY. + MOVE 123 TO X-999. + DISPLAY X-999 + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_DISPLAY.out b/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_DISPLAY.out new file mode 100644 index 000000000000..901408e1a90f --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_DISPLAY.out @@ -0,0 +1,5 @@ +00 +99 +000 +123 + diff --git a/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_MOVE.cob b/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_MOVE.cob new file mode 100644 index 000000000000..9f319faa6651 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_MOVE.cob @@ -0,0 +1,34 @@ + *> { dg-do run } + *> { dg-options "-dialect mf" } + *> { dg-output-file "group2/COMP-6_used_with_MOVE.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X-99 PIC 99 USAGE COMP-6. + 01 X-999 PIC 999 USAGE COMP-6. + 01 B-99 USAGE BINARY-LONG. + 01 B-999 USAGE BINARY-LONG. + PROCEDURE DIVISION. + MOVE 0 TO B-99. + MOVE B-99 TO X-99. + DISPLAY X-99 + END-DISPLAY. + MOVE 99 TO B-99. + MOVE B-99 TO X-99. + DISPLAY X-99 + END-DISPLAY. + MOVE 0 TO B-999. + MOVE B-999 TO X-999. + DISPLAY X-999 + END-DISPLAY. + MOVE 123 TO B-999. + MOVE B-999 TO X-999. + DISPLAY X-999 + END-DISPLAY. + MOVE B-999 TO X-99. + DISPLAY X-99 + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_MOVE.out b/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_MOVE.out new file mode 100644 index 000000000000..19f370480949 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/COMP-6_used_with_MOVE.out @@ -0,0 +1,6 @@ +00 +99 +000 +123 +23 + diff --git a/gcc/testsuite/cobol.dg/group2/COMPUTE_multiplication_to_FIX4.cob b/gcc/testsuite/cobol.dg/group2/COMPUTE_multiplication_to_FIX4.cob new file mode 100644 index 000000000000..4ea8b356689b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/COMPUTE_multiplication_to_FIX4.cob @@ -0,0 +1,154 @@ + *> { dg-do run } + *> { dg-output-file "group2/COMPUTE_multiplication_to_FIX4.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. onsize. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 FIX4DISPLAY PIC 9(4) DISPLAY. + 01 FIX8DISPLAY PIC 9(8) DISPLAY VALUE 12345678. + 01 FIX8BINARY PIC 9(8) BINARY VALUE 12345678. + 01 FIX8PACKED PIC 9(8) PACKED-DECIMAL VALUE 12345678. + 01 FIX8NUMEDT PIC 9(8).0 VALUE 12345678. + 01 FLOATSHORT FLOAT-SHORT VALUE 12345678. + 01 FLOATLONG FLOAT-LONG VALUE 12345678. + 01 FLOATEXT FLOAT-EXTENDED VALUE 12345678. + + PROCEDURE DIVISION. + + *> FIX8DISPLAY + DISPLAY "COMPUTE FIX4DISPLAY = FIX8DISPLAY without SIZE ERROR" + MOVE 9876 TO FIX4DISPLAY + COMPUTE FIX4DISPLAY = FIX8DISPLAY + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 5678" + DISPLAY "." + + DISPLAY "COMPUTE FIX4DISPLAY = FIX8DISPLAY with SIZE ERROR" + COMPUTE FIX4DISPLAY = FIX8DISPLAY + MOVE 9876 TO FIX4DISPLAY + COMPUTE FIX4DISPLAY = FIX8DISPLAY + ON SIZE ERROR Display "Proper size error" + NOT ON SIZE ERROR Display "Improper no error" + END-COMPUTE + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 9876" + DISPLAY "." + + *> FIX8BINARY + + DISPLAY "COMPUTE FIX4DISPLAY = FIX8BINARY without SIZE ERROR" + COMPUTE FIX4DISPLAY = FIX8BINARY + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 5678" + DISPLAY "." + + DISPLAY "COMPUTE FIX4DISPLAY = FIX8BINARY with SIZE ERROR" + COMPUTE FIX4DISPLAY = FIX8BINARY + MOVE 9876 TO FIX4DISPLAY + COMPUTE FIX4DISPLAY = FIX8BINARY + ON SIZE ERROR Display "Proper size error" + NOT ON SIZE ERROR Display "Improper no error" + END-COMPUTE + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 9876" + DISPLAY "." + + *> FIX8PACKED + + DISPLAY "COMPUTE FIX4DISPLAY = FIX8PACKED without SIZE ERROR" + COMPUTE FIX4DISPLAY = FIX8PACKED + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 5678" + DISPLAY "." + + DISPLAY "COMPUTE FIX4DISPLAY = FIX8PACKED with SIZE ERROR" + COMPUTE FIX4DISPLAY = FIX8PACKED + MOVE 9876 TO FIX4DISPLAY + COMPUTE FIX4DISPLAY = FIX8PACKED + ON SIZE ERROR Display "Proper size error" + NOT ON SIZE ERROR Display "Improper no error" + END-COMPUTE + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 9876" + DISPLAY "." + + *> FIX8NUMEDT + + DISPLAY "COMPUTE FIX4DISPLAY = FIX8NUMEDT without SIZE ERROR" + COMPUTE FIX4DISPLAY = FIX8NUMEDT + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 5678" + DISPLAY "." + + DISPLAY "COMPUTE FIX4DISPLAY = FIX8NUMEDT with SIZE ERROR" + COMPUTE FIX4DISPLAY = FIX8NUMEDT + MOVE 9876 TO FIX4DISPLAY + COMPUTE FIX4DISPLAY = FIX8NUMEDT + ON SIZE ERROR Display "Proper size error" + NOT ON SIZE ERROR Display "Improper no error" + END-COMPUTE + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 9876" + DISPLAY "." + + *> FLOATSHORT + + DISPLAY "COMPUTE FIX4DISPLAY = FLOATSHORT without SIZE ERROR" + COMPUTE FIX4DISPLAY = FLOATSHORT + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 5678" + DISPLAY "." + + DISPLAY "COMPUTE FIX4DISPLAY = FLOATSHORT with SIZE ERROR" + COMPUTE FIX4DISPLAY = FLOATSHORT + MOVE 9876 TO FIX4DISPLAY + COMPUTE FIX4DISPLAY = FLOATSHORT + ON SIZE ERROR Display "Proper size error" + NOT ON SIZE ERROR Display "Improper no error" + END-COMPUTE + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 9876" + DISPLAY "." + + *> FLOATLONG + + DISPLAY "COMPUTE FIX4DISPLAY = FLOATLONG without SIZE ERROR" + COMPUTE FIX4DISPLAY = FLOATLONG + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 5678" + DISPLAY "." + + DISPLAY "COMPUTE FIX4DISPLAY = FLOATLONG with SIZE ERROR" + COMPUTE FIX4DISPLAY = FLOATLONG + MOVE 9876 TO FIX4DISPLAY + COMPUTE FIX4DISPLAY = FLOATLONG + ON SIZE ERROR Display "Proper size error" + NOT ON SIZE ERROR Display "Improper no error" + END-COMPUTE + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 9876" + DISPLAY "." + + *> FLOATEXT + + DISPLAY "COMPUTE FIX4DISPLAY = FLOATEXT without SIZE ERROR" + COMPUTE FIX4DISPLAY = FLOATEXT + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 5678" + DISPLAY "." + + DISPLAY "COMPUTE FIX4DISPLAY = FLOATEXT with SIZE ERROR" + COMPUTE FIX4DISPLAY = FLOATEXT + MOVE 9876 TO FIX4DISPLAY + COMPUTE FIX4DISPLAY = FLOATEXT + ON SIZE ERROR Display "Proper size error" + NOT ON SIZE ERROR Display "Improper no error" + END-COMPUTE + DISPLAY "FIX4DISPLAY is " FIX4DISPLAY + DISPLAY "Should be 9876" + DISPLAY ".". + + STOP RUN. + END PROGRAM onsize. + diff --git a/gcc/testsuite/cobol.dg/group2/COMPUTE_multiplication_to_FIX4.out b/gcc/testsuite/cobol.dg/group2/COMPUTE_multiplication_to_FIX4.out new file mode 100644 index 000000000000..8970a6cf06f6 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/COMPUTE_multiplication_to_FIX4.out @@ -0,0 +1,64 @@ +COMPUTE FIX4DISPLAY = FIX8DISPLAY without SIZE ERROR +FIX4DISPLAY is 5678 +Should be 5678 +. +COMPUTE FIX4DISPLAY = FIX8DISPLAY with SIZE ERROR +Proper size error +FIX4DISPLAY is 9876 +Should be 9876 +. +COMPUTE FIX4DISPLAY = FIX8BINARY without SIZE ERROR +FIX4DISPLAY is 5678 +Should be 5678 +. +COMPUTE FIX4DISPLAY = FIX8BINARY with SIZE ERROR +Proper size error +FIX4DISPLAY is 9876 +Should be 9876 +. +COMPUTE FIX4DISPLAY = FIX8PACKED without SIZE ERROR +FIX4DISPLAY is 5678 +Should be 5678 +. +COMPUTE FIX4DISPLAY = FIX8PACKED with SIZE ERROR +Proper size error +FIX4DISPLAY is 9876 +Should be 9876 +. +COMPUTE FIX4DISPLAY = FIX8NUMEDT without SIZE ERROR +FIX4DISPLAY is 5678 +Should be 5678 +. +COMPUTE FIX4DISPLAY = FIX8NUMEDT with SIZE ERROR +Proper size error +FIX4DISPLAY is 9876 +Should be 9876 +. +COMPUTE FIX4DISPLAY = FLOATSHORT without SIZE ERROR +FIX4DISPLAY is 5678 +Should be 5678 +. +COMPUTE FIX4DISPLAY = FLOATSHORT with SIZE ERROR +Proper size error +FIX4DISPLAY is 9876 +Should be 9876 +. +COMPUTE FIX4DISPLAY = FLOATLONG without SIZE ERROR +FIX4DISPLAY is 5678 +Should be 5678 +. +COMPUTE FIX4DISPLAY = FLOATLONG with SIZE ERROR +Proper size error +FIX4DISPLAY is 9876 +Should be 9876 +. +COMPUTE FIX4DISPLAY = FLOATEXT without SIZE ERROR +FIX4DISPLAY is 5678 +Should be 5678 +. +COMPUTE FIX4DISPLAY = FLOATEXT with SIZE ERROR +Proper size error +FIX4DISPLAY is 9876 +Should be 9876 +. + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.cob b/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.cob new file mode 100644 index 000000000000..6225c203ce82 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.cob @@ -0,0 +1,40 @@ + *> { dg-do run } + *> { dg-output-file "group2/DISPLAY__Sign_ASCII.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 G. + 02 X PIC X(5). + 02 X-9 REDEFINES X PIC 9(4). + 02 X-S9 REDEFINES X PIC S9(4). + 02 X-S9-L REDEFINES X PIC S9(4) LEADING. + 02 X-S9-LS REDEFINES X PIC S9(4) LEADING SEPARATE. + 02 X-S9-T REDEFINES X PIC S9(4) TRAILING. + 02 X-S9-TS REDEFINES X PIC S9(4) TRAILING SEPARATE. + PROCEDURE DIVISION. + MOVE ZERO TO X. MOVE 1234 TO X-9. DISPLAY X + END-DISPLAY. + MOVE ZERO TO X. MOVE 1234 TO X-S9. DISPLAY X + END-DISPLAY. + MOVE ZERO TO X. MOVE -1234 TO X-S9. DISPLAY X + END-DISPLAY. + MOVE ZERO TO X. MOVE 1234 TO X-S9-L. DISPLAY X + END-DISPLAY. + MOVE ZERO TO X. MOVE -1234 TO X-S9-L. DISPLAY X + END-DISPLAY. + MOVE ZERO TO X. MOVE 1234 TO X-S9-LS. DISPLAY X + END-DISPLAY. + MOVE ZERO TO X. MOVE -1234 TO X-S9-LS. DISPLAY X + END-DISPLAY. + MOVE ZERO TO X. MOVE 1234 TO X-S9-T. DISPLAY X + END-DISPLAY. + MOVE ZERO TO X. MOVE -1234 TO X-S9-T. DISPLAY X + END-DISPLAY. + MOVE ZERO TO X. MOVE 1234 TO X-S9-TS. DISPLAY X + END-DISPLAY. + MOVE ZERO TO X. MOVE -1234 TO X-S9-TS. DISPLAY X + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.out b/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.out new file mode 100644 index 000000000000..bda63c760f9e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.out @@ -0,0 +1,12 @@ +12340 +12340 +123t0 +12340 +q2340 ++1234 +-1234 +12340 +123t0 +1234+ +1234- + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII__2_.cob b/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII__2_.cob new file mode 100644 index 000000000000..585e60c130d9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII__2_.cob @@ -0,0 +1,38 @@ + *> { dg-do run } + *> { dg-output-file "group2/DISPLAY__Sign_ASCII__2_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 G. + 02 X PIC X(10). + 02 X-S99 REDEFINES X PIC S99. + 02 X-S9 REDEFINES X PIC S9 OCCURS 10. + PROCEDURE DIVISION. + MOVE 0 TO X-S9(1). + MOVE 1 TO X-S9(2). + MOVE 2 TO X-S9(3). + MOVE 3 TO X-S9(4). + MOVE 4 TO X-S9(5). + MOVE 5 TO X-S9(6). + MOVE 6 TO X-S9(7). + MOVE 7 TO X-S9(8). + MOVE 8 TO X-S9(9). + MOVE 9 TO X-S9(10). + DISPLAY X NO ADVANCING + END-DISPLAY. + MOVE -10 TO X-S99. MOVE X(2:1) TO X(1:1). + MOVE -1 TO X-S9(2). + MOVE -2 TO X-S9(3). + MOVE -3 TO X-S9(4). + MOVE -4 TO X-S9(5). + MOVE -5 TO X-S9(6). + MOVE -6 TO X-S9(7). + MOVE -7 TO X-S9(8). + MOVE -8 TO X-S9(9). + MOVE -9 TO X-S9(10). + DISPLAY X NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII__2_.out b/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII__2_.out new file mode 100644 index 000000000000..6717b6ebb5d7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII__2_.out @@ -0,0 +1 @@ +0123456789pqrstuvwxy diff --git a/gcc/testsuite/cobol.dg/group2/Floating_continuation_indicator__1_.cob b/gcc/testsuite/cobol.dg/group2/Floating_continuation_indicator__1_.cob new file mode 100644 index 000000000000..53211b2a8355 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Floating_continuation_indicator__1_.cob @@ -0,0 +1,21 @@ + *> { dg-do run } + *> { dg-options "-ffixed-form" } + *> { dg-output-file "group2/Floating_continuation_indicator__1_.out" } + IDENTIFICATION DIVISION. + * testing floating continuation literals ("'-" and '"-') + PROGRAM-ID. FF2. + PROCEDURE DIVISION. + DISPLAY "hello "- + "world.". + DISPLAY 'hello '- + 'world.'. + DISPLAY "hello "- + * non-interrupting comment + "world.". + DISPLAY 'hello '- + *> non-interrupting comment + + 'world.'. + EXIT PROGRAM. + + diff --git a/gcc/testsuite/cobol.dg/group2/Floating_continuation_indicator__1_.out b/gcc/testsuite/cobol.dg/group2/Floating_continuation_indicator__1_.out new file mode 100644 index 000000000000..fe031c3d28ed --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Floating_continuation_indicator__1_.out @@ -0,0 +1,5 @@ +hello world. +hello world. +hello world. +hello world. + diff --git a/gcc/testsuite/cobol.dg/group2/IBM_dialect_COMP_redefined_by_POINTER_as_64-bit.cob b/gcc/testsuite/cobol.dg/group2/IBM_dialect_COMP_redefined_by_POINTER_as_64-bit.cob new file mode 100644 index 000000000000..071b88aecd35 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/IBM_dialect_COMP_redefined_by_POINTER_as_64-bit.cob @@ -0,0 +1,34 @@ + *> { dg-do run } + *> { dg-options "-dialect ibm" } + *> { dg-output-file "group2/IBM_dialect_COMP_redefined_by_POINTER_as_64-bit.out" } + + identification division. + program-id. prog. + data division. + working-storage section. + *> This is a test of the "-dialect ibm" special interpretation of a common + *> construction in IBM mainframe code. That machine is a 32-bit + *> big-endian architecture. We are assuming a 64-bit little-endian + *> x86_64 architecture. So, the COMP PIC S8(8) would usually be an 32-bit + *> big-endian value. But "-dialect ibm" means that the following + *> REDEFINES USAGE POINTER causes the prior "COMP" to actually be defined + *> as a 64-bit little-endian binary value. + 77 pointer-value COMP PIC S9(8) VALUE ZERO. + 77 point-at REDEFINES pointer-value USAGE POINTER. + procedure division. + *> The following value is 0x123456789 + move 4886718345 to pointer-value + display point-at " should be 0x0000000123456789" + set point-at down by 4886718345 + display point-at " should be 0x0000000000000000" + set point-at down by 4886718345 + display point-at " should be 0xfffffffedcba9877" + set point-at up by 4886718345 + display point-at " should be 0x0000000000000000" + subtract 1 from pointer-value + display point-at " should be 0xffffffffffffffff" + add 1 to pointer-value + display point-at " should be 0x0000000000000000" + goback. + end program prog. + diff --git a/gcc/testsuite/cobol.dg/group2/IBM_dialect_COMP_redefined_by_POINTER_as_64-bit.out b/gcc/testsuite/cobol.dg/group2/IBM_dialect_COMP_redefined_by_POINTER_as_64-bit.out new file mode 100644 index 000000000000..cd7fa5b10c8a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/IBM_dialect_COMP_redefined_by_POINTER_as_64-bit.out @@ -0,0 +1,7 @@ +0x0000000123456789 should be 0x0000000123456789 +0x0000000000000000 should be 0x0000000000000000 +0xfffffffedcba9877 should be 0xfffffffedcba9877 +0x0000000000000000 should be 0x0000000000000000 +0xffffffffffffffff should be 0xffffffffffffffff +0x0000000000000000 should be 0x0000000000000000 + diff --git a/gcc/testsuite/cobol.dg/group2/Indicators_______________-____D__.cob b/gcc/testsuite/cobol.dg/group2/Indicators_______________-____D__.cob new file mode 100644 index 000000000000..fe988ee865b3 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Indicators_______________-____D__.cob @@ -0,0 +1,26 @@ + *> { dg-do run } + *> { dg-options "-ffixed-form" } + *> { dg-output-file "group2/Indicators_______________-____D__.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. FF2. + *Asterisk in correct column + / + PROCEDURE DIVISION. + DISPLAY "gekk + -"os rule". + DISPLAY "gerb + * ISO says blank and comment lines do not interfere with + * literal continuation + + -"ils don't rule". + * "D" is a deprecated feature of COBOL dropped from + * the ISO-IEC standard. Lines with "D" in the indicator + * column were enabled when OBJECT COMPUTER contained + * "WITH DEBUG MODE". Otherwise they were treated as + * comments. This behavior is a "vendor extension" to + * the current standard but allows old code to be used + * as it was prior to the deprecation. + D DISPLAY 'Should not display'. + EXIT PROGRAM. + diff --git a/gcc/testsuite/cobol.dg/group2/Indicators_______________-____D__.out b/gcc/testsuite/cobol.dg/group2/Indicators_______________-____D__.out new file mode 100644 index 000000000000..8ad4d0a3d443 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Indicators_______________-____D__.out @@ -0,0 +1,3 @@ +gekkos rule +gerbils don't rule + diff --git a/gcc/testsuite/cobol.dg/group2/MULTIPLY_to_FIX4.cob b/gcc/testsuite/cobol.dg/group2/MULTIPLY_to_FIX4.cob new file mode 100644 index 000000000000..1f9b8dc04db4 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/MULTIPLY_to_FIX4.cob @@ -0,0 +1,101 @@ + *> { dg-do run } + *> { dg-output-file "group2/MULTIPLY_to_FIX4.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. onsize. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 FIX4DISPLAY PIC 9(4) DISPLAY. + 01 FIX4PACKED PIC 9(4) PACKED-DECIMAL. + 01 FIX4BINARY PIC 9(4) BINARY. + 01 FIX4COMP5 PIC 9(4) COMP-5. + 01 FLTSHORT FLOAT-SHORT. + 01 FLTLONG FLOAT-LONG. + 01 FLTEXT FLOAT-EXTENDED. + + PROCEDURE DIVISION. + + DISPLAY "Checking size error on FIX4DISPLAY" + MOVE 1 TO FIX4DISPLAY + PERFORM 10 TIMEs + DISPLAY " FIX4DISPLAY is : " FIX4DISPLAY + MULTIPLY 10 BY FIX4DISPLAY + ON SIZE ERROR DISPLAY " Got size error" GO TO DONE1 + END-MULTIPLY + END-PERFORM. + DONE1. + DISPLAY " Final is : " FIX4DISPLAY + DISPLAY "." + + DISPLAY "Checking size error on FIX4PACKED" + MOVE 1 TO FIX4PACKED + PERFORM 10 TIMEs + DISPLAY " FIX4PACKED is : " FIX4PACKED + MULTIPLY 10 BY FIX4PACKED + ON SIZE ERROR DISPLAY " Got size error" GO TO DONE2 + END-MULTIPLY + END-PERFORM. + DONE2. + DISPLAY " Final is : " FIX4PACKED + DISPLAY "." + + DISPLAY "Checking size error on FIX4BINARY" + MOVE 1 TO FIX4BINARY + PERFORM 10 TIMEs + DISPLAY " FIX4BINARY is : " FIX4BINARY + MULTIPLY 10 BY FIX4BINARY + ON SIZE ERROR DISPLAY " Got size error" GO TO DONE3 + END-MULTIPLY + END-PERFORM. + DONE3. + DISPLAY " Final is : " FIX4BINARY + DISPLAY "." + + DISPLAY "Checking size error on FIX4COMP5" + MOVE 1 TO FIX4COMP5 + PERFORM 10 TIMEs + DISPLAY " FIX4COMP5 is : " FIX4COMP5 + MULTIPLY 10 BY FIX4COMP5 + ON SIZE ERROR DISPLAY " Got size error" GO TO DONE4 + END-MULTIPLY + END-PERFORM. + DONE4. + DISPLAY " Final is : " FIX4COMP5 + DISPLAY "." + + DISPLAY "Checking size error on FLTSHORT" + MOVE 1.E34 TO FLTSHORT + PERFORM 10 TIMEs + DISPLAY " FLTSHORT is : " FLTSHORT + MULTIPLY 10 BY FLTSHORT + ON SIZE ERROR DISPLAY " Got size error" GO TO DONE5 + END-MULTIPLY + END-PERFORM. + DONE5. + DISPLAY " Final is : " FLTSHORT + DISPLAY "." + + MOVE 1.E304 TO FLTLONG + PERFORM 1000 TIMEs + DISPLAY " FLTLONG is : " FLTLONG + MULTIPLY 10 BY FLTLONG + ON SIZE ERROR DISPLAY " Got size error" GO TO DONE6 + END-MULTIPLY + END-PERFORM. + DONE6. + DISPLAY " Final is : " FLTLONG + DISPLAY "." + + MOVE 1.E4928 TO FLTEXT + PERFORM 10 TIMEs + DISPLAY " FLTEXT is : " FLTEXT + MULTIPLY 10 BY FLTEXT + ON SIZE ERROR DISPLAY " Got size error" GO TO DONE7 + END-MULTIPLY + END-PERFORM. + DONE7. + DISPLAY " Final is : " FLTEXT + DISPLAY ".". + + END PROGRAM onsize. + diff --git a/gcc/testsuite/cobol.dg/group2/MULTIPLY_to_FIX4.out b/gcc/testsuite/cobol.dg/group2/MULTIPLY_to_FIX4.out new file mode 100644 index 000000000000..90cf292334d9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/MULTIPLY_to_FIX4.out @@ -0,0 +1,58 @@ +Checking size error on FIX4DISPLAY + FIX4DISPLAY is : 0001 + FIX4DISPLAY is : 0010 + FIX4DISPLAY is : 0100 + FIX4DISPLAY is : 1000 + Got size error + Final is : 1000 +. +Checking size error on FIX4PACKED + FIX4PACKED is : 0001 + FIX4PACKED is : 0010 + FIX4PACKED is : 0100 + FIX4PACKED is : 1000 + Got size error + Final is : 1000 +. +Checking size error on FIX4BINARY + FIX4BINARY is : 0001 + FIX4BINARY is : 0010 + FIX4BINARY is : 0100 + FIX4BINARY is : 1000 + Got size error + Final is : 1000 +. +Checking size error on FIX4COMP5 + FIX4COMP5 is : 0001 + FIX4COMP5 is : 0010 + FIX4COMP5 is : 0100 + FIX4COMP5 is : 1000 + Got size error + Final is : 1000 +. +Checking size error on FLTSHORT + FLTSHORT is : 9.99999979E+33 + FLTSHORT is : 9.999999419E+34 + FLTSHORT is : 9.999999617E+35 + FLTSHORT is : 9.999999934E+36 + FLTSHORT is : 9.99999968E+37 + Got size error + Final is : 9.99999968E+37 +. + FLTLONG is : 9.99999999999999939E+303 + FLTLONG is : 9.99999999999999939E+304 + FLTLONG is : 9.99999999999999861E+305 + FLTLONG is : 9.99999999999999861E+306 + FLTLONG is : 9.99999999999999811E+307 + Got size error + Final is : 9.99999999999999811E+307 +. + FLTEXT is : 9.999999999999999999999999999999999576E+4927 + FLTEXT is : 9.999999999999999999999999999999999856E+4928 + FLTEXT is : 1.000000000000000000000000000000000053E+4930 + FLTEXT is : 1.000000000000000000000000000000000124E+4931 + FLTEXT is : 1.000000000000000000000000000000000124E+4932 + Got size error + Final is : 1.000000000000000000000000000000000124E+4932 +. + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_arithmetic.cob b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_arithmetic.cob new file mode 100644 index 000000000000..09303a292c99 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_arithmetic.cob @@ -0,0 +1,24 @@ + *> { dg-do run } + *> { dg-output-file "group2/PACKED-DECIMAL_arithmetic.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC 99 USAGE PACKED-DECIMAL VALUE 0. + 01 Y PIC 99 USAGE PACKED-DECIMAL VALUE 9. + PROCEDURE DIVISION. + COMPUTE X = 1 + END-COMPUTE. + DISPLAY X + END-DISPLAY. + COMPUTE X = Y + END-COMPUTE. + DISPLAY X + END-DISPLAY. + COMPUTE X = X + Y + END-COMPUTE. + DISPLAY X + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_arithmetic.out b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_arithmetic.out new file mode 100644 index 000000000000..79f7d9d02e05 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_arithmetic.out @@ -0,0 +1,4 @@ +01 +09 +18 + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__1_.cob b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__1_.cob new file mode 100644 index 000000000000..f718cf4cbc42 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__1_.cob @@ -0,0 +1,52 @@ + *> { dg-do run } + *> { dg-options "-dialect mf" } + *> { dg-output-file "group2/PACKED-DECIMAL_basic_comp-3_comp-6__1_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 x1 PIC 9 COMP-3. + 01 x2 PIC 99 COMP-3. + 01 x3 PIC 999 COMP-3. + 01 x4 PIC 9999 COMP-3. + 01 x5 PIC 99999 COMP-3. + 01 x6 PIC 999999 COMP-3. + 01 y1 PIC 9 COMP-6. + 01 y2 PIC 99 COMP-6. + 01 y3 PIC 999 COMP-6. + 01 y4 PIC 9999 COMP-6. + 01 y5 PIC 99999 COMP-6. + 01 y6 PIC 999999 COMP-6. + procedure division. + display "check lengths of comp-3" + display FUNCTION LENGTH(x1) " should be 1" + display FUNCTION LENGTH(x2) " should be 2" + display FUNCTION LENGTH(x3) " should be 2" + display FUNCTION LENGTH(x4) " should be 3" + display FUNCTION LENGTH(x5) " should be 3" + display FUNCTION LENGTH(x6) " should be 4" + display "check lengths of comp-6" + display FUNCTION LENGTH(y1) " should be 1" + display FUNCTION LENGTH(y2) " should be 1" + display FUNCTION LENGTH(y3) " should be 2" + display FUNCTION LENGTH(y4) " should be 2" + display FUNCTION LENGTH(y5) " should be 3" + display FUNCTION LENGTH(y6) " should be 3" + move 654321 to x1 x2 x3 x4 x5 x6 y1 y2 y3 y4 y5 y6 + display "results of MOVE TO COMP-3" + display x1 + display x2 + display x3 + display x4 + display x5 + display x6 + display "results of MOVE TO COMP-6" + display y1 + display y2 + display y3 + display y4 + display y5 + display y6 + goback. + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__1_.out b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__1_.out new file mode 100644 index 000000000000..ae8169d6807b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__1_.out @@ -0,0 +1,29 @@ +check lengths of comp-3 +1 should be 1 +2 should be 2 +2 should be 2 +3 should be 3 +3 should be 3 +4 should be 4 +check lengths of comp-6 +1 should be 1 +1 should be 1 +2 should be 2 +2 should be 2 +3 should be 3 +3 should be 3 +results of MOVE TO COMP-3 +1 +21 +321 +4321 +54321 +654321 +results of MOVE TO COMP-6 +1 +21 +321 +4321 +54321 +654321 + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.cob b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.cob new file mode 100644 index 000000000000..52a4e0a8fe14 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.cob @@ -0,0 +1,41 @@ + *> { dg-do run } + *> { dg-options "-dialect mf" } + *> { dg-output-file "group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.out" } + + identification division. + program-id. prog. + data division. + working-storage section. + 01 vars. + 05 var1d . + 10 var01 pic 99v99 comp-3 value 43.21 . + 10 filler binary-double value zero . + 05 var1 redefines var1d pointer . + 05 var2d . + 10 var02 pic s99v99 comp-3 value 43.21 . + 10 filler binary-double value zero . + 05 var2 redefines var2d pointer . + 05 var3d . + 10 var03 pic s99v99 comp-3 value -43.21 . + 10 filler binary-double value zero . + 05 var3 redefines var3d pointer . + 05 var4d . + 10 var04 pic 99v99 comp-6 value 43.21 . + 10 filler binary-double value zero . + 05 var4 redefines var4d pointer . + procedure division. + display length of var01 space var1 space space var01 + display length of var02 space var2 space var02 + display length of var03 space var3 space var03 + display length of var04 space var4 space space var04 + move 12.34 to var01 + move 12.34 to var02 + move 12.34 to var03 + move 12.34 to var04 + display function length(var01) space var1 space space var01 + display function length(var02) space var2 space var02 + display function length(var03) space var3 space var03 + display function length(var04) space var4 space space var04 + goback. + end program prog. + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.out b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.out new file mode 100644 index 000000000000..6acdee42b584 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.out @@ -0,0 +1,9 @@ +3 0x00000000001f3204 43.21 +3 0x00000000001c3204 +43.21 +3 0x00000000001d3204 -43.21 +2 0x0000000000002143 43.21 +3 0x00000000004f2301 12.34 +3 0x00000000004c2301 +12.34 +3 0x00000000004c2301 +12.34 +2 0x0000000000003412 12.34 + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_dump.cob b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_dump.cob new file mode 100644 index 000000000000..f4c755024ac3 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_dump.cob @@ -0,0 +1,486 @@ + *> { dg-do run } + *> { dg-output-file "group2/PACKED-DECIMAL_dump.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 G-1. + 02 X-1 PIC 9(1) VALUE 1 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-2. + 02 X-2 PIC 9(2) VALUE 12 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-3. + 02 X-3 PIC 9(3) VALUE 123 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-4. + 02 X-4 PIC 9(4) VALUE 1234 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-5. + 02 X-5 PIC 9(5) VALUE 12345 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-6. + 02 X-6 PIC 9(6) VALUE 123456 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-7. + 02 X-7 PIC 9(7) VALUE 1234567 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-8. + 02 X-8 PIC 9(8) VALUE 12345678 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-9. + 02 X-9 PIC 9(9) VALUE 123456789 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-10. + 02 X-10 PIC 9(10) VALUE 1234567890 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-11. + 02 X-11 PIC 9(11) VALUE 12345678901 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-12. + 02 X-12 PIC 9(12) VALUE 123456789012 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-13. + 02 X-13 PIC 9(13) VALUE 1234567890123 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-14. + 02 X-14 PIC 9(14) VALUE 12345678901234 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-15. + 02 X-15 PIC 9(15) VALUE 123456789012345 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-16. + 02 X-16 PIC 9(16) VALUE 1234567890123456 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-17. + 02 X-17 PIC 9(17) VALUE 12345678901234567 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-18. + 02 X-18 PIC 9(18) VALUE 123456789012345678 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S1. + 02 X-S1 PIC S9(1) VALUE -1 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S2. + 02 X-S2 PIC S9(2) VALUE -12 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S3. + 02 X-S3 PIC S9(3) VALUE -123 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S4. + 02 X-S4 PIC S9(4) VALUE -1234 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S5. + 02 X-S5 PIC S9(5) VALUE -12345 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S6. + 02 X-S6 PIC S9(6) VALUE -123456 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S7. + 02 X-S7 PIC S9(7) VALUE -1234567 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S8. + 02 X-S8 PIC S9(8) VALUE -12345678 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S9. + 02 X-S9 PIC S9(9) VALUE -123456789 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S10. + 02 X-S10 PIC S9(10) VALUE -1234567890 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S11. + 02 X-S11 PIC S9(11) VALUE -12345678901 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S12. + 02 X-S12 PIC S9(12) VALUE -123456789012 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S13. + 02 X-S13 PIC S9(13) VALUE -1234567890123 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S14. + 02 X-S14 PIC S9(14) VALUE -12345678901234 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S15. + 02 X-S15 PIC S9(15) VALUE -123456789012345 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S16. + 02 X-S16 PIC S9(16) VALUE -1234567890123456 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S17. + 02 X-S17 PIC S9(17) VALUE -12345678901234567 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + 01 G-S18. + 02 X-S18 PIC S9(18) VALUE -123456789012345678 + COMP-3. + 02 FILLER PIC X(18) VALUE SPACE. + PROCEDURE DIVISION. + *> Dump all values + CALL "dump" USING G-1 + END-CALL. + CALL "dump" USING G-2 + END-CALL. + CALL "dump" USING G-3 + END-CALL. + CALL "dump" USING G-4 + END-CALL. + CALL "dump" USING G-5 + END-CALL. + CALL "dump" USING G-6 + END-CALL. + CALL "dump" USING G-7 + END-CALL. + CALL "dump" USING G-8 + END-CALL. + CALL "dump" USING G-9 + END-CALL. + CALL "dump" USING G-10 + END-CALL. + CALL "dump" USING G-11 + END-CALL. + CALL "dump" USING G-12 + END-CALL. + CALL "dump" USING G-13 + END-CALL. + CALL "dump" USING G-14 + END-CALL. + CALL "dump" USING G-15 + END-CALL. + CALL "dump" USING G-16 + END-CALL. + CALL "dump" USING G-17 + END-CALL. + CALL "dump" USING G-18 + END-CALL. + CALL "dump" USING G-S1 + END-CALL. + CALL "dump" USING G-S2 + END-CALL. + CALL "dump" USING G-S3 + END-CALL. + CALL "dump" USING G-S4 + END-CALL. + CALL "dump" USING G-S5 + END-CALL. + CALL "dump" USING G-S6 + END-CALL. + CALL "dump" USING G-S7 + END-CALL. + CALL "dump" USING G-S8 + END-CALL. + CALL "dump" USING G-S9 + END-CALL. + CALL "dump" USING G-S10 + END-CALL. + CALL "dump" USING G-S11 + END-CALL. + CALL "dump" USING G-S12 + END-CALL. + CALL "dump" USING G-S13 + END-CALL. + CALL "dump" USING G-S14 + END-CALL. + CALL "dump" USING G-S15 + END-CALL. + CALL "dump" USING G-S16 + END-CALL. + CALL "dump" USING G-S17 + END-CALL. + CALL "dump" USING G-S18 + END-CALL. + INITIALIZE X-1. + CALL "dump" USING G-1 + END-CALL. + INITIALIZE X-2. + CALL "dump" USING G-2 + END-CALL. + INITIALIZE X-3. + CALL "dump" USING G-3 + END-CALL. + INITIALIZE X-4. + CALL "dump" USING G-4 + END-CALL. + INITIALIZE X-5. + CALL "dump" USING G-5 + END-CALL. + INITIALIZE X-6. + CALL "dump" USING G-6 + END-CALL. + INITIALIZE X-7. + CALL "dump" USING G-7 + END-CALL. + INITIALIZE X-8. + CALL "dump" USING G-8 + END-CALL. + INITIALIZE X-9. + CALL "dump" USING G-9 + END-CALL. + INITIALIZE X-10. + CALL "dump" USING G-10 + END-CALL. + INITIALIZE X-11. + CALL "dump" USING G-11 + END-CALL. + INITIALIZE X-12. + CALL "dump" USING G-12 + END-CALL. + INITIALIZE X-13. + CALL "dump" USING G-13 + END-CALL. + INITIALIZE X-14. + CALL "dump" USING G-14 + END-CALL. + INITIALIZE X-15. + CALL "dump" USING G-15 + END-CALL. + INITIALIZE X-16. + CALL "dump" USING G-16 + END-CALL. + INITIALIZE X-17. + CALL "dump" USING G-17 + END-CALL. + INITIALIZE X-18. + CALL "dump" USING G-18 + END-CALL. + INITIALIZE X-S1. + CALL "dump" USING G-S1 + END-CALL. + INITIALIZE X-S2. + CALL "dump" USING G-S2 + END-CALL. + INITIALIZE X-S3. + CALL "dump" USING G-S3 + END-CALL. + INITIALIZE X-S4. + CALL "dump" USING G-S4 + END-CALL. + INITIALIZE X-S5. + CALL "dump" USING G-S5 + END-CALL. + INITIALIZE X-S6. + CALL "dump" USING G-S6 + END-CALL. + INITIALIZE X-S7. + CALL "dump" USING G-S7 + END-CALL. + INITIALIZE X-S8. + CALL "dump" USING G-S8 + END-CALL. + INITIALIZE X-S9. + CALL "dump" USING G-S9 + END-CALL. + INITIALIZE X-S10. + CALL "dump" USING G-S10 + END-CALL. + INITIALIZE X-S11. + CALL "dump" USING G-S11 + END-CALL. + INITIALIZE X-S12. + CALL "dump" USING G-S12 + END-CALL. + INITIALIZE X-S13. + CALL "dump" USING G-S13 + END-CALL. + INITIALIZE X-S14. + CALL "dump" USING G-S14 + END-CALL. + INITIALIZE X-S15. + CALL "dump" USING G-S15 + END-CALL. + INITIALIZE X-S16. + CALL "dump" USING G-S16 + END-CALL. + INITIALIZE X-S17. + CALL "dump" USING G-S17 + END-CALL. + INITIALIZE X-S18. + CALL "dump" USING G-S18 + END-CALL. + MOVE ZERO TO X-1. + CALL "dump" USING G-1 + END-CALL. + MOVE ZERO TO X-2. + CALL "dump" USING G-2 + END-CALL. + MOVE ZERO TO X-3. + CALL "dump" USING G-3 + END-CALL. + MOVE ZERO TO X-4. + CALL "dump" USING G-4 + END-CALL. + MOVE ZERO TO X-5. + CALL "dump" USING G-5 + END-CALL. + MOVE ZERO TO X-6. + CALL "dump" USING G-6 + END-CALL. + MOVE ZERO TO X-7. + CALL "dump" USING G-7 + END-CALL. + MOVE ZERO TO X-8. + CALL "dump" USING G-8 + END-CALL. + MOVE ZERO TO X-9. + CALL "dump" USING G-9 + END-CALL. + MOVE ZERO TO X-10. + CALL "dump" USING G-10 + END-CALL. + MOVE ZERO TO X-11. + CALL "dump" USING G-11 + END-CALL. + MOVE ZERO TO X-12. + CALL "dump" USING G-12 + END-CALL. + MOVE ZERO TO X-13. + CALL "dump" USING G-13 + END-CALL. + MOVE ZERO TO X-14. + CALL "dump" USING G-14 + END-CALL. + MOVE ZERO TO X-15. + CALL "dump" USING G-15 + END-CALL. + MOVE ZERO TO X-16. + CALL "dump" USING G-16 + END-CALL. + MOVE ZERO TO X-17. + CALL "dump" USING G-17 + END-CALL. + MOVE ZERO TO X-18. + CALL "dump" USING G-18 + END-CALL. + MOVE ZERO TO X-S1. + CALL "dump" USING G-S1 + END-CALL. + MOVE ZERO TO X-S2. + CALL "dump" USING G-S2 + END-CALL. + MOVE ZERO TO X-S3. + CALL "dump" USING G-S3 + END-CALL. + MOVE ZERO TO X-S4. + CALL "dump" USING G-S4 + END-CALL. + MOVE ZERO TO X-S5. + CALL "dump" USING G-S5 + END-CALL. + MOVE ZERO TO X-S6. + CALL "dump" USING G-S6 + END-CALL. + MOVE ZERO TO X-S7. + CALL "dump" USING G-S7 + END-CALL. + MOVE ZERO TO X-S8. + CALL "dump" USING G-S8 + END-CALL. + MOVE ZERO TO X-S9. + CALL "dump" USING G-S9 + END-CALL. + MOVE ZERO TO X-S10. + CALL "dump" USING G-S10 + END-CALL. + MOVE ZERO TO X-S11. + CALL "dump" USING G-S11 + END-CALL. + MOVE ZERO TO X-S12. + CALL "dump" USING G-S12 + END-CALL. + MOVE ZERO TO X-S13. + CALL "dump" USING G-S13 + END-CALL. + MOVE ZERO TO X-S14. + CALL "dump" USING G-S14 + END-CALL. + MOVE ZERO TO X-S15. + CALL "dump" USING G-S15 + END-CALL. + MOVE ZERO TO X-S16. + CALL "dump" USING G-S16 + END-CALL. + MOVE ZERO TO X-S17. + CALL "dump" USING G-S17 + END-CALL. + MOVE ZERO TO X-S18. + CALL "dump" USING G-S18 + END-CALL. + STOP RUN. + END PROGRAM prog. + IDENTIFICATION DIVISION. + PROGRAM-ID. dump. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 HEXCHARS. + 02 HEXCHART PIC X(16) VALUE "0123456789abcdef". + 02 HEXCHAR REDEFINES HEXCHART PIC X OCCURS 16. + 01 BYTE-TO-DUMP PIC X(1). + 01 FILLER. + 02 DUMPER1 PIC 9999 COMP-5. + 02 DUMPER2 REDEFINES DUMPER1 PIC X(1). + 01 THE-BYTE PIC 99. + 01 LADVANCE PIC 9. + LINKAGE SECTION. + 01 G-VAL PIC X(20). + 01 G-PTR REDEFINES G-VAL USAGE POINTER. + PROCEDURE DIVISION USING G-VAL. + MOVE 1 TO THE-BYTE + MOVE 0 TO LADVANCE + PERFORM UNTIL THE-BYTE GREATER THAN 10 + MOVE G-VAL(THE-BYTE:1) TO BYTE-TO-DUMP + IF THE-BYTE EQUAL TO 10 MOVE 1 TO LADVANCE END-IF + PERFORM DUMP-BYTE + ADD 1 TO THE-BYTE + END-PERFORM. + GOBACK. + DUMP-BYTE. + MOVE ZERO TO DUMPER1 + MOVE BYTE-TO-DUMP TO DUMPER2 + DIVIDE DUMPER1 BY 16 GIVING DUMPER1 + ADD 1 TO DUMPER1 + DISPLAY HEXCHAR(DUMPER1) NO ADVANCING. + MOVE ZERO TO DUMPER1 + MOVE BYTE-TO-DUMP TO DUMPER2 + MOVE FUNCTION MOD(DUMPER1 16) TO DUMPER1 + ADD 1 TO DUMPER1 + IF LADVANCE EQUAL TO 1 THEN + DISPLAY HEXCHAR(DUMPER1) + ELSE + DISPLAY HEXCHAR(DUMPER1) NO ADVANCING + END-IF. + END PROGRAM dump. + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_dump.out b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_dump.out new file mode 100644 index 000000000000..31a5a7973103 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_dump.out @@ -0,0 +1,109 @@ +1f202020202020202020 +012f2020202020202020 +123f2020202020202020 +01234f20202020202020 +12345f20202020202020 +0123456f202020202020 +1234567f202020202020 +012345678f2020202020 +123456789f2020202020 +01234567890f20202020 +12345678901f20202020 +0123456789012f202020 +1234567890123f202020 +012345678901234f2020 +123456789012345f2020 +01234567890123456f20 +12345678901234567f20 +0123456789012345678f +1d202020202020202020 +012d2020202020202020 +123d2020202020202020 +01234d20202020202020 +12345d20202020202020 +0123456d202020202020 +1234567d202020202020 +012345678d2020202020 +123456789d2020202020 +01234567890d20202020 +12345678901d20202020 +0123456789012d202020 +1234567890123d202020 +012345678901234d2020 +123456789012345d2020 +01234567890123456d20 +12345678901234567d20 +0123456789012345678d +0f202020202020202020 +000f2020202020202020 +000f2020202020202020 +00000f20202020202020 +00000f20202020202020 +0000000f202020202020 +0000000f202020202020 +000000000f2020202020 +000000000f2020202020 +00000000000f20202020 +00000000000f20202020 +0000000000000f202020 +0000000000000f202020 +000000000000000f2020 +000000000000000f2020 +00000000000000000f20 +00000000000000000f20 +0000000000000000000f +0c202020202020202020 +000c2020202020202020 +000c2020202020202020 +00000c20202020202020 +00000c20202020202020 +0000000c202020202020 +0000000c202020202020 +000000000c2020202020 +000000000c2020202020 +00000000000c20202020 +00000000000c20202020 +0000000000000c202020 +0000000000000c202020 +000000000000000c2020 +000000000000000c2020 +00000000000000000c20 +00000000000000000c20 +0000000000000000000c +0f202020202020202020 +000f2020202020202020 +000f2020202020202020 +00000f20202020202020 +00000f20202020202020 +0000000f202020202020 +0000000f202020202020 +000000000f2020202020 +000000000f2020202020 +00000000000f20202020 +00000000000f20202020 +0000000000000f202020 +0000000000000f202020 +000000000000000f2020 +000000000000000f2020 +00000000000000000f20 +00000000000000000f20 +0000000000000000000f +0c202020202020202020 +000c2020202020202020 +000c2020202020202020 +00000c20202020202020 +00000c20202020202020 +0000000c202020202020 +0000000c202020202020 +000000000c2020202020 +000000000c2020202020 +00000000000c20202020 +00000000000c20202020 +0000000000000c202020 +0000000000000c202020 +000000000000000c2020 +000000000000000c2020 +00000000000000000c20 +00000000000000000c20 +0000000000000000000c + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__1_.cob b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__1_.cob new file mode 100644 index 000000000000..a1173251028b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__1_.cob @@ -0,0 +1,119 @@ + *> { dg-do run } + *> { dg-output-file "group2/PACKED-DECIMAL_numeric_test__1_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 G. + 02 X-2 PIC X(2). + 02 N-2 REDEFINES X-2 PIC 999 USAGE PACKED-DECIMAL. + 02 N-S2 REDEFINES X-2 PIC S999 USAGE PACKED-DECIMAL. + PROCEDURE DIVISION. + MOVE X"0000" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "1 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "2 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + MOVE X"000c" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "3 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "OK" + END-DISPLAY + ELSE + DISPLAY "4 NG" + END-DISPLAY + END-IF. + MOVE X"000d" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "5 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "OK" + END-DISPLAY + ELSE + DISPLAY "6 NG" + END-DISPLAY + END-IF. + MOVE X"000f" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "OK" + END-DISPLAY + ELSE + DISPLAY "7 NG" + END-DISPLAY + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "8 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + MOVE X"1234" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "9 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "10 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + MOVE X"999f" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "OK" + END-DISPLAY + ELSE + DISPLAY "11 NG" + END-DISPLAY + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "12 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + MOVE X"ffff" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "13 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "14 NG" + END-DISPLAY + ELSE + DISPLAY "OK" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__1_.out b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__1_.out new file mode 100644 index 000000000000..b2fdeb24a3d7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__1_.out @@ -0,0 +1,15 @@ +OK +OK +OK +OK +OK +OK +OK +OK +OK +OK +OK +OK +OK +OK + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__2_.cob b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__2_.cob new file mode 100644 index 000000000000..7c7d2b00bfc6 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__2_.cob @@ -0,0 +1,91 @@ + *> { dg-do run } + *> { dg-output-file "group2/PACKED-DECIMAL_numeric_test__2_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 G. + 02 X-2 PIC X(2). + 02 N-2 REDEFINES X-2 PIC 999 USAGE PACKED-DECIMAL. + 02 N-S2 REDEFINES X-2 PIC S999 USAGE PACKED-DECIMAL. + PROCEDURE DIVISION. + MOVE X"0000" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "NG 1" + ELSE + DISPLAY "OK" + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "NG 2" + ELSE + DISPLAY "OK" + END-IF. + MOVE X"000c" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "NG 3" + ELSE + DISPLAY "OK" + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "OK" + ELSE + DISPLAY "NG 4" + END-IF. + MOVE X"000d" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "NG 5" + ELSE + DISPLAY "OK" + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "OK" + ELSE + DISPLAY "NG 6" + END-IF. + MOVE X"000f" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "OK" + ELSE + DISPLAY "NG 7" + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "NG 8" + ELSE + DISPLAY "OK" + END-IF. + MOVE X"1234" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "NG 9" + ELSE + DISPLAY "OK" + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "NG 10" + ELSE + DISPLAY "OK" + END-IF. + MOVE X"999f" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "OK" + ELSE + DISPLAY "NG 11" + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "NG 12" + ELSE + DISPLAY "OK" + END-IF. + MOVE X"ffff" TO X-2. + IF N-2 IS NUMERIC + DISPLAY "NG 13" + ELSE + DISPLAY "OK" + END-IF. + IF N-S2 IS NUMERIC + DISPLAY "NG 14" + ELSE + DISPLAY "OK" + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__2_.out b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__2_.out new file mode 100644 index 000000000000..b2fdeb24a3d7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_numeric_test__2_.out @@ -0,0 +1,15 @@ +OK +OK +OK +OK +OK +OK +OK +OK +OK +OK +OK +OK +OK +OK + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_DISPLAY.cob b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_DISPLAY.cob new file mode 100644 index 000000000000..4b3d3911108c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_DISPLAY.cob @@ -0,0 +1,38 @@ + *> { dg-do run } + *> { dg-output-file "group2/PACKED-DECIMAL_used_with_DISPLAY.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X-99 PIC 99 USAGE PACKED-DECIMAL. + 01 X-S99 PIC S99 USAGE PACKED-DECIMAL. + 01 X-999 PIC 999 USAGE PACKED-DECIMAL. + 01 X-S999 PIC S999 USAGE PACKED-DECIMAL. + PROCEDURE DIVISION. + MOVE 0 TO X-99. + DISPLAY X-99 + END-DISPLAY. + MOVE 99 TO X-99. + DISPLAY X-99 + END-DISPLAY. + MOVE 0 TO X-S99. + DISPLAY X-S99 + END-DISPLAY. + MOVE -1 TO X-S99. + DISPLAY X-S99 + END-DISPLAY. + MOVE 0 TO X-999. + DISPLAY X-999 + END-DISPLAY. + MOVE 123 TO X-999. + DISPLAY X-999 + END-DISPLAY. + MOVE 0 TO X-S999. + DISPLAY X-S999 + END-DISPLAY. + MOVE -123 TO X-S999. + DISPLAY X-S999 + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_DISPLAY.out b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_DISPLAY.out new file mode 100644 index 000000000000..4d26a9516573 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_DISPLAY.out @@ -0,0 +1,9 @@ +00 +99 ++00 +-01 +000 +123 ++000 +-123 + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_INITIALIZE.cob b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_INITIALIZE.cob new file mode 100644 index 000000000000..5bd324b60d05 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_INITIALIZE.cob @@ -0,0 +1,26 @@ + *> { dg-do run } + *> { dg-output-file "group2/PACKED-DECIMAL_used_with_INITIALIZE.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X-99 PIC 99 USAGE PACKED-DECIMAL. + 01 X-S99 PIC S99 USAGE PACKED-DECIMAL. + 01 X-999 PIC 999 USAGE PACKED-DECIMAL. + 01 X-S999 PIC S999 USAGE PACKED-DECIMAL. + PROCEDURE DIVISION. + INITIALIZE X-99. + DISPLAY X-99 + END-DISPLAY. + INITIALIZE X-S99. + DISPLAY X-S99 + END-DISPLAY. + INITIALIZE X-999. + DISPLAY X-999 + END-DISPLAY. + INITIALIZE X-S999. + DISPLAY X-S999 + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_INITIALIZE.out b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_INITIALIZE.out new file mode 100644 index 000000000000..ff3759eb45d7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_INITIALIZE.out @@ -0,0 +1,5 @@ +00 ++00 +000 ++000 + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_MOVE.cob b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_MOVE.cob new file mode 100644 index 000000000000..cfdc8dbfb57c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_MOVE.cob @@ -0,0 +1,40 @@ + *> { dg-do run } + *> { dg-output-file "group2/PACKED-DECIMAL_used_with_MOVE.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X-99 PIC 99 USAGE PACKED-DECIMAL. + 01 X-S99 PIC S99 USAGE PACKED-DECIMAL. + 01 X-999 PIC 999 USAGE PACKED-DECIMAL. + 01 X-S999 PIC S999 USAGE PACKED-DECIMAL. + 01 C-P1234 PIC 9999 VALUE 1234. + 01 C-N1234 PIC S9999 VALUE -1234. + PROCEDURE DIVISION. + MOVE C-P1234 TO X-99. + DISPLAY X-99 + END-DISPLAY. + MOVE C-P1234 TO X-S99. + DISPLAY X-S99 + END-DISPLAY. + MOVE C-P1234 TO X-999. + DISPLAY X-999 + END-DISPLAY. + MOVE C-P1234 TO X-S999. + DISPLAY X-S999 + END-DISPLAY. + MOVE C-N1234 TO X-99. + DISPLAY X-99 + END-DISPLAY. + MOVE C-N1234 TO X-S99. + DISPLAY X-S99 + END-DISPLAY. + MOVE C-N1234 TO X-999. + DISPLAY X-999 + END-DISPLAY. + MOVE C-N1234 TO X-S999. + DISPLAY X-S999 + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_MOVE.out b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_MOVE.out new file mode 100644 index 000000000000..ddb1080b876b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_used_with_MOVE.out @@ -0,0 +1,9 @@ +34 ++34 +234 ++234 +34 +-34 +234 +-234 + diff --git a/gcc/testsuite/cobol.dg/group2/POINTER__display.cob b/gcc/testsuite/cobol.dg/group2/POINTER__display.cob new file mode 100644 index 000000000000..46a7cb13341e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/POINTER__display.cob @@ -0,0 +1,18 @@ + *> { dg-do run } + *> { dg-output-file "group2/POINTER__display.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 PTR USAGE POINTER VALUE NULL. + PROCEDURE DIVISION. + DISPLAY PTR + END-DISPLAY. + SET PTR UP BY 1 + DISPLAY PTR + SET PTR DOWN BY 1 + DISPLAY PTR + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/POINTER__display.out b/gcc/testsuite/cobol.dg/group2/POINTER__display.out new file mode 100644 index 000000000000..c8ee9bcf317f --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/POINTER__display.out @@ -0,0 +1,4 @@ +0x0000000000000000 +0x0000000000000001 +0x0000000000000000 + diff --git a/gcc/testsuite/cobol.dg/group2/Simple_floating-point_MOVE.cob b/gcc/testsuite/cobol.dg/group2/Simple_floating-point_MOVE.cob new file mode 100644 index 000000000000..50f9ffa8535b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Simple_floating-point_MOVE.cob @@ -0,0 +1,48 @@ + *> { dg-do run } + *> { dg-output-file "group2/Simple_floating-point_MOVE.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-move. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 S1 PIC 999V99 DISPLAY VALUE 123.45 . + 01 S2 PIC 999V99 COMP VALUE 123.45 . + 01 S3 PIC 999V99 COMP-3 VALUE 123.45 . + 01 S4 PIC 999V99 COMP-5 VALUE 123.45 . + 01 S5 FLOAT-SHORT VALUE 123.45 . + 01 S6 FLOAT-LONG VALUE 123.45 . + 01 S7 FLOAT-EXTENDED VALUE 123.45 . + 01 D1 PIC 999V99 DISPLAY . + 01 D2 PIC 999V99 COMP . + 01 D3 PIC 999V99 COMP-3 . + 01 D4 PIC 999V99 COMP-5 . + 01 D5 FLOAT-SHORT . + 01 D6 FLOAT-LONG . + 01 D7 FLOAT-EXTENDED . + PROCEDURE DIVISION. + MOVE S1 TO D1 D2 D3 D4 D5 D6 D7 + PERFORM DISPLAY-D. + MOVE S2 TO D1 D2 D3 D4 D5 D6 D7 + PERFORM DISPLAY-D. + MOVE S3 TO D1 D2 D3 D4 D5 D6 D7 + PERFORM DISPLAY-D. + MOVE S4 TO D1 D2 D3 D4 D5 D6 D7 + PERFORM DISPLAY-D. + MOVE S5 TO D1 D2 D3 D4 D5 D6 D7 + PERFORM DISPLAY-D. + MOVE S6 TO D1 D2 D3 D4 D5 D6 D7 + PERFORM DISPLAY-D. + MOVE S7 TO D1 D2 D3 D4 D5 D6 D7 + PERFORM DISPLAY-D. + GOBACK. + DISPLAY-D. + DISPLAY D1 SPACE + D2 SPACE + D3 SPACE + D4 SPACE + D5 SPACE + D6 SPACE + D7 . + MOVE 0 TO D1 D2 D3 D4 D5 D6 D7. + END PROGRAM float-move. + diff --git a/gcc/testsuite/cobol.dg/group2/Simple_floating-point_MOVE.out b/gcc/testsuite/cobol.dg/group2/Simple_floating-point_MOVE.out new file mode 100644 index 000000000000..fb072514f9ce --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Simple_floating-point_MOVE.out @@ -0,0 +1,8 @@ +123.45 123.45 123.45 123.45 123.4499969 123.450000000000003 123.4500000000000000000000000000000025 +123.45 123.45 123.45 123.45 123.4499969 123.450000000000003 123.4500000000000000000000000000000025 +123.45 123.45 123.45 123.45 123.4499969 123.450000000000003 123.4500000000000000000000000000000025 +123.45 123.45 123.45 123.45 123.4499969 123.450000000000003 123.4500000000000000000000000000000025 +123.44 123.45 123.44 123.45 123.4499969 123.449996948242188 123.4499969482421875 +123.45 123.45 123.45 123.45 123.4499969 123.450000000000003 123.4500000000000028421709430404007435 +123.45 123.45 123.45 123.45 123.4499969 123.450000000000003 123.4500000000000000000000000000000025 + diff --git a/gcc/testsuite/cobol.dg/group2/Simple_floating-point_VALUE_and_MOVE.cob b/gcc/testsuite/cobol.dg/group2/Simple_floating-point_VALUE_and_MOVE.cob new file mode 100644 index 000000000000..42d5954cd83e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Simple_floating-point_VALUE_and_MOVE.cob @@ -0,0 +1,176 @@ + *> { dg-do run } + *> { dg-output-file "group2/Simple_floating-point_VALUE_and_MOVE.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-demo. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 P-1 PIC 999PPPPPP COMP-5 VALUE 123000000. + 01 C-1A COMP-1 VALUE 12.3456E-7. + 01 C-1B COMP-1 VALUE 12.3456E-6. + 01 C-1C COMP-1 VALUE 12.3456E-5. + 01 C-1D COMP-1 VALUE 12.3456E-4. + 01 C-1E COMP-1 VALUE 12.3456E-3. + 01 C-1F COMP-1 VALUE 12.3456E-2. + 01 C-1G COMP-1 VALUE 12.3456E-1. + 01 C-1H COMP-1 VALUE 12.3456E0 . + 01 C-1I COMP-1 VALUE 12.3456E1 . + 01 C-1J COMP-1 VALUE 12.3456E2 . + 01 C-1K COMP-1 VALUE 12.3456E3 . + 01 C-1L COMP-1 VALUE 12.3456E4 . + 01 C-1M COMP-1 VALUE 12.3456E5 . + 01 C-1N COMP-1 VALUE 12.3456E6 . + 01 C-1O COMP-1 VALUE 12.3456E7 . + 01 C-1P COMP-1 VALUE 12.3456E8 . + 01 C-1Q COMP-1 VALUE 12.3456E9 . + 01 C-1R COMP-1 VALUE 12.3456E10. + 01 C-1S COMP-1 VALUE 12.3456E11. + 01 C-2A COMP-2 VALUE 12.3456789098765E-7. + 01 C-2B COMP-2 VALUE 12.3456789098765E-6. + 01 C-2C COMP-2 VALUE 12.3456789098765E-5. + 01 C-2D COMP-2 VALUE 12.3456789098765E-4. + 01 C-2E COMP-2 VALUE 12.3456789098765E-3. + 01 C-2F COMP-2 VALUE 12.3456789098765E-2. + 01 C-2G COMP-2 VALUE 12.3456789098765E-1. + 01 C-2H COMP-2 VALUE 12.3456789098765E0 . + 01 C-2I COMP-2 VALUE 12.3456789098765E1 . + 01 C-2J COMP-2 VALUE 12.3456789098765E2 . + 01 C-2K COMP-2 VALUE 12.3456789098765E3 . + 01 C-2L COMP-2 VALUE 12.3456789098765E4 . + 01 C-2M COMP-2 VALUE 12.3456789098765E5 . + 01 C-2N COMP-2 VALUE 12.3456789098765E6 . + 01 C-2O COMP-2 VALUE 12.3456789098765E7 . + 01 C-2P COMP-2 VALUE 12.3456789098765E8 . + 01 C-2Q COMP-2 VALUE 12.3456789098765E9 . + 01 C-2R COMP-2 VALUE 12.3456789098765E10. + 01 C-2S COMP-2 VALUE 12.3456789098765E11. + 01 C-2T COMP-2 VALUE 12.3456789098765E12. + 01 C-2U COMP-2 VALUE 12.3456789098765E13. + 01 C-2V COMP-2 VALUE 12.3456789098765E14. + 01 C-2W COMP-2 VALUE 12.3456789098765E15. + 01 C-2X COMP-2 VALUE 12.3456789098765E16. + 01 C-EA FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E-7. + 01 C-EB FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E-6. + 01 C-EC FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E-5. + 01 C-ED FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E-4. + 01 C-EE FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E-3. + 01 C-EF FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E-2. + 01 C-EG FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E-1. + 01 C-EH FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E0 . + 01 C-EI FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E1 . + 01 C-EJ FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E2 . + 01 C-EK FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E3 . + 01 C-EL FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E4 . + 01 C-EM FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E5 . + 01 C-EN FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E6 . + 01 C-EO FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E7 . + 01 C-EP FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E8 . + 01 C-EQ FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E9 . + 01 C-ER FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E10. + 01 C-ES FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E11. + 01 C-ET FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E12. + 01 C-EU FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E13. + 01 C-EV FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E14. + 01 C-EW FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E15. + 01 C-EX FLOAT-EXTENDED VALUE 11.11222233334444995555666677778888E16. + 01 A PIC X(24). + PROCEDURE DIVISION. + DISPLAY "Variations on COMP-1 12." + MOVE 12.E-7 TO C-1A . + MOVE 12.E-6 TO C-1B . + MOVE 12.E-5 TO C-1C . + MOVE 12.E-4 TO C-1D . + MOVE 12.E-3 TO C-1E . + MOVE 12.E-2 TO C-1F . + MOVE 12.E-1 TO C-1G . + MOVE 12.E0 TO C-1H . + MOVE 12.E1 TO C-1I . + MOVE 12.E2 TO C-1J . + MOVE 12.E3 TO C-1K . + MOVE 12.E4 TO C-1L . + MOVE 12.E5 TO C-1M . + MOVE 12.E6 TO C-1N . + MOVE 12.E7 TO C-1O . + MOVE 12.E8 TO C-1P . + MOVE 12.E9 TO C-1Q . + MOVE 12.E10 TO C-1R . + MOVE 12.E11 TO C-1S . + PERFORM DISPLAY-COMP-1. + DISPLAY "Variations on COMP-2 12.3456789098765" + PERFORM DISPLAY-COMP-2. + DISPLAY "Variations on COMP-2 12." + MOVE 12.E-7 TO C-2A . + MOVE 12.E-6 TO C-2B . + MOVE 12.E-5 TO C-2C . + MOVE 12.E-4 TO C-2D . + MOVE 12.E-3 TO C-2E . + MOVE 12.E-2 TO C-2F . + MOVE 12.E-1 TO C-2G . + MOVE 12.E0 TO C-2H . + MOVE 12.E1 TO C-2I . + MOVE 12.E2 TO C-2J . + MOVE 12.E3 TO C-2K . + MOVE 12.E4 TO C-2L . + MOVE 12.E5 TO C-2M . + MOVE 12.E6 TO C-2N . + MOVE 12.E7 TO C-2O . + MOVE 12.E8 TO C-2P . + MOVE 12.E9 TO C-2Q . + MOVE 12.E10 TO C-2R . + MOVE 12.E11 TO C-2S . + MOVE 12.E12 TO C-2T . + MOVE 12.E13 TO C-2U . + MOVE 12.E14 TO C-2V . + MOVE 12.E15 TO C-2W . + MOVE 12.E16 TO C-2X . + PERFORM DISPLAY-COMP-2. + DISPLAY "Variations on FLOAT-EXTENDED 11.11222233334444995555666677778888" + PERFORM DISPLAY-EXTENDED. + GOBACK. + DISPLAY-COMP-1. + DISPLAY C-1A + DISPLAY C-1B + DISPLAY C-1C + DISPLAY C-1D + DISPLAY C-1E + DISPLAY C-1F + DISPLAY C-1G + DISPLAY C-1H + DISPLAY C-1I + DISPLAY C-1J + DISPLAY C-1K + DISPLAY C-1L + DISPLAY C-1M + DISPLAY C-1N. + DISPLAY-COMP-2. + DISPLAY C-2A + DISPLAY C-2B + DISPLAY C-2C + DISPLAY C-2D + DISPLAY C-2E + DISPLAY C-2F + DISPLAY C-2G + DISPLAY C-2H + DISPLAY C-2I + DISPLAY C-2J + DISPLAY C-2K + DISPLAY C-2L + DISPLAY C-2M + DISPLAY C-2N. + DISPLAY-EXTENDED. + DISPLAY C-EA + DISPLAY C-EB + DISPLAY C-EC + DISPLAY C-ED + DISPLAY C-EE + DISPLAY C-EF + DISPLAY C-EG + DISPLAY C-EH + DISPLAY C-EI + DISPLAY C-EJ + DISPLAY C-EK + DISPLAY C-EL + DISPLAY C-EM + DISPLAY C-EN. + END PROGRAM float-demo. + diff --git a/gcc/testsuite/cobol.dg/group2/Simple_floating-point_VALUE_and_MOVE.out b/gcc/testsuite/cobol.dg/group2/Simple_floating-point_VALUE_and_MOVE.out new file mode 100644 index 000000000000..bf1afbf47e21 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Simple_floating-point_VALUE_and_MOVE.out @@ -0,0 +1,61 @@ +Variations on COMP-1 12. +1.200000042E-06 +1.200000042E-05 +0.000119999997 +0.001200000057 +0.0120000001 +0.1199999973 +1.200000048 +12 +120 +1200 +12000 +120000 +1.2E+06 +1.2E+07 +Variations on COMP-2 12.3456789098765 +1.23456789098764994E-06 +1.23456789098764994E-05 +0.000123456789098764987 +0.00123456789098764998 +0.0123456789098764994 +0.123456789098764994 +1.23456789098765007 +12.3456789098765007 +123.456789098765 +1234.56789098764989 +12345.6789098765003 +123456.789098765003 +1.23456789098765003E+06 +1.23456789098764993E+07 +Variations on COMP-2 12. +1.19999999999999995E-06 +1.20000000000000003E-05 +0.000120000000000000003 +0.00119999999999999989 +0.0120000000000000002 +0.119999999999999996 +1.19999999999999996 +12 +120 +1200 +12000 +120000 +1.2E+06 +1.2E+07 +Variations on FLOAT-EXTENDED 11.11222233334444995555666677778888 +1.111222233334444995555666677778887977E-06 +1.11122223333444499555566667777888794E-05 +0.0001111222233334444995555666677778887999 +0.001111222233334444995555666677778888046 +0.01111222233334444995555666677778887971 +0.1111222233334444995555666677778887971 +1.111222233334444995555666677778887923 +11.11222233334444995555666677778888 +111.1222233334444995555666677778888062 +1111.222233334444995555666677778888012 +11112.22233334444995555666677778888052 +111122.2233334444995555666677778887957 +1.111222233334444995555666677778887982E+06 +1.111222233334444995555666677778888023E+07 + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_1.cob b/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_1.cob new file mode 100644 index 000000000000..442888b5eb37 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_1.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/floating-point_ADD_FORMAT_1.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-arith1. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 S1 PIC 999V99 DISPLAY VALUE 123.45 . + 01 S2 PIC 999V99 COMP VALUE 123.45 . + 01 S3 PIC 999V99 COMP-3 VALUE 123.45 . + 01 S4 PIC 999V99 COMP-5 VALUE 123.45 . + 01 S5 FLOAT-SHORT VALUE 123.45 . + 01 S6 FLOAT-LONG VALUE 123.45 . + 01 S7 FLOAT-EXTENDED VALUE 123.45 . + 01 D1 PIC 999V99 DISPLAY . + 01 D2 PIC 999V99 COMP . + 01 D3 PIC 999V99 COMP-3 . + 01 D4 PIC 999V99 COMP-5 . + 01 D5 FLOAT-SHORT . + 01 D6 FLOAT-LONG . + 01 D7 FLOAT-EXTENDED . + PROCEDURE DIVISION. + MOVE S1 TO D1 ADD S1 TO D1 + MOVE S2 TO D2 ADD S2 TO D2 + MOVE S3 TO D3 ADD S3 TO D3 + MOVE S4 TO D4 ADD S4 TO D4 + MOVE S5 TO D5 ADD S5 TO D5 + MOVE S6 TO D6 ADD S6 TO D6 + MOVE S7 TO D7 ADD S7 TO D7 + PERFORM DISPLAY-D. + MOVE S1 TO D1 ADD S2 TO D1 + MOVE S2 TO D2 ADD S3 TO D2 + MOVE S3 TO D3 ADD S4 TO D3 + MOVE S4 TO D4 ADD S5 TO D4 + MOVE S5 TO D5 ADD S6 TO D5 + MOVE S6 TO D6 ADD S7 TO D6 + MOVE S7 TO D7 ADD S1 TO D7 + PERFORM DISPLAY-D. + MOVE S1 TO D1 ADD S3 TO D1 + MOVE S2 TO D2 ADD S4 TO D2 + MOVE S3 TO D3 ADD S5 TO D3 + MOVE S4 TO D4 ADD S6 TO D4 + MOVE S5 TO D5 ADD S7 TO D5 + MOVE S6 TO D6 ADD S1 TO D6 + MOVE S7 TO D7 ADD S2 TO D7 + PERFORM DISPLAY-D. + MOVE S1 TO D1 ADD S4 TO D1 + MOVE S2 TO D2 ADD S5 TO D2 + MOVE S3 TO D3 ADD S6 TO D3 + MOVE S4 TO D4 ADD S7 TO D4 + MOVE S5 TO D5 ADD S1 TO D5 + MOVE S6 TO D6 ADD S2 TO D6 + MOVE S7 TO D7 ADD S3 TO D7 + PERFORM DISPLAY-D. + MOVE S1 TO D1 ADD S5 TO D1 + MOVE S2 TO D2 ADD S6 TO D2 + MOVE S3 TO D3 ADD S7 TO D3 + MOVE S4 TO D4 ADD S1 TO D4 + MOVE S5 TO D5 ADD S2 TO D5 + MOVE S6 TO D6 ADD S3 TO D6 + MOVE S7 TO D7 ADD S4 TO D7 + PERFORM DISPLAY-D. + MOVE S1 TO D1 ADD S6 TO D1 + MOVE S2 TO D2 ADD S7 TO D2 + MOVE S3 TO D3 ADD S1 TO D3 + MOVE S4 TO D4 ADD S2 TO D4 + MOVE S5 TO D5 ADD S3 TO D5 + MOVE S6 TO D6 ADD S4 TO D6 + MOVE S7 TO D7 ADD S5 TO D7 + PERFORM DISPLAY-D. + MOVE S1 TO D1 ADD S7 TO D1 + MOVE S2 TO D2 ADD S1 TO D2 + MOVE S3 TO D3 ADD S2 TO D3 + MOVE S4 TO D4 ADD S3 TO D4 + MOVE S5 TO D5 ADD S4 TO D5 + MOVE S6 TO D6 ADD S5 TO D6 + MOVE S7 TO D7 ADD S6 TO D7 + PERFORM DISPLAY-D. + GOBACK. + DISPLAY-D. + DISPLAY D1 SPACE + D2 SPACE + D3 SPACE + D4 SPACE + D5 SPACE + D6 SPACE + D7 . + MOVE 0 TO D1 D2 D3 D4 D5 D6 D7. + END PROGRAM float-arith1. + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_1.out b/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_1.out new file mode 100644 index 000000000000..d48643c9c19f --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_1.out @@ -0,0 +1,8 @@ +246.90 246.90 246.90 246.90 246.8999939 246.900000000000006 246.9000000000000000000000000000000049 +246.90 246.90 246.90 246.89 246.8999939 246.900000000000006 246.9000000000000000000000000000000049 +246.90 246.90 246.89 246.90 246.8999939 246.900000000000006 246.9000000000000000000000000000000049 +246.90 246.89 246.90 246.90 246.8999939 246.900000000000006 246.9000000000000000000000000000000049 +246.89 246.90 246.90 246.90 246.8999939 246.900000000000006 246.9000000000000000000000000000000049 +246.90 246.90 246.90 246.90 246.8999939 246.900000000000006 246.8999969482421874999999999999999901 +246.90 246.90 246.90 246.90 246.8999939 246.899996948242176 246.9000000000000028421709430404007336 + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_2.cob b/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_2.cob new file mode 100644 index 000000000000..ef3f730b0546 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_2.cob @@ -0,0 +1,96 @@ + *> { dg-do run } + *> { dg-output-file "group2/floating-point_ADD_FORMAT_2.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-add2. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 S1 PIC 999V99 DISPLAY VALUE 123.45 . + 01 S2 PIC 999V99 COMP VALUE 123.45 . + 01 S3 PIC 999V99 COMP-3 VALUE 123.45 . + 01 S4 PIC 999V99 COMP-5 VALUE 123.45 . + 01 S5 FLOAT-SHORT VALUE 123.45 . + 01 S6 FLOAT-LONG VALUE 123.45 . + 01 S7 FLOAT-EXTENDED VALUE 123.45 . + 01 D1 PIC 999V99 DISPLAY VALUE 543.21 . + 01 D2 PIC 999V99 COMP VALUE 543.21 . + 01 D3 PIC 999V99 COMP-3 VALUE 543.21 . + 01 D4 PIC 999V99 COMP-5 VALUE 543.21 . + 01 D5 FLOAT-SHORT VALUE 543.21 . + 01 D6 FLOAT-LONG VALUE 543.21 . + 01 D7 FLOAT-EXTENDED VALUE 543.21 . + 01 X1 PIC 999V99 DISPLAY . + 01 X2 PIC 999V99 COMP . + 01 X3 PIC 999V99 COMP-3 . + 01 X4 PIC 999V99 COMP-5 . + 01 X5 FLOAT-SHORT . + 01 X6 FLOAT-LONG . + 01 X7 FLOAT-EXTENDED . + PROCEDURE DIVISION. + ADD S1 TO D1 GIVING X1 + ADD S2 TO D2 GIVING X2 + ADD S3 TO D3 GIVING X3 + ADD S4 TO D4 GIVING X4 + ADD S5 TO D5 GIVING X5 + ADD S6 TO D6 GIVING X6 + ADD S7 TO D7 GIVING X7 + PERFORM DISPLAY-X. + ADD S2 TO D1 GIVING X1 + ADD S3 TO D2 GIVING X2 + ADD S4 TO D3 GIVING X3 + ADD S5 TO D4 GIVING X4 + ADD S6 TO D5 GIVING X5 + ADD S7 TO D6 GIVING X6 + ADD S1 TO D7 GIVING X7 + PERFORM DISPLAY-X. + ADD S3 TO D1 GIVING X1 + ADD S4 TO D2 GIVING X2 + ADD S5 TO D3 GIVING X3 + ADD S6 TO D4 GIVING X4 + ADD S7 TO D5 GIVING X5 + ADD S1 TO D6 GIVING X6 + ADD S2 TO D7 GIVING X7 + PERFORM DISPLAY-X. + ADD S4 TO D1 GIVING X1 + ADD S5 TO D2 GIVING X2 + ADD S6 TO D3 GIVING X3 + ADD S7 TO D4 GIVING X4 + ADD S1 TO D5 GIVING X5 + ADD S2 TO D6 GIVING X6 + ADD S3 TO D7 GIVING X7 + PERFORM DISPLAY-X. + ADD S5 TO D1 GIVING X1 + ADD S6 TO D2 GIVING X2 + ADD S7 TO D3 GIVING X3 + ADD S1 TO D4 GIVING X4 + ADD S2 TO D5 GIVING X5 + ADD S3 TO D6 GIVING X6 + ADD S4 TO D7 GIVING X7 + PERFORM DISPLAY-X. + ADD S6 TO D1 GIVING X1 + ADD S7 TO D2 GIVING X2 + ADD S1 TO D3 GIVING X3 + ADD S2 TO D4 GIVING X4 + ADD S3 TO D5 GIVING X5 + ADD S4 TO D6 GIVING X6 + ADD S5 TO D7 GIVING X7 + PERFORM DISPLAY-X. + ADD S7 TO D1 GIVING X1 + ADD S1 TO D2 GIVING X2 + ADD S2 TO D3 GIVING X3 + ADD S3 TO D4 GIVING X4 + ADD S4 TO D5 GIVING X5 + ADD S5 TO D6 GIVING X6 + ADD S6 TO D7 GIVING X7 + PERFORM DISPLAY-X. + GOBACK. + DISPLAY-X. + DISPLAY X1 SPACE + X2 SPACE + X3 SPACE + X4 SPACE + X5 SPACE + X6 SPACE + X7 . + END PROGRAM float-add2. + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_2.out b/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_2.out new file mode 100644 index 000000000000..933b56df7aff --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_ADD_FORMAT_2.out @@ -0,0 +1,8 @@ +666.66 666.66 666.66 666.66 666.6600342 666.660000000000082 666.660000000000000000000000000000071 +666.66 666.66 666.66 666.65 666.6600342 666.660000000000082 666.660000000000000000000000000000071 +666.66 666.66 666.65 666.66 666.6600342 666.660000000000082 666.660000000000000000000000000000071 +666.66 666.65 666.66 666.66 666.6600342 666.660000000000082 666.660000000000000000000000000000071 +666.65 666.66 666.66 666.66 666.6600342 666.660000000000082 666.660000000000000000000000000000071 +666.66 666.66 666.66 666.66 666.6600342 666.660000000000082 666.6599969482421875000000000000000316 +666.66 666.66 666.66 666.66 666.6600342 666.659996948242224 666.660000000000002842170943040400775 + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_1.cob b/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_1.cob new file mode 100644 index 000000000000..efe3d979efab --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_1.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/floating-point_DIVIDE_FORMAT_1.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-div1. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 S1 PIC 999V99 DISPLAY VALUE 1.1 . + 01 S2 PIC 999V99 COMP VALUE 1.1 . + 01 S3 PIC 999V99 COMP-3 VALUE 1.1 . + 01 S4 PIC 999V99 COMP-5 VALUE 1.1 . + 01 S5 FLOAT-SHORT VALUE 1.1 . + 01 S6 FLOAT-LONG VALUE 1.1 . + 01 S7 FLOAT-EXTENDED VALUE 1.1 . + 01 D1 PIC 999V99 DISPLAY VALUE 611.05. + 01 D2 PIC 999V99 COMP VALUE 611.05. + 01 D3 PIC 999V99 COMP-3 VALUE 611.05. + 01 D4 PIC 999V99 COMP-5 VALUE 611.05. + 01 D5 FLOAT-SHORT VALUE 611.05. + 01 D6 FLOAT-LONG VALUE 611.05. + 01 D7 FLOAT-EXTENDED VALUE 611.05. + PROCEDURE DIVISION. + DIVIDE S1 INTO D1 + DIVIDE S2 INTO D2 + DIVIDE S3 INTO D3 + DIVIDE S4 INTO D4 + DIVIDE S5 INTO D5 + DIVIDE S6 INTO D6 + DIVIDE S7 INTO D7 + PERFORM DISPLAY-D. + DIVIDE S1 INTO D2 + DIVIDE S2 INTO D3 + DIVIDE S3 INTO D4 + DIVIDE S4 INTO D5 + DIVIDE S5 INTO D6 + DIVIDE S6 INTO D7 + DIVIDE S7 INTO D1 + PERFORM DISPLAY-D. + DIVIDE S1 INTO D3 + DIVIDE S2 INTO D4 + DIVIDE S3 INTO D5 + DIVIDE S4 INTO D6 + DIVIDE S5 INTO D7 + DIVIDE S6 INTO D1 + DIVIDE S7 INTO D2 + PERFORM DISPLAY-D. + DIVIDE S1 INTO D4 + DIVIDE S2 INTO D5 + DIVIDE S3 INTO D6 + DIVIDE S4 INTO D7 + DIVIDE S5 INTO D1 + DIVIDE S6 INTO D2 + DIVIDE S7 INTO D3 + PERFORM DISPLAY-D. + DIVIDE S1 INTO D5 + DIVIDE S2 INTO D6 + DIVIDE S3 INTO D7 + DIVIDE S4 INTO D1 + DIVIDE S5 INTO D2 + DIVIDE S6 INTO D3 + DIVIDE S7 INTO D4 + PERFORM DISPLAY-D. + DIVIDE S1 INTO D6 + DIVIDE S2 INTO D7 + DIVIDE S3 INTO D1 + DIVIDE S4 INTO D2 + DIVIDE S5 INTO D3 + DIVIDE S6 INTO D4 + DIVIDE S7 INTO D5 + PERFORM DISPLAY-D. + DIVIDE S1 INTO D7 + DIVIDE S2 INTO D1 + DIVIDE S3 INTO D2 + DIVIDE S4 INTO D3 + DIVIDE S5 INTO D4 + DIVIDE S6 INTO D5 + DIVIDE S7 INTO D6 + PERFORM DISPLAY-D. + GOBACK. + DISPLAY-D. + DISPLAY D1 SPACE + D2 SPACE + D3 SPACE + D4 SPACE + D5 SPACE + D6 SPACE + D7 . + INITIALIZE D1 D2 D3 D4 D5 D6 D7 ALL VALUE. + END PROGRAM float-div1. + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_1.out b/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_1.out new file mode 100644 index 000000000000..cc7a17778653 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_1.out @@ -0,0 +1,8 @@ +555.50 555.50 555.50 555.50 555.5 555.499999999999886 555.4999999999999999999999999999999014 +555.49 555.50 555.50 555.50 555.5 555.499987959861983 555.4999999999999551469898051436793168 +555.49 555.49 555.50 555.50 555.5 555.5 555.4999879598620163340565002169066332 +555.49 555.49 555.49 555.50 555.5 555.5 555.4999999999999999999999999999999014 +555.50 555.49 555.49 555.49 555.5 555.5 555.4999999999999999999999999999999014 +555.50 555.50 555.49 555.49 555.5 555.5 555.4999999999999999999999999999999014 +555.50 555.50 555.50 555.49 555.5 555.5 555.4999999999999999999999999999999014 + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_2.cob b/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_2.cob new file mode 100644 index 000000000000..068844bdfcee --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_2.cob @@ -0,0 +1,96 @@ + *> { dg-do run } + *> { dg-output-file "group2/floating-point_DIVIDE_FORMAT_2.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-DIVIDE2. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 S1 PIC 999V99 DISPLAY VALUE 123.21 . + 01 S2 PIC 999V99 COMP VALUE 123.21 . + 01 S3 PIC 999V99 COMP-3 VALUE 123.21 . + 01 S4 PIC 999V99 COMP-5 VALUE 123.21 . + 01 S5 FLOAT-SHORT VALUE 123.21 . + 01 S6 FLOAT-LONG VALUE 123.21 . + 01 S7 FLOAT-EXTENDED VALUE 123.21 . + 01 D1 PIC 999V99 DISPLAY VALUE 111.00 . + 01 D2 PIC 999V99 COMP VALUE 111.00 . + 01 D3 PIC 999V99 COMP-3 VALUE 111.00 . + 01 D4 PIC 999V99 COMP-5 VALUE 111.00 . + 01 D5 FLOAT-SHORT VALUE 111.00 . + 01 D6 FLOAT-LONG VALUE 111.00 . + 01 D7 FLOAT-EXTENDED VALUE 111.00 . + 01 X1 PIC 999V99 DISPLAY . + 01 X2 PIC 999V99 COMP . + 01 X3 PIC 999V99 COMP-3 . + 01 X4 PIC 999V99 COMP-5 . + 01 X5 FLOAT-SHORT . + 01 X6 FLOAT-LONG . + 01 X7 FLOAT-EXTENDED . + PROCEDURE DIVISION. + DIVIDE S1 BY D1 GIVING X1 + DIVIDE S2 BY D2 GIVING X2 + DIVIDE S3 BY D3 GIVING X3 + DIVIDE S4 BY D4 GIVING X4 + DIVIDE S5 BY D5 GIVING X5 + DIVIDE S6 BY D6 GIVING X6 + DIVIDE S7 BY D7 GIVING X7 + PERFORM DISPLAY-X. + DIVIDE S2 BY D1 GIVING X1 + DIVIDE S3 BY D2 GIVING X2 + DIVIDE S4 BY D3 GIVING X3 + DIVIDE S5 BY D4 GIVING X4 + DIVIDE S6 BY D5 GIVING X5 + DIVIDE S7 BY D6 GIVING X6 + DIVIDE S1 BY D7 GIVING X7 + PERFORM DISPLAY-X. + DIVIDE S3 BY D1 GIVING X1 + DIVIDE S4 BY D2 GIVING X2 + DIVIDE S5 BY D3 GIVING X3 + DIVIDE S6 BY D4 GIVING X4 + DIVIDE S7 BY D5 GIVING X5 + DIVIDE S1 BY D6 GIVING X6 + DIVIDE S2 BY D7 GIVING X7 + PERFORM DISPLAY-X. + DIVIDE S4 BY D1 GIVING X1 + DIVIDE S5 BY D2 GIVING X2 + DIVIDE S6 BY D3 GIVING X3 + DIVIDE S7 BY D4 GIVING X4 + DIVIDE S1 BY D5 GIVING X5 + DIVIDE S2 BY D6 GIVING X6 + DIVIDE S3 BY D7 GIVING X7 + PERFORM DISPLAY-X. + DIVIDE S5 BY D1 GIVING X1 + DIVIDE S6 BY D2 GIVING X2 + DIVIDE S7 BY D3 GIVING X3 + DIVIDE S1 BY D4 GIVING X4 + DIVIDE S2 BY D5 GIVING X5 + DIVIDE S3 BY D6 GIVING X6 + DIVIDE S4 BY D7 GIVING X7 + PERFORM DISPLAY-X. + DIVIDE S6 BY D1 GIVING X1 + DIVIDE S7 BY D2 GIVING X2 + DIVIDE S1 BY D3 GIVING X3 + DIVIDE S2 BY D4 GIVING X4 + DIVIDE S3 BY D5 GIVING X5 + DIVIDE S4 BY D6 GIVING X6 + DIVIDE S5 BY D7 GIVING X7 + PERFORM DISPLAY-X. + DIVIDE S7 BY D1 GIVING X1 + DIVIDE S1 BY D2 GIVING X2 + DIVIDE S2 BY D3 GIVING X3 + DIVIDE S3 BY D4 GIVING X4 + DIVIDE S4 BY D5 GIVING X5 + DIVIDE S5 BY D6 GIVING X6 + DIVIDE S6 BY D7 GIVING X7 + PERFORM DISPLAY-X. + GOBACK. + DISPLAY-X. + DISPLAY X1 SPACE + X2 SPACE + X3 SPACE + X4 SPACE + X5 SPACE + X6 SPACE + X7 . + END PROGRAM float-DIVIDE2. + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_2.out b/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_2.out new file mode 100644 index 000000000000..1723f56989ed --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_DIVIDE_FORMAT_2.out @@ -0,0 +1,8 @@ +001.11 001.11 001.11 001.11 1.110000014 1.10999999999999988 1.109999999999999999999999999999999892 +001.11 001.11 001.11 001.10 1.110000014 1.1100000000000001 1.109999999999999999999999999999999892 +001.11 001.11 001.10 001.10 1.110000014 1.1100000000000001 1.109999999999999999999999999999999892 +001.11 001.10 001.10 001.10 1.110000014 1.1100000000000001 1.109999999999999999999999999999999892 +001.10 001.10 001.10 001.11 1.110000014 1.1100000000000001 1.109999999999999999999999999999999892 +001.10 001.10 001.11 001.11 1.110000014 1.1100000000000001 1.10999999175200591216216216216216224 +001.10 001.11 001.11 001.11 1.110000014 1.10999999175200581 1.109999999999999943668684011811877144 + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_1.cob b/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_1.cob new file mode 100644 index 000000000000..4365a40ea5b0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_1.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/floating-point_MULTIPLY_FORMAT_1.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-mult1. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 S1 PIC 999V99 DISPLAY VALUE 1.2 . + 01 S2 PIC 999V99 COMP VALUE 1.2 . + 01 S3 PIC 999V99 COMP-3 VALUE 1.2 . + 01 S4 PIC 999V99 COMP-5 VALUE 1.2 . + 01 S5 FLOAT-SHORT VALUE 1.2 . + 01 S6 FLOAT-LONG VALUE 1.2 . + 01 S7 FLOAT-EXTENDED VALUE 1.2 . + 01 D1 PIC 999V99 DISPLAY VALUE 1.1. + 01 D2 PIC 999V99 COMP VALUE 1.1. + 01 D3 PIC 999V99 COMP-3 VALUE 1.1. + 01 D4 PIC 999V99 COMP-5 VALUE 1.1. + 01 D5 FLOAT-SHORT VALUE 1.1. + 01 D6 FLOAT-LONG VALUE 1.1. + 01 D7 FLOAT-EXTENDED VALUE 1.1. + PROCEDURE DIVISION. + MULTIPLY S1 BY D1 + MULTIPLY S2 BY D2 + MULTIPLY S3 BY D3 + MULTIPLY S4 BY D4 + MULTIPLY S5 BY D5 + MULTIPLY S6 BY D6 + MULTIPLY S7 BY D7 + PERFORM DISPLAY-D. + MULTIPLY S1 BY D2 + MULTIPLY S2 BY D3 + MULTIPLY S3 BY D4 + MULTIPLY S4 BY D5 + MULTIPLY S5 BY D6 + MULTIPLY S6 BY D7 + MULTIPLY S7 BY D1 + PERFORM DISPLAY-D. + MULTIPLY S1 BY D3 + MULTIPLY S2 BY D4 + MULTIPLY S3 BY D5 + MULTIPLY S4 BY D6 + MULTIPLY S5 BY D7 + MULTIPLY S6 BY D1 + MULTIPLY S7 BY D2 + PERFORM DISPLAY-D. + MULTIPLY S1 BY D4 + MULTIPLY S2 BY D5 + MULTIPLY S3 BY D6 + MULTIPLY S4 BY D7 + MULTIPLY S5 BY D1 + MULTIPLY S6 BY D2 + MULTIPLY S7 BY D3 + PERFORM DISPLAY-D. + MULTIPLY S1 BY D5 + MULTIPLY S2 BY D6 + MULTIPLY S3 BY D7 + MULTIPLY S4 BY D1 + MULTIPLY S5 BY D2 + MULTIPLY S6 BY D3 + MULTIPLY S7 BY D4 + PERFORM DISPLAY-D. + MULTIPLY S1 BY D6 + MULTIPLY S2 BY D7 + MULTIPLY S3 BY D1 + MULTIPLY S4 BY D2 + MULTIPLY S5 BY D3 + MULTIPLY S6 BY D4 + MULTIPLY S7 BY D5 + PERFORM DISPLAY-D. + MULTIPLY S1 BY D7 + MULTIPLY S2 BY D1 + MULTIPLY S3 BY D2 + MULTIPLY S4 BY D3 + MULTIPLY S5 BY D4 + MULTIPLY S6 BY D5 + MULTIPLY S7 BY D6 + PERFORM DISPLAY-D. + GOBACK. + DISPLAY-D. + DISPLAY D1 SPACE + D2 SPACE + D3 SPACE + D4 SPACE + D5 SPACE + D6 SPACE + D7 . + INITIALIZE D1 D2 D3 D4 D5 D6 D7 ALL VALUE. + END PROGRAM float-mult1. + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_1.out b/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_1.out new file mode 100644 index 000000000000..27225450b011 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_1.out @@ -0,0 +1,8 @@ +001.32 001.32 001.32 001.32 1.320000052 1.32000000000000006 1.320000000000000000000000000000000054 +001.32 001.32 001.32 001.32 1.320000052 1.3200000524520874 1.319999999999999951150186916493112221 +001.31 001.32 001.32 001.32 1.320000052 1.32000000000000006 1.32000005245208740234375 +001.32 001.31 001.32 001.32 1.320000052 1.32000000000000006 1.320000000000000000000000000000000054 +001.32 001.32 001.31 001.32 1.320000052 1.32000000000000006 1.320000000000000000000000000000000054 +001.32 001.32 001.32 001.31 1.320000052 1.32000000000000006 1.320000000000000000000000000000000054 +001.32 001.32 001.32 001.32 1.320000052 1.32000000000000006 1.320000000000000000000000000000000054 + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_2.cob b/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_2.cob new file mode 100644 index 000000000000..183f1af7a0ce --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_2.cob @@ -0,0 +1,96 @@ + *> { dg-do run } + *> { dg-output-file "group2/floating-point_MULTIPLY_FORMAT_2.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-MULTIPLY2. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 S1 PIC 999V99 DISPLAY VALUE 111.00 . + 01 S2 PIC 999V99 COMP VALUE 111.00 . + 01 S3 PIC 999V99 COMP-3 VALUE 111.00 . + 01 S4 PIC 999V99 COMP-5 VALUE 111.00 . + 01 S5 FLOAT-SHORT VALUE 111.00 . + 01 S6 FLOAT-LONG VALUE 111.00 . + 01 S7 FLOAT-EXTENDED VALUE 111.00 . + 01 D1 PIC 999V99 DISPLAY VALUE 1.11 . + 01 D2 PIC 999V99 COMP VALUE 1.11 . + 01 D3 PIC 999V99 COMP-3 VALUE 1.11 . + 01 D4 PIC 999V99 COMP-5 VALUE 1.11 . + 01 D5 FLOAT-SHORT VALUE 1.11 . + 01 D6 FLOAT-LONG VALUE 1.11 . + 01 D7 FLOAT-EXTENDED VALUE 1.11 . + 01 X1 PIC 999V99 DISPLAY . + 01 X2 PIC 999V99 COMP . + 01 X3 PIC 999V99 COMP-3 . + 01 X4 PIC 999V99 COMP-5 . + 01 X5 FLOAT-SHORT . + 01 X6 FLOAT-LONG . + 01 X7 FLOAT-EXTENDED . + PROCEDURE DIVISION. + MULTIPLY S1 BY D1 GIVING X1 + MULTIPLY S2 BY D2 GIVING X2 + MULTIPLY S3 BY D3 GIVING X3 + MULTIPLY S4 BY D4 GIVING X4 + MULTIPLY S5 BY D5 GIVING X5 + MULTIPLY S6 BY D6 GIVING X6 + MULTIPLY S7 BY D7 GIVING X7 + PERFORM DISPLAY-X. + MULTIPLY S2 BY D1 GIVING X1 + MULTIPLY S3 BY D2 GIVING X2 + MULTIPLY S4 BY D3 GIVING X3 + MULTIPLY S5 BY D4 GIVING X4 + MULTIPLY S6 BY D5 GIVING X5 + MULTIPLY S7 BY D6 GIVING X6 + MULTIPLY S1 BY D7 GIVING X7 + PERFORM DISPLAY-X. + MULTIPLY S3 BY D1 GIVING X1 + MULTIPLY S4 BY D2 GIVING X2 + MULTIPLY S5 BY D3 GIVING X3 + MULTIPLY S6 BY D4 GIVING X4 + MULTIPLY S7 BY D5 GIVING X5 + MULTIPLY S1 BY D6 GIVING X6 + MULTIPLY S2 BY D7 GIVING X7 + PERFORM DISPLAY-X. + MULTIPLY S4 BY D1 GIVING X1 + MULTIPLY S5 BY D2 GIVING X2 + MULTIPLY S6 BY D3 GIVING X3 + MULTIPLY S7 BY D4 GIVING X4 + MULTIPLY S1 BY D5 GIVING X5 + MULTIPLY S2 BY D6 GIVING X6 + MULTIPLY S3 BY D7 GIVING X7 + PERFORM DISPLAY-X. + MULTIPLY S5 BY D1 GIVING X1 + MULTIPLY S6 BY D2 GIVING X2 + MULTIPLY S7 BY D3 GIVING X3 + MULTIPLY S1 BY D4 GIVING X4 + MULTIPLY S2 BY D5 GIVING X5 + MULTIPLY S3 BY D6 GIVING X6 + MULTIPLY S4 BY D7 GIVING X7 + PERFORM DISPLAY-X. + MULTIPLY S6 BY D1 GIVING X1 + MULTIPLY S7 BY D2 GIVING X2 + MULTIPLY S1 BY D3 GIVING X3 + MULTIPLY S2 BY D4 GIVING X4 + MULTIPLY S3 BY D5 GIVING X5 + MULTIPLY S4 BY D6 GIVING X6 + MULTIPLY S5 BY D7 GIVING X7 + PERFORM DISPLAY-X. + MULTIPLY S7 BY D1 GIVING X1 + MULTIPLY S1 BY D2 GIVING X2 + MULTIPLY S2 BY D3 GIVING X3 + MULTIPLY S3 BY D4 GIVING X4 + MULTIPLY S4 BY D5 GIVING X5 + MULTIPLY S5 BY D6 GIVING X6 + MULTIPLY S6 BY D7 GIVING X7 + PERFORM DISPLAY-X. + GOBACK. + DISPLAY-X. + DISPLAY X1 SPACE + X2 SPACE + X3 SPACE + X4 SPACE + X5 SPACE + X6 SPACE + X7 . + END PROGRAM float-MULTIPLY2. + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_2.out b/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_2.out new file mode 100644 index 000000000000..c8f6231772f0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_MULTIPLY_FORMAT_2.out @@ -0,0 +1,8 @@ +123.21 123.21 123.21 123.21 123.2099991 123.210000000000008 123.2100000000000000000000000000000069 +123.21 123.21 123.21 123.21 123.2099991 123.210000000000008 123.2100000000000000000000000000000069 +123.21 123.21 123.21 123.21 123.2099991 123.210000000000008 123.2100000000000000000000000000000069 +123.21 123.21 123.21 123.21 123.2099991 123.210000000000008 123.2100000000000000000000000000000069 +123.21 123.21 123.21 123.21 123.2099991 123.210000000000008 123.2100000000000000000000000000000069 +123.21 123.21 123.21 123.21 123.2099991 123.210000000000008 123.2100000000000000000000000000000069 +123.21 123.21 123.21 123.21 123.2099991 123.210000000000008 123.2100000000000000000000000000000069 + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_1.cob b/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_1.cob new file mode 100644 index 000000000000..7ba81612ee2d --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_1.cob @@ -0,0 +1,90 @@ + *> { dg-do run } + *> { dg-output-file "group2/floating-point_SUBTRACT_FORMAT_1.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-sub1. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 S1 PIC 999V99 DISPLAY VALUE 111.11 . + 01 S2 PIC 999V99 COMP VALUE 111.11 . + 01 S3 PIC 999V99 COMP-3 VALUE 111.11 . + 01 S4 PIC 999V99 COMP-5 VALUE 111.11 . + 01 S5 FLOAT-SHORT VALUE 111.11 . + 01 S6 FLOAT-LONG VALUE 111.11 . + 01 S7 FLOAT-EXTENDED VALUE 111.11 . + 01 D1 PIC 999V99 DISPLAY VALUE 666.66. + 01 D2 PIC 999V99 COMP VALUE 666.66. + 01 D3 PIC 999V99 COMP-3 VALUE 666.66. + 01 D4 PIC 999V99 COMP-5 VALUE 666.66. + 01 D5 FLOAT-SHORT VALUE 666.66. + 01 D6 FLOAT-LONG VALUE 666.66. + 01 D7 FLOAT-EXTENDED VALUE 666.66. + PROCEDURE DIVISION. + SUBTRACT S1 FROM D1 + SUBTRACT S1 FROM D2 + SUBTRACT S1 FROM D3 + SUBTRACT S1 FROM D4 + SUBTRACT S1 FROM D5 + SUBTRACT S1 FROM D6 + SUBTRACT S1 FROM D7 + PERFORM DISPLAY-D. + SUBTRACT S2 FROM D2 + SUBTRACT S2 FROM D3 + SUBTRACT S2 FROM D4 + SUBTRACT S2 FROM D5 + SUBTRACT S2 FROM D6 + SUBTRACT S2 FROM D7 + SUBTRACT S2 FROM D1 + PERFORM DISPLAY-D. + SUBTRACT S3 FROM D3 + SUBTRACT S3 FROM D4 + SUBTRACT S3 FROM D5 + SUBTRACT S3 FROM D6 + SUBTRACT S3 FROM D7 + SUBTRACT S3 FROM D1 + SUBTRACT S3 FROM D2 + PERFORM DISPLAY-D. + SUBTRACT S4 FROM D4 + SUBTRACT S4 FROM D5 + SUBTRACT S4 FROM D6 + SUBTRACT S4 FROM D7 + SUBTRACT S4 FROM D1 + SUBTRACT S4 FROM D2 + SUBTRACT S4 FROM D3 + PERFORM DISPLAY-D. + SUBTRACT S5 FROM D5 + SUBTRACT S5 FROM D6 + SUBTRACT S5 FROM D7 + SUBTRACT S5 FROM D1 + SUBTRACT S5 FROM D2 + SUBTRACT S5 FROM D3 + SUBTRACT S5 FROM D4 + PERFORM DISPLAY-D. + SUBTRACT S6 FROM D6 + SUBTRACT S6 FROM D7 + SUBTRACT S6 FROM D1 + SUBTRACT S6 FROM D2 + SUBTRACT S6 FROM D3 + SUBTRACT S6 FROM D4 + SUBTRACT S6 FROM D5 + PERFORM DISPLAY-D. + SUBTRACT S7 FROM D7 + SUBTRACT S7 FROM D1 + SUBTRACT S7 FROM D2 + SUBTRACT S7 FROM D3 + SUBTRACT S7 FROM D4 + SUBTRACT S7 FROM D5 + SUBTRACT S7 FROM D6 + PERFORM DISPLAY-D. + GOBACK. + DISPLAY-D. + DISPLAY D1 SPACE + D2 SPACE + D3 SPACE + D4 SPACE + D5 SPACE + D6 SPACE + D7 . + INITIALIZE D1 D2 D3 D4 D5 D6 D7 ALL VALUE. + END PROGRAM float-sub1. + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_1.out b/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_1.out new file mode 100644 index 000000000000..39978ac50096 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_1.out @@ -0,0 +1,8 @@ +555.55 555.55 555.55 555.55 555.5499878 555.549999999999955 555.5499999999999999999999999999999606 +555.55 555.55 555.55 555.55 555.5499878 555.549999999999955 555.5499999999999999999999999999999606 +555.55 555.55 555.55 555.55 555.5499878 555.549999999999955 555.5499999999999999999999999999999606 +555.55 555.55 555.55 555.55 555.5499878 555.549999999999955 555.5499999999999999999999999999999606 +555.54 555.54 555.54 555.54 555.5499878 555.549999389648406 555.5499993896484374999999999999999724 +555.55 555.55 555.55 555.55 555.5499878 555.549999999999955 555.5500000000000005684341886080801211 +555.54 555.54 555.54 555.54 555.5499878 555.549999999999955 555.5499999999999999999999999999999606 + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_2.cob b/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_2.cob new file mode 100644 index 000000000000..fa7d6a144655 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_2.cob @@ -0,0 +1,96 @@ + *> { dg-do run } + *> { dg-output-file "group2/floating-point_SUBTRACT_FORMAT_2.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-SUBTRACT2. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 S1 PIC 999V99 DISPLAY VALUE 123.45 . + 01 S2 PIC 999V99 COMP VALUE 123.45 . + 01 S3 PIC 999V99 COMP-3 VALUE 123.45 . + 01 S4 PIC 999V99 COMP-5 VALUE 123.45 . + 01 S5 FLOAT-SHORT VALUE 123.45 . + 01 S6 FLOAT-LONG VALUE 123.45 . + 01 S7 FLOAT-EXTENDED VALUE 123.45 . + 01 D1 PIC 999V99 DISPLAY VALUE 678.55 . + 01 D2 PIC 999V99 COMP VALUE 678.55 . + 01 D3 PIC 999V99 COMP-3 VALUE 678.55 . + 01 D4 PIC 999V99 COMP-5 VALUE 678.55 . + 01 D5 FLOAT-SHORT VALUE 678.55 . + 01 D6 FLOAT-LONG VALUE 678.55 . + 01 D7 FLOAT-EXTENDED VALUE 678.55 . + 01 X1 PIC 999V99 DISPLAY . + 01 X2 PIC 999V99 COMP . + 01 X3 PIC 999V99 COMP-3 . + 01 X4 PIC 999V99 COMP-5 . + 01 X5 FLOAT-SHORT . + 01 X6 FLOAT-LONG . + 01 X7 FLOAT-EXTENDED . + PROCEDURE DIVISION. + SUBTRACT S1 FROM D1 GIVING X1 + SUBTRACT S2 FROM D2 GIVING X2 + SUBTRACT S3 FROM D3 GIVING X3 + SUBTRACT S4 FROM D4 GIVING X4 + SUBTRACT S5 FROM D5 GIVING X5 + SUBTRACT S6 FROM D6 GIVING X6 + SUBTRACT S7 FROM D7 GIVING X7 + PERFORM DISPLAY-X. + SUBTRACT S2 FROM D1 GIVING X1 + SUBTRACT S3 FROM D2 GIVING X2 + SUBTRACT S4 FROM D3 GIVING X3 + SUBTRACT S5 FROM D4 GIVING X4 + SUBTRACT S6 FROM D5 GIVING X5 + SUBTRACT S7 FROM D6 GIVING X6 + SUBTRACT S1 FROM D7 GIVING X7 + PERFORM DISPLAY-X. + SUBTRACT S3 FROM D1 GIVING X1 + SUBTRACT S4 FROM D2 GIVING X2 + SUBTRACT S5 FROM D3 GIVING X3 + SUBTRACT S6 FROM D4 GIVING X4 + SUBTRACT S7 FROM D5 GIVING X5 + SUBTRACT S1 FROM D6 GIVING X6 + SUBTRACT S2 FROM D7 GIVING X7 + PERFORM DISPLAY-X. + SUBTRACT S4 FROM D1 GIVING X1 + SUBTRACT S5 FROM D2 GIVING X2 + SUBTRACT S6 FROM D3 GIVING X3 + SUBTRACT S7 FROM D4 GIVING X4 + SUBTRACT S1 FROM D5 GIVING X5 + SUBTRACT S2 FROM D6 GIVING X6 + SUBTRACT S3 FROM D7 GIVING X7 + PERFORM DISPLAY-X. + SUBTRACT S5 FROM D1 GIVING X1 + SUBTRACT S6 FROM D2 GIVING X2 + SUBTRACT S7 FROM D3 GIVING X3 + SUBTRACT S1 FROM D4 GIVING X4 + SUBTRACT S2 FROM D5 GIVING X5 + SUBTRACT S3 FROM D6 GIVING X6 + SUBTRACT S4 FROM D7 GIVING X7 + PERFORM DISPLAY-X. + SUBTRACT S6 FROM D1 GIVING X1 + SUBTRACT S7 FROM D2 GIVING X2 + SUBTRACT S1 FROM D3 GIVING X3 + SUBTRACT S2 FROM D4 GIVING X4 + SUBTRACT S3 FROM D5 GIVING X5 + SUBTRACT S4 FROM D6 GIVING X6 + SUBTRACT S5 FROM D7 GIVING X7 + PERFORM DISPLAY-X. + SUBTRACT S7 FROM D1 GIVING X1 + SUBTRACT S1 FROM D2 GIVING X2 + SUBTRACT S2 FROM D3 GIVING X3 + SUBTRACT S3 FROM D4 GIVING X4 + SUBTRACT S4 FROM D5 GIVING X5 + SUBTRACT S5 FROM D6 GIVING X6 + SUBTRACT S6 FROM D7 GIVING X7 + PERFORM DISPLAY-X. + GOBACK. + DISPLAY-X. + DISPLAY X1 SPACE + X2 SPACE + X3 SPACE + X4 SPACE + X5 SPACE + X6 SPACE + X7 . + END PROGRAM float-SUBTRACT2. + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_2.out b/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_2.out new file mode 100644 index 000000000000..e0bf4c9baa9e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_SUBTRACT_FORMAT_2.out @@ -0,0 +1,8 @@ +555.10 555.10 555.10 555.10 555.0999756 555.100000000000023 555.1000000000000000000000000000000197 +555.10 555.10 555.10 555.10 555.0999756 555.100000000000023 555.1000000000000000000000000000000197 +555.10 555.10 555.10 555.10 555.0999756 555.100000000000023 555.1000000000000000000000000000000197 +555.10 555.10 555.10 555.10 555.0999756 555.100000000000023 555.1000000000000000000000000000000197 +555.10 555.10 555.10 555.10 555.0999756 555.100000000000023 555.1000000000000000000000000000000197 +555.10 555.10 555.10 555.10 555.0999756 555.100000000000023 555.1000000000000000000000000000000197 +555.10 555.10 555.10 555.10 555.0999756 555.100000000000023 555.1000000000000000000000000000000197 + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_literals.cob b/gcc/testsuite/cobol.dg/group2/floating-point_literals.cob new file mode 100644 index 000000000000..51d823207ca0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_literals.cob @@ -0,0 +1,48 @@ + *> { dg-do run } + *> { dg-output-file "group2/floating-point_literals.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. float-literal. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 D1 PIC 999V9999 DISPLAY . + 01 D2 PIC 999V9999 COMP . + 01 D3 PIC 999V9999 COMP-3 . + 01 D4 PIC 999V9999 COMP-5 . + 01 D5 FLOAT-SHORT . + 01 D6 FLOAT-LONG . + 01 D7 FLOAT-EXTENDED . + PROCEDURE DIVISION. + DISPLAY -555 + DISPLAY -555.55 + DISPLAY -555.55e206 + DISPLAY 555 + DISPLAY 555.55 + DISPLAY 555.55e206 + MOVE 333.33 TO D1 + MOVE 333.33 TO D2 + MOVE 333.33 TO D3 + MOVE 333.33 TO D4 + MOVE 333.33e20 TO D5 + MOVE 333.33e100 TO D6 + MOVE 333.33e200 TO D7 + PERFORM DISPLAY-D. + ADD 222.22 TO D1 + ADD 222.22 TO D2 + ADD 222.22 TO D3 + ADD 222.22 TO D4 + ADD 222.22e20 TO D5 + ADD 222.22e100 TO D6 + ADD 222.22e200 TO D7 + PERFORM DISPLAY-D. + GOBACK. + DISPLAY-D. + DISPLAY D1 SPACE + D2 SPACE + D3 SPACE + D4 SPACE + D5 SPACE + D6 SPACE + D7 . + END PROGRAM float-literal. + diff --git a/gcc/testsuite/cobol.dg/group2/floating-point_literals.out b/gcc/testsuite/cobol.dg/group2/floating-point_literals.out new file mode 100644 index 000000000000..6417d0193821 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/floating-point_literals.out @@ -0,0 +1,9 @@ +-555 +-555.55 +-5.5555E+208 +555 +555.55 +5.5555E+208 +333.3300 333.3300 333.3300 333.3300 3.333300083E+22 3.33329999999999994E+102 3.333300000000000000000000000000000168E+202 +555.5500 555.5500 555.5500 555.5500 5.555499988E+22 5.55549999999999973E+102 5.555500000000000000000000000000000029E+202 +