diff options
Diffstat (limited to 'gcc/testsuite')
186 files changed, 5088 insertions, 9 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 422b365..25aca79 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,345 @@ +2025-04-04 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/119564 + * g++.dg/modules/gc-3_a.C: New test. + * g++.dg/modules/gc-3_b.C: New test. + +2025-04-04 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/119608 + * g++.dg/modules/pr119608_a.C: New test. + * g++.dg/modules/pr119608_b.C: New test. + +2025-04-04 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/119462 + * g++.dg/modules/noexcept-3_a.C: New test. + * g++.dg/modules/noexcept-3_b.C: New test. + * g++.dg/modules/noexcept-3_c.C: New test. + +2025-04-04 Bob Dubner <rdubner@symas.com> + + * cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.cob: New testcase. + * cobol.dg/group2/FUNCTION_ABS.cob: Likewise. + * cobol.dg/group2/FUNCTION_ACOS.cob: Likewise. + * cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.cob: Likewise. + * cobol.dg/group2/FUNCTION_ANNUITY.cob: Likewise. + * cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob: Likewise. + * cobol.dg/group2/FUNCTION_ASIN.cob: Likewise. + * cobol.dg/group2/FUNCTION_ATAN.cob: Likewise. + * cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.cob: Likewise. + * cobol.dg/group2/FUNCTION_BIGGER-POINTER.cob: Likewise. + * cobol.dg/group2/FUNCTION_BYTE-LENGTH.cob: Likewise. + * cobol.dg/group2/FUNCTION_CHAR.cob: Likewise. + * cobol.dg/group2/FUNCTION_COMBINED-DATETIME.cob: Likewise. + * cobol.dg/group2/FUNCTION_CONCAT___CONCATENATE.cob: Likewise. + * cobol.dg/group2/FUNCTION_CONCAT_with_reference_modding.cob: Likewise. + * cobol.dg/group2/FUNCTION_COS.cob: Likewise. + * cobol.dg/group2/FUNCTION_CURRENT-DATE.cob: Likewise. + * cobol.dg/group2/FUNCTION_DATE-OF-INTEGER.cob: Likewise. + * cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob: Likewise. + * cobol.dg/group2/FUNCTION_DATE-TO-YYYYMMDD.cob: Likewise. + * cobol.dg/group2/FUNCTION_DAY-OF-INTEGER.cob: Likewise. + * cobol.dg/group2/FUNCTION_DAY-TO-YYYYDDD.cob: Likewise. + * cobol.dg/group2/FUNCTION_E.cob: Likewise. + * cobol.dg/group2/FUNCTION_EXCEPTION-FILE.cob: Likewise. + * cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.cob: Likewise. + * cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.cob: Likewise. + * cobol.dg/group2/FUNCTION_EXP10.cob: Likewise. + * cobol.dg/group2/FUNCTION_EXP.cob: Likewise. + * cobol.dg/group2/FUNCTION_FACTORIAL.cob: Likewise. + * cobol.dg/group2/FUNCTION_FORMATTED-DATE.cob: Likewise. + * cobol.dg/group2/FUNCTION_FORMATTED-DATETIME.cob: Likewise. + * cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.cob: Likewise. + * cobol.dg/group2/FUNCTION_FORMATTED-DATETIME_with_ref_modding.cob: Likewise. + * cobol.dg/group2/FUNCTION_FORMATTED-DATE_with_ref_modding.cob: Likewise. + * cobol.dg/group2/FUNCTION_FORMATTED-TIME_DP.COMMA.cob: Likewise. + * cobol.dg/group2/FUNCTION_FORMATTED-TIME_with_ref_modding.cob: Likewise. + * cobol.dg/group2/FUNCTION_FRACTION-PART.cob: Likewise. + * cobol.dg/group2/FUNCTION_HEX-OF.cob: Likewise. + * cobol.dg/group2/FUNCTION_HIGHEST-ALGEBRAIC.cob: Likewise. + * cobol.dg/group2/FUNCTION_INTEGER.cob: Likewise. + * cobol.dg/group2/FUNCTION_INTEGER-OF-DATE.cob: Likewise. + * cobol.dg/group2/FUNCTION_INTEGER-OF-DAY.cob: Likewise. + * cobol.dg/group2/FUNCTION_INTEGER-OF-FORMATTED-DATE.cob: Likewise. + * cobol.dg/group2/FUNCTION_INTEGER-PART.cob: Likewise. + * cobol.dg/group2/FUNCTION_LENGTH__1_.cob: Likewise. + * cobol.dg/group2/FUNCTION_LENGTH__2_.cob: Likewise. + * cobol.dg/group2/FUNCTION_LOCALE-COMPARE.cob: Likewise. + * cobol.dg/group2/FUNCTION_LOCALE-DATE.cob: Likewise. + * cobol.dg/group2/FUNCTION_LOCALE-TIME.cob: Likewise. + * cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.cob: Likewise. + * cobol.dg/group2/FUNCTION_LOG10.cob: Likewise. + * cobol.dg/group2/FUNCTION_LOG.cob: Likewise. + * cobol.dg/group2/FUNCTION_LOWER-CASE.cob: Likewise. + * cobol.dg/group2/FUNCTION_LOWER-CASE_with_reference_modding.cob: Likewise. + * cobol.dg/group2/FUNCTION_LOWEST-ALGEBRAIC.cob: Likewise. + * cobol.dg/group2/FUNCTION_MAX.cob: Likewise. + * cobol.dg/group2/FUNCTION_MEAN.cob: Likewise. + * cobol.dg/group2/FUNCTION_MEDIAN.cob: Likewise. + * cobol.dg/group2/FUNCTION_MIDRANGE.cob: Likewise. + * cobol.dg/group2/FUNCTION_MIN.cob: Likewise. + * cobol.dg/group2/FUNCTION_MOD__invalid_.cob: Likewise. + * cobol.dg/group2/FUNCTION_MODULE-NAME.cob: Likewise. + * cobol.dg/group2/FUNCTION_MOD__valid_.cob: Likewise. + * cobol.dg/group2/FUNCTION_NUMVAL-C.cob: Likewise. + * cobol.dg/group2/FUNCTION_NUMVAL-C_DP.COMMA.cob: Likewise. + * cobol.dg/group2/FUNCTION_NUMVAL.cob: Likewise. + * cobol.dg/group2/FUNCTION_NUMVAL-F.cob: Likewise. + * cobol.dg/group2/FUNCTION_ORD.cob: Likewise. + * cobol.dg/group2/FUNCTION_ORD-MAX.cob: Likewise. + * cobol.dg/group2/FUNCTION_ORD-MIN.cob: Likewise. + * cobol.dg/group2/FUNCTION_PI.cob: Likewise. + * cobol.dg/group2/FUNCTION_PRESENT-VALUE.cob: Likewise. + * cobol.dg/group2/FUNCTION_RANDOM.cob: Likewise. + * cobol.dg/group2/FUNCTION_RANGE.cob: Likewise. + * cobol.dg/group2/FUNCTION_REM__invalid_.cob: Likewise. + * cobol.dg/group2/FUNCTION_REM__valid_.cob: Likewise. + * cobol.dg/group2/FUNCTION_REVERSE.cob: Likewise. + * cobol.dg/group2/FUNCTION_REVERSE_with_reference_modding.cob: Likewise. + * cobol.dg/group2/FUNCTION_SECONDS-FROM-FORMATTED-TIME.cob: Likewise. + * cobol.dg/group2/FUNCTION_SECONDS-PAST-MIDNIGHT.cob: Likewise. + * cobol.dg/group2/FUNCTION_SIGN.cob: Likewise. + * cobol.dg/group2/FUNCTION_SIN.cob: Likewise. + * cobol.dg/group2/FUNCTION_SQRT.cob: Likewise. + * cobol.dg/group2/FUNCTION_STANDARD-DEVIATION.cob: Likewise. + * cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE.cob: Likewise. + * cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE_with_reference_mod.cob: Likewise. + * cobol.dg/group2/FUNCTION_SUBSTITUTE.cob: Likewise. + * cobol.dg/group2/FUNCTION_SUBSTITUTE_with_reference_modding.cob: Likewise. + * cobol.dg/group2/FUNCTION_SUM.cob: Likewise. + * cobol.dg/group2/FUNCTION_TAN.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__2_.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_additional.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_DP.COMMA.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_dates.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_datetimes.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_times.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-NUMVAL-C.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-NUMVAL.cob: Likewise. + * cobol.dg/group2/FUNCTION_TEST-NUMVAL-F.cob: Likewise. + * cobol.dg/group2/FUNCTION_TRIM.cob: Likewise. + * cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.cob: Likewise. + * cobol.dg/group2/FUNCTION_TRIM_zero_length.cob: Likewise. + * cobol.dg/group2/FUNCTION_UPPER-CASE.cob: Likewise. + * cobol.dg/group2/FUNCTION_UPPER-CASE_with_reference_modding.cob: Likewise. + * cobol.dg/group2/FUNCTION_VARIANCE.cob: Likewise. + * cobol.dg/group2/FUNCTION_WHEN-COMPILED.cob: Likewise. + * cobol.dg/group2/FUNCTION_YEAR-TO-YYYY.cob: Likewise. + * cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__2_.cob: Likewise. + * cobol.dg/group2/Program-to-program_parameters_and_retvals.cob: Likewise. + * cobol.dg/group2/Recursive_FUNCTION_with_local-storage.cob: Likewise. + * cobol.dg/group2/Repository_functions_clause.cob: Likewise. + * cobol.dg/group2/UDF_fibonacci_recursion.cob: Likewise. + * cobol.dg/group2/UDF_in_COMPUTE.cob: Likewise. + * cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.cob: Likewise. + * cobol.dg/group2/UDF_with_recursion.cob: Likewise. + * cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.out: New known-good file. + * cobol.dg/group2/FUNCTION_ABS.out: Likewise. + * cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.out: Likewise. + * cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out: Likewise. + * cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.out: Likewise. + * cobol.dg/group2/FUNCTION_BIGGER-POINTER.out: Likewise. + * cobol.dg/group2/FUNCTION_BYTE-LENGTH.out: Likewise. + * cobol.dg/group2/FUNCTION_EXCEPTION-FILE.out: Likewise. + * cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.out: Likewise. + * cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.out: Likewise. + * cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.out: Likewise. + * cobol.dg/group2/FUNCTION_HEX-OF.out: Likewise. + * cobol.dg/group2/FUNCTION_LENGTH__2_.out: Likewise. + * cobol.dg/group2/FUNCTION_LOCALE-DATE.out: Likewise. + * cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.out: Likewise. + * cobol.dg/group2/FUNCTION_LOCALE-TIME.out: Likewise. + * cobol.dg/group2/FUNCTION_MAX.out: Likewise. + * cobol.dg/group2/FUNCTION_MEAN.out: Likewise. + * cobol.dg/group2/FUNCTION_MEDIAN.out: Likewise. + * cobol.dg/group2/FUNCTION_MIDRANGE.out: Likewise. + * cobol.dg/group2/FUNCTION_MIN.out: Likewise. + * cobol.dg/group2/FUNCTION_MODULE-NAME.out: Likewise. + * cobol.dg/group2/FUNCTION_NUMVAL-F.out: Likewise. + * cobol.dg/group2/FUNCTION_ORD-MAX.out: Likewise. + * cobol.dg/group2/FUNCTION_ORD-MIN.out: Likewise. + * cobol.dg/group2/FUNCTION_ORD.out: Likewise. + * cobol.dg/group2/FUNCTION_PRESENT-VALUE.out: Likewise. + * cobol.dg/group2/FUNCTION_SUBSTITUTE.out: Likewise. + * cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.out: Likewise. + * cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.out: Likewise. + * cobol.dg/group2/FUNCTION_TRIM.out: Likewise. + * cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.out: Likewise. + * cobol.dg/group2/FUNCTION_TRIM_zero_length.out: Likewise. + * cobol.dg/group2/Program-to-program_parameters_and_retvals.out: Likewise. + * cobol.dg/group2/Recursive_FUNCTION_with_local-storage.out: Likewise. + * cobol.dg/group2/Repository_functions_clause.out: Likewise. + * cobol.dg/group2/UDF_fibonacci_recursion.out: Likewise. + * cobol.dg/group2/UDF_in_COMPUTE.out: Likewise. + * cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.out: Likewise. + * cobol.dg/group2/UDF_with_recursion.out: Likewise. + +2025-04-04 Jason Merrill <jason@redhat.com> + + PR c++/99546 + PR c++/113925 + PR c++/106976 + PR c++/109961 + PR c++/117336 + * g++.dg/cpp2a/lambda-requires2.C: New test. + * g++.dg/cpp2a/lambda-requires3.C: New test. + * g++.dg/cpp2a/lambda-requires4.C: New test. + * g++.dg/cpp2a/lambda-requires5.C: New test. + +2025-04-04 Jakub Jelinek <jakub@redhat.com> + + PR gcov-profile/119618 + * c-c++-common/pr119618.c: New test. + +2025-04-04 Jakub Jelinek <jakub@redhat.com> + + PR tree-optimization/119616 + * c-c++-common/pr119616.c: New test. + +2025-04-04 Jakub Jelinek <jakub@redhat.com> + + PR middle-end/119613 + * g++.dg/opt/pr119613.C: New test. + +2025-04-04 Jakub Jelinek <jakub@redhat.com> + + PR target/115910 + * gcc.target/i386/pr115910.c: New test. + +2025-04-04 Patrick Palka <ppalka@redhat.com> + + PR c++/117849 + * g++.dg/cpp2a/concepts-requires41.C: New test. + +2025-04-04 Andrew Pinski <quic_apinski@quicinc.com> + + PR ipa/119599 + * gcc.dg/torture/pr119599-1.c: New test. + * gcc.dg/builtin-apply5.c: New test. + +2025-04-04 Jakub Jelinek <jakub@redhat.com> + + PR preprocessor/119391 + * g++.dg/cpp/pr119391.C: New test. + +2025-04-04 Richard Earnshaw <rearnsha@arm.com> + + * gcc.target/arm/mve/mve.exp: Save dg-do-what-default before + changing it. Restore it once done. + +2025-04-04 Jakub Jelinek <jakub@redhat.com> + + PR tree-optimization/119614 + * c-c++-common/pr119614-1.c: New test. + * c-c++-common/pr119614-2.c: New test. + * c-c++-common/pr119614-3.c: New test. + +2025-04-03 Thomas Schwinge <tschwinge@baylibre.com> + + PR target/119573 + * gcc.c-torture/compile/pr46534.c: Don't 'dg-skip-if' nvptx. + * gcc.target/nvptx/decl.c: Adjust. + +2025-04-03 Jason Merrill <jason@redhat.com> + + * g++.dg/cpp2a/spaceship-rewrite6.C: New test. + +2025-04-03 Victor Do Nascimento <victor.donascimento@arm.com> + + PR testsuite/118597 + * gcc.dg/vect/vect-fncall-mask.c: Update test directives. + +2025-04-03 Bob Dubner <rdubner@symas.com> + + * cobol.dg/group2/INSPECT_BACKWARD_REPLACING_LEADING.cob: New testcase. + * cobol.dg/group2/INSPECT_BACKWARD_REPLACING_TRAILING.cob: Likewise. + * cobol.dg/group2/INSPECT_BACKWARD_simple_CONVERTING.cob: Likewise. + * cobol.dg/group2/INSPECT_BACKWARD_simple_REPLACING.cob: Likewise. + * cobol.dg/group2/INSPECT_BACKWARD_simple_TALLYING.cob: Likewise. + * cobol.dg/group2/INSPECT_CONVERTING_NULL.cob: Likewise. + * cobol.dg/group2/INSPECT_CONVERTING_TO_figurative_constant.cob: Likewise. + * cobol.dg/group2/INSPECT_CONVERTING_TO_figurative_constants.cob: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_1.cob: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_2.cob: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_3.cob: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_4.cob: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_5.cob: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_5-f.cob: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_5-r.cob: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_6.cob: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_7.cob: Likewise. + * cobol.dg/group2/INSPECT_No_repeat_conversion_check.cob: Likewise. + * cobol.dg/group2/INSPECT_REPLACING_figurative_constant.cob: Likewise. + * cobol.dg/group2/INSPECT_REPLACING_LEADING_ZEROS_BY_SPACES.cob: Likewise. + * cobol.dg/group2/INSPECT_TALLYING_AFTER.cob: Likewise. + * cobol.dg/group2/INSPECT_TALLYING_BEFORE.cob: Likewise. + * cobol.dg/group2/INSPECT_TALLYING_REPLACING_ISO_Example.cob: Likewise. + * cobol.dg/group2/INSPECT_TRAILING.cob: Likewise. + * cobol.dg/group2/INSPECT_BACKWARD_REPLACING_LEADING.out: New known-good result. + * cobol.dg/group2/INSPECT_BACKWARD_REPLACING_TRAILING.out: Likewise. + * cobol.dg/group2/INSPECT_BACKWARD_simple_CONVERTING.out: Likewise. + * cobol.dg/group2/INSPECT_BACKWARD_simple_REPLACING.out: Likewise. + * cobol.dg/group2/INSPECT_BACKWARD_simple_TALLYING.out: Likewise. + * cobol.dg/group2/INSPECT_CONVERTING_TO_figurative_constants.out: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_1.out: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_2.out: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_3.out: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_4.out: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_5-f.out: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_5.out: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_5-r.out: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_6.out: Likewise. + * cobol.dg/group2/INSPECT_ISO_Example_7.out: Likewise. + * cobol.dg/group2/INSPECT_TALLYING_REPLACING_ISO_Example.out: Likewise. + * cobol.dg/group2/INSPECT_TRAILING.out: Likewise. + +2025-04-03 Andrew Pinski <quic_apinski@quicinc.com> + Jakub Jelinek <jakub@redhat.com> + + PR c++/119563 + * g++.dg/cpp0x/pr119563.C: New test. + * g++.dg/cpp/embed-26.C: New test. + +2025-04-03 Christophe Lyon <christophe.lyon@linaro.org> + + * gcc.dg/guality/pr90074.c: Remove xfail for aarch64. + * gcc.dg/guality/pr90716.c: Likewise. + +2025-04-03 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE> + + * gcc.target/i386/pr111673.c (dg-options): Add + -fasynchronous-unwind-tables -fdwarf2-cfi-asm. + * gcc.target/i386/pr82142a.c: Likewise. + * gcc.target/i386/pr82142b.c (dg-options): Add -mno-stackrealign + -fasynchronous-unwind-tables -fdwarf2-cfi-asm. + +2025-04-03 Alexandre Oliva <oliva@adacore.com> + + * gcc.target/riscv/rvv/base/vwaddsub-1.c: Require rv64. + +2025-04-03 Alexandre Oliva <oliva@adacore.com> + + * gcc.target/riscv/mcpu-xiangshan-nanhu.c: Skip on non-rv64. + +2025-04-03 Alexandre Oliva <oliva@adacore.com> + + PR tree-optimization/113281 + * gcc.dg/vect/costmodel/riscv/rvv/pr113281-1.c: XFAIL. + * gcc.dg/vect/costmodel/riscv/rvv/pr113281-2.c: Likewise. + * gcc.dg/vect/costmodel/riscv/rvv/pr113281-5.c: Likewise. + +2025-04-03 Alexandre Oliva <oliva@adacore.com> + + * gcc.dg/tree-ssa/ssa-dom-cse-2.c: XFAIL on riscv lp64. + +2025-04-03 Hongyu Wang <hongyu.wang@intel.com> + + PR target/119539 + * gcc.target/i386/apx-nf-pr119539.c: New test. + 2025-04-02 Jin Ma <jinma@linux.alibaba.com> * gcc.target/riscv/zba-shNadd-09.c: New test. diff --git a/gcc/testsuite/c-c++-common/pr119614-1.c b/gcc/testsuite/c-c++-common/pr119614-1.c new file mode 100644 index 0000000..89105a3 --- /dev/null +++ b/gcc/testsuite/c-c++-common/pr119614-1.c @@ -0,0 +1,28 @@ +/* PR tree-optimization/119614 */ +/* { dg-do compile { target musttail } } */ +/* { dg-options "-O2" } */ + +volatile int v; + +[[gnu::noinline]] const char * +foo (int x) +{ + v += x; + return 0; +} + +const char * +bar (int x) +{ + if (x == 42) + [[gnu::musttail]] return foo (42); + [[gnu::musttail]] return foo (32); +} + +const char * +baz (int x) +{ + if (x == 5) + return foo (42); + return foo (32); +} diff --git a/gcc/testsuite/c-c++-common/pr119614-2.c b/gcc/testsuite/c-c++-common/pr119614-2.c new file mode 100644 index 0000000..8833eee --- /dev/null +++ b/gcc/testsuite/c-c++-common/pr119614-2.c @@ -0,0 +1,28 @@ +/* PR tree-optimization/119614 */ +/* { dg-do compile { target musttail } } */ +/* { dg-options "-O2" } */ + +volatile int v; + +[[gnu::noinline]] const char * +foo (int x) +{ + v += x; + return (const char *) -42; +} + +const char * +bar (int x) +{ + if (x == 42) + [[gnu::musttail]] return foo (42); + [[gnu::musttail]] return foo (32); +} + +const char * +baz (int x) +{ + if (x == 5) + return foo (42); + return foo (32); +} diff --git a/gcc/testsuite/c-c++-common/pr119614-3.c b/gcc/testsuite/c-c++-common/pr119614-3.c new file mode 100644 index 0000000..59ed36b --- /dev/null +++ b/gcc/testsuite/c-c++-common/pr119614-3.c @@ -0,0 +1,28 @@ +/* PR tree-optimization/119614 */ +/* { dg-do compile { target musttail } } */ +/* { dg-options "-O2" } */ + +volatile int v; + +[[gnu::noinline]] double +foo (int x) +{ + v += x; + return 0.5; +} + +double +bar (int x) +{ + if (x == 42) + [[gnu::musttail]] return foo (42); + [[gnu::musttail]] return foo (32); +} + +double +baz (int x) +{ + if (x == 5) + return foo (42); + return foo (32); +} diff --git a/gcc/testsuite/c-c++-common/pr119616.c b/gcc/testsuite/c-c++-common/pr119616.c new file mode 100644 index 0000000..5ffdb8c --- /dev/null +++ b/gcc/testsuite/c-c++-common/pr119616.c @@ -0,0 +1,23 @@ +/* PR tree-optimization/119616 */ +/* { dg-do compile { target external_musttail } } */ +/* { dg-options "-O2" } */ + +int foo (int *); +int bar (int); + +int +baz (int x) +{ + if (!x) + [[gnu::musttail]] return bar (x); + return foo (&x); +} + +int +qux (int x) +{ + if (!x) + [[gnu::musttail]] return bar (x); + foo (&x); + return 1; +} diff --git a/gcc/testsuite/c-c++-common/pr119618.c b/gcc/testsuite/c-c++-common/pr119618.c new file mode 100644 index 0000000..a56e669 --- /dev/null +++ b/gcc/testsuite/c-c++-common/pr119618.c @@ -0,0 +1,21 @@ +/* PR gcov-profile/119618 */ +/* { dg-do compile { target musttail } } */ +/* { dg-options "-fcompare-debug -fprofile-generate -O1" } */ +/* { dg-require-profiling "-fprofile-generate" } */ + +struct S { char s; }; +int foo (void); +int *(*fn) (void); + +int * +bar (void) +{ + if (foo ()) + return 0; + { + struct S s; + do + [[gnu::musttail]] return fn (); + while (0); + } +} diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.cob new file mode 100644 index 0000000..3f4049b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_ABS.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC S9(4)V9(4) VALUE -1.2345. + PROCEDURE DIVISION. + COMPUTE X = FUNCTION ABS( X ) + DISPLAY X + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.out new file mode 100644 index 0000000..ab39cfe --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.out @@ -0,0 +1,2 @@ ++0001.2345 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ACOS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ACOS.cob new file mode 100644 index 0000000..73e192f --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ACOS.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC S9V9(33). + PROCEDURE DIVISION. + MOVE FUNCTION ACOS ( -0.2345 ) TO Z. + IF Z NOT = 1.807500521108243435101500438523210 + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.cob new file mode 100644 index 0000000..276c33f --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.cob @@ -0,0 +1,17 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_ALL_INTRINSIC_simple_test.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. phase0. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + DATA DIVISION. + WORKING-STORAGE SECTION. + 77 work-string pic X(80) VALUE " ABC ". + PROCEDURE DIVISION. + DISPLAY """" TRIM(work-string) """" + goback. + end program phase0. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.out new file mode 100644 index 0000000..7b9bc93 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.out @@ -0,0 +1,2 @@ +"ABC" + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ANNUITY.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ANNUITY.cob new file mode 100644 index 0000000..29049dd --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ANNUITY.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC S9V9(33). + PROCEDURE DIVISION. + MOVE FUNCTION ANNUITY ( 3, 5 ) TO Z. + IF Z NOT = 3.002932551319648093841642228739003 + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ASIN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ASIN.cob new file mode 100644 index 0000000..b364a40 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ASIN.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(33). + PROCEDURE DIVISION. + MOVE FUNCTION ASIN ( -0.2345 ) TO Y. + IF Y NOT = -0.236704194313346815870178746883458 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ATAN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ATAN.cob new file mode 100644 index 0000000..1f884ce --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ATAN.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(33). + PROCEDURE DIVISION. + MOVE FUNCTION ATAN ( 1 ) TO Y. + IF Y NOT = 0.785398163397448309615660845819875 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.cob new file mode 100644 index 0000000..70b40ba --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.cob @@ -0,0 +1,40 @@ + *> { dg-do run } + *> { dg-options "-dialect ibm" } + *> { dg-output-file "group2/FUNCTION_BIGGER-POINTER.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 N PIC S9(8) COMP-5 value 0. + 01 P REDEFINES N POINTER. + 01 FILLER. + 05 X PIC A(4) VALUE "ABC". + 05 E REDEFINES X PIC A(1) OCCURS 4. + LINKAGE SECTION. + 77 B PIC A. + + PROCEDURE DIVISION. + set P to address of E(1). + + display FUNCTION trim(x) '.' + + set address of B to p. + perform until B = SPACE + display B no advancing + set p up by 1 + set address of B to p + end-perform + display '.' + + set P to address of E(1) + set address of B to p + perform until B = SPACES + display B no advancing + add 1 to N + set address of B to p + end-perform + display '.' + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.out new file mode 100644 index 0000000..d31e83b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.out @@ -0,0 +1,4 @@ +ABC. +ABC. +ABC. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.cob new file mode 100644 index 0000000..d6d04d1 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.cob @@ -0,0 +1,22 @@ + *> { dg-do run } + *> { dg-options "-dialect ibm" } + *> { dg-output-file "group2/FUNCTION_BIGGER-POINTER__2_.out" } + + identification division. + program-id. prog. + data division. + working-storage section. + 01 n4 pic s9(8) comp-5 value 0. + 01 p4 redefines n4 pointer. + 01 n8 pic s9(16) comp-5 value 0. + 01 p8 redefines n8 pointer. + procedure division. + move -1 to n8 + set p4 to p8 + display "P4 and P8 before: " p4 space p8 + display "Increment N4 and N8" + add 1 to n4 n8 + display "P4 and P8 after: " p4 space p8 + goback. + end program prog. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.out new file mode 100644 index 0000000..b15a754 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.out @@ -0,0 +1,4 @@ +P4 and P8 before: 0xffffffffffffffff 0xffffffffffffffff +Increment N4 and N8 +P4 and P8 after: 0x0000000000000000 0x0000000000000000 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.cob new file mode 100644 index 0000000..9a5f384 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.cob @@ -0,0 +1,20 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_BYTE-LENGTH.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(4). + 01 TEST-FLD PIC S9(04)V9(08). + PROCEDURE DIVISION. + MOVE FUNCTION BYTE-LENGTH ( TEST-FLD ) TO TEST-FLD. + DISPLAY "BYTE-LENGTH of PIC S9(04)V9(08) is " TEST-FLD + MOVE FUNCTION BYTE-LENGTH ( X ) TO TEST-FLD. + DISPLAY "BYTE-LENGTH of PIC X(4) is " TEST-FLD + MOVE FUNCTION BYTE-LENGTH ( '00128' ) TO TEST-FLD + DISPLAY "BYTE-LENGTH of PIC '00128' is " TEST-FLD + MOVE FUNCTION BYTE-LENGTH ( x'a0' ) TO TEST-FLD + DISPLAY "BYTE-LENGTH of PIC x'a0' is " TEST-FLD + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.out new file mode 100644 index 0000000..64ad515 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.out @@ -0,0 +1,5 @@ +BYTE-LENGTH of PIC S9(04)V9(08) is +0012.00000000 +BYTE-LENGTH of PIC X(4) is +0004.00000000 +BYTE-LENGTH of PIC '00128' is +0005.00000000 +BYTE-LENGTH of PIC x'a0' is +0001.00000000 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_CHAR.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_CHAR.cob new file mode 100644 index 0000000..955cc51 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_CHAR.cob @@ -0,0 +1,29 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC S9(4)V9(4) VALUE 108. + 01 TEST-FLD. + 05 TEST-DATA PIC X(01). + 88 VALID-DATA VALUE 'k'. + 05 TEST-UNSET PIC X VALUE '_'. + 88 VALID-UNSET VALUE '_'. + PROCEDURE DIVISION. + STRING FUNCTION CHAR ( X ) + DELIMITED BY SIZE + INTO TEST-FLD + END-STRING. + EVALUATE TRUE + WHEN NOT VALID-UNSET + DISPLAY "FUNCTION result too long" + END-DISPLAY + WHEN VALID-DATA + CONTINUE + WHEN OTHER + DISPLAY TEST-DATA + END-DISPLAY + END-EVALUATE. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_COMBINED-DATETIME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_COMBINED-DATETIME.cob new file mode 100644 index 0000000..3f9c6e1 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_COMBINED-DATETIME.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD PIC S9(04)V9(08). + PROCEDURE DIVISION. + MOVE FUNCTION COMBINED-DATETIME ( 987, 345.6 ) + TO TEST-FLD. + IF TEST-FLD NOT = 987.003456 + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT___CONCATENATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT___CONCATENATE.cob new file mode 100644 index 0000000..d982432 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT___CONCATENATE.cob @@ -0,0 +1,36 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC X(4). + 01 TEST-FLD. + 05 TEST-DATA PIC X(14). + 88 VALID-DATA VALUE 'defxabczz55666'. + 05 TEST-UNSET PIC X VALUE '_'. + 88 VALID-UNSET VALUE '_'. + PROCEDURE DIVISION. + MOVE "defx" TO Y. + STRING FUNCTION CONCAT ( Y "abc" "zz" "55" "666" ) + DELIMITED BY SIZE + INTO TEST-FLD + END-STRING. + EVALUATE TRUE + WHEN NOT VALID-UNSET + DISPLAY "FUNCTION result too long" + END-DISPLAY + WHEN TEST-DATA + <> FUNCTION CONCAT ( Y "abc" "zz" "55" "666" ) + DISPLAY "CONCAT issue, '" TEST-DATA + "' vs. '" + FUNCTION CONCAT ( Y "abc" "zz" "55" "666" ) "'" + END-DISPLAY + WHEN VALID-DATA + CONTINUE + WHEN OTHER + DISPLAY TEST-DATA + END-DISPLAY + END-EVALUATE. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT_with_reference_modding.cob new file mode 100644 index 0000000..98f21c3 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT_with_reference_modding.cob @@ -0,0 +1,19 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC X(4). + 01 TEST-FLD PIC X(9) VALUE SPACES. + PROCEDURE DIVISION. + MOVE 'defx' TO Y. + MOVE FUNCTION CONCAT + ( Y "abc" "zz" "55" "666" ) (2 : 9) + TO TEST-FLD. + IF TEST-FLD NOT = 'efxabczz5' + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_COS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_COS.cob new file mode 100644 index 0000000..6651b9d --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_COS.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(33). + PROCEDURE DIVISION. + MOVE FUNCTION COS ( -0.2345 ) TO Y. + IF Y NOT = 0.972630641256258184713416962414561 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_CURRENT-DATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_CURRENT-DATE.cob new file mode 100644 index 0000000..429f247 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_CURRENT-DATE.cob @@ -0,0 +1,62 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD. + 02 WS-YEAR PIC 9(04). + 88 VALID-YEAR VALUE 1980 THRU 9999. + 02 WS-MONTH PIC 9(02). + 88 VALID-MONTH VALUE 01 THRU 12. + 02 WS-DAY PIC 9(02). + 88 VALID-DAY VALUE 01 THRU 31. + 02 WS-HOUR PIC 9(02). + 88 VALID-HOUR VALUE 00 THRU 23. + 02 WS-MIN PIC 9(02). + 88 VALID-MIN VALUE 00 THRU 59. + 02 WS-SEVALIDD PIC 9(02). + 88 VALID-SEC VALUE 00 THRU 59. + 02 WS-HUNDSEC PIC 9(02). + 88 VALID-HUNDSEC VALUE 00 THRU 99. + 02 WS-GREENW PIC X. + 88 VALID-GREENW VALUE "-", "+", "0". + 88 ZERO-GREENW VALUE "0". + 02 WS-OFFSET PIC 9(02). + 88 VALID-OFFSET VALUE 00 THRU 13. + 88 ZERO-OFFSET VALUE 00. + 02 WS-OFFSET2 PIC 9(02). + 88 VALID-OFFSET2 VALUE 00 THRU 59. + 88 ZERO-OFFSET2 VALUE 00. + 02 WS-UNSET PIC X VALUE '_'. + 88 VALID-UNSET VALUE '_'. + PROCEDURE DIVISION. + STRING FUNCTION CURRENT-DATE + DELIMITED BY SIZE + INTO TEST-FLD + END-STRING. + EVALUATE TRUE + WHEN NOT VALID-UNSET + DISPLAY "FUNCTION result too long" + END-DISPLAY + WHEN VALID-YEAR AND + VALID-MONTH AND + VALID-DAY AND + VALID-HOUR AND + VALID-MIN AND + VALID-SEC AND + VALID-HUNDSEC AND + VALID-GREENW AND + VALID-OFFSET AND + VALID-OFFSET2 AND + VALID-UNSET AND + ((NOT ZERO-GREENW) OR (ZERO-OFFSET AND ZERO-OFFSET2)) + CONTINUE + WHEN OTHER + DISPLAY "CURRENT-DATE with wrong format: " + TEST-FLD (01:21) + END-DISPLAY + END-EVALUATE. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-OF-INTEGER.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-OF-INTEGER.cob new file mode 100644 index 0000000..708aa96 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-OF-INTEGER.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD PIC S9(09)V9(02). + PROCEDURE DIVISION. + MOVE FUNCTION DATE-OF-INTEGER ( 146000 ) + TO TEST-FLD. + IF TEST-FLD NOT = 20000925 + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-TO-YYYYMMDD.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-TO-YYYYMMDD.cob new file mode 100644 index 0000000..5b2bd43 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-TO-YYYYMMDD.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD PIC S9(09)V9(02). + PROCEDURE DIVISION. + MOVE FUNCTION DATE-TO-YYYYMMDD ( 981002, -10, 1994 ) + TO TEST-FLD. + IF TEST-FLD NOT = 018981002 + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob new file mode 100644 index 0000000..bb48bb0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob @@ -0,0 +1,334 @@ + *> { dg-do run } + + identification division. + program-id. test. + *> Tests all the DATE and TIME functions + *> + *> The various functions are used to test each other. + *> + *> COMBINED-DATETIME OK + *> CURRENT_DATE OK + *> DATE-OF-INTEGER OK + *> DATE-TO-YYYYMMDD OK + *> DAY-OF-INTEGER OK + *> DAY-TO-YYYYDDD OK + *> FORMATTED-CURRENT-DATE OK + *> FORMATTED-DATE OK + *> FORMATTED-DATETIME OK + *> FORMATTED-TIME OK + *> INTEGER-OF-DATE OK + *> INTEGER-OF-DAY OK + *> INTEGER-OF-FORMATTED-DATE OK + *> SECONDS-FROM-FORMATTED-TIME OK + *> SECONDS-PAST-MIDNIGHT OK + *> TEST-DATE-YYYYMMDD OK + *> TEST-DAY-YYYYDDD OK + *> TEST-FORMATTED-DATETIME OK + *> + data division. + working-storage section. + + 01 checking pic x(80). + 01 should-be pic x(32). + 01 but-is pic x(32). + 01 but-is-n redefines but-is pic 99999999.999999. + 01 but-is-integer_part pic 99999. + + 01 jd1601 pic 9(7). + 01 jd9999 pic 9(7). + 01 jd pic s9(7). + + 01 integer-date pic s9(7). + 01 integer-result pic 99. + 01 standard-date-form pic 9(8). + 01 julian-date-form PIC 9(8). + + 01 date1. + 02 YYYY pic 9999. + 02 MM pic 99. + 02 DD pic 99. + 01 date2. + 02 YYYY pic 9999. + 02 filler pic x value "-". + 02 MM pic 99. + 02 filler pic x value "-". + 02 DD pic 99. + 01 date3. + 02 YYYY pic 9999. + 02 DDD pic 999. + 01 date4. + 02 YYYY pic 9999. + 02 filler pic x value "-". + 02 DDD pic 999. + 01 date5. + 02 YYYY pic 9999. + 02 filler pic x value "W". + 02 ww pic 99. + 02 d pic 9. + 01 date6. + 02 YYYY pic 9999. + 02 filler pic xx value "-W". + 02 ww pic 99. + 02 filler pic x value "-". + 02 d pic 9. + + 01 yymmdd. + 02 YY pic 99. + 02 MM pic 99. + 02 DD pic 99. + + 01 minus10 pic s99 value -10. + + 01 forced_date_n pic X(64) VALUE Z"COB_CURRENT_DATE". + 01 forced_date_v pic X(64) VALUE Z"1945/06/01 12:34:56". + + procedure division. + CALL "setenv" using forced_date_n, forced_date_v + + move "SECONDS-PAST-MIDNIGHT" to checking + move "45296" to should-be + MOVE FUNCTION SECONDS-PAST-MIDNIGHT to but-is-integer_part + move but-is-integer_part to but-is + perform checkit + + *> Establish the initial date integer + move "integer-of-date" to checking + move function integer-of-date(19000101) to jd1601 + move "integer-of-date(19000101)" to checking + move 0109208 to should-be + move jd1601 to but-is + perform checkit + + *> Establish the final date integer + move "integer-of-date" to checking + move function integer-of-date(21011231) to jd9999 + move "integer-of-date(21001231)" to checking + move 0182986 to should-be + move jd9999 to but-is + perform checkit + + *> We are going to do the following tests over all valid dates: + perform varying jd from jd1601 by 1 until jd > jd9999 + + *> Convert JD to all six DATE types: + move FUNCTION FORMATTED-DATE("YYYYMMDD" jd) TO date1 + move FUNCTION FORMATTED-DATE("YYYY-MM-DD" jd) TO date2 + move FUNCTION FORMATTED-DATE("YYYYDDD" jd) TO date3 + move FUNCTION FORMATTED-DATE("YYYY-DDD" jd) TO date4 + move FUNCTION FORMATTED-DATE("YYYYWwwD" jd) TO date5 + move FUNCTION FORMATTED-DATE("YYYY-Www-D" jd) TO date6 + + *> Test the routines that check DATE types + move zero to should-be + move FUNCTION TEST-FORMATTED-DATETIME("YYYYMMDD" date1) TO but-is + move "TEST-FORMATTED-DATETIME(""YYYYMMDD"" date1)" to checking + perform checkit + move FUNCTION TEST-FORMATTED-DATETIME("YYYY-MM-DD" date2) TO but-is + move "TEST-FORMATTED-DATETIME(""YYYY-MM-DD"" date2)" to checking + perform checkit + move FUNCTION TEST-FORMATTED-DATETIME("YYYYDDD" date3) TO but-is + move "TEST-FORMATTED-DATETIME(""YYYYDDD"" date3)" to checking + perform checkit + move FUNCTION TEST-FORMATTED-DATETIME("YYYY-DDD" date4) TO but-is + move "TEST-FORMATTED-DATETIME(""YYYY-DDD"" date4)" to checking + perform checkit + move FUNCTION TEST-FORMATTED-DATETIME("YYYYWwwD" date5) TO but-is + move "TEST-FORMATTED-DATETIME(""YYYYWwwD"" date5)" to checking + perform checkit + move FUNCTION TEST-FORMATTED-DATETIME("YYYY-Www-D" date6) TO but-is + move "TEST-FORMATTED-DATETIME(""YYYY-Www-D"" date6)" to checking + perform checkit + + *> Test the routines that extract the integer date + + move function INTEGER-OF-FORMATTED-DATE("YYYYMMDD" date1) TO integer-date + move "INTEGER-OF-FORMATTED-DATE(""YYYYMMDD"" date1)" to checking + move jd to should-be + move integer-date to but-is + perform checkit + + move function INTEGER-OF-FORMATTED-DATE("YYYY-MM-DD" date2) TO integer-date + move "INTEGER-OF-FORMATTED-DATE(""YYYY-MM-DD"" date2)" to checking + move jd to should-be + move integer-date to but-is + perform checkit + + move function INTEGER-OF-FORMATTED-DATE("YYYYDDD" date3) TO integer-date + move "INTEGER-OF-FORMATTED-DATE(""YYYYDDD"" date3)" to checking + move jd to should-be + move integer-date to but-is + perform checkit + + move function INTEGER-OF-FORMATTED-DATE("YYYY-DDD" date4) TO integer-date + move "INTEGER-OF-FORMATTED-DATE(""YYYY-DDD"" date4)" to checking + move jd to should-be + move integer-date to but-is + perform checkit + + move function INTEGER-OF-FORMATTED-DATE("YYYYWwwD" date5) TO integer-date + move "INTEGER-OF-FORMATTED-DATE(""YYYYWwwD"" date5)" to checking + move jd to should-be + move integer-date to but-is + perform checkit + + move function INTEGER-OF-FORMATTED-DATE("YYYY-Www-D" date6) TO integer-date + move "INTEGER-OF-FORMATTED-DATE(""YYYY-Www-D"" date6)" to checking + move jd to should-be + move integer-date to but-is + perform checkit + + move function DATE-OF-INTEGER(jd) to standard-date-form + move function INTEGER-OF-DATE(standard-date-form) to integer-date + move "DATE-OF-INTEGER and INTEGER-OF-DATE" to checking + move jd to should-be + move integer-date to but-is + perform checkit + + move function TEST-DATE-YYYYMMDD(standard-date-form) to integer-result + move "TEST-DATE-YYYYMMDD" to checking + move zero to should-be + move integer-result to but-is + perform checkit + + move function DAY-OF-INTEGER(jd) to julian-date-form + move function INTEGER-OF-DAY(julian-date-form) to integer-date + move "DAY-OF-INTEGER and INTEGER-OF-DAY" to checking + move jd to should-be + move integer-date to but-is + perform checkit + + move function TEST-DAY-YYYYDDD(julian-date-form) to integer-result + move "TEST-DAY-YYYYDDD" to checking + move zero to should-be + move integer-result to but-is + perform checkit + end-perform. + + move function integer-of-date(19980101) to jd1601 + move function integer-of-date(19981231) to jd9999 + perform varying jd from jd1601 by 1 until jd > jd9999 + move FUNCTION FORMATTED-DATE("YYYYMMDD" jd) TO date1 + move FUNCTION FORMATTED-DATE("YYYYDDD" jd) TO date3 + + move FUNCTION MOD( YYYY of date1 100) to yy of yymmdd + move MM of date1 to MM of yymmdd + move DD of date1 to DD of yymmdd + + move FUNCTION DATE-TO-YYYYMMDD(yymmdd, minus10, 1994) + to standard-date-form + move "DATE-TO-YYYYMMDD" to checking + move "18" to date1(1:2) + move date1 to should-be + move standard-date-form to but-is + perform checkit + end-perform. + + move "DAY-TO-YYYYDDD" to checking + MOVE 1910004 to should-be + MOVE FUNCTION DAY-TO-YYYYDDD(10004 -20 2002) TO but-is + perform checkit + MOVE 1810004 to should-be + MOVE FUNCTION DAY-TO-YYYYDDD(10004 -120 2002) TO but-is + perform checkit + MOVE 2010004 to should-be + MOVE FUNCTION DAY-TO-YYYYDDD(10004 20 2002) TO but-is + perform checkit + MOVE 1995005 to should-be + MOVE FUNCTION DAY-TO-YYYYDDD(95005 -10 2013) TO but-is + perform checkit + + move "COMBINED-DATETIME" to checking + MOVE "19450601.123456" TO should-be + MOVE FUNCTION COMBINED-DATETIME(19450601 123456) TO but-is-n + perform checkit + + move "CURRENT_DATE" to checking + MOVE "1945060112345600+0000" TO should-be + MOVE FUNCTION CURRENT-DATE TO but-is + move "+0000" to but-is(17:5) + perform checkit + + move "FORMATTED-CURRENT-DATE (1)" to checking + MOVE "1945-06-01T12:34:56" TO should-be + MOVE FUNCTION FORMATTED-CURRENT-DATE("YYYY-MM-DDThh:mm:ss") TO but-is + perform blot-zulu + perform checkit + + move "FORMATTED-CURRENT-DATE (2)" to checking + MOVE "1945-06-01T12:34:56Z" TO should-be + MOVE FUNCTION FORMATTED-CURRENT-DATE("YYYY-MM-DDThh:mm:ssZ") TO but-is + perform blot-zulu + perform checkit + + move "FORMATTED-CURRENT-DATE (3)" to checking + MOVE "1945-06-01T12:34:56-05:00" TO should-be + MOVE FUNCTION FORMATTED-CURRENT-DATE("YYYY-MM-DDThh:mm:ss+hh:mm") TO but-is + perform blot-zulu + perform checkit + + move "formatted-time" to checking + move "01:12:34Z" to should-be + MOVE FUNCTION formatted-time("hh:mm:ssZ" 754 -60 ) to but-is + perform checkit. + + move "00:12:34Z" to should-be + MOVE FUNCTION formatted-time("hh:mm:ssZ" 754 0 ) to but-is + perform checkit. + + move "23:12:34Z" to should-be + MOVE FUNCTION formatted-time("hh:mm:ssZ" 754 60 ) to but-is + perform checkit. + + move "formatted-datetime" to checking + MOVE "1900-01-01T00:00:00-01:00" TO SHOULD-BE + MOVE FUNCTION formatted-datetime("YYYY-MM-DDThh:mm:ss+hh:mm" 0109208 0 -60 ) TO but-is + perform checkit. + + MOVE "1900-01-01T00:00:00+00:00" TO SHOULD-BE + MOVE FUNCTION formatted-datetime("YYYY-MM-DDThh:mm:ss+hh:mm" 0109208 0 -0 ) TO but-is + perform checkit. + + MOVE "1900-01-01T00:00:00+01:00" TO SHOULD-BE + MOVE FUNCTION formatted-datetime("YYYY-MM-DDThh:mm:ss+hh:mm" 0109208 0 +60 ) TO but-is + perform checkit. + + move "SECONDS-FROM-FORMATTED-TIME" to checking + MOVE "00043200.000000" TO SHOULD-BE + MOVE SPACE TO but-is + MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME("hh:mm:ss" "12:00:00") TO but-is-n + perform checkit. + + stop run. + + checkit. + *> display "checkit " """" should-be """" space """" but-is """" + if FUNCTION TRIM(should-be) IS NUMERIC AND FUNCTION TRIM(but-is) IS NUMERIC + if FUNCTION NUMVAL(should-be) + not equal to FUNCTION NUMVAL(but-is) + and should-be not equal to but-is + then + display function trim (checking) ":" + " should be " """" function trim (should-be) """" + " but is " """" function trim (but-is) """" + move 1 to return-code + end-if + else + if should-be not equal to but-is + and should-be not equal to but-is + then + display function trim (checking) ":" + " should be " """" function trim (should-be) """" + " but is " """" function trim (but-is) """" + move 1 to return-code + end-if + . + blot-zulu. + move "hh:mm" TO but-is(12:5) + move "hh:mm" TO should-be(12:5) + if but-is(21:1) not equal to space + move "+hh:mm" TO but-is(20:6) + move "+hh:mm" TO should-be(20:6) + end-if + . + end program test. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-OF-INTEGER.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-OF-INTEGER.cob new file mode 100644 index 0000000..df70a82 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-OF-INTEGER.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD PIC S9(09)V9(02). + PROCEDURE DIVISION. + MOVE FUNCTION DAY-OF-INTEGER ( 146000 ) + TO TEST-FLD. + IF TEST-FLD NOT = 2000269 + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-TO-YYYYDDD.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-TO-YYYYDDD.cob new file mode 100644 index 0000000..5316a70 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-TO-YYYYDDD.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD PIC S9(09)V9(02). + PROCEDURE DIVISION. + MOVE FUNCTION DAY-TO-YYYYDDD ( 95005, -10, 2013 ) + TO TEST-FLD. + IF TEST-FLD NOT = 001995005 + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_E.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_E.cob new file mode 100644 index 0000000..e07edf0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_E.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC 9V9(33). + PROCEDURE DIVISION. + MOVE FUNCTION E TO Y. + IF Y NOT = 2.718281828459045235360287471352662 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.cob new file mode 100644 index 0000000..e822708 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.cob @@ -0,0 +1,26 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_EXCEPTION-FILE.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE ASSIGN "NOTEXIST" + FILE STATUS IS TEST-STATUS. + DATA DIVISION. + FILE SECTION. + FD TEST-FILE. + 01 TEST-REC PIC X(4). + WORKING-STORAGE SECTION. + 01 TEST-STATUS PIC XX. + PROCEDURE DIVISION. + DISPLAY FUNCTION EXCEPTION-FILE '|' + NO ADVANCING + END-DISPLAY. + OPEN INPUT TEST-FILE. + DISPLAY FUNCTION EXCEPTION-FILE + NO ADVANCING + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.out new file mode 100644 index 0000000..ece5467 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.out @@ -0,0 +1 @@ +00|35TEST-FILE diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.cob new file mode 100644 index 0000000..d68261d --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.cob @@ -0,0 +1,24 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_EXCEPTION-STATEMENT.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE ASSIGN "NOTEXIST" + FILE STATUS IS TEST-STATUS. + DATA DIVISION. + FILE SECTION. + FD TEST-FILE. + 01 TEST-REC PIC X(4). + WORKING-STORAGE SECTION. + 01 TEST-STATUS PIC XX. + PROCEDURE DIVISION. + DISPLAY "EXCEPTION-STATEMENT before bad OPEN: " + """" FUNCTION EXCEPTION-STATEMENT """" + OPEN INPUT TEST-FILE. + DISPLAY "EXCEPTION-STATEMENT after bad OPEN: " + """" FUNCTION EXCEPTION-STATEMENT """" + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.out new file mode 100644 index 0000000..5656102 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.out @@ -0,0 +1,3 @@ +EXCEPTION-STATEMENT before bad OPEN: " " +EXCEPTION-STATEMENT after bad OPEN: "OPEN" + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.cob new file mode 100644 index 0000000..1ffa366 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.cob @@ -0,0 +1,24 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_EXCEPTION-STATUS.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE ASSIGN "NOTEXIST" + FILE STATUS IS TEST-STATUS. + DATA DIVISION. + FILE SECTION. + FD TEST-FILE. + 01 TEST-REC PIC X(4). + WORKING-STORAGE SECTION. + 01 TEST-STATUS PIC XX. + PROCEDURE DIVISION. + DISPLAY "EXCEPTION STATUS before bad open: " + """" FUNCTION EXCEPTION-STATUS """" + OPEN INPUT TEST-FILE. + DISPLAY "EXCEPTION STATUS after bad open: " + """" FUNCTION EXCEPTION-STATUS """" + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.out new file mode 100644 index 0000000..02b4f84 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.out @@ -0,0 +1,3 @@ +EXCEPTION STATUS before bad open: " " +EXCEPTION STATUS after bad open: "EC-I-O-PERMANENT-ERROR" + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP.cob new file mode 100644 index 0000000..756612c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S99V9(31). + PROCEDURE DIVISION. + MOVE FUNCTION EXP ( 3 ) TO Y. + IF Y NOT = 20.0855369231876677409285296545817 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP10.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP10.cob new file mode 100644 index 0000000..a76fcfb --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP10.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD PIC S9(09)V9(02). + PROCEDURE DIVISION. + MOVE FUNCTION EXP10 ( 4 ) + TO TEST-FLD. + IF TEST-FLD NOT = 000010000 + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FACTORIAL.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FACTORIAL.cob new file mode 100644 index 0000000..969663c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FACTORIAL.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD PIC S9(09)V9(02). + PROCEDURE DIVISION. + MOVE FUNCTION FACTORIAL ( 6 ) + TO TEST-FLD. + IF TEST-FLD NOT = 000000720 + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE.cob new file mode 100644 index 0000000..cde5644 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE.cob @@ -0,0 +1,54 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 str PIC X(10). + PROCEDURE DIVISION. + *> Test normal inputs. + MOVE FUNCTION FORMATTED-DATE ( "YYYYMMDD", 1 ) TO str + IF str <> "16010101" + DISPLAY "Test 1 failed: " str END-DISPLAY + END-IF + + MOVE FUNCTION FORMATTED-DATE ( "YYYY-MM-DD", 1 ) TO str + IF str <> "1601-01-01" + DISPLAY "Test 2 failed: " str END-DISPLAY + END-IF + + MOVE FUNCTION FORMATTED-DATE ( "YYYYDDD", 1 ) TO str + IF str <> "1601001" + DISPLAY "Test 3 failed: " str END-DISPLAY + END-IF + + MOVE FUNCTION FORMATTED-DATE ( "YYYY-DDD", 1 ) TO str + IF str <> "1601-001" + DISPLAY "Test 4 failed: " str END-DISPLAY + END-IF + + MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 1 ) TO str + IF str <> "1601W011" + DISPLAY "Test 5 failed: " str END-DISPLAY + END-IF + + MOVE FUNCTION FORMATTED-DATE ( "YYYY-Www-D", 1 ) TO str + IF str <> "1601-W01-1" + DISPLAY "Test 6 failed: " str END-DISPLAY + END-IF + + *> Test week number edge cases. + *> For 2012-01-01. + MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 150115 ) TO str + IF str <> "2011W527" + DISPLAY "Test 7 failed: " str END-DISPLAY + END-IF + + *> and for 2013-12-30. + MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 150844 ) TO str + IF str <> "2014W011" + DISPLAY "Test 8 failed: " str END-DISPLAY + END-IF + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME.cob new file mode 100644 index 0000000..47654cb --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME.cob @@ -0,0 +1,48 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 str PIC X(40). + PROCEDURE DIVISION. + *> Test normal inputs. + MOVE FUNCTION FORMATTED-DATETIME + ("YYYYMMDDThhmmss", 1, 45296) + TO str + IF str <> "16010101T123456" + DISPLAY "Test 1 failed: " str END-DISPLAY + END-IF + + MOVE FUNCTION FORMATTED-DATETIME + ("YYYY-MM-DDThh:mm:ss", 1, 45296) + TO str + IF str <> "1601-01-01T12:34:56" + DISPLAY "Test 2 failed: " str END-DISPLAY + END-IF + + MOVE FUNCTION FORMATTED-DATETIME + ("YYYYDDDThhmmss+hhmm", 1, 45296, -754) + TO str + IF str <> "1601001T123456-1234" + DISPLAY "Test 3 failed: " str END-DISPLAY + END-IF + + MOVE FUNCTION FORMATTED-DATETIME + ("YYYYDDDThhmmss+hhmm", 1, 45296) + TO str + IF str <> "1601001T123456+0000" + DISPLAY "Test 4 failed: " str END-DISPLAY + END-IF + + *> Test underflow to next day due to offset + MOVE FUNCTION FORMATTED-DATETIME + ("YYYYDDDThhmmss.sssssssssZ", 150846, 0, + 1) + TO str + IF str <> "2013365T235900.000000000Z" + DISPLAY "Test 5 failed: " str END-DISPLAY + END-IF + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME_with_ref_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME_with_ref_modding.cob new file mode 100644 index 0000000..c440755 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME_with_ref_modding.cob @@ -0,0 +1,17 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 str PIC X(04). + PROCEDURE DIVISION. + MOVE FUNCTION FORMATTED-DATETIME + ("YYYYMMDDThhmmss", 1, 1) (3:4) + TO STR + IF STR NOT = '0101' + DISPLAY STR + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.cob new file mode 100644 index 0000000..c495e0d --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.cob @@ -0,0 +1,69 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. datetime. + PROCEDURE DIVISION. + DISPLAY "FUNCTION FORMATTED-DATETIME - valid format strings" + DISPLAY " FORMATTED-DATE Basic" + DISPLAY FUNCTION FORMATTED-DATE("YYYYMMDD" 128623). + DISPLAY FUNCTION FORMATTED-DATE("YYYYDDD" 128623). + DISPLAY FUNCTION FORMATTED-DATE("YYYYWwwD" 128623). + DISPLAY " FORMATTED-DATE Extended" + DISPLAY FUNCTION FORMATTED-DATE("YYYY-MM-DD" 128623). + DISPLAY FUNCTION FORMATTED-DATE("YYYY-DDD" 128623). + DISPLAY FUNCTION FORMATTED-DATE("YYYY-Www-D" 128623). + DISPLAY " FORMATTED-TIME Basic" + DISPLAY FUNCTION FORMATTED-TIME("hhmmss" 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-TIME("hhmmss+hhmm" 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-TIME("hhmmss.ssss" 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-TIME("hhmmss.ssss+hhmm" 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-TIME("hhmmss.ssssZ" 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-TIME("hhmmssZ" 45296.987654321 -300). + DISPLAY " FORMATTED-TIME Extended" + DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ss" 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ss+hh:mm" 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ss.ssss" 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ss.ssss+hh:mm" 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ss.ssssZ" 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ssZ" 45296.987654321 -300). + DISPLAY " FORMATTED-DATETIME Basic" + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmss+hhmm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmss.ssss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmss.ssss+hhmm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmss.ssssZ" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmssZ" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmss+hhmm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmss.ssss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmss.ssss+hhmm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmss.ssssZ" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmssZ" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmss+hhmm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmss.ssss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmss.ssss+hhmm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmss.ssssZ" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmssZ" 128623 45296.987654321 -300). + DISPLAY " FORMATTED-DATETIME Extended" + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ss+hh:mm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ss.ssss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ss.ssss+hh:mm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ss.ssssZ" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ssZ" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ss+hh:mm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ss.ssss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ss.ssss+hh:mm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ss.ssssZ" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ssZ" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ss+hh:mm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ss.ssss" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ss.ssss+hh:mm" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ss.ssssZ" 128623 45296.987654321 -300). + DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ssZ" 128623 45296.987654321 -300). + END PROGRAM datetime. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.out new file mode 100644 index 0000000..5395f4e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.out @@ -0,0 +1,62 @@ +FUNCTION FORMATTED-DATETIME - valid format strings + FORMATTED-DATE Basic +19530227 +1953058 +1953W095 + FORMATTED-DATE Extended +1953-02-27 +1953-058 +1953-W09-5 + FORMATTED-TIME Basic +123456 +123456-0500 +123456.9876 +123456.9876-0500 +173456.0000Z +173456Z + FORMATTED-TIME Extended +12:34:56 +12:34:56-05:00 +12:34:56.9876 +12:34:56.9876-05:00 +17:34:56.0000Z +17:34:56Z + FORMATTED-DATETIME Basic +19530227T123456 +19530227T123456-0500 +19530227T123456.9876 +19530227T123456.9876-0500 +19530227T173456.0000Z +19530227T173456Z +1953058T123456 +1953058T123456-0500 +1953058T123456.9876 +1953058T123456.9876-0500 +1953058T173456.0000Z +1953058T173456Z +1953W095T123456 +1953W095T123456-0500 +1953W095T123456.9876 +1953W095T123456.9876-0500 +1953W095T173456.0000Z +1953W095T173456Z + FORMATTED-DATETIME Extended +1953-02-27T12:34:56 +1953-02-27T12:34:56-05:00 +1953-02-27T12:34:56.9876 +1953-02-27T12:34:56.9876-05:00 +1953-02-27T17:34:56.0000Z +1953-02-27T17:34:56Z +1953-058T12:34:56 +1953-058T12:34:56-05:00 +1953-058T12:34:56.9876 +1953-058T12:34:56.9876-05:00 +1953-058T17:34:56.0000Z +1953-058T17:34:56Z +1953-W09-5T12:34:56 +1953-W09-5T12:34:56-05:00 +1953-W09-5T12:34:56.9876 +1953-W09-5T12:34:56.9876-05:00 +1953-W09-5T17:34:56.0000Z +1953-W09-5T17:34:56Z + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_with_ref_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_with_ref_modding.cob new file mode 100644 index 0000000..ac5c828 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_with_ref_modding.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 str PIC X(04). + PROCEDURE DIVISION. + MOVE FUNCTION FORMATTED-DATE ("YYYYMMDD", 1) (3:4) + TO STR + IF STR NOT = '0101' + DISPLAY STR + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_DP.COMMA.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_DP.COMMA.cob new file mode 100644 index 0000000..1abd625 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_DP.COMMA.cob @@ -0,0 +1,22 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SPECIAL-NAMES. + DECIMAL-POINT IS COMMA. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 str PIC X(11). + + PROCEDURE DIVISION. + MOVE FUNCTION FORMATTED-TIME ("hh:mm:ss,ss", 45296) TO str + IF str <> "12:34:56,00" + DISPLAY "Test 1 failed: " str END-DISPLAY + END-IF + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_with_ref_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_with_ref_modding.cob new file mode 100644 index 0000000..cfcf0c7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_with_ref_modding.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 str PIC X(04). + PROCEDURE DIVISION. + MOVE FUNCTION FORMATTED-TIME ("hhmmss", 45296) (3:4) + TO STR + IF STR NOT = '3456' + DISPLAY STR + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FRACTION-PART.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FRACTION-PART.cob new file mode 100644 index 0000000..65f341b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FRACTION-PART.cob @@ -0,0 +1,22 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD PIC S9(04)V9(04). + PROCEDURE DIVISION. + MOVE FUNCTION FRACTION-PART ( 3.12345 ) + TO TEST-FLD. + IF TEST-FLD NOT = +0000.1234 + DISPLAY 'FRACTION-PART ( +3.12345 ) wrong: ' TEST-FLD + END-DISPLAY + END-IF. + MOVE FUNCTION FRACTION-PART ( -3.12345 ) + TO TEST-FLD. + IF TEST-FLD NOT = -0000.1234 + DISPLAY 'FRACTION-PART ( -3.12345 ) wrong: ' TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.cob new file mode 100644 index 0000000..ed31eb6 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.cob @@ -0,0 +1,13 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_HEX-OF.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 PAC PIC 9(5) COMP-3 VALUE 12345. + PROCEDURE DIVISION. + DISPLAY FUNCTION HEX-OF('Hello, world!') + DISPLAY FUNCTION HEX-OF(PAC). + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.out new file mode 100644 index 0000000..40892ac --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.out @@ -0,0 +1,3 @@ +48656C6C6F2C20776F726C6421 +12345F + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_HIGHEST-ALGEBRAIC.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_HIGHEST-ALGEBRAIC.cob new file mode 100644 index 0000000..2e59df3 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_HIGHEST-ALGEBRAIC.cob @@ -0,0 +1,76 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 F1 PIC S999. + 01 F2 PIC S9(4) BINARY. + 01 F3 PIC 99V9(3). + 01 F4 PIC $**,**9.99BCR. + 01 F5 PIC $**,**9.99. + 01 F6 USAGE BINARY-CHAR SIGNED. + 01 F7 USAGE BINARY-CHAR UNSIGNED. + 01 F8 PIC 999PPP. + 01 F9 PIC P99. + 01 TEST-FLD PIC S9(08)V9(04). + PROCEDURE DIVISION. + MOVE FUNCTION HIGHEST-ALGEBRAIC (F1) + TO TEST-FLD. + IF TEST-FLD NOT = 999 + DISPLAY "Test 1 fail: " TEST-FLD + END-DISPLAY + END-IF. + MOVE FUNCTION HIGHEST-ALGEBRAIC (F2) + TO TEST-FLD. + IF TEST-FLD NOT = 9999 + DISPLAY "Test 2 fail: " TEST-FLD + END-DISPLAY + END-IF. + MOVE FUNCTION HIGHEST-ALGEBRAIC (F3) + TO TEST-FLD. + IF TEST-FLD NOT = 99.999 + DISPLAY "Test 3 fail: " TEST-FLD + END-DISPLAY + END-IF. + MOVE FUNCTION HIGHEST-ALGEBRAIC (F4) + TO TEST-FLD. + IF TEST-FLD NOT = 99999.99 + DISPLAY "Test 4 fail: " TEST-FLD + END-DISPLAY + END-IF. + MOVE FUNCTION HIGHEST-ALGEBRAIC (F5) + TO TEST-FLD. + IF TEST-FLD NOT = 99999.99 + DISPLAY "Test 5 fail: " TEST-FLD + END-DISPLAY + END-IF. + MOVE FUNCTION HIGHEST-ALGEBRAIC (F6) + TO TEST-FLD. + IF TEST-FLD NOT = 127 + DISPLAY "Test 6 fail: " TEST-FLD + END-DISPLAY + END-IF. + MOVE FUNCTION HIGHEST-ALGEBRAIC (F7) + TO TEST-FLD. + IF TEST-FLD NOT = 255 + DISPLAY "Test 7 fail: " TEST-FLD + END-DISPLAY + END-IF. + + MOVE FUNCTION HIGHEST-ALGEBRAIC (F8) + TO TEST-FLD. + IF TEST-FLD NOT = 999000 + DISPLAY "Test 7 fail: " TEST-FLD + END-DISPLAY + END-IF. + + MOVE FUNCTION HIGHEST-ALGEBRAIC (F9) + TO TEST-FLD. + IF TEST-FLD NOT = 0.099 + DISPLAY "Test 7 fail: " TEST-FLD + END-DISPLAY + END-IF. + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DATE.cob new file mode 100644 index 0000000..4632864 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DATE.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD PIC S9(09)V9(02). + PROCEDURE DIVISION. + MOVE FUNCTION INTEGER-OF-DATE ( 20000925 ) + TO TEST-FLD. + IF TEST-FLD NOT = 000146000 + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DAY.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DAY.cob new file mode 100644 index 0000000..38162bf --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DAY.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-FLD PIC S9(09)V9(02). + PROCEDURE DIVISION. + MOVE FUNCTION INTEGER-OF-DAY ( 2000269 ) + TO TEST-FLD. + IF TEST-FLD NOT = 000146000 + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-FORMATTED-DATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-FORMATTED-DATE.cob new file mode 100644 index 0000000..d580ea8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-FORMATTED-DATE.cob @@ -0,0 +1,41 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 day-int PIC 9(9). + + PROCEDURE DIVISION. + *> The date 2013-12-30 is used as it can also be used to + *> check the conversion of dates in week form. + MOVE FUNCTION INTEGER-OF-FORMATTED-DATE + ("YYYY-MM-DD", "2013-12-30") + TO day-int + IF day-int <> 150844 + DISPLAY "Test 1 failed: " day-int END-DISPLAY + END-IF + + MOVE FUNCTION INTEGER-OF-FORMATTED-DATE + ("YYYY-DDD", "2013-364") + TO day-int + IF day-int <> 150844 + DISPLAY "Test 2 failed: " day-int END-DISPLAY + END-IF + + MOVE FUNCTION INTEGER-OF-FORMATTED-DATE + ("YYYY-Www-D", "2014-W01-1") + TO day-int + IF day-int <> 150844 + DISPLAY "Test 3 failed: " day-int END-DISPLAY + END-IF + + MOVE FUNCTION INTEGER-OF-FORMATTED-DATE + ("YYYY-MM-DDThh:mm:ss", "2013-12-30T12:34:56") + TO day-int + IF day-int <> 150844 + DISPLAY "Test 4 failed: " day-int END-DISPLAY + END-IF + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-PART.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-PART.cob new file mode 100644 index 0000000..cc97765 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-PART.cob @@ -0,0 +1,17 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC S9(4)V9(4) VALUE -1.5. + 01 TEST-FLD PIC S9(04)V9(02). + PROCEDURE DIVISION. + MOVE FUNCTION INTEGER-PART ( X ) + TO TEST-FLD. + IF TEST-FLD NOT = -1 + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER.cob new file mode 100644 index 0000000..d43dd08 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER.cob @@ -0,0 +1,24 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC S9(4)V9(4) VALUE -1.5. + 01 Y PIC 9(12) VALUE 600851475143. + 01 TEST-FLD PIC S9(14)V9(08). + PROCEDURE DIVISION. + MOVE FUNCTION INTEGER ( X ) + TO TEST-FLD. + IF TEST-FLD NOT = -2 + DISPLAY 'INTEGER ( X ) wrong: ' TEST-FLD + END-DISPLAY + END-IF. + MOVE FUNCTION INTEGER ( Y / 71 ) + TO TEST-FLD. + IF TEST-FLD NOT = 8462696833 + DISPLAY 'INTEGER ( Y / 71 ) wrong: ' TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__1_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__1_.cob new file mode 100644 index 0000000..8bbf689 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__1_.cob @@ -0,0 +1,38 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC S9(4)V9(4) VALUE -1.5. + 01 TEST-FLD PIC S9(04)V9(02). + PROCEDURE DIVISION. + MOVE FUNCTION LENGTH ( X ) TO TEST-FLD + IF TEST-FLD NOT = 8 + DISPLAY 'LENGTH "00128" wrong: ' TEST-FLD + END-DISPLAY + END-IF + + MOVE FUNCTION LENGTH ( '00128' ) + TO TEST-FLD + IF TEST-FLD NOT = 5 + DISPLAY 'LENGTH "00128" wrong: ' TEST-FLD + END-DISPLAY + END-IF + + MOVE FUNCTION LENGTH ( x'a0' ) + TO TEST-FLD + IF TEST-FLD NOT = 1 + DISPLAY 'LENGTH x"a0" wrong: ' TEST-FLD + END-DISPLAY + END-IF + + MOVE FUNCTION LENGTH ( z'a0' ) + TO TEST-FLD + IF TEST-FLD NOT = 3 + DISPLAY 'LENGTH z"a0" wrong: ' TEST-FLD + END-DISPLAY + END-IF + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.cob new file mode 100644 index 0000000..9416ca0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.cob @@ -0,0 +1,139 @@ + *> { dg-do run } + *> { dg-options "-dialect ibm" } + *> { dg-output-file "group2/FUNCTION_LENGTH__2_.out" } + program-id. prog. + data division. + working-storage section. + 01 desc1. + 05 desc1-entry pic x(5) occurs 10. + + 01 desc2. + 05 desc2-table occurs 10 times. + 10 desc2-entry pic x(5). + + 01 desc3. + 05 desc3-outer occurs 1 to 5 times depending on desc3-lim. + 10 desc3-outer-txt pic x(7). + 10 desc3-inner occurs 11 times. + 15 desc3-inner-text pic x(13). + 77 desc3-lim binary-long. + + 77 msg pic x(64). + 77 should-be pic zzzz9. + 77 but-is pic zzzz9. + + procedure division. + + display "using FUNCTION LENGTH" + + move "function length(desc1)" to msg + move 50 to should-be + move function length(desc1) to but-is + perform result-is + + move "function length(desc1-entry)" to msg + move 50 to should-be + move function length(desc1-entry) to but-is + perform result-is + + move "function length(desc1-entry(1))" to msg + move 5 to should-be + move function length(desc1-entry(1)) to but-is + perform result-is + + move "function length(desc2)" to msg + move 50 to should-be + move function length(desc2) to but-is + perform result-is + + move "function length(desc2-table)" to msg + move 50 to should-be + move function length(desc2-table) to but-is + perform result-is + + move "function length(desc2-entry)" to msg + move 5 to should-be + move function length(desc2-entry) to but-is + perform result-is + + move "function length(desc2-entry(1))" to msg + move 5 to should-be + move function length(desc2-entry(1)) to but-is + perform result-is + + move 5 to desc3-lim + + move "function length(desc3)" to msg + move 750 to should-be + move function length(desc3) to but-is + perform result-is + + move "function length(desc3-outer)" to msg + move 750 to should-be + move function length(desc3-outer) to but-is + perform result-is + + move "function length(desc3-outer(1))" to msg + move 150 to should-be + move function length(desc3-outer(1)) to but-is + perform result-is + + move "function length(desc3-outer-txt)" to msg + move 7 to should-be + move function length(desc3-outer-txt) to but-is + perform result-is + + move "function length(desc3-inner)" to msg + move 143 to should-be + move function length(desc3-inner) to but-is + perform result-is + + move "function length(desc3-inner(1))" to msg + move 13 to should-be + move function length(desc3-inner(1)) to but-is + perform result-is + + display "After changing desc3-lim from 5 to 3..." + move 3 to desc3-lim + + move "function length(desc3)" to msg + move 450 to should-be + move function length(desc3) to but-is + perform result-is + + move "function length(desc3-outer)" to msg + move 450 to should-be + move function length(desc3-outer) to but-is + perform result-is + + move "function length(desc3-outer(1))" to msg + move 150 to should-be + move function length(desc3-outer(1)) to but-is + perform result-is + + move "function length(desc3-outer-txt)" to msg + move 7 to should-be + move function length(desc3-outer-txt) to but-is + perform result-is + + move "function length(desc3-inner)" to msg + move 143 to should-be + move function length(desc3-inner) to but-is + perform result-is + + move "function length(desc3-inner(1))" to msg + move 13 to should-be + move function length(desc3-inner(1)) to but-is + perform result-is + + goback. + result-is. + display function trim(msg) ": " with no advancing + if but-is equal to should-be + display function trim(but-is) + else + display "should be " function trim(should-be) + " but is " function trim(but-is) + end-if. + end program prog. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.out new file mode 100644 index 0000000..9d90261 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.out @@ -0,0 +1,22 @@ +using FUNCTION LENGTH +function length(desc1): 50 +function length(desc1-entry): 50 +function length(desc1-entry(1)): 5 +function length(desc2): 50 +function length(desc2-table): 50 +function length(desc2-entry): 5 +function length(desc2-entry(1)): 5 +function length(desc3): 750 +function length(desc3-outer): 750 +function length(desc3-outer(1)): 150 +function length(desc3-outer-txt): 7 +function length(desc3-inner): 143 +function length(desc3-inner(1)): 13 +After changing desc3-lim from 5 to 3... +function length(desc3): 450 +function length(desc3-outer): 450 +function length(desc3-outer(1)): 150 +function length(desc3-outer-txt): 7 +function length(desc3-inner): 143 +function length(desc3-inner(1)): 13 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-COMPARE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-COMPARE.cob new file mode 100644 index 0000000..cb6d783 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-COMPARE.cob @@ -0,0 +1,21 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + IF FUNCTION LOCALE-COMPARE ("A", "B") NOT = "<" + DISPLAY "Test 1 fail" + END-DISPLAY + END-IF. + IF FUNCTION LOCALE-COMPARE ("B", "A") NOT = ">" + DISPLAY "Test 2 fail" + END-DISPLAY + END-IF. + IF FUNCTION LOCALE-COMPARE ("A", "A") NOT = "=" + DISPLAY "Test 3 fail" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.cob new file mode 100644 index 0000000..35e0729 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_LOCALE-DATE.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(32) VALUE SPACES. + PROCEDURE DIVISION. + MOVE FUNCTION LOCALE-DATE ( "19630302" ) TO X. + IF X NOT = SPACES + DISPLAY "OK" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.out new file mode 100644 index 0000000..885fd66 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.out @@ -0,0 +1,2 @@ +OK + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.cob new file mode 100644 index 0000000..d04e7a9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(32) VALUE SPACES. + PROCEDURE DIVISION. + MOVE FUNCTION LOCALE-TIME-FROM-SECONDS ( 33012 ) TO X. + IF X NOT = SPACES + DISPLAY "OK" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.out new file mode 100644 index 0000000..885fd66 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.out @@ -0,0 +1,2 @@ +OK + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.cob new file mode 100644 index 0000000..aeba184 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_LOCALE-TIME.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(32) VALUE SPACES. + PROCEDURE DIVISION. + MOVE FUNCTION LOCALE-TIME ( "233012" ) TO X. + IF X NOT = SPACES + DISPLAY "OK" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.out new file mode 100644 index 0000000..885fd66 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.out @@ -0,0 +1,2 @@ +OK + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG.cob new file mode 100644 index 0000000..f0ab0e7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(33). + PROCEDURE DIVISION. + MOVE FUNCTION LOG ( 1.5 ) TO Y. + IF Y NOT = 0.405465108108164381978013115464349 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG10.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG10.cob new file mode 100644 index 0000000..e37210b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG10.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(33). + PROCEDURE DIVISION. + MOVE FUNCTION LOG10 ( 1.5 ) TO Y. + IF Y NOT = 0.176091259055681242081289008530622 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE.cob new file mode 100644 index 0000000..4cf24d5 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE.cob @@ -0,0 +1,19 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(10) VALUE "A#B.C%D+E$". + 01 TEST-FLD PIC X(12) VALUE ALL '_'. + PROCEDURE DIVISION. + STRING FUNCTION LOWER-CASE ( X ) + DELIMITED BY SIZE + INTO TEST-FLD + END-STRING + IF TEST-FLD NOT = 'a#b.c%d+e$__' + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE_with_reference_modding.cob new file mode 100644 index 0000000..eb53ca4 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE_with_reference_modding.cob @@ -0,0 +1,17 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(10) VALUE "A#B.C%D+E$". + 01 TEST-FLD PIC X(03). + PROCEDURE DIVISION. + MOVE FUNCTION LOWER-CASE ( X ) (1 : 3) + TO TEST-FLD + IF TEST-FLD NOT = 'a#b' + DISPLAY TEST-FLD + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWEST-ALGEBRAIC.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWEST-ALGEBRAIC.cob new file mode 100644 index 0000000..4750c7e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWEST-ALGEBRAIC.cob @@ -0,0 +1,55 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 F1 PIC S999. + 01 F2 PIC S9(4) BINARY. + 01 F3 PIC 99V9(3). + 01 F4 PIC $**,**9.99BCR. + 01 F5 PIC $**,**9.99. + 01 F6 USAGE BINARY-CHAR SIGNED. + 01 F7 USAGE BINARY-CHAR UNSIGNED. + 01 F8 PIC S999PPP. + 01 F9 PIC SP99. + PROCEDURE DIVISION. + IF FUNCTION LOWEST-ALGEBRAIC (F1) NOT = -999 + DISPLAY "Test 1 fail" + END-DISPLAY + END-IF. + IF FUNCTION LOWEST-ALGEBRAIC (F2) NOT = -9999 + DISPLAY "Test 2 fail" + END-DISPLAY + END-IF. + IF FUNCTION LOWEST-ALGEBRAIC (F3) NOT = 0 + DISPLAY "Test 3 fail" + END-DISPLAY + END-IF. + IF FUNCTION LOWEST-ALGEBRAIC (F4) NOT = -99999.99 + DISPLAY "Test 4 fail" + END-DISPLAY + END-IF. + IF FUNCTION LOWEST-ALGEBRAIC (F5) NOT = 0 + DISPLAY "Test 5 fail" + END-DISPLAY + END-IF. + IF FUNCTION LOWEST-ALGEBRAIC (F6) NOT = -128 + DISPLAY "Test 6 fail" + END-DISPLAY + END-IF. + IF FUNCTION LOWEST-ALGEBRAIC (F7) NOT = 0 + DISPLAY "Test 7 fail" + END-DISPLAY + END-IF. + IF FUNCTION LOWEST-ALGEBRAIC (F8) NOT = -999000 + DISPLAY "Test 8 fail" + END-DISPLAY + END-IF. + IF FUNCTION LOWEST-ALGEBRAIC (F9) NOT = -0.099 + DISPLAY "Test 9 fail" + END-DISPLAY + END-IF. + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.cob new file mode 100644 index 0000000..99971a9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.cob @@ -0,0 +1,12 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_MAX.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY FUNCTION MAX ( 3 -14 0 8 -3 ) + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.out new file mode 100644 index 0000000..2f95459 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.out @@ -0,0 +1,2 @@ +8 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.cob new file mode 100644 index 0000000..007f235 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_MEAN.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 result PIC S999V999. + PROCEDURE DIVISION. + COMPUTE result = FUNCTION MEAN ( 3 -14 0 8 -3 ) + DISPLAY result + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.out new file mode 100644 index 0000000..7f05c89 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.out @@ -0,0 +1,2 @@ +-001.200 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.cob new file mode 100644 index 0000000..ac2515d --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.cob @@ -0,0 +1,12 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_MEDIAN.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY FUNCTION MEDIAN ( 3 -14 0 8 -3 ) + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.out new file mode 100644 index 0000000..77ac542 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.out @@ -0,0 +1,2 @@ +0 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.cob new file mode 100644 index 0000000..601cbc7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_MIDRANGE.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 RESULT PIC S999V999. + PROCEDURE DIVISION. + COMPUTE RESULT = FUNCTION MIDRANGE ( 3 -14 0 8 -3 ) + DISPLAY RESULT + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.out new file mode 100644 index 0000000..6945d25 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.out @@ -0,0 +1,2 @@ +-003.000 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.cob new file mode 100644 index 0000000..85ef141 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.cob @@ -0,0 +1,12 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_MIN.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY FUNCTION MIN ( 3 -14 0 8 -3 ) + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.out new file mode 100644 index 0000000..1bd872a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.out @@ -0,0 +1,2 @@ +-14 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.cob new file mode 100644 index 0000000..cbb445f --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.cob @@ -0,0 +1,110 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_MODULE-NAME.out" } + + identification division. + program-id. level-1. + data division. + working-storage section. + procedure division. + display "From level-1:" + perform reportt. + call "level-2" + goback. + reportt. + display " " "top-level: " """" function module-name(top-level) """" + display " " "current: " """" function module-name(current) """" + display " " "activating: " """" function module-name(activating) """" + display " " "nested: " """" function module-name(nested) """" + display " " "stack: " """" function module-name(stack) """" + continue. + end program level-1. + + identification division. + program-id. level-2. + data division. + working-storage section. + procedure division. + display "From level-2:" + perform reportt. + call "level-3" + goback. + reportt. + display " " "top-level: " """" function module-name(top-level) """" + display " " "current: " """" function module-name(current) """" + display " " "activating: " """" function module-name(activating) """" + display " " "nested: " """" function module-name(nested) """" + display " " "stack: " """" function module-name(stack) """" + continue. + end program level-2. + + identification division. + program-id. level-3. + data division. + working-storage section. + procedure division. + display "From level-3:" + perform reportt. + call "level-3a" + goback. + reportt. + display " " "top-level: " """" function module-name(top-level) """" + display " " "current: " """" function module-name(current) """" + display " " "activating: " """" function module-name(activating) """" + display " " "nested: " """" function module-name(nested) """" + display " " "stack: " """" function module-name(stack) """" + continue. + + identification division. + program-id. level-3a. + data division. + working-storage section. + procedure division. + display "From level-3a:" + perform reportt. + call "level-3b" + goback. + reportt. + display " " "top-level: " """" function module-name(top-level) """" + display " " "current: " """" function module-name(current) """" + display " " "activating: " """" function module-name(activating) """" + display " " "nested: " """" function module-name(nested) """" + display " " "stack: " """" function module-name(stack) """" + continue. + + identification division. + program-id. level-3b. + data division. + working-storage section. + procedure division. + display "From level-3b:" + perform reportt. + call "level-3c" + goback. + reportt. + display " " "top-level: " """" function module-name(top-level) """" + display " " "current: " """" function module-name(current) """" + display " " "activating: " """" function module-name(activating) """" + display " " "nested: " """" function module-name(nested) """" + display " " "stack: " """" function module-name(stack) """" + continue. + + identification division. + program-id. level-3c. + data division. + working-storage section. + procedure division. + display "From level-3c:" + perform reportt. + goback. + reportt. + display " " "top-level: " """" function module-name(top-level) """" + display " " "current: " """" function module-name(current) """" + display " " "activating: " """" function module-name(activating) """" + display " " "nested: " """" function module-name(nested) """" + display " " "stack: " """" function module-name(stack) """" + continue. + end program level-3c. + end program level-3b. + end program level-3a. + end program level-3. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.out new file mode 100644 index 0000000..7be80f0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.out @@ -0,0 +1,37 @@ +From level-1: + top-level: "level-1" + current: "level-1" + activating: " " + nested: "level-1" + stack: "level-1; " +From level-2: + top-level: "level-1" + current: "level-2" + activating: "level-1" + nested: "level-2" + stack: "level-2;level-1; " +From level-3: + top-level: "level-1" + current: "level-3" + activating: "level-2" + nested: "level-3" + stack: "level-3;level-2;level-1; " +From level-3a: + top-level: "level-1" + current: "level-3" + activating: "level-3" + nested: "level-3a" + stack: "level-3a;level-3;level-2;level-1; " +From level-3b: + top-level: "level-1" + current: "level-3" + activating: "level-3a" + nested: "level-3b" + stack: "level-3b;level-3a;level-3;level-2;level-1; " +From level-3c: + top-level: "level-1" + current: "level-3" + activating: "level-3b" + nested: "level-3c" + stack: "level-3c;level-3b;level-3a;level-3;level-2;level-1; " + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__invalid_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__invalid_.cob new file mode 100644 index 0000000..56ecbcd --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__invalid_.cob @@ -0,0 +1,22 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC 9 VALUE 0. + 01 R PIC S9(4)V9(4) VALUE 1. + PROCEDURE DIVISION. + MOVE FUNCTION MOD ( -11 Z ) TO R + IF FUNCTION EXCEPTION-STATUS + NOT = 'EC-ARGUMENT-FUNCTION' + DISPLAY 'Wrong/missing exception: ' + FUNCTION EXCEPTION-STATUS + END-DISPLAY + END-IF + IF R NOT = 0 + DISPLAY 'result is not zero: ' R + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__valid_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__valid_.cob new file mode 100644 index 0000000..0db8679 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__valid_.cob @@ -0,0 +1,21 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC 9(12) VALUE 600851475143. + 01 R PIC S9(4)V9(4) VALUE 0. + PROCEDURE DIVISION. + MOVE FUNCTION MOD ( -11 5 ) TO R + IF R NOT = 4 + DISPLAY 'first one wrong: ' R + END-DISPLAY + END-IF + MOVE FUNCTION MOD ( Y, 71 ) TO R + IF R NOT = 0 + DISPLAY 'second one wrong: ' R + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C.cob new file mode 100644 index 0000000..2eb8eb9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C.cob @@ -0,0 +1,22 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X1 PIC X(14) VALUE " -% 9876.1234 ". + 01 X2 PIC X(20) VALUE " % 19,876.1234 DB". + 01 N PIC s9(5)v9(5). + PROCEDURE DIVISION. + MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N + IF N NOT = -9876.1234 + DISPLAY N + END-DISPLAY + END-IF + MOVE FUNCTION NUMVAL-C ( X2 , "%" ) TO N + IF N NOT = -19876.1234 + DISPLAY N + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C_DP.COMMA.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C_DP.COMMA.cob new file mode 100644 index 0000000..bd57463 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C_DP.COMMA.cob @@ -0,0 +1,21 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SPECIAL-NAMES. + DECIMAL-POINT IS COMMA + . + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X1 PIC X(20) VALUE " % 19.876,1234 DB". + 01 N PIC s9(5)v9(5). + PROCEDURE DIVISION. + MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N + IF N NOT = -19876,1234 + DISPLAY N + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.cob new file mode 100644 index 0000000..522f810 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.cob @@ -0,0 +1,30 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_NUMVAL-F.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 result PIC S9(8)V9(9) COMP-5. + 01 vector. + 05 vd. + 10 FILLER PIC X(32) VALUE " - 123.456 E + 2 ". + 10 FILLER PIC X(32) VALUE "123". + 10 FILLER PIC X(32) VALUE ".456". + 10 FILLER PIC X(32) VALUE "123.456". + 10 FILLER PIC X(32) VALUE "-123.456". + 10 FILLER PIC X(32) VALUE "123.456E2". + 10 FILLER PIC X(32) VALUE "-123.456E-2". + 10 FILLER PIC X(32) VALUE "DONE". + 10 FILLER PIC X(32) OCCURS 100 TIMES. + 05 datat REDEFINES vd PIC X(32) OCCURS 100 TIMES INDEXED BY I. + PROCEDURE DIVISION. + SET I TO 1 + PERFORM UNTIL datat(I) EQUALS "DONE" + DISPLAY """"datat(I)"""" SPACE WITH NO ADVANCING + MOVE FUNCTION NUMVAL-F(datat(I)) TO result + DISPLAY result + ADD 1 TO I + END-PERFORM. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.out new file mode 100644 index 0000000..6d27dd2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.out @@ -0,0 +1,8 @@ +" - 123.456 E + 2 " -00012345.600000000 +"123 " +00000123.000000000 +".456 " +00000000.456000000 +"123.456 " +00000123.456000000 +"-123.456 " -00000123.456000000 +"123.456E2 " +00012345.600000000 +"-123.456E-2 " -00000001.234560000 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL.cob new file mode 100644 index 0000000..9288331 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL.cob @@ -0,0 +1,22 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X1 PIC X(12) VALUE " -9876.1234 ". + 01 X2 PIC X(18) VALUE " 19876.1234 CR". + 01 N PIC s9(5)v9(5). + PROCEDURE DIVISION. + MOVE FUNCTION NUMVAL ( X1 ) TO N + IF N NOT = -9876.1234 + DISPLAY N + END-DISPLAY + END-IF + MOVE FUNCTION NUMVAL ( X2 ) TO N + IF N NOT = -19876.1234 + DISPLAY N + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.cob new file mode 100644 index 0000000..0dd1053 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_ORD-MAX.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 RESULT PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD-MAX ( 3 -14 0 8 -3 ) TO RESULT + DISPLAY RESULT + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.out new file mode 100644 index 0000000..c9ce4ea --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.out @@ -0,0 +1,2 @@ +004 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.cob new file mode 100644 index 0000000..fd55396 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_ORD-MIN.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 RESULT PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD-MIN ( 3 -14 0 8 -3 ) TO RESULT + DISPLAY RESULT + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.out new file mode 100644 index 0000000..4119821 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.out @@ -0,0 +1,2 @@ +002 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.cob new file mode 100644 index 0000000..fe5e290 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_ORD.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 RESULT PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD ( "k" ) TO RESULT + DISPLAY RESULT + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.out new file mode 100644 index 0000000..e55677a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.out @@ -0,0 +1,2 @@ +108 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_PI.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_PI.cob new file mode 100644 index 0000000..9792e03 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_PI.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC 9V9(32). + PROCEDURE DIVISION. + MOVE FUNCTION PI TO Y. + IF Y NOT = 3.14159265358979323846264338327950 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.cob new file mode 100644 index 0000000..5883abd --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_PRESENT-VALUE.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 RESULT PIC 9(5)V9(4). + PROCEDURE DIVISION. + MOVE FUNCTION PRESENT-VALUE ( 3 2 1 ) TO RESULT + DISPLAY RESULT + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.out new file mode 100644 index 0000000..52ce840 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.out @@ -0,0 +1,2 @@ +00000.5625 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_RANDOM.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_RANDOM.cob new file mode 100644 index 0000000..0a3e151 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_RANDOM.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S99V99 COMP VALUE -1.0. + PROCEDURE DIVISION. + MOVE FUNCTION RANDOM ( ) TO Y. + IF Y < 0 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_RANGE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_RANGE.cob new file mode 100644 index 0000000..48a9511 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_RANGE.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC S9(4)V9(4) COMP-5. + PROCEDURE DIVISION. + MOVE FUNCTION RANGE ( 3 -14 0 8 -3 ) TO Z. + IF Z NOT = 22 + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__invalid_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__invalid_.cob new file mode 100644 index 0000000..38298a8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__invalid_.cob @@ -0,0 +1,22 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 R PIC S9(4)V9(4) COMP-5 VALUE 4.1. + 01 Z PIC 9 COMP-5 VALUE 0. + PROCEDURE DIVISION. + MOVE FUNCTION REM ( -11 Z ) TO R + IF FUNCTION EXCEPTION-STATUS + NOT = 'EC-ARGUMENT-FUNCTION' + DISPLAY 'Wrong/missing exception: ' + FUNCTION EXCEPTION-STATUS + END-DISPLAY + END-IF + IF R NOT = 0 + DISPLAY 'result is not zero: ' R + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__valid_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__valid_.cob new file mode 100644 index 0000000..7ace4a2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__valid_.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 R PIC S9(4)V9(4) COMP-5 VALUE 0. + PROCEDURE DIVISION. + MOVE FUNCTION REM ( -11 5 ) TO R + IF R NOT = -1 + DISPLAY R END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE.cob new file mode 100644 index 0000000..b1b1690 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(10) VALUE "A#B.C%D+E$". + 01 Z PIC X(10). + PROCEDURE DIVISION. + MOVE FUNCTION REVERSE ( X ) TO Z. + IF Z NOT = "$E+D%C.B#A" + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE_with_reference_modding.cob new file mode 100644 index 0000000..98c28ad --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE_with_reference_modding.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(10) VALUE "A#B.C%D+E$". + 01 Z PIC X(10). + PROCEDURE DIVISION. + MOVE FUNCTION REVERSE ( X ) (1 : 4) TO Z. + IF Z NOT = "$E+D " + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-FROM-FORMATTED-TIME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-FROM-FORMATTED-TIME.cob new file mode 100644 index 0000000..2641e08 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-FROM-FORMATTED-TIME.cob @@ -0,0 +1,58 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 result PIC 9(8)V9(9) COMP-5. + PROCEDURE DIVISION. + MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME + ("hhmmss", "010203") + TO result. + IF result NOT = 3723 + DISPLAY "Test 1 failed: " result + END-DISPLAY + END-IF. + + MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME + ("hh:mm:ss", "01:02:03") + TO result. + IF result NOT = 3723 + DISPLAY "Test 2 failed: " result + END-DISPLAY + END-IF. + + MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME + ("hhmmss.ssssssss", "010203.04050607") + TO result. + IF result NOT = 3723.04050607 + DISPLAY "Test 3 failed: " result + END-DISPLAY + END-IF. + + MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME + ("hhmmssZ", "010203Z") + TO result. + IF result NOT = 3723 + DISPLAY "Test 4 failed: " result + END-DISPLAY + END-IF. + + MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME + ("hhmmss+hhmm", "010203+0405") + TO result. + IF result NOT = 3723 + DISPLAY "Test 5 failed: " result + END-DISPLAY + END-IF. + + MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME + ("YYYYMMDDThhmmss", "16010101T010203") + TO result. + IF result NOT = 3723 + DISPLAY "Test 6 failed: " result + END-DISPLAY + END-IF. + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-PAST-MIDNIGHT.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-PAST-MIDNIGHT.cob new file mode 100644 index 0000000..b229ac3 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-PAST-MIDNIGHT.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC 9(8) COMP-5. + PROCEDURE DIVISION. + MOVE FUNCTION SECONDS-PAST-MIDNIGHT TO Y. + IF Y NOT < 86402 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SIGN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SIGN.cob new file mode 100644 index 0000000..f698d97 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SIGN.cob @@ -0,0 +1,30 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z USAGE BINARY-LONG SIGNED. + PROCEDURE DIVISION. + MOVE FUNCTION SIGN ( 3.12345 ) TO Z. + IF Z NOT = 1 + DISPLAY "Sign 1 " Z + END-DISPLAY + END-IF. + MOVE FUNCTION SIGN ( -0.0 ) TO Z. + IF Z NOT = 0 + DISPLAY "Sign 2 " Z + END-DISPLAY + END-IF. + MOVE FUNCTION SIGN ( 0.0 ) TO Z. + IF Z NOT = 0 + DISPLAY "Sign 3 " Z + END-DISPLAY + END-IF. + MOVE FUNCTION SIGN ( -3.12345 ) TO Z. + IF Z NOT = -1 + DISPLAY "Sign 4 " Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SIN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SIN.cob new file mode 100644 index 0000000..a72df35 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SIN.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(33). + PROCEDURE DIVISION. + MOVE FUNCTION SIN ( 1.5 ) TO Y. + IF Y NOT = 0.997494986604054430941723371141487 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SQRT.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SQRT.cob new file mode 100644 index 0000000..ddf36da --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SQRT.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(33). + PROCEDURE DIVISION. + MOVE FUNCTION SQRT ( 1.5 ) TO Y. + IF Y NOT = 1.224744871391589049098642037352945 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_STANDARD-DEVIATION.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_STANDARD-DEVIATION.cob new file mode 100644 index 0000000..8deadc7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_STANDARD-DEVIATION.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(32). + PROCEDURE DIVISION. + MOVE FUNCTION STANDARD-DEVIATION ( 3 -14 0 8 -3 ) TO Y. + IF Y NOT = 7.35934779718963954877237043574538 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE.cob new file mode 100644 index 0000000..850f1da --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE.cob @@ -0,0 +1,19 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC X(20). + 01 Z PIC X(20). + PROCEDURE DIVISION. + MOVE "ABC111444555defxxabc" TO Y. + MOVE FUNCTION SUBSTITUTE (Y anycase "abc" "zz" + anycase "55" "666") + TO Z. + IF Z NOT = "zz1114446665defxxzz" + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE_with_reference_mod.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE_with_reference_mod.cob new file mode 100644 index 0000000..24ed1b8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE_with_reference_mod.cob @@ -0,0 +1,20 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC X(20). + 01 Z PIC X(20). + PROCEDURE DIVISION. + MOVE "abc111444555defxxabc" TO Y. + MOVE FUNCTION SUBSTITUTE + ( Y anycase "ABC" "zz" + anycase "55" "666" ) (2 : 9) + TO Z. + IF Z NOT = "z11144466" + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.cob new file mode 100644 index 0000000..072c159 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.cob @@ -0,0 +1,24 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_SUBSTITUTE.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC X(24). + PROCEDURE DIVISION. + MOVE "abc111444555defxxabc" TO Y + DISPLAY FUNCTION TRIM (FUNCTION SUBSTITUTE ( Y "abc" "zz" "55" "666" )) + + MOVE "bobBobjimJimbobBobjimJim" TO Y + DISPLAY FUNCTION SUBSTITUTE ( Y "bob" "FILLER" "jim" "Z") + + MOVE "bobBobjimJimbobBobjimJim" TO Y + DISPLAY FUNCTION SUBSTITUTE ( Y FIRST "bob" "FILLER" "jim" "Z") + + MOVE "bobBobjimJimbobBobjimJim" TO Y + DISPLAY FUNCTION SUBSTITUTE ( Y LAST "bob" "FILLER" "jim" "Z") + + MOVE "bobBobjimJimbobBobjimJim" TO Y + DISPLAY FUNCTION SUBSTITUTE ( Y ANYCASE "bob" "FILLER" ANYCASE "jim" "Z") + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.out new file mode 100644 index 0000000..4f5f7a0 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.out @@ -0,0 +1,6 @@ +zz1114446665defxxzz +FILLERBobZJimFILLERBobZJim +FILLERBobZJimbobBobZJim +bobBobZJimFILLERBobZJim +FILLERFILLERZZFILLERFILLERZZ + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE_with_reference_modding.cob new file mode 100644 index 0000000..7894915 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE_with_reference_modding.cob @@ -0,0 +1,19 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC X(20). + 01 Z PIC X(20). + PROCEDURE DIVISION. + MOVE "abc111444555defxxabc" TO Y. + MOVE FUNCTION SUBSTITUTE + ( Y "abc" "zz" "55" "666" ) (2 : 9) + TO Z. + IF Z NOT = "z11144466" + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUM.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUM.cob new file mode 100644 index 0000000..228e996 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUM.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z USAGE BINARY-LONG. + PROCEDURE DIVISION. + MOVE FUNCTION SUM ( 3 -14 0 8 -3 ) TO Z. + IF Z NOT = -6 + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TAN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TAN.cob new file mode 100644 index 0000000..f932157 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TAN.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S99V9(31). + PROCEDURE DIVISION. + MOVE FUNCTION TAN ( 1.5 ) TO Y. + IF Y NOT = 14.1014199471717193876460836519877 + DISPLAY Y + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.cob new file mode 100644 index 0000000..8841f5a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_TEST-DATE-YYYYMMDD.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 RESULT PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION TEST-DATE-YYYYMMDD ( 20020231 ) TO RESULT + DISPLAY RESULT + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.out new file mode 100644 index 0000000..56fa706 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.out @@ -0,0 +1,2 @@ +003 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.cob new file mode 100644 index 0000000..71fbdb9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_TEST-DAY-YYYYDDD__1_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 RESULT PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION TEST-DAY-YYYYDDD ( 2002400 ) TO RESULT + DISPLAY RESULT + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.out new file mode 100644 index 0000000..4119821 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.out @@ -0,0 +1,2 @@ +002 + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__2_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__2_.cob new file mode 100644 index 0000000..24893ab --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__2_.cob @@ -0,0 +1,170 @@ + *> { dg-do run } + + identification division. + program-id. test. + data division. + working-storage section. + 01 datev pic 99999999. + 01 should_be pic 9999. + 01 result pic 9999. + procedure division. + move function test-day-yyyyddd(1945123) to result + move zero to should_be + if result not equal to should_be then + display "test-day-yyyyddd(1945123) should have been " + should_be " but was " result + move 1 to return-code + end-if. + move function test-day-yyyyddd(10000000) to result + move 1 to should_be + if result not equal to should_be then + display "test-day-yyyyddd(100000000) should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1601000 to datev + move 2 to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1601001 to datev + move zero to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1601364 to datev + move zero to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1601365 to datev + move zero to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1601366 to datev + move 2 to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1601367 to datev + move 2 to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 2000365 to datev + move zero to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 2000366 to datev + move zero to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 2000367 to datev + move 2 to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 2100365 to datev + move zero to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 2100366 to datev + move 2 to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 2100367 to datev + move 2 to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1988365 to datev + move zero to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1988366 to datev + move zero to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1988367 to datev + move 2 to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1989365 to datev + move zero to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1989366 to datev + move 2 to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1989367 to datev + move 2 to should_be + move function test-day-yyyyddd(datev) to result + if result not equal to should_be then + display "test-day-yyyyddd(" datev ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + end program test. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_DP.COMMA.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_DP.COMMA.cob new file mode 100644 index 0000000..b825198 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_DP.COMMA.cob @@ -0,0 +1,32 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SPECIAL-NAMES. + DECIMAL-POINT IS COMMA. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss,ss", "000000,00") <> 0 + DISPLAY "Test 1 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDDThhmmss,ss", "16010101T000000,00") <> 0 + DISPLAY "Test 2 failed" END-DISPLAY + END-IF + + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss,ss", "000000.00") <> 7 + DISPLAY "Test 3 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDDThhmmss,ss", "16010101T000000.00") <> 16 + DISPLAY "Test 4 failed" END-DISPLAY + END-IF + + STOP RUN + . + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_additional.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_additional.cob new file mode 100644 index 0000000..e782647 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_additional.cob @@ -0,0 +1,173 @@ + *> { dg-do run } + + identification division. + program-id. test. + data division. + working-storage section. + 01 datev pic 99999999. + 01 should_be pic 9999. + 01 result pic 9999. + 01 date-integer PIC 999999. + 01 i PIC 999. + 01 datex PIC X(8). + 01 xone PIC X. + 01 yyyydddv . + 02 yyyy PIC 9999. + 02 filler PIC X VALUE "-". + 02 ddd PIC 999. + procedure division. + *> TESTING YYYYMMDD + move "19000229" to datex + move function TEST-FORMATTED-DATETIME("YYYYMMDD", datex) to RESULT + move 8 to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYYMMDD""" + ", " + function trim(datex) + ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + *> Test an entire year of YYYYMMDD: + move function integer-of-date(19880101) to date-integer + perform until date-integer >= function integer-of-date(19890101) + move function date-of-integer(date-integer) to datev + move function TEST-FORMATTED-DATETIME("YYYYMMDD", datev) to RESULT + move zero to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYYMMDD""" + ", " + datev + ") should have been " + should_be " but was " result + move 1 to return-code + end-if + add 1 to date-integer + end-perform. + *> Make sure foreign characters trigger the correct gazinga in YYYYMMDD + move "19530227" to datex + perform varying i from 1 by 1 until i > 8 + move datex(i:1) to xone + move 'X' to datex(i:1) + move function TEST-FORMATTED-DATETIME("YYYYMMDD", datex) to RESULT + move i to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYYMMDD""" + ", " + function trim(datex) + ") should have been " + should_be " but was " result + move 1 to return-code + end-if + move xone to datex(i:1) + end-perform. + move "19000229" to datex + move function TEST-FORMATTED-DATETIME("YYYYMMDD", datex) to RESULT + move 8 to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYYMMDD""" + ", " + function trim(datex) + ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move "20000229" to datex + move function TEST-FORMATTED-DATETIME("YYYYMMDD", datex) to RESULT + move 0 to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYYMMDD""" + ", " + function trim(datex) + ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move "20007029" to datex + move function TEST-FORMATTED-DATETIME("YYYYMMDD", datex) to RESULT + move 5 to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYYMMDD""" + ", " + function trim(datex) + ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + *> TESTING YYYY-DDD + move "1988" to yyyy of yyyydddv + move "000" to ddd of yyyydddv + move function TEST-FORMATTED-DATETIME("YYYY-DDD", yyyydddv) to RESULT + move 8 to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYYDDD""" + ", " + function trim(yyyydddv) + ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move "1988" to yyyy of yyyydddv + move "367" to ddd of yyyydddv + move function TEST-FORMATTED-DATETIME("YYYY-DDD", yyyydddv) to RESULT + move 8 to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYYDDD""" + ", " + function trim(yyyydddv) + ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move "1988" to yyyy of yyyydddv + move "399" to ddd of yyyydddv + move function TEST-FORMATTED-DATETIME("YYYY-DDD", yyyydddv) to RESULT + move 7 to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYYDDD""" + ", " + function trim(yyyydddv) + ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1988 to yyyy of yyyydddv + move 400 to ddd of yyyydddv + move function TEST-FORMATTED-DATETIME("YYYY-DDD", yyyydddv) to RESULT + move 6 to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYYDDD""" + ", " + function trim(yyyydddv) + ") should have been " + should_be " but was " result + move 1 to return-code + end-if. + move 1988 to yyyy of yyyydddv + perform varying i from 1 by 1 until i > 366 + move i to ddd of yyyydddv + move function TEST-FORMATTED-DATETIME("YYYY-DDD", yyyydddv) to RESULT + move zero to should_be + if result not equal to should_be then + display "TEST-FORMATTED-DATETIME(" + """YYYY-DDD""" + ", " + function trim(yyyydddv) + ") should have been " + should_be " but was " result + move 1 to return-code + end-if + add 1 to date-integer + end-perform. + end program test. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_dates.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_dates.cob new file mode 100644 index 0000000..1b571f9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_dates.cob @@ -0,0 +1,118 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "16010101") <> 0 + DISPLAY "Test 1 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYY-MM-DD", "1601-01-01") <> 0 + DISPLAY "Test 2 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYDDD", "1601001") <> 0 + DISPLAY "Test 3 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYY-DDD", "1601-001") <> 0 + DISPLAY "Test 4 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYWwwD", "1601W011") <> 0 + DISPLAY "Test 5 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYY-Www-D", "1601-W01-1") <> 0 + DISPLAY "Test 6 failed" END-DISPLAY + END-IF + + + *> How will this work with zero-length items? + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "1") <> 2 + DISPLAY "Test 7 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "160A0101") <> 4 + DISPLAY "Test 8 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "00000101") <> 1 + DISPLAY "Test 9 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "16000101") <> 4 + DISPLAY "Test 10 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "16010001") <> 6 + DISPLAY "Test 11 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "16011301") <> 6 + DISPLAY "Test 12 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "16010190") <> 7 + DISPLAY "Test 13 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "18000229") <> 8 + DISPLAY "Test 14 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYY-MM-DD", "1601 01 01") <> 5 + DISPLAY "Test 15 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "160101010") <> 9 + DISPLAY "Test 16 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYWwwD", "1601A011") <> 5 + DISPLAY "Test 17 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYWwwD", "1601W531") <> 7 + DISPLAY "Test 18 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYWwwD", "1601W601") <> 6 + DISPLAY "Test 19 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYWwwD", "2009W531") <> 0 + DISPLAY "Test 20 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYWwwD", "1601W018") <> 8 + DISPLAY "Test 21 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYDDD", "1601366") <> 7 + DISPLAY "Test 22 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYDDD", "1601370") <> 6 + DISPLAY "Test 23 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYDDD", "1601400") <> 5 + DISPLAY "Test 24 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "01") <> 1 + DISPLAY "Test 25 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDD", "1601010") <> 8 + DISPLAY "Test 26 failed" END-DISPLAY + END-IF + + STOP RUN + . + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_datetimes.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_datetimes.cob new file mode 100644 index 0000000..5591fbb --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_datetimes.cob @@ -0,0 +1,44 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 77 RESULT PIC 9(02). + PROCEDURE DIVISION. + MOVE FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDDThhmmss", "16010101T000000") + TO RESULT + IF RESULT <> 0 + DISPLAY "Test 1 failed: " RESULT END-DISPLAY + END-IF + MOVE FUNCTION TEST-FORMATTED-DATETIME + ("YYYY-MM-DDThh:mm:ss.sssssssss+hh:mm", + "1601-01-01T00:00:00.000000000+00:00") + TO RESULT + IF RESULT <> 0 + DISPLAY "Test 2 failed: " RESULT END-DISPLAY + END-IF + + MOVE FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDDThhmmss", "16010101 000000") + TO RESULT + IF RESULT <> 9 + DISPLAY "Test 3 failed: " RESULT END-DISPLAY + END-IF + MOVE FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDDThhmmss", SPACE) + TO RESULT + IF RESULT <> 1 + DISPLAY "Test 4 failed: " RESULT END-DISPLAY + END-IF + MOVE FUNCTION TEST-FORMATTED-DATETIME + ("YYYYMMDDThhmmss", "16010101T ") + TO RESULT + IF RESULT <> 10 + DISPLAY "Test 5 failed: " RESULT END-DISPLAY + END-IF + + STOP RUN + . + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_times.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_times.cob new file mode 100644 index 0000000..ded9551 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_times.cob @@ -0,0 +1,72 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss.sssssssssZ", "000000.000000000Z") <> 0 + DISPLAY "Test 1 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hh:mm:ss.sssssssssZ", "00:00:00.000000000Z") <> 0 + DISPLAY "Test 2 failed" END-DISPLAY + END-IF + *> 0 instead of +/- valid in sending fields with offset of zero. + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss.sssssssss+hhmm", "000000.00000000000000") + <> 0 + DISPLAY "Test 3 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hh:mm:ss.sssssssss+hh:mm", + "00:00:00.000000000+00:00") + <> 0 + DISPLAY "Test 4 failed" END-DISPLAY + END-IF + + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss", "300000") <> 1 + DISPLAY "Test 5 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss", "250000") <> 2 + DISPLAY "Test 6 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss", "006000") <> 3 + DISPLAY "Test 7 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss", "000060") <> 5 + DISPLAY "Test 8 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hh:mm:ss", "00-00-00") <> 3 + DISPLAY "Test 9 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss.ss", "000000,00") <> 7 + DISPLAY "Test 10 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss+hhmm", "000000 0000") <> 7 + DISPLAY "Test 11 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss+hhmm", "00000000001") <> 11 + DISPLAY "Test 12 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmssZ", "000000A") <> 7 + DISPLAY "Test 13 failed" END-DISPLAY + END-IF + IF FUNCTION TEST-FORMATTED-DATETIME + ("hhmmss", SPACE) <> 1 + DISPLAY "Test 14 failed" END-DISPLAY + END-IF + + STOP RUN + . + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-C.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-C.cob new file mode 100644 index 0000000..e458f4a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-C.cob @@ -0,0 +1,89 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + IF FUNCTION TEST-NUMVAL-C ("+ 1") NOT = 0 + DISPLAY "Test 1 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C (" + 1") NOT = 0 + DISPLAY "Test 2 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("- 1") NOT = 0 + DISPLAY "Test 3 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C (" - 1") NOT = 0 + DISPLAY "Test 4 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("+- 1") NOT = 2 + DISPLAY "Test 5 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("1 +") NOT = 0 + DISPLAY "Test 6 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("1 -") NOT = 0 + DISPLAY "Test 7 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("1 +-") NOT = 4 + DISPLAY "Test 8 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("1 -+") NOT = 4 + DISPLAY "Test 9 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("+ 1.1") NOT = 0 + DISPLAY "Test 10 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("- 1.1") NOT = 0 + DISPLAY "Test 11 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("1.1 +") NOT = 0 + DISPLAY "Test 12 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("1.1 -") NOT = 0 + DISPLAY "Test 13 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("1.1 CR") NOT = 0 + DISPLAY "Test 14 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("1.1 DB") NOT = 0 + DISPLAY "Test 15 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("1.1 -CR") NOT = 6 + DISPLAY "Test 16 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("+ $1.1 ") NOT = 0 + DISPLAY "Test 17 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("- $1.1 ") NOT = 0 + DISPLAY "Test 18 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("+ X1.1 ", "X") NOT = 0 + DISPLAY "Test 19 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-C ("- X1.1 ", "X") NOT = 0 + DISPLAY "Test 20 fail" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-F.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-F.cob new file mode 100644 index 0000000..3fcec0e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-F.cob @@ -0,0 +1,89 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + IF FUNCTION TEST-NUMVAL-F ("+ 1") NOT = 0 + DISPLAY "Test 1 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F (" + 1") NOT = 0 + DISPLAY "Test 2 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("- 1") NOT = 0 + DISPLAY "Test 3 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F (" - 1") NOT = 0 + DISPLAY "Test 4 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("+- 1") NOT = 2 + DISPLAY "Test 5 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1 +") NOT = 3 + DISPLAY "Test 6 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1 -") NOT = 3 + DISPLAY "Test 7 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1 +-") NOT = 3 + DISPLAY "Test 8 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1 -+") NOT = 3 + DISPLAY "Test 9 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("+ 1.1") NOT = 0 + DISPLAY "Test 10 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("- 1.1") NOT = 0 + DISPLAY "Test 11 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1.1 +") NOT = 5 + DISPLAY "Test 12 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1.1 -") NOT = 5 + DISPLAY "Test 13 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1.1 ") NOT = 0 + DISPLAY "Test 14 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1.1 ") NOT = 0 + DISPLAY "Test 15 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1.1 -CR") NOT = 5 + DISPLAY "Test 16 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1.1 E+1") NOT = 0 + DISPLAY "Test 17 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1.1 E -1") NOT = 0 + DISPLAY "Test 18 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("1.1 EE") NOT = 6 + DISPLAY "Test 19 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL-F ("+1.1 E+01") NOT = 0 + DISPLAY "Test 20 fail" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL.cob new file mode 100644 index 0000000..bc38b4e --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL.cob @@ -0,0 +1,89 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + IF FUNCTION TEST-NUMVAL ("+ 1") NOT = 0 + DISPLAY "Test 1 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL (" + 1") NOT = 0 + DISPLAY "Test 2 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("- 1") NOT = 0 + DISPLAY "Test 3 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL (" - 1") NOT = 0 + DISPLAY "Test 4 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("+- 1") NOT = 2 + DISPLAY "Test 5 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1 +") NOT = 0 + DISPLAY "Test 6 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1 -") NOT = 0 + DISPLAY "Test 7 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1 +-") NOT = 4 + DISPLAY "Test 8 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1 -+") NOT = 4 + DISPLAY "Test 9 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("+ 1.1") NOT = 0 + DISPLAY "Test 10 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("- 1.1") NOT = 0 + DISPLAY "Test 11 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1.1 +") NOT = 0 + DISPLAY "Test 12 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1.1 -") NOT = 0 + DISPLAY "Test 13 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1.1 CR") NOT = 0 + DISPLAY "Test 14 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1.1 DB") NOT = 0 + DISPLAY "Test 15 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1.1 -CR") NOT = 6 + DISPLAY "Test 16 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1.1 +DB") NOT = 6 + DISPLAY "Test 17 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("1.1 CDB") NOT = 6 + DISPLAY "Test 18 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("+1.1 CR") NOT = 6 + DISPLAY "Test 19 fail" + END-DISPLAY + END-IF. + IF FUNCTION TEST-NUMVAL ("+ ") NOT = 8 + DISPLAY "Test 20 fail" + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.cob new file mode 100644 index 0000000..054b14a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_TRIM.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(12) VALUE " a#b.c%d+e$ ". + PROCEDURE DIVISION. + DISPLAY FUNCTION TRIM ( X ) + END-DISPLAY. + DISPLAY FUNCTION TRIM ( X TRAILING ) + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.out new file mode 100644 index 0000000..b0e4a72 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.out @@ -0,0 +1,3 @@ +a#b.c%d+e$ + a#b.c%d+e$ + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.cob new file mode 100644 index 0000000..f14f0fa --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_TRIM_with_reference_modding.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(12) VALUE " a#b.c%d+e$ ". + PROCEDURE DIVISION. + DISPLAY FUNCTION TRIM ( X ) (2 : 3) + END-DISPLAY. + DISPLAY FUNCTION TRIM ( X TRAILING ) (2 : 3) + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.out new file mode 100644 index 0000000..f716581 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.out @@ -0,0 +1,3 @@ +#b. +a#b + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.cob new file mode 100644 index 0000000..d92a490 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.cob @@ -0,0 +1,18 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_TRIM_zero_length.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 A2 PIC X(2) VALUE " ". + 01 A3 PIC X(3) VALUE " ". + 01 X PIC X(4) VALUE "NOOK". + PROCEDURE DIVISION. + MOVE FUNCTION TRIM ( A2 ) TO X. + DISPLAY ">" X "<" + END-DISPLAY. + DISPLAY ">" FUNCTION TRIM ( A3 ) "<" + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.out new file mode 100644 index 0000000..9aa7900 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.out @@ -0,0 +1,3 @@ +> < +>< + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE.cob new file mode 100644 index 0000000..9bf6a6b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(10) VALUE "a#b.c%d+e$". + 01 Z PIC X(10). + PROCEDURE DIVISION. + MOVE FUNCTION UPPER-CASE ( X ) TO Z. + IF Z NOT = "A#B.C%D+E$" + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE_with_reference_modding.cob new file mode 100644 index 0000000..2f96446 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE_with_reference_modding.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X PIC X(10) VALUE "a#b.c%d+e$". + 01 Z PIC X(4). + PROCEDURE DIVISION. + MOVE FUNCTION UPPER-CASE ( X ) (1 : 3) TO Z. + IF Z NOT = "A#B " + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_VARIANCE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_VARIANCE.cob new file mode 100644 index 0000000..0a08f5a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_VARIANCE.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC S9(4)V9(4) COMP-5. + PROCEDURE DIVISION. + MOVE FUNCTION VARIANCE ( 3 -14 0 8 -3 ) TO Z. + IF Z NOT = 54.16 + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_WHEN-COMPILED.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_WHEN-COMPILED.cob new file mode 100644 index 0000000..d47967b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_WHEN-COMPILED.cob @@ -0,0 +1,45 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 compiled-datetime. + 03 compiled-date. + 05 millennium PIC X. + 05 FILLER PIC X(15). + 03 timezone PIC X(5). + PROCEDURE DIVISION. + *> Check millennium. + MOVE FUNCTION WHEN-COMPILED TO compiled-datetime. + IF millennium NOT = "2" + DISPLAY "Millennium NOT OK: " millennium + END-DISPLAY + END-IF. + + *> Check timezone. + IF timezone NOT = FUNCTION CURRENT-DATE (17:5) + DISPLAY "Timezone NOT OK: " timezone + END-DISPLAY + END-IF. + + *> Check date format. + INSPECT compiled-date CONVERTING "0123456789" + TO "9999999999". + IF compiled-date NOT = ALL "9" + DISPLAY "Date format NOT OK: " compiled-date + END-DISPLAY + END-IF. + + *> Check timezone format. + IF timezone NOT = "00000" + INSPECT timezone CONVERTING "0123456789" + TO "9999999999" + IF timezone NOT = "+9999" AND "-9999" + DISPLAY "Timezone format NOT OK: " timezone + END-DISPLAY + END-IF + END-IF. + + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_YEAR-TO-YYYY.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_YEAR-TO-YYYY.cob new file mode 100644 index 0000000..ece8151 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_YEAR-TO-YYYY.cob @@ -0,0 +1,15 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z USAGE BINARY-LONG. + PROCEDURE DIVISION. + MOVE FUNCTION YEAR-TO-YYYY ( 50 ) TO Z. + IF Z NOT = 2050 + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob new file mode 100644 index 0000000..e25ac8b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob @@ -0,0 +1,27 @@ + *> { dg-do run } + *> { dg-output-file "group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + PROCEDURE DIVISION. + PROG-MAIN. + CALL "subprog" USING BY CONTENT + FUNCTION CONCAT("Abc" "D") + STOP RUN. + + *> ***************************** + IDENTIFICATION DIVISION. + PROGRAM-ID. subprog. + + DATA DIVISION. + LINKAGE SECTION. + 01 TESTING PIC X ANY LENGTH. + + PROCEDURE DIVISION USING TESTING. + SUBPROG-MAIN. + DISPLAY TESTING + GOBACK. + END PROGRAM subprog. + END PROGRAM prog. *> bzzt + diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out new file mode 100644 index 0000000..11f0477 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out @@ -0,0 +1,2 @@ +AbcD + diff --git a/gcc/testsuite/cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__2_.cob b/gcc/testsuite/cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__2_.cob new file mode 100644 index 0000000..b94adf5 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__2_.cob @@ -0,0 +1,17 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION PI + FUNCTION E. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC 99V99. + PROCEDURE DIVISION. + MOVE PI TO Z. + MOVE E TO Z. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.cob b/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.cob new file mode 100644 index 0000000..6e0443d --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.cob @@ -0,0 +1,237 @@ + *> { dg-do run } + *> { dg-output-file "group2/Program-to-program_parameters_and_retvals.out" } + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 var1 pic 9 VALUE 1. + 01 var2 BINARY-CHAR VALUE 22. + 01 var3 pic s999 COMP-3 VALUE -333. + 01 var4 pic 9999 BINARY VALUE 4444. + 01 var5 pic 99.99 VALUE "12.34". + 01 var6 pic s999V999 COMP-5 VALUE -123.456. + 01 var7 float-short VALUE 1.23E10. + 01 var8 float-long VALUE -1.23E20. + 01 var9 float-extended VALUE 1.23E40. + 01 var64 pic 9(15) VALUE 987654321098765. + 01 var128 pic s9(30) VALUE -987654321098765432109876543210. + 01 filler. + 02 varpd pic 9(18) comp-5 value 1250999747361. + 02 varp redefines varpd pointer. + 01 varg. + 02 varg1 pic x(7) VALUE "That's". + 02 varg2 pic x(5) VALUE "all," . + 02 varg3 pic x(7) VALUE "folks!". + + 01 var1r pic 9 . + 01 var2r BINARY-CHAR . + 01 var3r pic s999 COMP-3 . + 01 var4r pic 9999 BINARY . + 01 var5r pic 99.99 . + 01 var6r pic s999V999 COMP-5 . + 01 var7r float-short . + 01 var8r float-long . + 01 var9r float-extended . + 01 var64r pic 9(15) . + 01 var128r pic s9(30) . + 01 varpr pointer. + 01 vargr. + 02 varg1 pic x(7). + 02 varg2 pic x(5). + 02 varg3 pic x(7). + + PROCEDURE DIVISION. + display var1 + call "rvar1" USING by value var1 RETURNING var1r + display var1r + + display var2 + call "rvar2" USING by reference var2 RETURNING var2r + display var2r + + display var3 + call "rvar3" USING by content var3 RETURNING var3r + display var3r + + display var4 + call "rvar4" USING by value var4 RETURNING var4r + display var4r + + display var5 + call "rvar5" USING by reference var5 RETURNING var5r + display var5r + + display var6 + call "rvar6" USING by content var6 RETURNING var6r + display var6r + + display var7 + call "rvar7" USING by reference var7 RETURNING var7r + display var7r + + display var8 + call "rvar8" USING by value var8 RETURNING var8r + display var8r + + display var9 + call "rvar9" USING by content var9 RETURNING var9r + display var9r + + display var64 + call "rvar64" USING by value var64 RETURNING var64r + display var64r + + display var128 + call "rvar128" USING by reference var128 RETURNING var128r + display var128r + + display varp + call "rvarp" USING by reference varp RETURNING varpr + display varpr + + display """"varg"""" + call "rvarg" USING by reference varg RETURNING vargr + display """"vargr"""" + + GOBACK. + END PROGRAM prog. + + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar1. + DATA DIVISION. + LINKAGE SECTION. + 01 var pic 9 . + 01 varr pic 9 . + PROCEDURE DIVISION USING by value var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvar1. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar2. + DATA DIVISION. + LINKAGE SECTION. + 01 var BINARY-CHAR . + 01 varr BINARY-CHAR . + PROCEDURE DIVISION USING by reference var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvar2. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar3. + DATA DIVISION. + LINKAGE SECTION. + 01 var pic s999 COMP-3 . + 01 varr pic s999 COMP-3 . + PROCEDURE DIVISION USING by reference var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvar3. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar4. + DATA DIVISION. + LINKAGE SECTION. + 01 var pic 9999 BINARY . + 01 varr pic 9999 BINARY . + PROCEDURE DIVISION USING by value var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvar4. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar5. + DATA DIVISION. + LINKAGE SECTION. + 01 var pic 99.99 . + 01 varr pic 99.99 . + PROCEDURE DIVISION USING by reference var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvar5. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar6. + DATA DIVISION. + LINKAGE SECTION. + 01 var pic s999V999 COMP-5 . + 01 varr pic s999V999 COMP-5 . + PROCEDURE DIVISION USING reference var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvar6. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar7. + DATA DIVISION. + LINKAGE SECTION. + 01 var float-short . + 01 varr float-short . + PROCEDURE DIVISION USING by reference VAR RETURNING varr. + MOVE var TO varr. + GOBACK. + END PROGRAM rvar7. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar8. + DATA DIVISION. + LINKAGE SECTION. + 01 var float-long . + 01 varr float-long . + PROCEDURE DIVISION USING by value var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvar8. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar9. + DATA DIVISION. + LINKAGE SECTION. + 01 var float-extended . + 01 varr float-extended . + PROCEDURE DIVISION USING by reference var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvar9. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar64. + DATA DIVISION. + LINKAGE SECTION. + 01 var pic 9(15) . + 01 varr pic 9(15) . + PROCEDURE DIVISION USING by value var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvar64. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvar128. + DATA DIVISION. + LINKAGE SECTION. + 01 var pic s9(30) . + 01 varr pic s9(30) . + PROCEDURE DIVISION USING by reference var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvar128. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvarp. + DATA DIVISION. + LINKAGE SECTION. + 01 var pointer . + 01 varr pointer . + PROCEDURE DIVISION USING by reference var RETURNING varr. + SET varr TO var. + END PROGRAM rvarp. + + IDENTIFICATION DIVISION. + PROGRAM-ID. rvarg. + DATA DIVISION. + LINKAGE SECTION. + 01 var. + 02 varg1 pic x(7). + 02 varg2 pic x(5). + 02 varg3 pic x(7). + 01 varr. + 02 varg1 pic x(7). + 02 varg2 pic x(5). + 02 varg3 pic x(7). + PROCEDURE DIVISION USING by reference var RETURNING varr. + MOVE var TO varr. + END PROGRAM rvarg. + diff --git a/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.out b/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.out new file mode 100644 index 0000000..ce543df --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.out @@ -0,0 +1,27 @@ +1 +1 ++022 ++022 +-333 +-333 +4444 +4444 +12.34 +12.34 +-123.456 +-123.456 +1.230000026E+10 +1.230000026E+10 +-1.23E+20 +-1.23E+20 +1.23E+40 +1.23E+40 +987654321098765 +987654321098765 +-987654321098765432109876543210 +-987654321098765432109876543210 +0x0000012345654321 +0x0000012345654321 +"That's all, folks! " +"That's all, folks! " + diff --git a/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.cob b/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.cob new file mode 100644 index 0000000..122aab7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.cob @@ -0,0 +1,38 @@ + *> { dg-do run } + *> { dg-output-file "group2/Recursive_FUNCTION_with_local-storage.out" } + IDENTIFICATION DIVISION. + FUNCTION-ID. callee. + DATA DIVISION. + LOCAL-STORAGE SECTION. + 01 LCL-X PIC 999 . + LINKAGE SECTION. + 01 parm PIC 999. + 01 retval PIC 999. + PROCEDURE DIVISION USING parm RETURNING retval. + display "On entry, parm is: " parm + move parm to lcl-x + move parm to retval + subtract 1 from parm + if parm > 0 + display "A The function returns " function callee(parm). + if lcl-x not equal to retval + display "On exit, lcl-s and retval are: " lcl-x " and " retval + display "But they should be equal to each other" + end-if + goback. + end function callee. + IDENTIFICATION DIVISION. + PROGRAM-ID. caller. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION callee. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 val PIC 999 VALUE 5. + PROCEDURE DIVISION. + DISPLAY "Starting value is: " val + display "B The function returns " function callee(val). + STOP RUN. + end program caller. + diff --git a/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.out b/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.out new file mode 100644 index 0000000..3ccd69a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.out @@ -0,0 +1,12 @@ +Starting value is: 005 +On entry, parm is: 005 +On entry, parm is: 004 +On entry, parm is: 003 +On entry, parm is: 002 +On entry, parm is: 001 +A The function returns 001 +A The function returns 002 +A The function returns 003 +A The function returns 004 +B The function returns 005 + diff --git a/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.cob b/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.cob new file mode 100644 index 0000000..cc306b4 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.cob @@ -0,0 +1,14 @@ + *> { dg-do run } + *> { dg-output-file "group2/Repository_functions_clause.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SOURCE-COMPUTER. a. + OBJECT-COMPUTER. a. + REPOSITORY. + FUNCTION ALL INTRINSIC. + PROCEDURE DIVISION. + DISPLAY "OK". + diff --git a/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.out b/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.out new file mode 100644 index 0000000..885fd66 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.out @@ -0,0 +1,2 @@ +OK + diff --git a/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.cob b/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.cob new file mode 100644 index 0000000..d4df058 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.cob @@ -0,0 +1,51 @@ + *> { dg-do run } + *> { dg-output-file "group2/UDF_RETURNING_group_and_PIC_9_5_.out" } + + IDENTIFICATION DIVISION. + FUNCTION-ID. COPYPAR. + DATA DIVISION. + LINKAGE SECTION. + 01 PARSA. + 02 PAR1 PICTURE X(32). + 02 PAR2 PICTURE X(32). + 01 PARSB. + 02 PAR1 PICTURE X(32). + 02 PAR2 PICTURE X(32). + PROCEDURE DIVISION USING PARSA RETURNING PARSB. + MOVE PARSA TO PARSB + DISPLAY """" PARSB """" + GOBACK. + END FUNCTION COPYPAR. + IDENTIFICATION DIVISION. + FUNCTION-ID. COPYPAR2. + DATA DIVISION. + LINKAGE SECTION. + 01 PARSB PIC 99999. + 01 PAR5 PIC 99999. + PROCEDURE DIVISION USING PAR5 RETURNING PARSB. + MOVE PAR5 TO PARSB + DISPLAY PARSB + GOBACK. + END FUNCTION COPYPAR2. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION COPYPAR, COPYPAR2. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 PARS1. + 02 PAR1 PICTURE X(32) VALUE "Santa". + 02 PAR2 PICTURE X(32) VALUE "Claus". + 01 PARS2. + 02 PAR1 PICTURE X(32). + 02 PAR2 PICTURE X(32). + 01 PAR5 PICTURE 99999 VALUE 54321. + PROCEDURE DIVISION. + MOVE COPYPAR(PARS1) TO PARS2 + DISPLAY """" PARS2 """". + DISPLAY COPYPAR2(PAR5) + STOP RUN. + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.out b/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.out new file mode 100644 index 0000000..1361e9a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.out @@ -0,0 +1,5 @@ +"Santa Claus " +"Santa Claus " +54321 +54321 + diff --git a/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.cob b/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.cob new file mode 100644 index 0000000..71ef09b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.cob @@ -0,0 +1,39 @@ + *> { dg-do run } + *> { dg-output-file "group2/UDF_fibonacci_recursion.out" } + + identification division. + function-id. fib-func. + data division. + working-storage section. + 01 instance pic 9999 value 0. + linkage section. + 01 n binary-char unsigned. + 01 f-n binary-long unsigned. + procedure division using n returning f-n. + evaluate true + when n = 0 + move 0 to f-n + when n = 1 + move 1 to f-n + when other + compute f-n = fib-func(n - 1) + fib-func(n - 2) + end-evaluate + goback . + end function fib-func. + + identification division. + program-id. pmain. + environment division. + configuration section. + repository. + function fib-func. + data division. + working-storage section. + 01 n binary-char unsigned. + procedure division. + perform varying n from 1 by 1 until n > 16 + display "fibonacci(" n "): " fib-func(n) + end-perform + stop run. + end program pmain. + diff --git a/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.out b/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.out new file mode 100644 index 0000000..34dabfb --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.out @@ -0,0 +1,17 @@ +fibonacci(001): 1 +fibonacci(002): 1 +fibonacci(003): 2 +fibonacci(004): 3 +fibonacci(005): 5 +fibonacci(006): 8 +fibonacci(007): 13 +fibonacci(008): 21 +fibonacci(009): 34 +fibonacci(010): 55 +fibonacci(011): 89 +fibonacci(012): 144 +fibonacci(013): 233 +fibonacci(014): 377 +fibonacci(015): 610 +fibonacci(016): 987 + diff --git a/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.cob b/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.cob new file mode 100644 index 0000000..74576b6 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.cob @@ -0,0 +1,33 @@ + *> { dg-do run } + *> { dg-output-file "group2/UDF_in_COMPUTE.out" } + + IDENTIFICATION DIVISION. + FUNCTION-ID. func. + + DATA DIVISION. + LINKAGE SECTION. + 01 num PIC 999. + + PROCEDURE DIVISION RETURNING num. + MOVE 100 TO num + . + END FUNCTION func. + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION func. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 x PIC 999. + + PROCEDURE DIVISION. + COMPUTE x = 101 + FUNCTION func + DISPLAY x + . + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.out b/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.out new file mode 100644 index 0000000..d757a46 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.out @@ -0,0 +1,2 @@ +201 + diff --git a/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.cob b/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.cob new file mode 100644 index 0000000..1e9b378 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.cob @@ -0,0 +1,49 @@ + *> { dg-do run } + *> { dg-output-file "group2/UDF_with_recursion.out" } + + IDENTIFICATION DIVISION. + FUNCTION-ID. foo. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 ttl PIC 9 VALUE 1. + + LOCAL-STORAGE SECTION. + 01 num PIC 9. + + LINKAGE SECTION. + 01 arg PIC 9. + 01 ret PIC 9. + + PROCEDURE DIVISION USING arg RETURNING ret. + IF arg < 5 + ADD 1 TO arg GIVING num END-ADD + MOVE FUNCTION foo (num) TO ret + ELSE + MOVE arg TO ret + END-IF + DISPLAY "Step: " ttl ", Arg: " arg ", Return: " ret + END-DISPLAY + ADD 1 to ttl END-ADD + GOBACK. + END FUNCTION foo. + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION foo. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 num PIC 9 VALUE 1. + + PROCEDURE DIVISION. + DISPLAY "Return value '" FUNCTION foo (num) "'" + WITH NO ADVANCING + END-DISPLAY + GOBACK. + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.out b/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.out new file mode 100644 index 0000000..13bd1e9 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.out @@ -0,0 +1,6 @@ +Step: 1, Arg: 5, Return: 5 +Step: 2, Arg: 4, Return: 5 +Step: 3, Arg: 3, Return: 5 +Step: 4, Arg: 2, Return: 5 +Step: 5, Arg: 1, Return: 5 +Return value '5' diff --git a/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.cob b/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.cob new file mode 100644 index 0000000..3753e7a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.cob @@ -0,0 +1,36 @@ + *> { dg-do run } + *> { dg-output-file "group2/call_subprogram_using_pointer__passing_pointer.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 77 varp program-pointer. + PROCEDURE DIVISION. + SET varp TO ENTRY "ref". + CALL "sub" USING BY VALUE varp. + end program prog. + + IDENTIFICATION DIVISION. + PROGRAM-ID. sub. + DATA DIVISION. + WORKING-STORAGE SECTION. + 77 param pic x(12) value "hi". + LINKAGE SECTION. + 77 varp program-pointer. + PROCEDURE DIVISION USING BY VALUE varp. + DISPLAY "About to call 'ref hi' directly" + CALL "ref" USING param. + DISPLAY "About to call 'ref hi' indirectly" + CALL varp USING param. + end program sub. + + IDENTIFICATION DIVISION. + PROGRAM-ID. ref. + DATA DIVISION. + LINKAGE SECTION. + 77 greeting pic x(12). + PROCEDURE DIVISION using greeting. + DISPLAY """" greeting """". + end program ref. + diff --git a/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.out b/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.out new file mode 100644 index 0000000..7a12ec1 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.out @@ -0,0 +1,5 @@ +About to call 'ref hi' directly +"hi " +About to call 'ref hi' indirectly +"hi " + diff --git a/gcc/testsuite/g++.dg/cpp/pr119391.C b/gcc/testsuite/g++.dg/cpp/pr119391.C new file mode 100644 index 0000000..6e70efc --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp/pr119391.C @@ -0,0 +1,15 @@ +// PR preprocessor/119391 +// { dg-do preprocess } +// { dg-options "" } + +#if (1 << 63) != -9223372036854775807 - 1 // { dg-warning "integer overflow in preprocessor expression" "" { target c++98_only } } +#warning "Unexpected value" +#endif +#if (3 << 62) != -4611686018427387904 // { dg-warning "integer overflow in preprocessor expression" "" { target c++98_only } } +#warning "Unexpected value" +#endif +#if 1 << 64 // { dg-warning "integer overflow in preprocessor expression" } +#endif +#if (3 << 63) != -9223372036854775807 - 1 // { dg-warning "integer overflow in preprocessor expression" "" { target c++17_down } } +#warning "Unexpected value" +#endif diff --git a/gcc/testsuite/g++.dg/cpp0x/lambda/lambda-__func__3.C b/gcc/testsuite/g++.dg/cpp0x/lambda/lambda-__func__3.C new file mode 100644 index 0000000..50ad6e5 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/lambda/lambda-__func__3.C @@ -0,0 +1,6 @@ +// PR c++/118629 +// { dg-do compile { target c++11 } } + +void foo() { + []() -> decltype(+__FUNCTION__) { return nullptr; }; +} diff --git a/gcc/testsuite/g++.dg/cpp2a/concepts-requires41.C b/gcc/testsuite/g++.dg/cpp2a/concepts-requires41.C new file mode 100644 index 0000000..28c9761 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/concepts-requires41.C @@ -0,0 +1,25 @@ +// PR c++/117849 +// { dg-do compile { target c++20 } } + +template<int N> +struct array { + constexpr int size() const { return N; } +}; + +struct vector { + int _size = 3; + constexpr int size() const { return _size; } +}; + +template<int N> +struct integral_constant { + constexpr operator int() const { return N; } +}; + +template<class T> +concept StaticSize = requires (T& t) { + typename integral_constant<t.size()>; +}; + +static_assert(StaticSize<array<5>>); +static_assert(!StaticSize<vector>); diff --git a/gcc/testsuite/g++.dg/cpp2a/lambda-requires2.C b/gcc/testsuite/g++.dg/cpp2a/lambda-requires2.C new file mode 100644 index 0000000..be5a71a --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/lambda-requires2.C @@ -0,0 +1,8 @@ +// PR c++/99546 +// { dg-do compile { target c++20 } } + +int main() { + constexpr auto b = requires { []{}; }; + static_assert(b); + static_assert(!b); // { dg-error "assertion failed" } +} diff --git a/gcc/testsuite/g++.dg/cpp2a/lambda-requires3.C b/gcc/testsuite/g++.dg/cpp2a/lambda-requires3.C new file mode 100644 index 0000000..8c4ef06 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/lambda-requires3.C @@ -0,0 +1,6 @@ +// PR c++/113925 +// { dg-do compile { target c++20 } } + +template<bool B> +struct b{}; +static_assert(requires { b<([]()consteval{ return true; }())>{}; }); diff --git a/gcc/testsuite/g++.dg/cpp2a/lambda-requires4.C b/gcc/testsuite/g++.dg/cpp2a/lambda-requires4.C new file mode 100644 index 0000000..f3bb041 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/lambda-requires4.C @@ -0,0 +1,6 @@ +// PR c++/106976 +// { dg-do compile { target c++20 } } + +struct S{ + constexpr static auto s = requires { []; }; // { dg-error "expected '\{'" } +}; diff --git a/gcc/testsuite/g++.dg/cpp2a/lambda-requires5.C b/gcc/testsuite/g++.dg/cpp2a/lambda-requires5.C new file mode 100644 index 0000000..c818313 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/lambda-requires5.C @@ -0,0 +1,10 @@ +// PR c++/109961 +// { dg-do compile { target c++20 } } + +auto a = requires{ + []( int b ) consteval { + if( b ) { + throw b; + } + }( 0 ); +}; diff --git a/gcc/testsuite/g++.dg/cpp2a/spaceship-rewrite6.C b/gcc/testsuite/g++.dg/cpp2a/spaceship-rewrite6.C new file mode 100644 index 0000000..0ec74e8 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/spaceship-rewrite6.C @@ -0,0 +1,33 @@ +// { dg-do compile { target c++20 } } + +// We wrongly considered D to be ne_comparable because we were looking for a +// corresponding op!= for N::op== in ::, because ::op== happened to be the +// first thing in the lookup set. + +template<bool, typename _Tp = void> +struct enable_if; + +template<typename _Tp> +struct enable_if<true, _Tp> +{ typedef _Tp type; }; + +template <class T, class U> struct A { }; + +namespace N { + struct X { }; + template <class T> auto operator== (const A<T,X>&, const A<T,X>&) + -> typename enable_if<sizeof(T() == T()), bool>::type; + template <class T> auto operator!= (const A<T,X>&, const A<T,X>&) + -> typename enable_if<sizeof(T() != T()), bool>::type; +} + +template<typename T, typename U = T> +concept ne_comparable += requires (const A<T,N::X>& t, const A<U,N::X>& u) { + t != u; +}; + +struct D { }; +int operator==(D, D); +bool operator!=(D, D) = delete; +static_assert( ! ne_comparable<D> ); diff --git a/gcc/testsuite/g++.dg/modules/gc-3_a.C b/gcc/testsuite/g++.dg/modules/gc-3_a.C new file mode 100644 index 0000000..b4adb2a --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/gc-3_a.C @@ -0,0 +1,7 @@ +// PR c++/119564 +// { dg-additional-options "-fmodules -Wtemplate-names-tu-local" } +// { dg-module-cmi M } + +export module M; +static void foo() {}; // { dg-message "declared" } +template <typename> void bar() { foo(); } // { dg-warning "TU-local" } diff --git a/gcc/testsuite/g++.dg/modules/gc-3_b.C b/gcc/testsuite/g++.dg/modules/gc-3_b.C new file mode 100644 index 0000000..1d1dc87 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/gc-3_b.C @@ -0,0 +1,4 @@ +// PR c++/119564 +// { dg-additional-options "-fmodules -fno-module-lazy --param=ggc-min-expand=0 --param=ggc-min-heapsize=0" } + +import M; diff --git a/gcc/testsuite/g++.dg/modules/noexcept-3_a.C b/gcc/testsuite/g++.dg/modules/noexcept-3_a.C new file mode 100644 index 0000000..00494d3 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/noexcept-3_a.C @@ -0,0 +1,14 @@ +// PR c++/119462 +// { dg-additional-options "-fmodules -std=c++20 -Wno-global-module" } +// { dg-module-cmi M:part } + +module; +struct exception_ptr { + // implicitly noexcept and constexpr + friend bool operator==(const exception_ptr&, const exception_ptr&) = default; +}; +export module M:part; +export template <typename = int> void enqueue() { + exception_ptr e; + e == e; +} diff --git a/gcc/testsuite/g++.dg/modules/noexcept-3_b.C b/gcc/testsuite/g++.dg/modules/noexcept-3_b.C new file mode 100644 index 0000000..f26f8f0 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/noexcept-3_b.C @@ -0,0 +1,12 @@ +// PR c++/119462 +// { dg-additional-options "-fmodules -std=c++20 -Wno-global-module" } +// { dg-module-cmi M } + +module; +struct exception_ptr { + // implicitly noexcept and constexpr, but this isn't known yet + friend bool operator==(const exception_ptr&, const exception_ptr&) = default; +}; +export module M; +export import :part; +export using ::exception_ptr; diff --git a/gcc/testsuite/g++.dg/modules/noexcept-3_c.C b/gcc/testsuite/g++.dg/modules/noexcept-3_c.C new file mode 100644 index 0000000..a1e98a5 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/noexcept-3_c.C @@ -0,0 +1,11 @@ +// PR c++/119462 +// { dg-additional-options "-fmodules -std=c++20" } + +import M; +int main() { + enqueue(); + + constexpr exception_ptr e; + static_assert(e == e); + static_assert(noexcept(e == e)); +} diff --git a/gcc/testsuite/g++.dg/modules/pr119608_a.C b/gcc/testsuite/g++.dg/modules/pr119608_a.C new file mode 100644 index 0000000..4e7b359 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/pr119608_a.C @@ -0,0 +1,16 @@ +// PR c++/119608 +// { dg-additional-options "-fmodules" } +// { dg-module-cmi repro } + +export module repro; + +export template<class Visitor> +auto +visit( + Visitor v +) -> decltype( + v); + +export template<class Visitor> auto visit(Visitor v) -> decltype(v) { + return {}; +} diff --git a/gcc/testsuite/g++.dg/modules/pr119608_b.C b/gcc/testsuite/g++.dg/modules/pr119608_b.C new file mode 100644 index 0000000..023d20a --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/pr119608_b.C @@ -0,0 +1,8 @@ +// PR c++/119608 +// { dg-additional-options "-fmodules" } + +import repro; + +int main() { + visit(123); +} diff --git a/gcc/testsuite/g++.dg/opt/pr119613.C b/gcc/testsuite/g++.dg/opt/pr119613.C new file mode 100644 index 0000000..432a30c --- /dev/null +++ b/gcc/testsuite/g++.dg/opt/pr119613.C @@ -0,0 +1,22 @@ +// PR middle-end/119613 +// { dg-do compile { target { musttail && { c || c++11 } } } } +// { dg-options "-O0" } + +struct S { S () {} }; +char *foo (S); +void bar (int); + +[[gnu::always_inline]] inline char * +baz (S x) +{ + unsigned i; + &i; + bar (i); + [[gnu::musttail]] return foo (x); +} + +char * +qux (S) +{ + [[gnu::musttail]] return baz (S {}); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/pr46534.c b/gcc/testsuite/gcc.c-torture/compile/pr46534.c index 1894636..7f10bc0 100644 --- a/gcc/testsuite/gcc.c-torture/compile/pr46534.c +++ b/gcc/testsuite/gcc.c-torture/compile/pr46534.c @@ -1,4 +1,3 @@ -/* { dg-skip-if "too big" { nvptx-*-* } } */ /* PR middle-end/46534 */ extern int printf (const char *, ...); diff --git a/gcc/testsuite/gcc.dg/builtin-apply5.c b/gcc/testsuite/gcc.dg/builtin-apply5.c new file mode 100644 index 0000000..16892f7 --- /dev/null +++ b/gcc/testsuite/gcc.dg/builtin-apply5.c @@ -0,0 +1,23 @@ +/* { dg-options "-O2 -Wmissing-noreturn -fgnu89-inline" } */ +/* { dg-additional-options "-mno-mmx" { target { { i?86-*-* x86_64-*-* } && ia32 } } } */ +/* { dg-do compile } */ + +extern void abort (void); + +double +foo (int arg) +{ + if (arg != 116) + abort(); + return arg + 1; +} + +__attribute__((noreturn)) +double +bar (int arg) +{ + foo (arg); + __builtin_return (__builtin_apply ((void (*) ()) foo, /* { dg-warning "'noreturn' function does return" } */ + __builtin_apply_args (), 16)); +} + diff --git a/gcc/testsuite/gcc.dg/torture/pr119599-1.c b/gcc/testsuite/gcc.dg/torture/pr119599-1.c new file mode 100644 index 0000000..4fbd228 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr119599-1.c @@ -0,0 +1,27 @@ +/* { dg-do compile } */ +/* { dg-options "-fdump-tree-einline" } */ + +/* PR ipa/119599 */ +/* inlining a noreturn function which returns + can cause an ICE when dealing finding an unreachable block. + We should get a __builtin_unreachable after the inliing. */ + + +void baz (void); + +static inline __attribute__((always_inline, noreturn)) void +bar (void) +{ + static volatile int t = 0; + if (t == 0) + baz (); +} /* { dg-warning "function does return" } */ + +void +foo (void) +{ + bar (); +} + +/* After inlining, we should have call to __builtin_unreachable now. */ +/* { dg-final { scan-tree-dump "__builtin_unreachable " "einline" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-fncall-mask.c b/gcc/testsuite/gcc.dg/vect/vect-fncall-mask.c index 554488e..ba1886d 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-fncall-mask.c +++ b/gcc/testsuite/gcc.dg/vect/vect-fncall-mask.c @@ -1,7 +1,7 @@ /* { dg-do compile { target { aarch64*-*-* } } } */ -/* { dg-additional-options "-march=armv8.2-a+sve -fdump-tree-ifcvt-raw -Ofast" { target { aarch64*-*-* } } } */ +/* { dg-additional-options "-march=armv8.2-a+sve -fdump-tree-ifcvt -Ofast" { target { aarch64*-*-* } } } */ -extern int __attribute__ ((simd, const)) fn (int); +extern int __attribute__ ((simd, const)) fn (float); const int N = 20; const float lim = 101.0; @@ -26,6 +26,4 @@ int main (void) return (0); } -/* { dg-final { scan-tree-dump {gimple_assign <gt_expr, _12, _1, 1.01e\+2, NULL>} ifcvt } } */ -/* { dg-final { scan-tree-dump {gimple_assign <bit_not_expr, _34, _12, NULL, NULL>} ifcvt } } */ -/* { dg-final { scan-tree-dump {gimple_call <.MASK_CALL, _3, fn, _2, _34>} ifcvt } } */ +/* { dg-final { scan-tree-dump {(_\d+) = (_\d+) > 1.01e\+2;\n\s*(_\d+) = ~\1;\n\s*_\d+ = .MASK_CALL \(fn, \2, \3\);} ifcvt } } */ diff --git a/gcc/testsuite/gcc.target/arm/mve/mve.exp b/gcc/testsuite/gcc.target/arm/mve/mve.exp index a5d8511..9dc56c9 100644 --- a/gcc/testsuite/gcc.target/arm/mve/mve.exp +++ b/gcc/testsuite/gcc.target/arm/mve/mve.exp @@ -35,6 +35,7 @@ global dg_runtest_extra_prunes set dg_runtest_extra_prunes "" lappend dg_runtest_extra_prunes "warning: switch '-m(cpu|arch)=.*' conflicts with switch '-m(cpu|arch)=.*'" +set saved-dg-do-what-default ${dg-do-what-default} set dg-do-what-default "assemble" # Initialize `dg'. @@ -53,6 +54,8 @@ dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/general-c/*.\[cCS\]]] \ dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.\[cCS\]]] \ "" $DEFAULT_CFLAGS +set dg-do-what-default ${saved-dg-do-what-default} + # All done. set dg_runtest_extra_prunes "" dg-finish diff --git a/gcc/testsuite/gcc.target/i386/pr115910.c b/gcc/testsuite/gcc.target/i386/pr115910.c new file mode 100644 index 0000000..5f1cd9a --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr115910.c @@ -0,0 +1,20 @@ +/* PR target/115910 */ +/* { dg-do compile { target { ! ia32 } } } */ +/* { dg-options "-O2 -march=x86-64 -mtune=generic -masm=att" } */ +/* { dg-final { scan-assembler-times {\timulq\t} 2 } } */ +/* { dg-final { scan-assembler-times {\tshrq\t\$33,} 2 } } */ +/* { dg-final { scan-assembler-not {\tsarl\t} } } */ + +int +foo (int x) +{ + if (x < 0) + __builtin_unreachable (); + return x / 3U; +} + +int +bar (int x) +{ + return x / 3U; +} diff --git a/gcc/testsuite/gcc.target/nvptx/decl.c b/gcc/testsuite/gcc.target/nvptx/decl.c index 190a64d..45dd699 100644 --- a/gcc/testsuite/gcc.target/nvptx/decl.c +++ b/gcc/testsuite/gcc.target/nvptx/decl.c @@ -13,8 +13,8 @@ int Foo () } /* { dg-final { scan-assembler "\[\r\n\]\[\t \]*.visible .global \[^,\r\n\]*glob_export" } } */ -/* { dg-final { scan-assembler "\[\r\n\]\[\t \]*.visible .const \[^,\r\n\]*cst_export" } } */ +/* { dg-final { scan-assembler "\[\r\n\]\[\t \]*.visible .global \[^,\r\n\]*cst_export" } } */ /* { dg-final { scan-assembler "\[\r\n\]\[\t \]*.global \[^,\r\n\]*glob_local" } } */ -/* { dg-final { scan-assembler "\[\r\n\]\[\t \]*.const \[^,\r\n\]*cst_local" } } */ +/* { dg-final { scan-assembler "\[\r\n\]\[\t \]*.global \[^,\r\n\]*cst_local" } } */ /* { dg-final { scan-assembler "\[\r\n\]\[\t \]*.extern .global \[^,\r\n\]*glob_import" } } */ -/* { dg-final { scan-assembler "\[\r\n\]\[\t \]*.extern .const \[^,\r\n\]*cst_import" } } */ +/* { dg-final { scan-assembler "\[\r\n\]\[\t \]*.extern .global \[^,\r\n\]*cst_import" } } */ |