From 4130413971e246a85a82e55f740e0484958e9e94 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Fri, 12 Jul 2024 19:17:57 +0200 Subject: [PATCH] Merge SVN 4728 --- cobc/ChangeLog | 6 -- libcob/ChangeLog | 9 --- tests/testsuite.src/run_misc.at | 114 ++++++++++++++++++++++++++++++++ 3 files changed, 114 insertions(+), 15 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 8b228426c..7e5edfa3b 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -216,9 +216,6 @@ cob_frame_ext (attached origin source location, section and paragraph name) and its addition to the cob_module * codegen.c (output_section_info, output_trace_info): minor refactoring - -2022-09-30 Simon Sobisch - * typeck.c (cb_build_identifier): fix codegen for odo-check on level 01 OCCURS items, bug introduced with 2022-07-12 * pplex.l: dropped check for "spurious '$'", fixing bug #839 @@ -1259,9 +1256,6 @@ which is tested before calling the 'trace' routines Also, section/paragraph/verb names are now set via pointers in cob_module - -2021-03-18 Ron Norman - * codegen.c (output_section_info, output_trace_info): current name of section/paragraph/verb are now set via pointers in cob_module instead of executing trace functions, which are now only generated if trace diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 56c1193f6..38c5856d5 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -209,9 +209,6 @@ section/paragraph + location to return to; allowing a full textual PERFORM stack and used for restoring those on return * common.h (cob_module): fields for current frame_ptr - -2022-09-30 Simon Sobisch - * general: merged missing line sequential changes from 4.x to 3.x * common.c: fixed, then disabled boolean options "not set" * fileio.c (lineseq_read): set io status 71 for EOF after x'00' @@ -756,9 +753,6 @@ replaced cob_gc_files/cob_mf_files with cob_file_format * common.c: Changes related to removal of COB_MF_LS_xxx from runtime.cfg * fileio.c: Changes related to removal of COB_MF_LS_xxx from runtime.cfg - -2021-10-01 Ron Norman - * fileio.c (lineseq_read): check LINE SEQUENTIAL data and if invalid return 09 status per COBOL 2022 * common.c: added 'not set' for boolean options [disabed in 3.x] @@ -1069,9 +1063,6 @@ Field added to cob_module for section/paragraph/verb names * common.c: New routines added to dump a module using the symbol table instead of a bunch in generated code to do it - -2021-03-18 Ron Norman - * common.h (cob_module): fields for section/paragraph/statement names * common.c: adjusted to use new fields in cob_module diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index f204b7528..50de0b9a9 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -3035,6 +3035,120 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP +AT_SETUP([UNSTRING combined]) +AT_KEYWORDS([runmisc]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. UnstringTest. + *>---------------------------------------------------------------- + *> Additional test case for UNSTRING + *> testing unstring tallying with and without OVERFLOW and with + *> ALL clause for delimiters + *>---------------------------------------------------------------- + DATA DIVISION. + WORKING-STORAGE SECTION. + *>----------------------- + 01 INP-STRING PIC X(13) VALUE 'ABC1|DEF--GHI'. + 01 STR-POINTER PIC 9(02). + 01 RES-DATA. + 05 RES-TRGT-1 PIC X(20). + 05 RES-DELIM-1 PIC X(01). + 05 RES-COUNT-1 PIC 9(02). + 05 RES-TRGT-2 PIC X(20). + 05 RES-DELIM-2 PIC X(01). + 05 RES-COUNT-2 PIC 9(02). + 05 RES-TALLY PIC 9(02). + *> + PROCEDURE DIVISION. + *>------------------ + *> + *> case A : should not OVERFLOW; use of one delimiter + INITIALIZE RES-DATA + MOVE 1 TO STR-POINTER + *> + UNSTRING INP-STRING + DELIMITED BY '|' + INTO RES-TRGT-1 + DELIMITER IN RES-DELIM-1 COUNT IN RES-COUNT-1 + RES-TRGT-2 + DELIMITER IN RES-DELIM-2 COUNT IN RES-COUNT-2 + WITH POINTER STR-POINTER + TALLYING RES-TALLY + ON OVERFLOW + DISPLAY + 'Unstring tallying case 1 should not OVERFLOW' + END-DISPLAY + END-UNSTRING. + PERFORM TEST-CASE-1-RESULT + *> + *> case B : should OVERFLOW; use of two delimiters + INITIALIZE RES-DATA + MOVE 1 TO STR-POINTER + + UNSTRING INP-STRING + DELIMITED BY '|' OR ALL '-' + INTO RES-TRGT-1 + DELIMITER IN RES-DELIM-1 COUNT IN RES-COUNT-1 + RES-TRGT-2 + DELIMITER IN RES-DELIM-2 COUNT IN RES-COUNT-2 + WITH POINTER STR-POINTER + TALLYING RES-TALLY + NOT ON OVERFLOW + DISPLAY + 'Unstring tallying case 2 should OVERFLOW' + END-DISPLAY + END-UNSTRING. + PERFORM TEST-CASE-2-RESULT + *> + GOBACK. + + *> + TEST-CASE-1-RESULT. + *>------------------ + IF RES-TRGT-1 NOT = 'ABC1' + DISPLAY 'A: RES-TRGT-1 <' RES-TRGT-1 '> != '. + IF RES-DELIM-1 NOT = '|' + DISPLAY 'A: RES-DELIM-1 <' RES-DELIM-1 '> != <|>'. + IF RES-COUNT-1 NOT = 4 + DISPLAY 'A: RES-COUNT-1 <' RES-COUNT-1 '> != <4>'. + IF RES-TRGT-2 NOT = 'DEF--GHI' + DISPLAY 'A: RES-TRGT-2 <' RES-TRGT-2 '> != '. + IF RES-DELIM-2 NOT = SPACES + DISPLAY 'A: RES-DELIM2 <' RES-DELIM-2 '> != SPACE'. + IF RES-COUNT-2 NOT = 8 + DISPLAY 'A: RES-COUNT-1 <' RES-COUNT-2 '> != <8>'. + IF STR-POINTER NOT = 14 + DISPLAY 'A: STR-POINTER <' STR-POINTER '> != <14>'. + IF RES-TALLY NOT = 2 + DISPLAY 'A: RES-TALLY <' RES-TALLY '> != <2>'. + *> + TEST-CASE-2-RESULT. + *>------------------ + IF RES-TRGT-1 NOT = 'ABC1' + DISPLAY 'B: RES-TRGT-1 <' RES-TRGT-1 '> != '. + IF RES-DELIM-1 NOT = '|' + DISPLAY 'B: RES-DELIM-1 <' RES-DELIM-1 '> != <|>'. + IF RES-COUNT-1 NOT = 4 + DISPLAY 'B: RES-COUNT-1 <' RES-COUNT-1 '> != <4>'. + IF RES-TRGT-2 NOT = 'DEF' + DISPLAY 'B: RES-TRGT-2 <' RES-TRGT-2 '> != '. + IF RES-DELIM-2 NOT = '-' + DISPLAY 'B: RES-DELIM2 <' RES-DELIM-2 '> != <->'. + IF RES-COUNT-2 NOT = 3 + DISPLAY 'B: RES-COUNT-1 <' RES-COUNT-2 '> != <3>'. + IF STR-POINTER NOT = 11 + DISPLAY 'B: STR-POINTER <' STR-POINTER '> != <11>'. + IF RES-TALLY NOT = 2 + DISPLAY 'B: RES-TALLY <' RES-TALLY '> != <2>'. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + AT_SETUP([UNSTRING with FUNCTION / literal]) AT_KEYWORDS([runmisc])