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 00000000000..69eb283d70a --- /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 00000000000..7a404fd4f53 --- /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 00000000000..6c1e4793031 --- /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 00000000000..601422043b7 --- /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 00000000000..a6ac8c4a70f --- /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 00000000000..6e8dc5c3011 --- /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 00000000000..fce98b0eee5 --- /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 00000000000..3628628fc08 --- /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 00000000000..09117b65b46 --- /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 00000000000..33d048e6232 --- /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 00000000000..901408e1a90 --- /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 00000000000..9f319faa665 --- /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 00000000000..19f37048094 --- /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 00000000000..4ea8b356689 --- /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 00000000000..8970a6cf06f --- /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 00000000000..6225c203ce8 --- /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 00000000000..bda63c760f9 --- /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 00000000000..585e60c130d --- /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 00000000000..6717b6ebb5d --- /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 00000000000..53211b2a835 --- /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 00000000000..fe031c3d28e --- /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 00000000000..071b88aecd3 --- /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 00000000000..cd7fa5b10c8 --- /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 00000000000..fe988ee865b --- /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 00000000000..8ad4d0a3d44 --- /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 00000000000..1f9b8dc04db --- /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 00000000000..90cf292334d --- /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 00000000000..09303a292c9 --- /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 00000000000..79f7d9d02e0 --- /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 00000000000..f718cf4cbc4 --- /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 00000000000..ae8169d6807 --- /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 00000000000..52a4e0a8fe1 --- /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 00000000000..6acdee42b58 --- /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 00000000000..f4c755024ac --- /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 00000000000..31a5a797310 --- /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 00000000000..a1173251028 --- /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 00000000000..b2fdeb24a3d --- /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 00000000000..7c7d2b00bfc --- /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 00000000000..b2fdeb24a3d --- /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 00000000000..4b3d3911108 --- /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 00000000000..4d26a951657 --- /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 00000000000..5bd324b60d0 --- /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 00000000000..ff3759eb45d --- /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 00000000000..cfdc8dbfb57 --- /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 00000000000..ddb1080b876 --- /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 00000000000..46a7cb13341 --- /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 00000000000..c8ee9bcf317 --- /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 00000000000..50f9ffa8535 --- /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 00000000000..fb072514f9c --- /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 00000000000..42d5954cd83 --- /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 00000000000..bf1afbf47e2 --- /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 00000000000..442888b5eb3 --- /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 00000000000..d48643c9c19 --- /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 00000000000..ef3f730b054 --- /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 00000000000..933b56df7af --- /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 00000000000..efe3d979efa --- /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 00000000000..cc7a1777865 --- /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 00000000000..068844bdfce --- /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 00000000000..1723f56989e --- /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 00000000000..4365a40ea5b --- /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 00000000000..27225450b01 --- /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 00000000000..183f1af7a0c --- /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 00000000000..c8f6231772f --- /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 00000000000..7ba81612ee2 --- /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 00000000000..39978ac5009 --- /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 00000000000..fa7d6a14465 --- /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 00000000000..e0bf4c9baa9 --- /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 00000000000..51d823207ca --- /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 00000000000..6417d019382 --- /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 +