From: Robert Dubner Date: Fri, 25 Apr 2025 14:19:35 +0000 (-0400) Subject: cobol: New testcases. X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=591831dcd4bc9cb9c089d952e73ec8bfcb6cb3fb;p=thirdparty%2Fgcc.git cobol: New testcases. These testcases are derived from the cobolworx run_fundamental.at file. gcc/testsuite * cobol.dg/group2/88_level_with_FALSE_IS_clause.cob: New testcase. * cobol.dg/group2/88_level_with_FILLER.cob: Likewise. * cobol.dg/group2/88_level_with_THRU.cob: Likewise. * cobol.dg/group2/ADD_CORRESPONDING.cob: Likewise. * cobol.dg/group2/ADD_SUBTRACT_CORR_mixed_fix___float.cob: Likewise. * cobol.dg/group2/ALPHABETIC-LOWER_test.cob: Likewise. * cobol.dg/group2/ALPHABETIC_test.cob: Likewise. * cobol.dg/group2/ALPHABETIC-UPPER_test.cob: Likewise. * cobol.dg/group2/BLANK_WHEN_ZERO.cob: Likewise. * cobol.dg/group2/Check_for_equality_of_COMP-1___COMP-2.cob: Likewise. * cobol.dg/group2/Compare_COMP-2_with_floating-point_literal.cob: Likewise. * cobol.dg/group2/Contained_program_visibility__3_.cob: Likewise. * cobol.dg/group2/Contained_program_visibility__4_.cob: Likewise. * cobol.dg/group2/Context_sensitive_words__1_.cob: Likewise. * cobol.dg/group2/Context_sensitive_words__2_.cob: Likewise. * cobol.dg/group2/Context_sensitive_words__3_.cob: Likewise. * cobol.dg/group2/Context_sensitive_words__4_.cob: Likewise. * cobol.dg/group2/Context_sensitive_words__5_.cob: Likewise. * cobol.dg/group2/Context_sensitive_words__6_.cob: Likewise. * cobol.dg/group2/Context_sensitive_words__7_.cob: Likewise. * cobol.dg/group2/Context_sensitive_words__8_.cob: Likewise. * cobol.dg/group2/debugging_lines__not_active_.cob: Likewise. * cobol.dg/group2/debugging_lines__WITH_DEBUGGING_MODE_.cob: Likewise. * cobol.dg/group2/DEBUG_Line.cob: Likewise. * cobol.dg/group2/DISPLAY_and_assignment_NumericDisplay.cob: Likewise. * cobol.dg/group2/DISPLAY_data_items_with_MOVE_statement.cob: Likewise. * cobol.dg/group2/DISPLAY_data_items_with_VALUE_clause.cob: Likewise. * cobol.dg/group2/DISPLAY_literals__DECIMAL-POINT_is_COMMA.cob: Likewise. * cobol.dg/group2/GLOBAL_at_lower_level.cob: Likewise. * cobol.dg/group2/GLOBAL_at_same_level.cob: Likewise. * cobol.dg/group2/GLOBAL_FD__1_.cob: Likewise. * cobol.dg/group2/GLOBAL_FD__2_.cob: Likewise. * cobol.dg/group2/GLOBAL_FD__3_.cob: Likewise. * cobol.dg/group2/GLOBAL_FD__4_.cob: Likewise. * cobol.dg/group2/Hexadecimal_literal.cob: Likewise. * cobol.dg/group2/integer_arithmetic_on_floating-point_var.cob: Likewise. * cobol.dg/group2/MULTIPLY_BY_literal_in_INITIAL_program.cob: Likewise. * cobol.dg/group2/Named_conditionals_-_fixed__float__and_alphabetic.cob: Likewise. * cobol.dg/group2/Numeric_operations__1_.cob: Likewise. * cobol.dg/group2/Numeric_operations__2_.cob: Likewise. * cobol.dg/group2/Numeric_operations__3_.cob: Likewise. * cobol.dg/group2/Numeric_operations__4_.cob: Likewise. * cobol.dg/group2/Numeric_operations__5_.cob: Likewise. * cobol.dg/group2/Numeric_operations__7_.cob: Likewise. * cobol.dg/group2/Numeric_operations__8_.cob: Likewise. * cobol.dg/group2/ROUNDED_AWAY-FROM-ZERO.cob: Likewise. * cobol.dg/group2/ROUNDED_NEAREST-AWAY-FROM-ZERO.cob: Likewise. * cobol.dg/group2/ROUNDED_NEAREST-EVEN.cob: Likewise. * cobol.dg/group2/ROUNDED_NEAREST-TOWARD-ZERO.cob: Likewise. * cobol.dg/group2/ROUNDED_TOWARD-GREATER.cob: Likewise. * cobol.dg/group2/ROUNDED_TOWARD-LESSER.cob: Likewise. * cobol.dg/group2/ROUNDED_TRUNCATION.cob: Likewise. * cobol.dg/group2/ROUNDING_omnibus_Floating-Point_from_COMPUTE.cob: Likewise. * cobol.dg/group2/ROUNDING_omnibus_NumericDisplay_from_COMPUTE.cob: Likewise. * cobol.dg/group2/Separate_sign_positions__1_.cob: Likewise. * cobol.dg/group2/Separate_sign_positions__2_.cob: Likewise. * cobol.dg/group2/Simple_p-scaling.cob: Likewise. * cobol.dg/group2/Simple_TYPEDEF.cob: Likewise. * cobol.dg/group2/ADD_SUBTRACT_CORR_mixed_fix___float.out: New known-good result. * cobol.dg/group2/BLANK_WHEN_ZERO.out: Likewise. * cobol.dg/group2/Contained_program_visibility__4_.out: Likewise. * cobol.dg/group2/Context_sensitive_words__1_.out: Likewise. * cobol.dg/group2/Context_sensitive_words__2_.out: Likewise. * cobol.dg/group2/Context_sensitive_words__3_.out: Likewise. * cobol.dg/group2/Context_sensitive_words__4_.out: Likewise. * cobol.dg/group2/Context_sensitive_words__5_.out: Likewise. * cobol.dg/group2/Context_sensitive_words__6_.out: Likewise. * cobol.dg/group2/Context_sensitive_words__7_.out: Likewise. * cobol.dg/group2/Context_sensitive_words__8_.out: Likewise. * cobol.dg/group2/debugging_lines__not_active_.out: Likewise. * cobol.dg/group2/debugging_lines__WITH_DEBUGGING_MODE_.out: Likewise. * cobol.dg/group2/DEBUG_Line.out: Likewise. * cobol.dg/group2/DISPLAY_and_assignment_NumericDisplay.out: Likewise. * cobol.dg/group2/DISPLAY_data_items_with_MOVE_statement.out: Likewise. * cobol.dg/group2/DISPLAY_data_items_with_VALUE_clause.out: Likewise. * cobol.dg/group2/DISPLAY_literals__DECIMAL-POINT_is_COMMA.out: Likewise. * cobol.dg/group2/GLOBAL_at_lower_level.out: Likewise. * cobol.dg/group2/GLOBAL_at_same_level.out: Likewise. * cobol.dg/group2/Hexadecimal_literal.out: Likewise. * cobol.dg/group2/Named_conditionals_-_fixed__float__and_alphabetic.out: Likewise. * cobol.dg/group2/ROUNDED_AWAY-FROM-ZERO.out: Likewise. * cobol.dg/group2/ROUNDED_NEAREST-AWAY-FROM-ZERO.out: Likewise. * cobol.dg/group2/ROUNDED_NEAREST-EVEN.out: Likewise. * cobol.dg/group2/ROUNDED_NEAREST-TOWARD-ZERO.out: Likewise. * cobol.dg/group2/ROUNDED_TOWARD-GREATER.out: Likewise. * cobol.dg/group2/ROUNDED_TOWARD-LESSER.out: Likewise. * cobol.dg/group2/ROUNDED_TRUNCATION.out: Likewise. * cobol.dg/group2/ROUNDING_omnibus_Floating-Point_from_COMPUTE.out: Likewise. * cobol.dg/group2/ROUNDING_omnibus_NumericDisplay_from_COMPUTE.out: Likewise. * cobol.dg/group2/Separate_sign_positions__1_.out: Likewise. * cobol.dg/group2/Separate_sign_positions__2_.out: Likewise. * cobol.dg/group2/Simple_p-scaling.out: Likewise. --- diff --git a/gcc/testsuite/cobol.dg/group2/88_level_with_FALSE_IS_clause.cob b/gcc/testsuite/cobol.dg/group2/88_level_with_FALSE_IS_clause.cob new file mode 100644 index 00000000000..012da75e48c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/88_level_with_FALSE_IS_clause.cob @@ -0,0 +1,19 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 MYFLD PIC X(6) VALUE "ABCDEF". + 88 MYFLD88 VALUE "ABCDEF" + FALSE IS "OKOKOK". + PROCEDURE DIVISION. + ASTART SECTION. + A01. + SET MYFLD88 TO FALSE + IF MYFLD NOT = "OKOKOK" + DISPLAY MYFLD + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/88_level_with_FILLER.cob b/gcc/testsuite/cobol.dg/group2/88_level_with_FILLER.cob new file mode 100644 index 00000000000..49157f41513 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/88_level_with_FILLER.cob @@ -0,0 +1,20 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 FILLER PIC X VALUE SPACE. + 88 X VALUE "X". + PROCEDURE DIVISION. + IF X + DISPLAY "NOT OK" + END-DISPLAY + END-IF + SET X TO TRUE. + IF NOT X + DISPLAY "NOT OK" + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/88_level_with_THRU.cob b/gcc/testsuite/cobol.dg/group2/88_level_with_THRU.cob new file mode 100644 index 00000000000..005bb640b6c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/88_level_with_THRU.cob @@ -0,0 +1,86 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 VAR-X PIC X VALUE SPACE. + 88 X VALUE "X". + 88 T-Y VALUE "T" THRU "Y". + 01 VAR-9 PIC 9 VALUE ZERO. + 88 V9 VALUE 9. + 88 V2-4 VALUE 2 THRU 4. + PROCEDURE DIVISION. + IF X + DISPLAY "NOT OK '" VAR-X "' IS X" + END-DISPLAY + END-IF + SET X TO TRUE + IF NOT X + DISPLAY "NOT OK '" VAR-X "' IS NOT X" + END-DISPLAY + END-IF + IF NOT T-Y + DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" + END-DISPLAY + END-IF + SET T-Y TO TRUE + IF NOT T-Y + DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" + END-DISPLAY + END-IF + MOVE 'Y' TO VAR-X + IF NOT T-Y + DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" + END-DISPLAY + END-IF + MOVE 'Z' TO VAR-X + IF T-Y + DISPLAY "NOT OK '" VAR-X "' IS T-Y" + END-DISPLAY + END-IF + MOVE 'A' TO VAR-X + IF T-Y + DISPLAY "NOT OK '" VAR-X "' IS T-Y" + END-DISPLAY + END-IF + IF V9 + DISPLAY "NOT OK '" VAR-9 "' IS V9" + END-DISPLAY + END-IF + SET V9 TO TRUE + IF NOT V9 + DISPLAY "NOT OK '" VAR-9 "' IS NOT V9" + END-DISPLAY + END-IF + SET V2-4 TO TRUE + IF V9 + DISPLAY "NOT OK '" VAR-9 "' IS V9" + END-DISPLAY + END-IF + IF NOT V2-4 + DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" + END-DISPLAY + END-IF + MOVE 3 TO VAR-9 + IF NOT V2-4 + DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" + END-DISPLAY + END-IF + MOVE 4 TO VAR-9 + IF NOT V2-4 + DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" + END-DISPLAY + END-IF + MOVE 5 TO VAR-9 + IF V2-4 + DISPLAY "NOT OK '" VAR-9 "' IS V2-4" + END-DISPLAY + END-IF + MOVE 1 TO VAR-9 + IF V2-4 + DISPLAY "NOT OK '" VAR-9 "' IS V2-4" + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ADD_CORRESPONDING.cob b/gcc/testsuite/cobol.dg/group2/ADD_CORRESPONDING.cob new file mode 100644 index 00000000000..732d2413153 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ADD_CORRESPONDING.cob @@ -0,0 +1,39 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 GROUP-1. + 05 FIELD-A PIC 9 VALUE 1. + 05 FIELD-B USAGE BINARY-CHAR VALUE 2. + 05 INNER-GROUP. + 10 FIELD-C USAGE COMP-1 VALUE 3. + 05 FIELD-D PIC X VALUE "A". + 01 GROUP-2. + 05 FIELD-A PIC 9. + 05 FIELD-B USAGE BINARY-LONG. + 05 INNER-GROUP. + 10 FIELD-C PIC 9. + 05 FIELD-D PIC 9. + + PROCEDURE DIVISION. + ADD CORRESPONDING GROUP-1 TO GROUP-2. + IF FIELD-A IN GROUP-2 NOT EQUAL 1 THEN + DISPLAY "BAD FIELD-A " FIELD-A IN GROUP-2 + END-DISPLAY + END-IF. + IF FIELD-B IN GROUP-2 NOT EQUAL 2 THEN + DISPLAY "BAD FIELD-B " FIELD-B IN GROUP-2 + END-DISPLAY + END-IF. + IF FIELD-C IN GROUP-2 NOT EQUAL 3 THEN + DISPLAY "BAD FIELD-C " FIELD-C IN GROUP-2 + END-DISPLAY + END-IF. + IF FIELD-D IN GROUP-2 NOT EQUAL 0 THEN + DISPLAY "BAD FIELD-D " FIELD-D IN GROUP-2 + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ADD_SUBTRACT_CORR_mixed_fix___float.cob b/gcc/testsuite/cobol.dg/group2/ADD_SUBTRACT_CORR_mixed_fix___float.cob new file mode 100644 index 00000000000..d90ab7bee5c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ADD_SUBTRACT_CORR_mixed_fix___float.cob @@ -0,0 +1,33 @@ + *> { dg-do run } + *> { dg-output-file "group2/ADD_SUBTRACT_CORR_mixed_fix___float.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 GROUP1. + 05 VAR1 PIC 9999 VALUE 1. + 05 VAR2 PIC 9999 VALUE 2. + 05 VAR3 COMP-2 VALUE 3. + 05 VAR4 COMP-2 VALUE 4. + 01 GROUP2. + 05 VAR1 PIC 9999 VALUE 1000. + 05 VAR2 COMP-2 VALUE 2000. + 05 VAR3 PIC 9999 VALUE 3000. + 05 VAR4 COMP-2 VALUE 4000. + PROCEDURE DIVISION. + PERFORM DISP2 + ADD CORRESPONDING GROUP1 TO GROUP2 + PERFORM DISP2 + SUBTRACT CORRESPONDING GROUP1 FROM GROUP2 + PERFORM DISP2. + GOBACK. + DISP2. + DISPLAY + VAR1 OF GROUP2 SPACE + VAR2 OF GROUP2 SPACE + VAR3 OF GROUP2 SPACE + VAR4 OF GROUP2. + END PROGRAM prog. + + diff --git a/gcc/testsuite/cobol.dg/group2/ADD_SUBTRACT_CORR_mixed_fix___float.out b/gcc/testsuite/cobol.dg/group2/ADD_SUBTRACT_CORR_mixed_fix___float.out new file mode 100644 index 00000000000..e590ce329ef --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ADD_SUBTRACT_CORR_mixed_fix___float.out @@ -0,0 +1,4 @@ +1000 2000 3000 4000 +1001 2002 3003 4004 +1000 2000 3000 4000 + diff --git a/gcc/testsuite/cobol.dg/group2/ALPHABETIC-LOWER_test.cob b/gcc/testsuite/cobol.dg/group2/ALPHABETIC-LOWER_test.cob new file mode 100644 index 00000000000..ff719748de0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ALPHABETIC-LOWER_test.cob @@ -0,0 +1,23 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(04) VALUE "aaaa". + 01 FILLER REDEFINES X. + 03 XBYTE PIC X. + 03 FILLER PIC XXX. + PROCEDURE DIVISION. + MOVE X"0D" TO XBYTE. + IF X ALPHABETIC-LOWER + DISPLAY "Fail - Not alphabetic lower" + END-DISPLAY + END-IF. + MOVE "a" TO XBYTE. + IF X NOT ALPHABETIC-LOWER + DISPLAY "Fail - Alphabetic lower" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ALPHABETIC-UPPER_test.cob b/gcc/testsuite/cobol.dg/group2/ALPHABETIC-UPPER_test.cob new file mode 100644 index 00000000000..a3c7ed80e93 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ALPHABETIC-UPPER_test.cob @@ -0,0 +1,23 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(04) VALUE "AAAA". + 01 FILLER REDEFINES X. + 03 XBYTE PIC X. + 03 FILLER PIC XXX. + PROCEDURE DIVISION. + MOVE X"0D" TO XBYTE. + IF X ALPHABETIC-UPPER + DISPLAY "Fail - Not alphabetic upper" + END-DISPLAY + END-IF. + MOVE "A" TO XBYTE. + IF X NOT ALPHABETIC-UPPER + DISPLAY "Fail - Alphabetic upper" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ALPHABETIC_test.cob b/gcc/testsuite/cobol.dg/group2/ALPHABETIC_test.cob new file mode 100644 index 00000000000..ebc38cc92b2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ALPHABETIC_test.cob @@ -0,0 +1,23 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(04) VALUE "AAAA". + 01 FILLER REDEFINES X. + 03 XBYTE PIC X. + 03 FILLER PIC XXX. + PROCEDURE DIVISION. + MOVE X"0D" TO XBYTE. + IF X ALPHABETIC + DISPLAY "Fail - Alphabetic" + END-DISPLAY + END-IF. + MOVE "A" TO XBYTE. + IF X NOT ALPHABETIC + DISPLAY "Fail - Not Alphabetic" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/BLANK_WHEN_ZERO.cob b/gcc/testsuite/cobol.dg/group2/BLANK_WHEN_ZERO.cob new file mode 100644 index 00000000000..ae0aa716450 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/BLANK_WHEN_ZERO.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + *> { dg-output-file "group2/BLANK_WHEN_ZERO.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 x PIC 9, BLANK WHEN ZERO, VALUE 1. + PROCEDURE DIVISION. + DISPLAY "X should be 1: " """" x """" + MOVE 0 TO x + DISPLAY "X should be blank: " """" FUNCTION TRIM(x) """" + MOVE ZERO TO x + DISPLAY "X should be blank: " """" FUNCTION TRIM(x) """" + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/BLANK_WHEN_ZERO.out b/gcc/testsuite/cobol.dg/group2/BLANK_WHEN_ZERO.out new file mode 100644 index 00000000000..a03f1d16357 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/BLANK_WHEN_ZERO.out @@ -0,0 +1,4 @@ +X should be 1: "1" +X should be blank: "" +X should be blank: "" + diff --git a/gcc/testsuite/cobol.dg/group2/Check_for_equality_of_COMP-1___COMP-2.cob b/gcc/testsuite/cobol.dg/group2/Check_for_equality_of_COMP-1___COMP-2.cob new file mode 100644 index 00000000000..76bafa4b527 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Check_for_equality_of_COMP-1___COMP-2.cob @@ -0,0 +1,106 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 SRC1 COMP-2 VALUE 11.55. + 01 DST1 COMP-1. + 01 SRC2 COMP-1 VALUE 11.55. + 01 DST2 COMP-2. + + PROCEDURE DIVISION. + MOVE SRC1 TO DST1. + IF DST1 not = 11.55 + DISPLAY 'error: move/compare FLOAT-LONG to FLOAT-SHORT failed ' DST1 + END-DISPLAY + END-IF. + + MOVE SRC1 TO DST2. + IF DST1 not = 11.55 + DISPLAY 'error: move/compare FLOAT-LONG to FLOAT-LONG failed ' DST2 + END-DISPLAY + END-IF. + + MOVE ZERO TO DST1. + MOVE ZERO TO DST2. + + MOVE SRC2 TO DST1. + IF DST1 not = 11.55 + DISPLAY 'error: move/compare FLOAT-SHORT to FLOAT-SHORT failed: ' DST1 + END-DISPLAY + END-IF. + + MOVE SRC2 TO DST2. + IF DST2 not = 11.5500001907348633 + DISPLAY 'error: move/compare COMP-2 to literal failed: ' DST2 + END-DISPLAY + END-IF. + + MOVE ZERO TO DST1. + IF not (DST1 = 0 AND 0.0) + DISPLAY "Zero compare failed: " DST1 END-DISPLAY + END-IF. + + MOVE -0.0 TO DST1. + IF not (DST1 = 0 AND 0.0) + DISPLAY "Negative Zero compare failed: " DST1 + END-DISPLAY + END-IF. + + MOVE 1.1234567 TO DST1. + MOVE DST1 TO DST2. + IF DST2 not = 1.12345671653747559 + DISPLAY "move/compare number to FLOAT to DOUBLE failed: " + DST1 " - " DST2 + END-DISPLAY + END-IF. + + * Check for Tolerance + MOVE 1.1234567 TO DST1. + MOVE 1.1234568 TO DST2. + IF DST1 = DST2 THEN + DISPLAY 'move/compare of very near numbers failed (not identical): ' DST1 " - " DST2 + END-DISPLAY + END-IF. + + * Within tolerance by definition, therefore not checked + * MULTIPLY 10000000000 BY DST1 DST2 END-MULTIPLY. + * IF DST1 = DST2 THEN + * DISPLAY "compare of very near numbers computed failed (id + *- "entical): " DST1 " - " DST2 + * END-DISPLAY + * END-IF. + + MOVE 1.1234567 TO DST1. + MOVE 1.1234569 TO DST2. + IF DST1 = DST2 THEN + DISPLAY 'move/compare of near equal numbers failed (identical): ' DST1 " - " DST2 + END-DISPLAY + END-IF. + + MOVE 0.0001 TO DST1. + MOVE 0.0000 TO DST2. + IF DST1 = DST2 THEN + DISPLAY 'move/compare of nearly equal very small numbers failed (identical): ' DST1 " - " DST2 + END-DISPLAY + END-IF. + + MOVE 1000001.0 TO DST1. + MOVE 1000000.0 TO DST2. + IF DST1 = DST2 THEN + DISPLAY 'move/compare of nearly equal big numbers failed (identical): ' DST1 " - " DST2 + END-DISPLAY + END-IF. + + * Within tolerance by definition, therefore not checked + * MOVE 1000000000.0 TO DST1. + * MOVE 1000000001.0 TO DST2. + * IF DST1 = DST2 THEN + * DISPLAY 'move/compare of nearly equal very big numbers fa + *- 'iled (identical): ' DST1 " - " DST2 + * END-DISPLAY + * END-IF. + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Compare_COMP-2_with_floating-point_literal.cob b/gcc/testsuite/cobol.dg/group2/Compare_COMP-2_with_floating-point_literal.cob new file mode 100644 index 00000000000..677fadc4349 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Compare_COMP-2_with_floating-point_literal.cob @@ -0,0 +1,43 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 VAR COMP-2 VALUE 0.0. + + PROCEDURE DIVISION. + MOVE 9.899999999999E+304 TO VAR + IF VAR < 0 + DISPLAY "error: compare " VAR " < " 0 " failed!" + END-DISPLAY + END-IF. + IF VAR < 9.799999999999E+304 + DISPLAY 'error: compare ' VAR ' < ' 9.799999999999E+304 + ' failed!' + END-DISPLAY + END-IF. + IF VAR > 9.999999999999E+304 + DISPLAY 'error: compare ' VAR ' > ' 9.999999999999E+304 + ' failed!' + END-DISPLAY + END-IF. + MOVE -9.899999999999E+304 TO VAR + IF VAR > 0 + DISPLAY 'error: compare ' VAR ' > ' 0 + ' failed!' + END-DISPLAY + END-IF. + IF VAR < -9.999999999999E+304 + DISPLAY 'error: compare ' VAR ' < ' -9.999999999999E+304 + ' failed!' + END-DISPLAY + END-IF. + IF VAR > -9.799999999999E+304 + DISPLAY 'error: compare ' VAR ' > ' -9.799999999999E+304 + ' failed!' + END-DISPLAY + END-IF. + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Contained_program_visibility__3_.cob b/gcc/testsuite/cobol.dg/group2/Contained_program_visibility__3_.cob new file mode 100644 index 00000000000..624a9e168a8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Contained_program_visibility__3_.cob @@ -0,0 +1,42 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(5) GLOBAL VALUE "prog1". + PROCEDURE DIVISION. + IF X NOT = "prog1" + DISPLAY X + END-DISPLAY + END-IF. + CALL "prog2" + END-CALL. + STOP RUN. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(5) GLOBAL VALUE "prog2". + PROCEDURE DIVISION. + IF X NOT = "prog2" + DISPLAY X + END-DISPLAY + END-IF. + CALL "prog3" + END-CALL. + EXIT PROGRAM. + END PROGRAM prog2. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog3 COMMON. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + IF X NOT = "prog1" + DISPLAY X + END-DISPLAY + END-IF. + EXIT PROGRAM. + END PROGRAM prog3. + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/Contained_program_visibility__4_.cob b/gcc/testsuite/cobol.dg/group2/Contained_program_visibility__4_.cob new file mode 100644 index 00000000000..923ce767290 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Contained_program_visibility__4_.cob @@ -0,0 +1,46 @@ + *> { dg-do run } + *> { dg-output-file "group2/Contained_program_visibility__4_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY "P1" NO ADVANCING + END-DISPLAY. + CALL "prog2" + END-CALL + CALL "prog3" + END-CALL + STOP RUN. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY "P2" NO ADVANCING + END-DISPLAY. + EXIT PROGRAM. + END PROGRAM prog2. + END PROGRAM prog. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog3. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY "P3" NO ADVANCING + END-DISPLAY. + CALL "prog2" + END-CALL. + EXIT PROGRAM. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY "P4" NO ADVANCING + END-DISPLAY. + EXIT PROGRAM. + END PROGRAM prog2. + END PROGRAM prog3. + diff --git a/gcc/testsuite/cobol.dg/group2/Contained_program_visibility__4_.out b/gcc/testsuite/cobol.dg/group2/Contained_program_visibility__4_.out new file mode 100644 index 00000000000..f31c96b9c58 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Contained_program_visibility__4_.out @@ -0,0 +1 @@ +P1P2P3P4 diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__1_.cob b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__1_.cob new file mode 100644 index 00000000000..37f5c47d27b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__1_.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + *> { dg-output-file "group2/Context_sensitive_words__1_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 BYTE-LENGTH PIC 9. + 01 X CONSTANT AS BYTE-LENGTH OF BYTE-LENGTH. + PROCEDURE DIVISION. + MOVE X TO BYTE-LENGTH. + DISPLAY BYTE-LENGTH NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__1_.out b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__1_.out new file mode 100644 index 00000000000..d00491fd7e5 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__1_.out @@ -0,0 +1 @@ +1 diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__2_.cob b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__2_.cob new file mode 100644 index 00000000000..d29f505daf5 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__2_.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + *> { dg-output-file "group2/Context_sensitive_words__2_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 YYYYMMDD PIC 9 VALUE 0. + 01 X PIC X(16). + PROCEDURE DIVISION. + ACCEPT X FROM DATE YYYYMMDD + END-ACCEPT. + DISPLAY YYYYMMDD NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__2_.out b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__2_.out new file mode 100644 index 00000000000..573541ac970 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__2_.out @@ -0,0 +1 @@ +0 diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__3_.cob b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__3_.cob new file mode 100644 index 00000000000..0326650c79a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__3_.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + *> { dg-output-file "group2/Context_sensitive_words__3_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 YYYYDDD PIC 9 VALUE 0. + 01 X PIC X(16). + PROCEDURE DIVISION. + ACCEPT X FROM DAY YYYYDDD + END-ACCEPT. + DISPLAY YYYYDDD NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__3_.out b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__3_.out new file mode 100644 index 00000000000..573541ac970 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__3_.out @@ -0,0 +1 @@ +0 diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__4_.cob b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__4_.cob new file mode 100644 index 00000000000..05f21976e23 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__4_.cob @@ -0,0 +1,17 @@ + *> { dg-do run } + *> { dg-output-file "group2/Context_sensitive_words__4_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 INTRINSIC PIC 9 VALUE 0. + PROCEDURE DIVISION. + DISPLAY INTRINSIC NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__4_.out b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__4_.out new file mode 100644 index 00000000000..573541ac970 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__4_.out @@ -0,0 +1 @@ +0 diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__5_.cob b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__5_.cob new file mode 100644 index 00000000000..8a96cf14ae9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__5_.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + *> { dg-output-file "group2/Context_sensitive_words__5_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog RECURSIVE. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 RECURSIVE PIC 9 VALUE 0. + PROCEDURE DIVISION. + DISPLAY RECURSIVE NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__5_.out b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__5_.out new file mode 100644 index 00000000000..573541ac970 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__5_.out @@ -0,0 +1 @@ +0 diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__6_.cob b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__6_.cob new file mode 100644 index 00000000000..f83cb63bf0e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__6_.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/Context_sensitive_words__6_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 NORMAL PIC 9 VALUE 0. + PROCEDURE DIVISION. + DISPLAY NORMAL NO ADVANCING *> Intentionally no period or END-DISPLAY + STOP RUN NORMAL. + diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__6_.out b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__6_.out new file mode 100644 index 00000000000..573541ac970 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__6_.out @@ -0,0 +1 @@ +0 diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__7_.cob b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__7_.cob new file mode 100644 index 00000000000..0ad5cc8da20 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__7_.cob @@ -0,0 +1,19 @@ + *> { dg-do run } + *> { dg-output-file "group2/Context_sensitive_words__7_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC 9 VALUE 0. + 01 AWAY-FROM-ZERO PIC 9 VALUE 0. + PROCEDURE DIVISION. + COMPUTE X ROUNDED MODE AWAY-FROM-ZERO + AWAY-FROM-ZERO = 1.1 + END-COMPUTE + DISPLAY X AWAY-FROM-ZERO NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__7_.out b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__7_.out new file mode 100644 index 00000000000..aabe6ec3909 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__7_.out @@ -0,0 +1 @@ +21 diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__8_.cob b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__8_.cob new file mode 100644 index 00000000000..8943f923635 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__8_.cob @@ -0,0 +1,19 @@ + *> { dg-do run } + *> { dg-output-file "group2/Context_sensitive_words__8_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 UNBNDED. + 03 ATTRIBUTES PIC 9 VALUE 0. + 01 LOC. + 03 NAMESPACE PIC 9 VALUE 1. + PROCEDURE DIVISION. + DISPLAY UNBNDED ATTRIBUTES + NAMESPACE IN LOC + NO ADVANCING. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__8_.out b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__8_.out new file mode 100644 index 00000000000..5325a8dff75 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Context_sensitive_words__8_.out @@ -0,0 +1 @@ +001 diff --git a/gcc/testsuite/cobol.dg/group2/DEBUG_Line.cob b/gcc/testsuite/cobol.dg/group2/DEBUG_Line.cob new file mode 100644 index 00000000000..a7dca5dd8f4 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DEBUG_Line.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + *> { dg-output-file "group2/DEBUG_Line.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SOURCE-COMPUTER. + Linux WITH DEBUGGING MODE. + PROCEDURE DIVISION. + *> Success is printing this message. If nothing comes out, the + *> test fails. + D DISPLAY "DEBUG MESSAGE" NO ADVANCING. + EXIT PROGRAM. + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/DEBUG_Line.out b/gcc/testsuite/cobol.dg/group2/DEBUG_Line.out new file mode 100644 index 00000000000..6a3f59c8e48 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DEBUG_Line.out @@ -0,0 +1 @@ +DEBUG MESSAGE diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY_and_assignment_NumericDisplay.cob b/gcc/testsuite/cobol.dg/group2/DISPLAY_and_assignment_NumericDisplay.cob new file mode 100644 index 00000000000..2b311138140 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY_and_assignment_NumericDisplay.cob @@ -0,0 +1,82 @@ + *> { dg-do run } + *> { dg-output-file "group2/DISPLAY_and_assignment_NumericDisplay.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 vars. + 05 vars-display-1. + 10 var01a pic 99v999 display value 54.321 . + 10 var01b pic s99v999 display value 54.321 . + 10 var01c pic s99v999 leading display value -54.321 . + 10 var01d pic s99v999 trailing display value 54.321 . + 10 var01e pic s99v999 leading separate display value -54.321 . + 10 var01f pic s99v999 trailing separate display value 54.321 . + 05 vars-display-2. + 10 var01g pic 9999ppp display value 4321000 . + 10 var01h pic s9999ppp display value 4321000 . + 10 var01i pic s9999ppp leading display value -4321000 . + 10 var01j pic s9999ppp trailing display value 4321000 . + 10 var01k pic s9999ppp leading separate display value -4321000 . + 10 var01l pic s9999ppp trailing separate display value 4321000 . + 05 vars-display-3. + 10 var01m pic ppp9999 display value .0001234 . + 10 var01n pic sppp9999 display value .0001234 . + 10 var01o pic sppp9999 leading display value -.0001234 . + 10 var01p pic sppp9999 trailing display value .0001234 . + 10 var01q pic sppp9999 leading separate display value -.0001234 . + 10 var01r pic sppp9999 trailing separate display value .0001234 . + procedure division. + display var01a + display var01b + display var01c + display var01d + display var01e + display var01f + display var01g + display var01h + display var01i + display var01j + display var01k + display var01l + display var01m + display var01n + display var01o + display var01p + display var01q + display var01r + + move 12.345 to var01a var01c var01e + move -12.345 to var01b var01d var01f + + move 9876000 to var01g var01i var01k + move -9876000 to var01h var01j var01l + + move .0006789 to var01m var01o var01q + move -.0006789 to var01n var01p var01r + + display var01a + display var01b + display var01c + display var01d + display var01e + display var01f + display var01g + display var01h + display var01i + display var01j + display var01k + display var01l + display var01m + display var01n + display var01o + display var01p + display var01q + display var01r + + continue. + quit. + goback. + end program prog. + + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY_and_assignment_NumericDisplay.out b/gcc/testsuite/cobol.dg/group2/DISPLAY_and_assignment_NumericDisplay.out new file mode 100644 index 00000000000..b18b32de565 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY_and_assignment_NumericDisplay.out @@ -0,0 +1,37 @@ +54.321 ++54.321 +-54.321 ++54.321 +-54.321 +54.321+ +4321000 ++4321000 +-4321000 ++4321000 +-4321000 +4321000+ +.0001234 ++.0001234 +-.0001234 ++.0001234 +-.0001234 +.0001234+ +12.345 +-12.345 ++12.345 +-12.345 ++12.345 +12.345- +9876000 +-9876000 ++9876000 +-9876000 ++9876000 +9876000- +.0006789 +-.0006789 ++.0006789 +-.0006789 ++.0006789 +.0006789- + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_MOVE_statement.cob b/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_MOVE_statement.cob new file mode 100644 index 00000000000..50c139169f3 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_MOVE_statement.cob @@ -0,0 +1,38 @@ + *> { dg-do run } + *> { dg-output-file "group2/DISPLAY_data_items_with_MOVE_statement.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X-ABC PIC XXX VALUE "abc". + 01 X-123 PIC 999 VALUE 123. + 01 X-P123 PIC S999 VALUE +123. + 01 X-N123 PIC S999 VALUE -123. + 01 X-12-3 PIC 99V9 VALUE 12.3. + 01 X-P12-3 PIC S99V9 VALUE +12.3. + 01 X-N12-3 PIC S99V9 VALUE -12.3. + PROCEDURE DIVISION. + MOVE "abc" TO X-ABC. + DISPLAY X-ABC + END-DISPLAY. + MOVE 123 TO X-123. + DISPLAY X-123 + END-DISPLAY. + MOVE +123 TO X-P123. + DISPLAY X-P123 + END-DISPLAY. + MOVE -123 TO X-N123. + DISPLAY X-N123 + END-DISPLAY. + MOVE 12.3 TO X-12-3. + DISPLAY X-12-3 + END-DISPLAY. + MOVE +12.3 TO X-P12-3. + DISPLAY X-P12-3 + END-DISPLAY. + MOVE -12.3 TO X-N12-3. + DISPLAY X-N12-3 + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_MOVE_statement.out b/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_MOVE_statement.out new file mode 100644 index 00000000000..e0624a90490 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_MOVE_statement.out @@ -0,0 +1,8 @@ +abc +123 ++123 +-123 +12.3 ++12.3 +-12.3 + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_VALUE_clause.cob b/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_VALUE_clause.cob new file mode 100644 index 00000000000..6e502cb16a8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_VALUE_clause.cob @@ -0,0 +1,31 @@ + *> { dg-do run } + *> { dg-output-file "group2/DISPLAY_data_items_with_VALUE_clause.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X-ABC PIC XXX VALUE "abc". + 01 X-123 PIC 999 VALUE 123. + 01 X-P123 PIC S999 VALUE +123. + 01 X-N123 PIC S999 VALUE -123. + 01 X-12-3 PIC 99V9 VALUE 12.3. + 01 X-P12-3 PIC S99V9 VALUE +12.3. + 01 X-N12-3 PIC S99V9 VALUE -12.3. + PROCEDURE DIVISION. + DISPLAY X-ABC + END-DISPLAY. + DISPLAY X-123 + END-DISPLAY. + DISPLAY X-P123 + END-DISPLAY. + DISPLAY X-N123 + END-DISPLAY. + DISPLAY X-12-3 + END-DISPLAY. + DISPLAY X-P12-3 + END-DISPLAY. + DISPLAY X-N12-3 + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_VALUE_clause.out b/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_VALUE_clause.out new file mode 100644 index 00000000000..e0624a90490 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY_data_items_with_VALUE_clause.out @@ -0,0 +1,8 @@ +abc +123 ++123 +-123 +12.3 ++12.3 +-12.3 + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY_literals__DECIMAL-POINT_is_COMMA.cob b/gcc/testsuite/cobol.dg/group2/DISPLAY_literals__DECIMAL-POINT_is_COMMA.cob new file mode 100644 index 00000000000..8bb5a58b355 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY_literals__DECIMAL-POINT_is_COMMA.cob @@ -0,0 +1,24 @@ + *> { dg-do run } + *> { dg-output-file "group2/DISPLAY_literals__DECIMAL-POINT_is_COMMA.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SPECIAL-NAMES. + DECIMAL-POINT IS COMMA. + PROCEDURE DIVISION. + DISPLAY 12,3 + END-DISPLAY. + DISPLAY +12,3 + END-DISPLAY. + DISPLAY -12,3 + END-DISPLAY. + DISPLAY 1,23E0 + END-DISPLAY. + DISPLAY +1,23E0 + END-DISPLAY. + DISPLAY -1,23E0 + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY_literals__DECIMAL-POINT_is_COMMA.out b/gcc/testsuite/cobol.dg/group2/DISPLAY_literals__DECIMAL-POINT_is_COMMA.out new file mode 100644 index 00000000000..4f56ca92620 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/DISPLAY_literals__DECIMAL-POINT_is_COMMA.out @@ -0,0 +1,7 @@ +12,3 +12,3 +-12,3 +1,23 +1,23 +-1,23 + diff --git a/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__1_.cob b/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__1_.cob new file mode 100644 index 00000000000..6d89908432e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__1_.cob @@ -0,0 +1,42 @@ + *> { dg-do compile } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE + ASSIGN "TESTFILE" + ACCESS DYNAMIC + ORGANIZATION RELATIVE + STATUS TESTSTAT + RELATIVE KEY TESTKEY + . + DATA DIVISION. + FILE SECTION. + FD TEST-FILE GLOBAL. + 01 TEST-REC PIC X(4). + WORKING-STORAGE SECTION. + 01 GLOBVALS. + 03 TESTKEY PIC 9(4). + 03 TESTSTAT PIC XX. + PROCEDURE DIVISION. + OPEN INPUT TEST-FILE. + CALL "prog2" + END-CALL. + CLOSE TEST-FILE. + STOP RUN. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + READ TEST-FILE + INVALID KEY + DISPLAY "NOK" + END-DISPLAY + END-READ. + EXIT PROGRAM. + END PROGRAM prog2. + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__2_.cob b/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__2_.cob new file mode 100644 index 00000000000..44d5b2ec089 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__2_.cob @@ -0,0 +1,42 @@ + *> { dg-do compile } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE + ASSIGN "TESTFILE" + ACCESS DYNAMIC + ORGANIZATION INDEXED + STATUS TESTSTAT + RECORD KEY TESTKEY + . + DATA DIVISION. + FILE SECTION. + FD TEST-FILE GLOBAL. + 01 TEST-REC. + 03 TESTKEY PIC X(4). + WORKING-STORAGE SECTION. + 01 GLOBVALS. + 03 TESTSTAT PIC XX. + PROCEDURE DIVISION. + OPEN INPUT TEST-FILE. + CALL "prog2" + END-CALL. + CLOSE TEST-FILE. + STOP RUN. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + READ TEST-FILE + INVALID KEY + DISPLAY "NOK" + END-DISPLAY + END-READ. + EXIT PROGRAM. + END PROGRAM prog2. + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__3_.cob b/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__3_.cob new file mode 100644 index 00000000000..0f423babd95 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__3_.cob @@ -0,0 +1,41 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE + ASSIGN "TESTFILE" + ACCESS DYNAMIC + ORGANIZATION RELATIVE + STATUS TESTSTAT + RELATIVE KEY TESTKEY + . + DATA DIVISION. + FILE SECTION. + FD TEST-FILE GLOBAL. + 01 TEST-REC PIC X(4). + WORKING-STORAGE SECTION. + 01 GLOBVALS. + 03 TESTKEY PIC 9(4). + 03 TESTSTAT PIC XX. + PROCEDURE DIVISION. + MOVE "00" TO TESTSTAT. + CALL "prog2" + END-CALL. + IF TESTSTAT = "00" + DISPLAY "Not OK" + END-DISPLAY + END-IF. + STOP RUN. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + OPEN INPUT TEST-FILE. + EXIT PROGRAM. + END PROGRAM prog2. + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__4_.cob b/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__4_.cob new file mode 100644 index 00000000000..116a935c2a4 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/GLOBAL_FD__4_.cob @@ -0,0 +1,41 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE + ASSIGN "TESTFILE" + ACCESS DYNAMIC + ORGANIZATION INDEXED + STATUS TESTSTAT + RECORD KEY TESTKEY + . + DATA DIVISION. + FILE SECTION. + FD TEST-FILE GLOBAL. + 01 TEST-REC. + 03 TESTKEY PIC X(4). + WORKING-STORAGE SECTION. + 01 GLOBVALS. + 03 TESTSTAT PIC XX. + PROCEDURE DIVISION. + MOVE "00" TO TESTSTAT. + CALL "prog2" + END-CALL. + IF TESTSTAT = "00" + DISPLAY "Not OK" + END-DISPLAY + END-IF. + STOP RUN. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + OPEN INPUT TEST-FILE. + EXIT PROGRAM. + END PROGRAM prog2. + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/GLOBAL_at_lower_level.cob b/gcc/testsuite/cobol.dg/group2/GLOBAL_at_lower_level.cob new file mode 100644 index 00000000000..f4b5cbabfa5 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/GLOBAL_at_lower_level.cob @@ -0,0 +1,37 @@ + *> { dg-do run } + *> { dg-output-file "group2/GLOBAL_at_lower_level.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(5) GLOBAL VALUE "prog1". + PROCEDURE DIVISION. + DISPLAY X + END-DISPLAY. + CALL "prog2" + END-CALL + STOP RUN. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(5) GLOBAL VALUE "prog2". + PROCEDURE DIVISION. + DISPLAY X + END-DISPLAY. + CALL "prog3" + END-CALL + EXIT PROGRAM. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog3. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY X + END-DISPLAY. + EXIT PROGRAM. + END PROGRAM prog3. + END PROGRAM prog2. + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/GLOBAL_at_lower_level.out b/gcc/testsuite/cobol.dg/group2/GLOBAL_at_lower_level.out new file mode 100644 index 00000000000..ab69cb1a1be --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/GLOBAL_at_lower_level.out @@ -0,0 +1,4 @@ +prog1 +prog2 +prog2 + diff --git a/gcc/testsuite/cobol.dg/group2/GLOBAL_at_same_level.cob b/gcc/testsuite/cobol.dg/group2/GLOBAL_at_same_level.cob new file mode 100644 index 00000000000..749a26cfa9d --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/GLOBAL_at_same_level.cob @@ -0,0 +1,37 @@ + *> { dg-do run } + *> { dg-output-file "group2/GLOBAL_at_same_level.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(5) GLOBAL VALUE "prog1". + PROCEDURE DIVISION. + DISPLAY X + END-DISPLAY. + CALL "prog2" + END-CALL + CALL "prog3" + END-CALL + STOP RUN. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(5) GLOBAL VALUE "prog2". + PROCEDURE DIVISION. + DISPLAY X + END-DISPLAY. + EXIT PROGRAM. + END PROGRAM prog2. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog3. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY X + END-DISPLAY. + EXIT PROGRAM. + END PROGRAM prog3. + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/GLOBAL_at_same_level.out b/gcc/testsuite/cobol.dg/group2/GLOBAL_at_same_level.out new file mode 100644 index 00000000000..4bc5d8baa8c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/GLOBAL_at_same_level.out @@ -0,0 +1,4 @@ +prog1 +prog2 +prog1 + diff --git a/gcc/testsuite/cobol.dg/group2/Hexadecimal_literal.cob b/gcc/testsuite/cobol.dg/group2/Hexadecimal_literal.cob new file mode 100644 index 00000000000..9722ebd48f0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Hexadecimal_literal.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + *> { dg-output-file "group2/Hexadecimal_literal.out" } + + >>DEFINE CHARSET AS 'ASCII' + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + >>IF CHARSET = 'EBCDIC' + DISPLAY X"F1F2F3" + >>ELSE + DISPLAY X"313233" + >>END-IF + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Hexadecimal_literal.out b/gcc/testsuite/cobol.dg/group2/Hexadecimal_literal.out new file mode 100644 index 00000000000..cc12087def8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Hexadecimal_literal.out @@ -0,0 +1,2 @@ +123 + diff --git a/gcc/testsuite/cobol.dg/group2/MULTIPLY_BY_literal_in_INITIAL_program.cob b/gcc/testsuite/cobol.dg/group2/MULTIPLY_BY_literal_in_INITIAL_program.cob new file mode 100644 index 00000000000..56f470343a0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/MULTIPLY_BY_literal_in_INITIAL_program.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog INITIAL. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 num PIC 9(4) VALUE 5. + 01 result PIC 9(4). + 01 ws-temp PIC 9(8)V99. + 01 ws-temp2 PIC 9(3)V99 VALUE 10.50. + PROCEDURE DIVISION. + MULTIPLY num BY 4 GIVING result + MOVE 1.10 TO WS-TEMP. + MULTIPLY WS-TEMP2 BY WS-TEMP GIVING WS-TEMP. + diff --git a/gcc/testsuite/cobol.dg/group2/Named_conditionals_-_fixed__float__and_alphabetic.cob b/gcc/testsuite/cobol.dg/group2/Named_conditionals_-_fixed__float__and_alphabetic.cob new file mode 100644 index 00000000000..92a65111c43 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Named_conditionals_-_fixed__float__and_alphabetic.cob @@ -0,0 +1,69 @@ + *> { dg-do run } + *> { dg-output-file "group2/Named_conditionals_-_fixed__float__and_alphabetic.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 makeofcar pic x(10). + 88 volksgroup value "skoda", "seat", + "audi", "volkswagen" + false "boat". + 88 germanmade value "volkswagen", "audi", + "mercedes", "bmw", + "porsche". + 01 agegroup pic 999. + 88 child value 0 through 12. + 88 teen value 13 through 19. + 88 adult value 20 through 999. + 01 floats float-long. + 88 neg value -1 through -.1 . + 88 zed value zero . + 88 pos value .1 through 1.0 . + procedure division. + move "ford" to makeofcar + display function trim (makeofcar) + if volksgroup display " volksgroup" end-if + if germanmade display " germanmade" end-if + move "skoda" to makeofcar + display function trim (makeofcar) + if volksgroup display " volksgroup" end-if + if germanmade display " germanmade" end-if + move "volkswagen" to makeofcar + display function trim (makeofcar) + if volksgroup display " volksgroup" end-if + if germanmade display " germanmade" end-if + move 5 to agegroup. + display agegroup with no advancing + if child display " child" end-if + if teen display " teen" end-if + if adult display " adult" end-if + move 15 to agegroup. + display agegroup with no advancing + if child display " child" end-if + if teen display " teen" end-if + if adult display " adult" end-if + move 75 to agegroup. + display agegroup with no advancing + if child display " child" end-if + if teen display " teen" end-if + if adult display " adult" end-if + move -0.5 to floats + display floats with no advancing + if neg display " minus" end-if + if zed display " zero" end-if + if pos display " plus" end-if + move zero to floats + display floats with no advancing + if neg display " minus" end-if + if zed display " zero" end-if + if pos display " plus" end-if + move 0.5 to floats + display floats with no advancing + if neg display " minus" end-if + if zed display " zero" end-if + if pos display " plus" end-if + continue. + quit. + goback. + end program prog. + diff --git a/gcc/testsuite/cobol.dg/group2/Named_conditionals_-_fixed__float__and_alphabetic.out b/gcc/testsuite/cobol.dg/group2/Named_conditionals_-_fixed__float__and_alphabetic.out new file mode 100644 index 00000000000..9ac5e44b1b2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Named_conditionals_-_fixed__float__and_alphabetic.out @@ -0,0 +1,13 @@ +ford +skoda + volksgroup +volkswagen + volksgroup + germanmade +005 child +015 teen +075 adult +-0.5 minus +0 zero +0.5 plus + diff --git a/gcc/testsuite/cobol.dg/group2/Numeric_operations__1_.cob b/gcc/testsuite/cobol.dg/group2/Numeric_operations__1_.cob new file mode 100644 index 00000000000..1e8f48e8854 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Numeric_operations__1_.cob @@ -0,0 +1,35 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC S9V9. + 01 Y PIC S9V9 COMP-3. + PROCEDURE DIVISION. + MOVE -0.1 TO X. + ADD 1 TO X. + IF X NOT = 0.9 + DISPLAY X + END-DISPLAY + END-IF. + MOVE 0.1 TO X. + SUBTRACT 1 FROM X. + IF X NOT = -0.9 + DISPLAY X + END-DISPLAY + END-IF. + MOVE -0.1 TO Y. + ADD 1 TO Y. + IF Y NOT = 0.9 + DISPLAY Y + END-DISPLAY + END-IF. + MOVE 0.1 TO Y. + SUBTRACT 1 FROM Y. + IF Y NOT = -0.9 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Numeric_operations__2_.cob b/gcc/testsuite/cobol.dg/group2/Numeric_operations__2_.cob new file mode 100644 index 00000000000..d7d71d70685 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Numeric_operations__2_.cob @@ -0,0 +1,292 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 FIELD PIC S9(1)V9(1). + 01 FELD2 PIC S9(5)V9(5). + 01 FELD3 PIC 9(1)V9(1). + 01 FELD4 PIC S9(1). + PROCEDURE DIVISION. + MOVE 0.2 TO FIELD + ADD 1 TO FIELD + IF FIELD NOT = 1.2 + DISPLAY "Test 1 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + ADD -1 TO FIELD + IF FIELD NOT = -0.8 + DISPLAY "Test 2 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + ADD 1 TO FIELD + IF FIELD NOT = 0.8 + DISPLAY "Test 3 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + ADD -1 TO FIELD + IF FIELD NOT = -1.2 + DISPLAY "Test 4 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + SUBTRACT 1 FROM FIELD + IF FIELD NOT = -0.8 + DISPLAY "Test 5 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + SUBTRACT -1 FROM FIELD + IF FIELD NOT = 1.2 + DISPLAY "Test 6 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + SUBTRACT 1 FROM FIELD + IF FIELD NOT = -1.2 + DISPLAY "Test 7 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + SUBTRACT -1 FROM FIELD + IF FIELD NOT = 0.8 + DISPLAY "Test 8 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + ADD 1 TO FELD2 + IF FELD2 NOT = 1.2 + DISPLAY "Test 9 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + ADD -1 TO FELD2 + IF FELD2 NOT = -0.8 + DISPLAY "Test 10 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + ADD 1 TO FELD2 + IF FELD2 NOT = 0.8 + DISPLAY "Test 11 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + ADD -1 TO FELD2 + IF FELD2 NOT = -1.2 + DISPLAY "Test 12 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + SUBTRACT 1 FROM FELD2 + IF FELD2 NOT = -0.8 + DISPLAY "Test 13 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + SUBTRACT -1 FROM FELD2 + IF FELD2 NOT = 1.2 + DISPLAY "Test 14 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + SUBTRACT 1 FROM FELD2 + IF FELD2 NOT = -1.2 + DISPLAY "Test 15 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + SUBTRACT -1 FROM FELD2 + IF FELD2 NOT = 0.8 + DISPLAY "Test 16 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + ADD 1 TO FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 17 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + ADD -1 TO FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 18 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + ADD 1 TO FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 19 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + ADD -1 TO FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 20 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + SUBTRACT 1 FROM FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 21 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + SUBTRACT -1 FROM FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 22 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + SUBTRACT 1 FROM FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 23 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + SUBTRACT -1 FROM FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 24 " FELD3 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + ADD 1 TO FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 25 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + ADD -1 TO FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 26 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + ADD 1 TO FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 27 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + ADD -1 TO FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 28 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + SUBTRACT 1 FROM FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 29 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + SUBTRACT -1 FROM FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 30 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + SUBTRACT 1 FROM FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 31 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + SUBTRACT -1 FROM FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 32 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + ADD 2 TO FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 33 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + ADD -2 TO FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 34 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + ADD 2 TO FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 35 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + ADD -2 TO FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 36 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + SUBTRACT 2 FROM FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 37 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + SUBTRACT -2 FROM FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 38 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + SUBTRACT 2 FROM FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 39 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + SUBTRACT -2 FROM FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 40 " FELD4 + END-DISPLAY + END-IF. + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/Numeric_operations__3_.cob b/gcc/testsuite/cobol.dg/group2/Numeric_operations__3_.cob new file mode 100644 index 00000000000..e56804a6794 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Numeric_operations__3_.cob @@ -0,0 +1,292 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 FIELD PIC S9(1)V9(1) COMP-3. + 01 FELD2 PIC S9(5)V9(5) COMP-3. + 01 FELD3 PIC 9(1)V9(1) COMP-3. + 01 FELD4 PIC S9(1) COMP-3. + PROCEDURE DIVISION. + MOVE 0.2 TO FIELD + ADD 1 TO FIELD + IF FIELD NOT = 1.2 + DISPLAY "Test 1 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + ADD -1 TO FIELD + IF FIELD NOT = -0.8 + DISPLAY "Test 2 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + ADD 1 TO FIELD + IF FIELD NOT = 0.8 + DISPLAY "Test 3 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + ADD -1 TO FIELD + IF FIELD NOT = -1.2 + DISPLAY "Test 4 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + SUBTRACT 1 FROM FIELD + IF FIELD NOT = -0.8 + DISPLAY "Test 5 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + SUBTRACT -1 FROM FIELD + IF FIELD NOT = 1.2 + DISPLAY "Test 6 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + SUBTRACT 1 FROM FIELD + IF FIELD NOT = -1.2 + DISPLAY "Test 7 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + SUBTRACT -1 FROM FIELD + IF FIELD NOT = 0.8 + DISPLAY "Test 8 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + ADD 1 TO FELD2 + IF FELD2 NOT = 1.2 + DISPLAY "Test 9 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + ADD -1 TO FELD2 + IF FELD2 NOT = -0.8 + DISPLAY "Test 10 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + ADD 1 TO FELD2 + IF FELD2 NOT = 0.8 + DISPLAY "Test 11 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + ADD -1 TO FELD2 + IF FELD2 NOT = -1.2 + DISPLAY "Test 12 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + SUBTRACT 1 FROM FELD2 + IF FELD2 NOT = -0.8 + DISPLAY "Test 13 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + SUBTRACT -1 FROM FELD2 + IF FELD2 NOT = 1.2 + DISPLAY "Test 14 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + SUBTRACT 1 FROM FELD2 + IF FELD2 NOT = -1.2 + DISPLAY "Test 15 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + SUBTRACT -1 FROM FELD2 + IF FELD2 NOT = 0.8 + DISPLAY "Test 16 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + ADD 1 TO FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 17 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + ADD -1 TO FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 18 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + ADD 1 TO FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 19 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + ADD -1 TO FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 20 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + SUBTRACT 1 FROM FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 21 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + SUBTRACT -1 FROM FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 22 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + SUBTRACT 1 FROM FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 23 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + SUBTRACT -1 FROM FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 24 " FELD3 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + ADD 1 TO FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 25 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + ADD -1 TO FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 26 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + ADD 1 TO FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 27 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + ADD -1 TO FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 28 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + SUBTRACT 1 FROM FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 29 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + SUBTRACT -1 FROM FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 30 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + SUBTRACT 1 FROM FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 31 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + SUBTRACT -1 FROM FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 32 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + ADD 2 TO FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 33 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + ADD -2 TO FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 34 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + ADD 2 TO FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 35 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + ADD -2 TO FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 36 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + SUBTRACT 2 FROM FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 37 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + SUBTRACT -2 FROM FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 38 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + SUBTRACT 2 FROM FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 39 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + SUBTRACT -2 FROM FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 40 " FELD4 + END-DISPLAY + END-IF. + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/Numeric_operations__4_.cob b/gcc/testsuite/cobol.dg/group2/Numeric_operations__4_.cob new file mode 100644 index 00000000000..2b5c8ee70ae --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Numeric_operations__4_.cob @@ -0,0 +1,292 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 FIELD PIC S9(1)V9(1) COMP. + 01 FELD2 PIC S9(5)V9(5) COMP. + 01 FELD3 PIC 9(1)V9(1) COMP. + 01 FELD4 PIC S9(1) COMP. + PROCEDURE DIVISION. + MOVE 0.2 TO FIELD + ADD 1 TO FIELD + IF FIELD NOT = 1.2 + DISPLAY "Test 1 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + ADD -1 TO FIELD + IF FIELD NOT = -0.8 + DISPLAY "Test 2 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + ADD 1 TO FIELD + IF FIELD NOT = 0.8 + DISPLAY "Test 3 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + ADD -1 TO FIELD + IF FIELD NOT = -1.2 + DISPLAY "Test 4 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + SUBTRACT 1 FROM FIELD + IF FIELD NOT = -0.8 + DISPLAY "Test 5 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + SUBTRACT -1 FROM FIELD + IF FIELD NOT = 1.2 + DISPLAY "Test 6 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + SUBTRACT 1 FROM FIELD + IF FIELD NOT = -1.2 + DISPLAY "Test 7 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + SUBTRACT -1 FROM FIELD + IF FIELD NOT = 0.8 + DISPLAY "Test 8 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + ADD 1 TO FELD2 + IF FELD2 NOT = 1.2 + DISPLAY "Test 9 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + ADD -1 TO FELD2 + IF FELD2 NOT = -0.8 + DISPLAY "Test 10 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + ADD 1 TO FELD2 + IF FELD2 NOT = 0.8 + DISPLAY "Test 11 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + ADD -1 TO FELD2 + IF FELD2 NOT = -1.2 + DISPLAY "Test 12 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + SUBTRACT 1 FROM FELD2 + IF FELD2 NOT = -0.8 + DISPLAY "Test 13 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + SUBTRACT -1 FROM FELD2 + IF FELD2 NOT = 1.2 + DISPLAY "Test 14 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + SUBTRACT 1 FROM FELD2 + IF FELD2 NOT = -1.2 + DISPLAY "Test 15 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + SUBTRACT -1 FROM FELD2 + IF FELD2 NOT = 0.8 + DISPLAY "Test 16 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + ADD 1 TO FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 17 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + ADD -1 TO FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 18 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + ADD 1 TO FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 19 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + ADD -1 TO FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 20 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + SUBTRACT 1 FROM FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 21 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + SUBTRACT -1 FROM FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 22 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + SUBTRACT 1 FROM FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 23 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + SUBTRACT -1 FROM FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 24 " FELD3 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + ADD 1 TO FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 25 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + ADD -1 TO FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 26 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + ADD 1 TO FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 27 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + ADD -1 TO FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 28 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + SUBTRACT 1 FROM FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 29 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + SUBTRACT -1 FROM FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 30 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + SUBTRACT 1 FROM FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 31 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + SUBTRACT -1 FROM FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 32 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + ADD 2 TO FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 33 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + ADD -2 TO FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 34 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + ADD 2 TO FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 35 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + ADD -2 TO FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 36 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + SUBTRACT 2 FROM FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 37 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + SUBTRACT -2 FROM FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 38 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + SUBTRACT 2 FROM FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 39 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + SUBTRACT -2 FROM FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 40 " FELD4 + END-DISPLAY + END-IF. + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/Numeric_operations__5_.cob b/gcc/testsuite/cobol.dg/group2/Numeric_operations__5_.cob new file mode 100644 index 00000000000..1f72e69fbde --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Numeric_operations__5_.cob @@ -0,0 +1,292 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 FIELD PIC S9(1)V9(1) COMP-5. + 01 FELD2 PIC S9(5)V9(5) COMP-5. + 01 FELD3 PIC 9(1)V9(1) COMP-5. + 01 FELD4 PIC S9(1) COMP-5. + PROCEDURE DIVISION. + MOVE 0.2 TO FIELD + ADD 1 TO FIELD + IF FIELD NOT = 1.2 + DISPLAY "Test 1 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + ADD -1 TO FIELD + IF FIELD NOT = -0.8 + DISPLAY "Test 2 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + ADD 1 TO FIELD + IF FIELD NOT = 0.8 + DISPLAY "Test 3 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + ADD -1 TO FIELD + IF FIELD NOT = -1.2 + DISPLAY "Test 4 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + SUBTRACT 1 FROM FIELD + IF FIELD NOT = -0.8 + DISPLAY "Test 5 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FIELD + SUBTRACT -1 FROM FIELD + IF FIELD NOT = 1.2 + DISPLAY "Test 6 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + SUBTRACT 1 FROM FIELD + IF FIELD NOT = -1.2 + DISPLAY "Test 7 " FIELD + END-DISPLAY + END-IF. + + MOVE -0.2 TO FIELD + SUBTRACT -1 FROM FIELD + IF FIELD NOT = 0.8 + DISPLAY "Test 8 " FIELD + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + ADD 1 TO FELD2 + IF FELD2 NOT = 1.2 + DISPLAY "Test 9 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + ADD -1 TO FELD2 + IF FELD2 NOT = -0.8 + DISPLAY "Test 10 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + ADD 1 TO FELD2 + IF FELD2 NOT = 0.8 + DISPLAY "Test 11 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + ADD -1 TO FELD2 + IF FELD2 NOT = -1.2 + DISPLAY "Test 12 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + SUBTRACT 1 FROM FELD2 + IF FELD2 NOT = -0.8 + DISPLAY "Test 13 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD2 + SUBTRACT -1 FROM FELD2 + IF FELD2 NOT = 1.2 + DISPLAY "Test 14 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + SUBTRACT 1 FROM FELD2 + IF FELD2 NOT = -1.2 + DISPLAY "Test 15 " FELD2 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD2 + SUBTRACT -1 FROM FELD2 + IF FELD2 NOT = 0.8 + DISPLAY "Test 16 " FELD2 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + ADD 1 TO FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 17 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + ADD -1 TO FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 18 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + ADD 1 TO FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 19 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + ADD -1 TO FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 20 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + SUBTRACT 1 FROM FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 21 " FELD3 + END-DISPLAY + END-IF. + + MOVE 0.2 TO FELD3 + SUBTRACT -1 FROM FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 22 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + SUBTRACT 1 FROM FELD3 + IF FELD3 NOT = 0.8 + DISPLAY "Test 23 " FELD3 + END-DISPLAY + END-IF. + + MOVE -0.2 TO FELD3 + SUBTRACT -1 FROM FELD3 + IF FELD3 NOT = 1.2 + DISPLAY "Test 24 " FELD3 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + ADD 1 TO FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 25 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + ADD -1 TO FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 26 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + ADD 1 TO FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 27 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + ADD -1 TO FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 28 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + SUBTRACT 1 FROM FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 29 " FELD4 + END-DISPLAY + END-IF. + + MOVE 2 TO FELD4 + SUBTRACT -1 FROM FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 30 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + SUBTRACT 1 FROM FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 31 " FELD4 + END-DISPLAY + END-IF. + + MOVE -2 TO FELD4 + SUBTRACT -1 FROM FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 32 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + ADD 2 TO FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 33 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + ADD -2 TO FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 34 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + ADD 2 TO FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 35 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + ADD -2 TO FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 36 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + SUBTRACT 2 FROM FELD4 + IF FELD4 NOT = -1 + DISPLAY "Test 37 " FELD4 + END-DISPLAY + END-IF. + + MOVE 1 TO FELD4 + SUBTRACT -2 FROM FELD4 + IF FELD4 NOT = 3 + DISPLAY "Test 38 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + SUBTRACT 2 FROM FELD4 + IF FELD4 NOT = -3 + DISPLAY "Test 39 " FELD4 + END-DISPLAY + END-IF. + + MOVE -1 TO FELD4 + SUBTRACT -2 FROM FELD4 + IF FELD4 NOT = 1 + DISPLAY "Test 40 " FELD4 + END-DISPLAY + END-IF. + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/Numeric_operations__7_.cob b/gcc/testsuite/cobol.dg/group2/Numeric_operations__7_.cob new file mode 100644 index 00000000000..df517db4d3c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Numeric_operations__7_.cob @@ -0,0 +1,283 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 FIELD PIC S9(4)V9(2) COMP-5. + 01 FIELD-DISP PIC S9(4)V9(2) DISPLAY. + PROCEDURE DIVISION. + MOVE 0.2 TO FIELD. + ADD 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12 + 13 + 14 + 15 + 16 + 17 + 18 + 19 + 20 + 21 + 22 + 23 + 24 + 25 + 26 + 27 + 28 + 29 + 30 + 31 + 32 + 33 + 34 + 35 + 36 + 37 + 38 + 39 + 40 + 41 + 42 + 43 + 44 + 45 + 46 + 47 + 48 + 49 + 50 + 51 + 52 + 53 + 54 + 55 + 56 + 57 + 58 + 59 + 60 + 61 + 62 + 63 + 64 + 65 + 66 + 67 + 68 + 69 + 70 + 71 + 72 + 73 + 74 + 75 + 76 + 77 + 78 + 79 + 80 + 81 + 82 + 83 + 84 + 85 + 86 + 87 + 88 + 89 + 90 + 91 + 92 + 93 + 94 + 95 + 96 + 97 + 98 + 99 + 100 + 101 + 102 + 103 + 104 + 105 + 106 + 107 + 108 + 109 + 110 + 111 + 112 + 113 + 114 + 115 + 116 + 117 + 118 + 119 + 120 + 121 + 122 + 123 + 124 + 125 + 126 + 127 + 128 + 129 + TO FIELD + END-ADD. + IF FIELD NOT = 8385.2 + MOVE FIELD TO FIELD-DISP + DISPLAY 'ADD with wrong result: ' FIELD-DISP + END-DISPLAY + END-IF. + COMPUTE FIELD = (0.2 + + 2 + + 3 + + 4 + + 5 + + 6 + + 7 + + 8 + + 9 + + 10 + + 11 + + 12 + + 13 + + 14 + + 15 + + 16 + + 17 + + 18 + + 19 + + 20 + + 21 + + 22 + + 23 + + 24 + + 25 + + 26 + + 27 + + 28 + + 29 + + 30 + + 31 + + 32 + + 33 + + 34 + + 35 + + 36 + + 37 + + 38 + + 39 + + 40 + + 41 + + 42 + + 43 + + 44 + + 45 + + 46 + + 47 + + 48 + + 49 + + 50 + + 51 + + 52 + + 53 + + 54 + + 55 + + 56 + + 57 + + 58 + - 59 + - 60 + - 61 + - 62 + - 63 + - 64 + - 65 + - 66 + - 67 + - 68 + - 69 + - 70 + - 71 + - 72 + - 73 + - 74 + - 75 + - 76 + - 77 + - 78 + - 79 + - 80 + - 81 + - 82 + - 83 + - 84 + - 85 + - 86 + - 87 + - 88 + - 89 + - 90 + - 91 + - 92 + - 93 + - 94 + - 95 + - 96 + - 97 + - 98 + - 99 + - 100 + - 101 + - 102 + - 103 + - 104 + - 105 + - 106 + - 107 + - 108 + - 109 + - 110 + - 111 + - 112 + - 113 + - 114 + - 115 + - 116 + - 117 + - 118 + - 119 + - 120 + - 121 + - 122 + - 123 + - 124 + - 125 + - 126 + - 127) + * 12800000000 + / 12900000000 + END-COMPUTE. + IF FIELD NOT = -4670.31 + MOVE FIELD TO FIELD-DISP + DISPLAY 'COMPUTE with wrong result: ' FIELD-DISP + END-DISPLAY + END-IF. + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/Numeric_operations__8_.cob b/gcc/testsuite/cobol.dg/group2/Numeric_operations__8_.cob new file mode 100644 index 00000000000..68d5f9bb59f --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Numeric_operations__8_.cob @@ -0,0 +1,37 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 1 COMPUTE-DATA. + 2 COMPUTE-8 PICTURE 999 VALUE ZERO. + PROCEDURE DIVISION. + COMPUTE COMPUTE-8 = (((24.0 + 1) * (60 - 10)) / 125) ** 2 + IF COMPUTE-8 NOT = 100 + DISPLAY 'COMPUTE with wrong result: ' COMPUTE-8 + END-DISPLAY + END-IF + COMPUTE COMPUTE-8 = 55 / (1 - 2 + 1) + NOT ON SIZE ERROR + DISPLAY 'SIZE ERROR not set from divide by zero!' + END-DISPLAY + END-COMPUTE + COMPUTE COMPUTE-8 = 0 ** 1 + IF COMPUTE-8 NOT = 0 + DISPLAY '0 ** 1 <> 0: ' COMPUTE-8 + END-DISPLAY + END-IF + COMPUTE COMPUTE-8 = 55 ** 0 + IF COMPUTE-8 NOT = 1 + DISPLAY '55 ** 0 <> 1: ' COMPUTE-8 + END-DISPLAY + END-IF + COMPUTE COMPUTE-8 = 1 ** 55 + IF COMPUTE-8 NOT = 1 + DISPLAY '11 ** 55 <> 1: ' COMPUTE-8 + END-DISPLAY + END-IF + + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_AWAY-FROM-ZERO.cob b/gcc/testsuite/cobol.dg/group2/ROUNDED_AWAY-FROM-ZERO.cob new file mode 100644 index 00000000000..dc7ddadac06 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_AWAY-FROM-ZERO.cob @@ -0,0 +1,55 @@ + *> { dg-do run } + *> { dg-output-file "group2/ROUNDED_AWAY-FROM-ZERO.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 M PIC S9. + 01 N PIC S9. + 01 O PIC S9. + 01 P PIC S9. + 01 Q PIC S9. + 01 R PIC S9. + 01 S PIC S9. + 01 T PIC S9. + 01 U PIC S9. + 01 V PIC S9. + PROCEDURE DIVISION. + COMPUTE M ROUNDED MODE AWAY-FROM-ZERO + = 2.49 + END-COMPUTE + COMPUTE N ROUNDED MODE AWAY-FROM-ZERO + = -2.49 + END-COMPUTE + COMPUTE O ROUNDED MODE AWAY-FROM-ZERO + = 2.50 + END-COMPUTE + COMPUTE P ROUNDED MODE AWAY-FROM-ZERO + = -2.50 + END-COMPUTE + COMPUTE Q ROUNDED MODE AWAY-FROM-ZERO + = 3.49 + END-COMPUTE + COMPUTE R ROUNDED MODE AWAY-FROM-ZERO + = -3.49 + END-COMPUTE + COMPUTE S ROUNDED MODE AWAY-FROM-ZERO + = 3.50 + END-COMPUTE + COMPUTE T ROUNDED MODE AWAY-FROM-ZERO + = -3.50 + END-COMPUTE + COMPUTE U ROUNDED MODE AWAY-FROM-ZERO + = 3.510 + END-COMPUTE + COMPUTE V ROUNDED MODE AWAY-FROM-ZERO + = -3.510 + END-COMPUTE + DISPLAY M " " N " " O " " P " " Q " " R " " S " " T + " " U " " V + NO ADVANCING + END-DISPLAY + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_AWAY-FROM-ZERO.out b/gcc/testsuite/cobol.dg/group2/ROUNDED_AWAY-FROM-ZERO.out new file mode 100644 index 00000000000..67784dea908 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_AWAY-FROM-ZERO.out @@ -0,0 +1 @@ ++3 -3 +3 -3 +4 -4 +4 -4 +4 -4 diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-AWAY-FROM-ZERO.cob b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-AWAY-FROM-ZERO.cob new file mode 100644 index 00000000000..8a1e0ca1a01 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-AWAY-FROM-ZERO.cob @@ -0,0 +1,55 @@ + *> { dg-do run } + *> { dg-output-file "group2/ROUNDED_NEAREST-AWAY-FROM-ZERO.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 M PIC S9. + 01 N PIC S9. + 01 O PIC S9. + 01 P PIC S9. + 01 Q PIC S9. + 01 R PIC S9. + 01 S PIC S9. + 01 T PIC S9. + 01 U PIC S9. + 01 V PIC S9. + PROCEDURE DIVISION. + COMPUTE M ROUNDED MODE NEAREST-AWAY-FROM-ZERO + = 2.49 + END-COMPUTE + COMPUTE N ROUNDED MODE NEAREST-AWAY-FROM-ZERO + = -2.49 + END-COMPUTE + COMPUTE O ROUNDED MODE NEAREST-AWAY-FROM-ZERO + = 2.50 + END-COMPUTE + COMPUTE P ROUNDED MODE NEAREST-AWAY-FROM-ZERO + = -2.50 + END-COMPUTE + COMPUTE Q ROUNDED MODE NEAREST-AWAY-FROM-ZERO + = 3.49 + END-COMPUTE + COMPUTE R ROUNDED MODE NEAREST-AWAY-FROM-ZERO + = -3.49 + END-COMPUTE + COMPUTE S ROUNDED MODE NEAREST-AWAY-FROM-ZERO + = 3.50 + END-COMPUTE + COMPUTE T ROUNDED MODE NEAREST-AWAY-FROM-ZERO + = -3.50 + END-COMPUTE + COMPUTE U ROUNDED MODE NEAREST-AWAY-FROM-ZERO + = 3.510 + END-COMPUTE + COMPUTE V ROUNDED MODE NEAREST-AWAY-FROM-ZERO + = -3.510 + END-COMPUTE + DISPLAY M " " N " " O " " P " " Q " " R " " S " " T + " " U " " V + NO ADVANCING + END-DISPLAY + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-AWAY-FROM-ZERO.out b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-AWAY-FROM-ZERO.out new file mode 100644 index 00000000000..18afa23c2aa --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-AWAY-FROM-ZERO.out @@ -0,0 +1 @@ ++2 -2 +3 -3 +3 -3 +4 -4 +4 -4 diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-EVEN.cob b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-EVEN.cob new file mode 100644 index 00000000000..77529d2f4d2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-EVEN.cob @@ -0,0 +1,55 @@ + *> { dg-do run } + *> { dg-output-file "group2/ROUNDED_NEAREST-EVEN.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 M PIC S9. + 01 N PIC S9. + 01 O PIC S9. + 01 P PIC S9. + 01 Q PIC S9. + 01 R PIC S9. + 01 S PIC S9. + 01 T PIC S9. + 01 U PIC S9. + 01 V PIC S9. + PROCEDURE DIVISION. + COMPUTE M ROUNDED MODE NEAREST-EVEN + = 2.49 + END-COMPUTE + COMPUTE N ROUNDED MODE NEAREST-EVEN + = -2.49 + END-COMPUTE + COMPUTE O ROUNDED MODE NEAREST-EVEN + = 2.50 + END-COMPUTE + COMPUTE P ROUNDED MODE NEAREST-EVEN + = -2.50 + END-COMPUTE + COMPUTE Q ROUNDED MODE NEAREST-EVEN + = 3.49 + END-COMPUTE + COMPUTE R ROUNDED MODE NEAREST-EVEN + = -3.49 + END-COMPUTE + COMPUTE S ROUNDED MODE NEAREST-EVEN + = 3.50 + END-COMPUTE + COMPUTE T ROUNDED MODE NEAREST-EVEN + = -3.50 + END-COMPUTE + COMPUTE U ROUNDED MODE NEAREST-EVEN + = 3.510 + END-COMPUTE + COMPUTE V ROUNDED MODE NEAREST-EVEN + = -3.510 + END-COMPUTE + DISPLAY M " " N " " O " " P " " Q " " R " " S " " T + " " U " " V + NO ADVANCING + END-DISPLAY + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-EVEN.out b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-EVEN.out new file mode 100644 index 00000000000..59e459b7dc9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-EVEN.out @@ -0,0 +1 @@ ++2 -2 +2 -2 +3 -3 +4 -4 +4 -4 diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-TOWARD-ZERO.cob b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-TOWARD-ZERO.cob new file mode 100644 index 00000000000..6f3f28dd9d3 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-TOWARD-ZERO.cob @@ -0,0 +1,55 @@ + *> { dg-do run } + *> { dg-output-file "group2/ROUNDED_NEAREST-TOWARD-ZERO.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 M PIC S9. + 01 N PIC S9. + 01 O PIC S9. + 01 P PIC S9. + 01 Q PIC S9. + 01 R PIC S9. + 01 S PIC S9. + 01 T PIC S9. + 01 U PIC S9. + 01 V PIC S9. + PROCEDURE DIVISION. + COMPUTE M ROUNDED MODE NEAREST-TOWARD-ZERO + = 2.49 + END-COMPUTE + COMPUTE N ROUNDED MODE NEAREST-TOWARD-ZERO + = -2.49 + END-COMPUTE + COMPUTE O ROUNDED MODE NEAREST-TOWARD-ZERO + = 2.50 + END-COMPUTE + COMPUTE P ROUNDED MODE NEAREST-TOWARD-ZERO + = -2.50 + END-COMPUTE + COMPUTE Q ROUNDED MODE NEAREST-TOWARD-ZERO + = 3.49 + END-COMPUTE + COMPUTE R ROUNDED MODE NEAREST-TOWARD-ZERO + = -3.49 + END-COMPUTE + COMPUTE S ROUNDED MODE NEAREST-TOWARD-ZERO + = 3.50 + END-COMPUTE + COMPUTE T ROUNDED MODE NEAREST-TOWARD-ZERO + = -3.50 + END-COMPUTE + COMPUTE U ROUNDED MODE NEAREST-TOWARD-ZERO + = 3.510 + END-COMPUTE + COMPUTE V ROUNDED MODE NEAREST-TOWARD-ZERO + = -3.510 + END-COMPUTE + DISPLAY M " " N " " O " " P " " Q " " R " " S " " T + " " U " " V + NO ADVANCING + END-DISPLAY + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-TOWARD-ZERO.out b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-TOWARD-ZERO.out new file mode 100644 index 00000000000..05ce11c00fd --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_NEAREST-TOWARD-ZERO.out @@ -0,0 +1 @@ ++2 -2 +2 -2 +3 -3 +3 -3 +4 -4 diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-GREATER.cob b/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-GREATER.cob new file mode 100644 index 00000000000..c2b3cf875fa --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-GREATER.cob @@ -0,0 +1,55 @@ + *> { dg-do run } + *> { dg-output-file "group2/ROUNDED_TOWARD-GREATER.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 M PIC S9. + 01 N PIC S9. + 01 O PIC S9. + 01 P PIC S9. + 01 Q PIC S9. + 01 R PIC S9. + 01 S PIC S9. + 01 T PIC S9. + 01 U PIC S9. + 01 V PIC S9. + PROCEDURE DIVISION. + COMPUTE M ROUNDED MODE TOWARD-GREATER + = 2.49 + END-COMPUTE + COMPUTE N ROUNDED MODE TOWARD-GREATER + = -2.49 + END-COMPUTE + COMPUTE O ROUNDED MODE TOWARD-GREATER + = 2.50 + END-COMPUTE + COMPUTE P ROUNDED MODE TOWARD-GREATER + = -2.50 + END-COMPUTE + COMPUTE Q ROUNDED MODE TOWARD-GREATER + = 3.49 + END-COMPUTE + COMPUTE R ROUNDED MODE TOWARD-GREATER + = -3.49 + END-COMPUTE + COMPUTE S ROUNDED MODE TOWARD-GREATER + = 3.50 + END-COMPUTE + COMPUTE T ROUNDED MODE TOWARD-GREATER + = -3.50 + END-COMPUTE + COMPUTE U ROUNDED MODE TOWARD-GREATER + = 3.510 + END-COMPUTE + COMPUTE V ROUNDED MODE TOWARD-GREATER + = -3.510 + END-COMPUTE + DISPLAY M " " N " " O " " P " " Q " " R " " S " " T + " " U " " V + NO ADVANCING + END-DISPLAY + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-GREATER.out b/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-GREATER.out new file mode 100644 index 00000000000..54ab7f31096 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-GREATER.out @@ -0,0 +1 @@ ++3 -2 +3 -2 +4 -3 +4 -3 +4 -3 diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-LESSER.cob b/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-LESSER.cob new file mode 100644 index 00000000000..37c17495e00 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-LESSER.cob @@ -0,0 +1,55 @@ + *> { dg-do run } + *> { dg-output-file "group2/ROUNDED_TOWARD-LESSER.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 M PIC S9. + 01 N PIC S9. + 01 O PIC S9. + 01 P PIC S9. + 01 Q PIC S9. + 01 R PIC S9. + 01 S PIC S9. + 01 T PIC S9. + 01 U PIC S9. + 01 V PIC S9. + PROCEDURE DIVISION. + COMPUTE M ROUNDED MODE TOWARD-LESSER + = 2.49 + END-COMPUTE + COMPUTE N ROUNDED MODE TOWARD-LESSER + = -2.49 + END-COMPUTE + COMPUTE O ROUNDED MODE TOWARD-LESSER + = 2.50 + END-COMPUTE + COMPUTE P ROUNDED MODE TOWARD-LESSER + = -2.50 + END-COMPUTE + COMPUTE Q ROUNDED MODE TOWARD-LESSER + = 3.49 + END-COMPUTE + COMPUTE R ROUNDED MODE TOWARD-LESSER + = -3.49 + END-COMPUTE + COMPUTE S ROUNDED MODE TOWARD-LESSER + = 3.50 + END-COMPUTE + COMPUTE T ROUNDED MODE TOWARD-LESSER + = -3.50 + END-COMPUTE + COMPUTE U ROUNDED MODE TOWARD-LESSER + = 3.510 + END-COMPUTE + COMPUTE V ROUNDED MODE TOWARD-LESSER + = -3.510 + END-COMPUTE + DISPLAY M " " N " " O " " P " " Q " " R " " S " " T + " " U " " V + NO ADVANCING + END-DISPLAY + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-LESSER.out b/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-LESSER.out new file mode 100644 index 00000000000..2cf5645a676 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_TOWARD-LESSER.out @@ -0,0 +1 @@ ++2 -3 +2 -3 +3 -4 +3 -4 +3 -4 diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_TRUNCATION.cob b/gcc/testsuite/cobol.dg/group2/ROUNDED_TRUNCATION.cob new file mode 100644 index 00000000000..9f46dc7185b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_TRUNCATION.cob @@ -0,0 +1,55 @@ + *> { dg-do run } + *> { dg-output-file "group2/ROUNDED_TRUNCATION.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 M PIC S9. + 01 N PIC S9. + 01 O PIC S9. + 01 P PIC S9. + 01 Q PIC S9. + 01 R PIC S9. + 01 S PIC S9. + 01 T PIC S9. + 01 U PIC S9. + 01 V PIC S9. + PROCEDURE DIVISION. + COMPUTE M ROUNDED MODE TRUNCATION + = 2.49 + END-COMPUTE + COMPUTE N ROUNDED MODE TRUNCATION + = -2.49 + END-COMPUTE + COMPUTE O ROUNDED MODE TRUNCATION + = 2.50 + END-COMPUTE + COMPUTE P ROUNDED MODE TRUNCATION + = -2.50 + END-COMPUTE + COMPUTE Q ROUNDED MODE TRUNCATION + = 3.49 + END-COMPUTE + COMPUTE R ROUNDED MODE TRUNCATION + = -3.49 + END-COMPUTE + COMPUTE S ROUNDED MODE TRUNCATION + = 3.50 + END-COMPUTE + COMPUTE T ROUNDED MODE TRUNCATION + = -3.50 + END-COMPUTE + COMPUTE U ROUNDED MODE TRUNCATION + = 3.510 + END-COMPUTE + COMPUTE V ROUNDED MODE TRUNCATION + = -3.510 + END-COMPUTE + DISPLAY M " " N " " O " " P " " Q " " R " " S " " T + " " U " " V + NO ADVANCING + END-DISPLAY + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDED_TRUNCATION.out b/gcc/testsuite/cobol.dg/group2/ROUNDED_TRUNCATION.out new file mode 100644 index 00000000000..c178d5a24b4 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDED_TRUNCATION.out @@ -0,0 +1 @@ ++2 -2 +2 -2 +3 -3 +3 -3 +3 -3 diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_Floating-Point_from_COMPUTE.cob b/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_Floating-Point_from_COMPUTE.cob new file mode 100644 index 00000000000..4bc8b28347f --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_Floating-Point_from_COMPUTE.cob @@ -0,0 +1,427 @@ + *> { dg-do run } + *> { dg-output-file "group2/ROUNDING_omnibus_Floating-Point_from_COMPUTE.out" } + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 VAR1 COMP-2. + 01 VAR2 PICTURE S999. + 01 SHOULD_BE PICTURE S999. + 01 RMODE PICTURE X(64). + 01 EMPTY PIC X VALUE " ". + 01 FLAG PIC X. + PROCEDURE DIVISION. + + DISPLAY "ROUNDING from COMP-2 after COMPUTE." + + PERFORM truncation-e. + PERFORM truncation-m. + PERFORM nearest-away-from-zero-e. + PERFORM nearest-away-from-zero-m. + PERFORM away-from-zero-e. + PERFORM away-from-zero-m. + PERFORM nearest-even-e. + PERFORM nearest-even-m. + PERFORM nearest-toward-zero-e. + PERFORM nearest-toward-zero-m. + PERFORM toward-greater-e. + PERFORM toward-greater-m. + PERFORM toward-lesser-e. + PERFORM toward-lesser-m. + PERFORM prohibited-e. + GOBACK. + + truncation-e. + MOVE "TRUNCATION" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + + truncation-m. + MOVE "TRUNCATION" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + + nearest-away-from-zero-e. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + nearest-away-from-zero-m. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + away-from-zero-e. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + away-from-zero-m. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + nearest-even-e. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 110.0 TO VAR1 + MOVE 110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 110.1 TO VAR1 + MOVE 110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 110.5 TO VAR1 + MOVE 110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 110.9 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + MOVE "NEAREST-EVEN" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + + nearest-even-m. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -110.0 TO VAR1 + MOVE -110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -110.1 TO VAR1 + MOVE -110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -110.5 TO VAR1 + MOVE -110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -110.9 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + MOVE "NEAREST-EVEN" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + + nearest-toward-zero-e. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + nearest-toward-zero-m. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + toward-greater-e. + MOVE "TOWARD-GREATER" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + + toward-greater-m. + MOVE "TOWARD-GREATER" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + + toward-lesser-e. + MOVE "TOWARD-LESSER" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + + toward-lesser-m. + MOVE "TOWARD-LESSER" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + + prohibited-e. + MOVE "PROHIBITED - fits" TO RMODE + SET LAST EXCEPTION TO OFF + MOVE 123 TO VAR2 + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE PROHIBITED = VAR1 + PERFORM SHOW_RESULTS + DISPLAY " EXCEPTION STATUS IS " + """" FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """". + + MOVE "PROHIBITED - doesn't fit; no ON ERROR phrase" TO RMODE + SET LAST EXCEPTION TO OFF + MOVE 123 TO VAR2 + MOVE 111.5 TO VAR1 + MOVE 123 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE PROHIBITED = VAR1 + PERFORM SHOW_RESULTS + DISPLAY " EXCEPTION STATUS IS " + """" FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """". + + MOVE "PROHIBITED - doesn't fit; ON ERROR phrase" TO RMODE + SET LAST EXCEPTION TO OFF + MOVE SPACE TO FLAG + MOVE 123 TO VAR2 + MOVE 111.5 TO VAR1 + MOVE 123 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE PROHIBITED = VAR1 + ON SIZE ERROR MOVE 'X' TO FLAG + END-COMPUTE + PERFORM SHOW_RESULTS + IF FLAG EQUAL 'X' + DISPLAY " COMPUTE had an ON SIZE error" + END-IF. + DISPLAY " EXCEPTION STATUS IS " + """" FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """". + + SHOW_RESULTS. + DISPLAY "Rounding mode " FUNCTION TRIM(RMODE) + " " VAR1 " becomes " VAR2 + WITH NO ADVANCING + END-DISPLAY + IF VAR2 EQUALS SHOULD_BE + DISPLAY FUNCTION TRIM(EMPTY) + ELSE + DISPLAY " but it should be " SHOULD_BE + END-IF. + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_Floating-Point_from_COMPUTE.out b/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_Floating-Point_from_COMPUTE.out new file mode 100644 index 00000000000..4ff4e290167 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_Floating-Point_from_COMPUTE.out @@ -0,0 +1,71 @@ +ROUNDING from COMP-2 after COMPUTE. +Rounding mode TRUNCATION 111 becomes +111 +Rounding mode TRUNCATION 111.099999999999994 becomes +111 +Rounding mode TRUNCATION 111.5 becomes +111 +Rounding mode TRUNCATION 111.900000000000006 becomes +111 +Rounding mode TRUNCATION -111 becomes -111 +Rounding mode TRUNCATION -111.099999999999994 becomes -111 +Rounding mode TRUNCATION -111.5 becomes -111 +Rounding mode TRUNCATION -111.900000000000006 becomes -111 +Rounding mode NEAREST-AWAY-FROM-ZERO 111 becomes +111 +Rounding mode NEAREST-AWAY-FROM-ZERO 111.099999999999994 becomes +111 +Rounding mode NEAREST-AWAY-FROM-ZERO 111.5 becomes +112 +Rounding mode NEAREST-AWAY-FROM-ZERO 111.900000000000006 becomes +112 +Rounding mode NEAREST-AWAY-FROM-ZERO -111 becomes -111 +Rounding mode NEAREST-AWAY-FROM-ZERO -111.099999999999994 becomes -111 +Rounding mode NEAREST-AWAY-FROM-ZERO -111.5 becomes -112 +Rounding mode NEAREST-AWAY-FROM-ZERO -111.900000000000006 becomes -112 +Rounding mode AWAY-FROM-ZERO 111 becomes +111 +Rounding mode AWAY-FROM-ZERO 111.099999999999994 becomes +112 +Rounding mode AWAY-FROM-ZERO 111.5 becomes +112 +Rounding mode AWAY-FROM-ZERO 111.900000000000006 becomes +112 +Rounding mode AWAY-FROM-ZERO -111 becomes -111 +Rounding mode AWAY-FROM-ZERO -111.099999999999994 becomes -112 +Rounding mode AWAY-FROM-ZERO -111.5 becomes -112 +Rounding mode AWAY-FROM-ZERO -111.900000000000006 becomes -112 +Rounding mode NEAREST-EVEN 110 becomes +110 +Rounding mode NEAREST-EVEN 110.099999999999994 becomes +110 +Rounding mode NEAREST-EVEN 110.5 becomes +110 +Rounding mode NEAREST-EVEN 111 becomes +111 +Rounding mode NEAREST-EVEN 111.099999999999994 becomes +111 +Rounding mode NEAREST-EVEN 111.5 becomes +112 +Rounding mode NEAREST-EVEN 111.900000000000006 becomes +112 +Rounding mode NEAREST-EVEN -110 becomes -110 +Rounding mode NEAREST-EVEN -110.099999999999994 becomes -110 +Rounding mode NEAREST-EVEN -110.5 becomes -110 +Rounding mode NEAREST-EVEN -111 becomes -111 +Rounding mode NEAREST-EVEN -111.099999999999994 becomes -111 +Rounding mode NEAREST-EVEN -111.5 becomes -112 +Rounding mode NEAREST-EVEN -111.900000000000006 becomes -112 +Rounding mode NEAREST-TOWARD-ZERO 111 becomes +111 +Rounding mode NEAREST-TOWARD-ZERO 111.099999999999994 becomes +111 +Rounding mode NEAREST-TOWARD-ZERO 111.5 becomes +111 +Rounding mode NEAREST-TOWARD-ZERO 111.900000000000006 becomes +112 +Rounding mode NEAREST-TOWARD-ZERO -111 becomes -111 +Rounding mode NEAREST-TOWARD-ZERO -111.099999999999994 becomes -111 +Rounding mode NEAREST-TOWARD-ZERO -111.5 becomes -111 +Rounding mode NEAREST-TOWARD-ZERO -111.900000000000006 becomes -112 +Rounding mode TOWARD-GREATER 111 becomes +111 +Rounding mode TOWARD-GREATER 111.099999999999994 becomes +112 +Rounding mode TOWARD-GREATER 111.5 becomes +112 +Rounding mode TOWARD-GREATER 111.900000000000006 becomes +112 +Rounding mode TOWARD-GREATER -111 becomes -111 +Rounding mode TOWARD-GREATER -111.099999999999994 becomes -111 +Rounding mode TOWARD-GREATER -111.5 becomes -111 +Rounding mode TOWARD-GREATER -111.900000000000006 becomes -111 +Rounding mode TOWARD-LESSER 111 becomes +111 +Rounding mode TOWARD-LESSER 111.099999999999994 becomes +111 +Rounding mode TOWARD-LESSER 111.5 becomes +111 +Rounding mode TOWARD-LESSER 111.900000000000006 becomes +111 +Rounding mode TOWARD-LESSER -111 becomes -111 +Rounding mode TOWARD-LESSER -111.099999999999994 becomes -112 +Rounding mode TOWARD-LESSER -111.5 becomes -112 +Rounding mode TOWARD-LESSER -111.900000000000006 becomes -112 +Rounding mode PROHIBITED - fits 111 becomes +111 + EXCEPTION STATUS IS "" +Rounding mode PROHIBITED - doesn't fit; no ON ERROR phrase 111.5 becomes +123 + EXCEPTION STATUS IS "EC-SIZE-TRUNCATION" +Rounding mode PROHIBITED - doesn't fit; ON ERROR phrase 111.5 becomes +123 + COMPUTE had an ON SIZE error + EXCEPTION STATUS IS "EC-SIZE-TRUNCATION" + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_NumericDisplay_from_COMPUTE.cob b/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_NumericDisplay_from_COMPUTE.cob new file mode 100644 index 00000000000..3138233a2f7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_NumericDisplay_from_COMPUTE.cob @@ -0,0 +1,428 @@ + *> { dg-do run } + *> { dg-output-file "group2/ROUNDING_omnibus_NumericDisplay_from_COMPUTE.out" } + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 VAR1 PICTURE S999V9. + 01 VAR2 PICTURE S999. + 01 SHOULD_BE PICTURE S999. + 01 RMODE PICTURE X(64). + 01 EMPTY PIC X VALUE " ". + 01 FLAG PIC X. + PROCEDURE DIVISION. + + DISPLAY "ROUNDING from NumericDisplay after COMPUTE." + + PERFORM truncation-e. + PERFORM truncation-m. + PERFORM nearest-away-from-zero-e. + PERFORM nearest-away-from-zero-m. + PERFORM away-from-zero-e. + PERFORM away-from-zero-m. + PERFORM nearest-even-e. + PERFORM nearest-even-m. + PERFORM nearest-toward-zero-e. + PERFORM nearest-toward-zero-m. + PERFORM toward-greater-e. + PERFORM toward-greater-m. + PERFORM toward-lesser-e. + PERFORM toward-lesser-m. + PERFORM prohibited-e. + GOBACK. + + truncation-e. + MOVE "TRUNCATION" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + + truncation-m. + MOVE "TRUNCATION" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TRUNCATION" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TRUNCATION = VAR1 + PERFORM SHOW_RESULTS. + + nearest-away-from-zero-e. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + nearest-away-from-zero-m. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-AWAY-FROM-ZERO" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + away-from-zero-e. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + away-from-zero-m. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "AWAY-FROM-ZERO" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE AWAY-FROM-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + nearest-even-e. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 110.0 TO VAR1 + MOVE 110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 110.1 TO VAR1 + MOVE 110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 110.5 TO VAR1 + MOVE 110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 110.9 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + MOVE "NEAREST-EVEN" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + + nearest-even-m. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -110.0 TO VAR1 + MOVE -110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -110.1 TO VAR1 + MOVE -110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -110.5 TO VAR1 + MOVE -110 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -110.9 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + MOVE "NEAREST-EVEN" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-EVEN" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-EVEN = VAR1 + PERFORM SHOW_RESULTS. + + nearest-toward-zero-e. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + nearest-toward-zero-m. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + MOVE "NEAREST-TOWARD-ZERO" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE NEAREST-TOWARD-ZERO = VAR1 + PERFORM SHOW_RESULTS. + + toward-greater-e. + MOVE "TOWARD-GREATER" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + + toward-greater-m. + MOVE "TOWARD-GREATER" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-GREATER" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-GREATER = VAR1 + PERFORM SHOW_RESULTS. + + toward-lesser-e. + MOVE "TOWARD-LESSER" TO RMODE + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE 111.1 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE 111.5 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE 111.9 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + + toward-lesser-m. + MOVE "TOWARD-LESSER" TO RMODE + MOVE -111.0 TO VAR1 + MOVE -111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE -111.1 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE -111.5 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + MOVE "TOWARD-LESSER" TO RMODE + MOVE -111.9 TO VAR1 + MOVE -112 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE TOWARD-LESSER = VAR1 + PERFORM SHOW_RESULTS. + + prohibited-e. + MOVE "PROHIBITED - fits" TO RMODE + SET LAST EXCEPTION TO OFF + MOVE 123 TO VAR2 + MOVE 111.0 TO VAR1 + MOVE 111 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE PROHIBITED = VAR1 + PERFORM SHOW_RESULTS + DISPLAY " EXCEPTION STATUS IS " + """" FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """". + + MOVE "PROHIBITED - doesn't fit; no ON ERROR phrase" TO RMODE + SET LAST EXCEPTION TO OFF + MOVE 123 TO VAR2 + MOVE 111.5 TO VAR1 + MOVE 123 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE PROHIBITED = VAR1 + PERFORM SHOW_RESULTS + DISPLAY " EXCEPTION STATUS IS " + """" FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """". + + MOVE "PROHIBITED - doesn't fit; ON ERROR phrase" TO RMODE + SET LAST EXCEPTION TO OFF + MOVE SPACE TO FLAG + MOVE 123 TO VAR2 + MOVE 111.5 TO VAR1 + MOVE 123 TO SHOULD_BE + COMPUTE VAR2 ROUNDED MODE PROHIBITED = VAR1 + ON SIZE ERROR MOVE 'X' TO FLAG + END-COMPUTE + PERFORM SHOW_RESULTS + IF FLAG EQUAL 'X' + DISPLAY " COMPUTE had an ON SIZE error" + END-IF. + DISPLAY " EXCEPTION STATUS IS " + """" FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """". + + SHOW_RESULTS. + DISPLAY "Rounding mode " FUNCTION TRIM(RMODE) + " " VAR1 " becomes " VAR2 + WITH NO ADVANCING + END-DISPLAY + IF VAR2 EQUALS SHOULD_BE + DISPLAY FUNCTION TRIM(EMPTY) + ELSE + DISPLAY " but it should be " SHOULD_BE + END-IF. + + diff --git a/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_NumericDisplay_from_COMPUTE.out b/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_NumericDisplay_from_COMPUTE.out new file mode 100644 index 00000000000..af94786bbdb --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/ROUNDING_omnibus_NumericDisplay_from_COMPUTE.out @@ -0,0 +1,71 @@ +ROUNDING from NumericDisplay after COMPUTE. +Rounding mode TRUNCATION +111.0 becomes +111 +Rounding mode TRUNCATION +111.1 becomes +111 +Rounding mode TRUNCATION +111.5 becomes +111 +Rounding mode TRUNCATION +111.9 becomes +111 +Rounding mode TRUNCATION -111.0 becomes -111 +Rounding mode TRUNCATION -111.1 becomes -111 +Rounding mode TRUNCATION -111.5 becomes -111 +Rounding mode TRUNCATION -111.9 becomes -111 +Rounding mode NEAREST-AWAY-FROM-ZERO +111.0 becomes +111 +Rounding mode NEAREST-AWAY-FROM-ZERO +111.1 becomes +111 +Rounding mode NEAREST-AWAY-FROM-ZERO +111.5 becomes +112 +Rounding mode NEAREST-AWAY-FROM-ZERO +111.9 becomes +112 +Rounding mode NEAREST-AWAY-FROM-ZERO -111.0 becomes -111 +Rounding mode NEAREST-AWAY-FROM-ZERO -111.1 becomes -111 +Rounding mode NEAREST-AWAY-FROM-ZERO -111.5 becomes -112 +Rounding mode NEAREST-AWAY-FROM-ZERO -111.9 becomes -112 +Rounding mode AWAY-FROM-ZERO +111.0 becomes +111 +Rounding mode AWAY-FROM-ZERO +111.1 becomes +112 +Rounding mode AWAY-FROM-ZERO +111.5 becomes +112 +Rounding mode AWAY-FROM-ZERO +111.9 becomes +112 +Rounding mode AWAY-FROM-ZERO -111.0 becomes -111 +Rounding mode AWAY-FROM-ZERO -111.1 becomes -112 +Rounding mode AWAY-FROM-ZERO -111.5 becomes -112 +Rounding mode AWAY-FROM-ZERO -111.9 becomes -112 +Rounding mode NEAREST-EVEN +110.0 becomes +110 +Rounding mode NEAREST-EVEN +110.1 becomes +110 +Rounding mode NEAREST-EVEN +110.5 becomes +110 +Rounding mode NEAREST-EVEN +111.0 becomes +111 +Rounding mode NEAREST-EVEN +111.1 becomes +111 +Rounding mode NEAREST-EVEN +111.5 becomes +112 +Rounding mode NEAREST-EVEN +111.9 becomes +112 +Rounding mode NEAREST-EVEN -110.0 becomes -110 +Rounding mode NEAREST-EVEN -110.1 becomes -110 +Rounding mode NEAREST-EVEN -110.5 becomes -110 +Rounding mode NEAREST-EVEN -111.0 becomes -111 +Rounding mode NEAREST-EVEN -111.1 becomes -111 +Rounding mode NEAREST-EVEN -111.5 becomes -112 +Rounding mode NEAREST-EVEN -111.9 becomes -112 +Rounding mode NEAREST-TOWARD-ZERO +111.0 becomes +111 +Rounding mode NEAREST-TOWARD-ZERO +111.1 becomes +111 +Rounding mode NEAREST-TOWARD-ZERO +111.5 becomes +111 +Rounding mode NEAREST-TOWARD-ZERO +111.9 becomes +112 +Rounding mode NEAREST-TOWARD-ZERO -111.0 becomes -111 +Rounding mode NEAREST-TOWARD-ZERO -111.1 becomes -111 +Rounding mode NEAREST-TOWARD-ZERO -111.5 becomes -111 +Rounding mode NEAREST-TOWARD-ZERO -111.9 becomes -112 +Rounding mode TOWARD-GREATER +111.0 becomes +111 +Rounding mode TOWARD-GREATER +111.1 becomes +112 +Rounding mode TOWARD-GREATER +111.5 becomes +112 +Rounding mode TOWARD-GREATER +111.9 becomes +112 +Rounding mode TOWARD-GREATER -111.0 becomes -111 +Rounding mode TOWARD-GREATER -111.1 becomes -111 +Rounding mode TOWARD-GREATER -111.5 becomes -111 +Rounding mode TOWARD-GREATER -111.9 becomes -111 +Rounding mode TOWARD-LESSER +111.0 becomes +111 +Rounding mode TOWARD-LESSER +111.1 becomes +111 +Rounding mode TOWARD-LESSER +111.5 becomes +111 +Rounding mode TOWARD-LESSER +111.9 becomes +111 +Rounding mode TOWARD-LESSER -111.0 becomes -111 +Rounding mode TOWARD-LESSER -111.1 becomes -112 +Rounding mode TOWARD-LESSER -111.5 becomes -112 +Rounding mode TOWARD-LESSER -111.9 becomes -112 +Rounding mode PROHIBITED - fits +111.0 becomes +111 + EXCEPTION STATUS IS "" +Rounding mode PROHIBITED - doesn't fit; no ON ERROR phrase +111.5 becomes +123 + EXCEPTION STATUS IS "EC-SIZE-TRUNCATION" +Rounding mode PROHIBITED - doesn't fit; ON ERROR phrase +111.5 becomes +123 + COMPUTE had an ON SIZE error + EXCEPTION STATUS IS "EC-SIZE-TRUNCATION" + diff --git a/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__1_.cob b/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__1_.cob new file mode 100644 index 00000000000..631b48e9afb --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__1_.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + *> { dg-output-file "group2/Separate_sign_positions__1_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC S9 VALUE -1 SIGN LEADING SEPARATE. + 01 Y PIC S9 VALUE -1 SIGN TRAILING SEPARATE. + PROCEDURE DIVISION. + DISPLAY X(1:1) X(2:1) NO ADVANCING + END-DISPLAY. + DISPLAY Y(1:1) Y(2:1) NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__1_.out b/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__1_.out new file mode 100644 index 00000000000..d981f48c783 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__1_.out @@ -0,0 +1 @@ +-11- diff --git a/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__2_.cob b/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__2_.cob new file mode 100644 index 00000000000..1c6b423e001 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__2_.cob @@ -0,0 +1,24 @@ + *> { dg-do run } + *> { dg-output-file "group2/Separate_sign_positions__2_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC S9 SIGN LEADING SEPARATE. + 01 Y PIC S9 SIGN TRAILING SEPARATE. + PROCEDURE DIVISION. + MOVE 0 TO X. + DISPLAY X NO ADVANCING + END-DISPLAY. + MOVE ZERO TO X. + DISPLAY X NO ADVANCING + END-DISPLAY. + MOVE 0 TO Y. + DISPLAY Y NO ADVANCING + END-DISPLAY. + MOVE ZERO TO Y. + DISPLAY Y NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__2_.out b/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__2_.out new file mode 100644 index 00000000000..6d2ea724ad0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Separate_sign_positions__2_.out @@ -0,0 +1 @@ ++0+00+0+ diff --git a/gcc/testsuite/cobol.dg/group2/Simple_TYPEDEF.cob b/gcc/testsuite/cobol.dg/group2/Simple_TYPEDEF.cob new file mode 100644 index 00000000000..c2fffbe672a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Simple_TYPEDEF.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + *> { dg-options "-dialect mf" } + + identification division. + program-id. wrapper. + data division. + working-storage section. + 77 UNS-CHAR PIC 9(02) COMP-5 IS TYPEDEF. + 01 Z-H3 PIC X(017) . + 01 I-H3A USAGE UNS-CHAR. + 01 I-H3B USAGE UNS-CHAR. + 78 I-H3-max VALUE LENGTH OF Z-H3. + procedure division. + goback. + end program wrapper. + diff --git a/gcc/testsuite/cobol.dg/group2/Simple_p-scaling.cob b/gcc/testsuite/cobol.dg/group2/Simple_p-scaling.cob new file mode 100644 index 00000000000..db3bc414840 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Simple_p-scaling.cob @@ -0,0 +1,33 @@ + *> { dg-do run } + *> { dg-output-file "group2/Simple_p-scaling.out" } + + identification division. + program-id. prog. + data division. + working-storage section. + 01 vars. + 05 vars01 picture 99ppp DISPLAY value 78000 . + 05 vars02 picture 99ppp BINARY value 78000 . + 05 vars03 picture 99ppp COMP-3 value 78000 . + 05 vars04 picture 99ppp COMP-5 value 78000 . + 05 vars05 picture 99ppp PACKED-DECIMAL value 78000 . + 01 vary. + 05 vary01 picture ppp99 DISPLAY value 0.00078 . + 05 vary02 picture ppp99 BINARY value 0.00078 . + 05 vary03 picture ppp99 COMP-3 value 0.00078 . + 05 vary04 picture ppp99 COMP-5 value 0.00078 . + 05 vary05 picture ppp99 PACKED-DECIMAL value 0.00078 . + procedure division. + display vars01 + display vars02 + display vars03 + display vars04 + display vars05 + display vary01 + display vary02 + display vary03 + display vary04 + display vary05 + goback. + end program prog. + diff --git a/gcc/testsuite/cobol.dg/group2/Simple_p-scaling.out b/gcc/testsuite/cobol.dg/group2/Simple_p-scaling.out new file mode 100644 index 00000000000..8d9c45c33a7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Simple_p-scaling.out @@ -0,0 +1,11 @@ +78000 +78000 +78000 +78000 +78000 +.00078 +.00078 +.00078 +.00078 +.00078 + diff --git a/gcc/testsuite/cobol.dg/group2/debugging_lines__WITH_DEBUGGING_MODE_.cob b/gcc/testsuite/cobol.dg/group2/debugging_lines__WITH_DEBUGGING_MODE_.cob new file mode 100644 index 00000000000..880d865b524 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/debugging_lines__WITH_DEBUGGING_MODE_.cob @@ -0,0 +1,21 @@ + *> { dg-do run } + *> { dg-options "-ffixed-form" } + *> { dg-output-file "group2/debugging_lines__WITH_DEBUGGING_MODE_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SOURCE-COMPUTER. mine WITH DEBUGGING MODE. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + * Original "incorrect ordered lines" + * DISPLAY "KO" NO ADVANCING UPON STDOUT + * END-DISPLAY. + D DISPLAY "KO" UPON STDOUT NO ADVANCING + D END-DISPLAY. + DISPLAY "OK" UPON STDOUT NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/debugging_lines__WITH_DEBUGGING_MODE_.out b/gcc/testsuite/cobol.dg/group2/debugging_lines__WITH_DEBUGGING_MODE_.out new file mode 100644 index 00000000000..6f0a25f53a2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/debugging_lines__WITH_DEBUGGING_MODE_.out @@ -0,0 +1 @@ +KOOK diff --git a/gcc/testsuite/cobol.dg/group2/debugging_lines__not_active_.cob b/gcc/testsuite/cobol.dg/group2/debugging_lines__not_active_.cob new file mode 100644 index 00000000000..56cb067c646 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/debugging_lines__not_active_.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/debugging_lines__not_active_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY "OK" NO ADVANCING + END-DISPLAY. + D DISPLAY "KO" NO ADVANCING + D END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/debugging_lines__not_active_.out b/gcc/testsuite/cobol.dg/group2/debugging_lines__not_active_.out new file mode 100644 index 00000000000..d86bac9de59 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/debugging_lines__not_active_.out @@ -0,0 +1 @@ +OK diff --git a/gcc/testsuite/cobol.dg/group2/integer_arithmetic_on_floating-point_var.cob b/gcc/testsuite/cobol.dg/group2/integer_arithmetic_on_floating-point_var.cob new file mode 100644 index 00000000000..bf7bd7833f2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/integer_arithmetic_on_floating-point_var.cob @@ -0,0 +1,29 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 x USAGE COMP-1 VALUE 123.456. + PROCEDURE DIVISION. + ADD 360 TO x + IF x > 483.457 OR x < 483.455 + DISPLAY "ADD wrong: " x + MOVE 483.456 TO x + END-IF + SUBTRACT 360 FROM x + IF x > 123.457 OR x < 123.455 + DISPLAY "SUBTRACT wrong: " x + MOVE 123.456 TO x + END-IF + DIVIDE 2 INTO x + IF x > 61.729 OR x < 61.727 + DISPLAY "DIVIDE wrong: " x + MOVE 61.728 TO x + END-IF + MULTIPLY 2 BY x + IF x > 123.457 OR x < 123.455 + DISPLAY "MULTIPLY wrong: " x + END-IF + GOBACK. +