From bb25edbbeb7308fa7a1472c211b2183d43b221cc Mon Sep 17 00:00:00 2001 From: David Declerck Date: Fri, 5 Jul 2024 18:05:28 +0200 Subject: [PATCH] Merge SVN 4704 --- libcob/ChangeLog | 5 + libcob/intrinsic.c | 97 +++-- tests/testsuite.src/run_functions.at | 563 +++++++++++++++------------ 3 files changed, 381 insertions(+), 284 deletions(-) diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 78474cf6c..abb3c7357 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -201,6 +201,11 @@ PERFORM stack and used for restoring those on return * common.h (cob_module): fields for current frame_ptr +2022-09-13 Simon Sobisch + + * intrinsic.c (cob_check_numval): fix missing check for + embedded sign and decimal, minor performance-tweak + 2022-09-08 Simon Sobisch * fbdb.c: manual merge of fileio.c from 2019-08-25 and 2021-01-08 diff --git a/libcob/intrinsic.c b/libcob/intrinsic.c index 644bfb45a..b305f253a 100644 --- a/libcob/intrinsic.c +++ b/libcob/intrinsic.c @@ -3222,6 +3222,7 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, unsigned char *p; unsigned char *begp; unsigned char *endp; + const size_t max_pos = srcfield->size; size_t pos; size_t plus_minus; size_t digits; @@ -3233,14 +3234,20 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, unsigned char dec_pt; unsigned char cur_symb; + /* variabe-length zero-size field -> error */ + if (!max_pos) { + return 1; + } + /* FIXME later: srcfield may be of category national... */ begp = NULL; currcy_size = 0; if (currency) { + const size_t currency_max_pos = currency->size; endp = NULL; p = currency->data; - for (pos = 0; pos < currency->size; pos++, p++) { + for (pos = 0; pos < currency_max_pos; pos++, p++) { switch (*p) { case '0': case '1': @@ -3261,7 +3268,7 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, case ' ': break; default: - if (pos < currency->size - 1) { + if (pos < currency_max_pos - 1) { if (!memcmp (p, "CR", (size_t)2)) { return 1; } @@ -3281,7 +3288,7 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, } currcy_size = endp - begp; currcy_size++; - if (currcy_size >= srcfield->size) { + if (currcy_size >= max_pos) { begp = NULL; currcy_size = 0; } @@ -3291,20 +3298,12 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, currcy_size = 1; } - if (!srcfield->size) { - return 1; - } - p = srcfield->data; plus_minus = 0; - digits = 0; - dec_seen = 0; - space_seen = 0; break_needed = 0; dec_pt = COB_MODULE_PTR->decimal_point; - - /* Check leading positions */ - for (n = 0; n < (int)srcfield->size; ++n, ++p) { + /* check leading positions */ + for (n = 0; n < (int)max_pos; ++n, ++p) { switch (*p) { case '0': case '1': @@ -3335,7 +3334,7 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, break_needed = 1; break; default: - if (begp && n < (int)(srcfield->size - currcy_size)) { + if (begp && n < (int)(max_pos - currcy_size)) { if (!memcmp (p, begp, currcy_size)) { break; } @@ -3347,11 +3346,18 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, } } - if (n == (int)srcfield->size) { - return n + 1; + /* end reached without digit -> definitely not numeric */ + if (n == (int)max_pos) { + return max_pos + 1; } - for (; n < (int)srcfield->size; ++n, ++p) { + /* check actual data */ + break_needed = 0; + digits = 0; + dec_seen = 0; + space_seen = 0; + + for (; n < (int)max_pos; ++n, ++p) { switch (*p) { case '0': case '1': @@ -3377,6 +3383,20 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, } else if (!chkcurr) { return n + 1; } + if (digits) { + /* digit seen: must be at previous position */ + const char prev = *(p - 1); + if (prev < '0' || prev > '9') { + return n + 1; + } + + } else if (n < (int)max_pos - 1) { + /* no digit seen so far: must be at next position */ + const char next = *(p + 1); + if (next < '0' || next > '9') { + return n + 2; + } + } continue; case ' ': space_seen = 1; @@ -3386,8 +3406,9 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, if (plus_minus) { return n + 1; } - plus_minus = 1; - continue; + p++; n++; /* trailing +/-, only space afterwards allowed */ + break_needed = 1; + break; case 'c': if (!anycase) { return n + 1; @@ -3397,13 +3418,13 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, if (plus_minus) { return n + 1; } - if (n < (int)srcfield->size - 1) { + if (n < (int)max_pos - 1) { if (*(p + 1) == 'R' || (anycase && *(p + 1) == 'r')) { - plus_minus = 1; - p++; - n++; - continue; + p++; n++; /* trailing +/-, only space afterwards allowed */ + p++; n++; /* skip cR */ + break_needed = 1; + break; } } return n + 2; @@ -3416,23 +3437,34 @@ cob_check_numval (const cob_field *srcfield, const cob_field *currency, if (plus_minus) { return n + 1; } - if (n < (int)srcfield->size - 1) { + if (n < (int)max_pos - 1) { if (*(p + 1) == 'B' || (anycase && *(p + 1) == 'b')) { - plus_minus = 1; - p++; - n++; - continue; + p++; n++; /* trailing +/-, only space afterwards allowed */ + p++; n++; /* skip dB */ + break_needed = 1; + break; } } return n + 2; default: return n + 1; } + if (break_needed) { + break; + } } + /* no digit -> definitely not numeric */ if (!digits) { - return n + 1; + return max_pos + 1; + } + + /* check for trailing spaces only */ + for (; n < (int)max_pos; ++n, ++p) { + if (*p != ' ') { + return n + 1; + } } return 0; @@ -3831,6 +3863,11 @@ cob_intr_hex_to_char (cob_field *srcfield) size_t i, j; unsigned char *hex_char; + if (size * 2 != srcfield->size) { + /* posibly raise nonfatal exception here -> we only process the valid ones */ + // size--; + } + COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); COB_FIELD_INIT (size, NULL, &attr); make_field_entry (&field); diff --git a/tests/testsuite.src/run_functions.at b/tests/testsuite.src/run_functions.at index 9e600cece..d77fcdd8b 100644 --- a/tests/testsuite.src/run_functions.at +++ b/tests/testsuite.src/run_functions.at @@ -2585,7 +2585,7 @@ AT_CLEANUP AT_SETUP([FUNCTION NUMVAL-C]) -AT_KEYWORDS([functions]) +AT_KEYWORDS([functions NUMVAL]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -2594,18 +2594,18 @@ AT_DATA([prog.cob], [ WORKING-STORAGE SECTION. 01 X1 PIC X(14) VALUE " % -9876.1234 ". 01 X2 PIC X(20) VALUE " % 19,876.1234 DB". + 01 X3 PIC X(12) VALUE "% -9876.1234". 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 + DISPLAY X1 " - " N. MOVE FUNCTION NUMVAL-C ( X2 , "%" ) TO N IF N NOT = -19876.1234 - DISPLAY N - END-DISPLAY - END-IF + DISPLAY X2 " - " N. + MOVE FUNCTION NUMVAL-C ( X3 , "%" ) TO N + IF N NOT = -9876.1234 + DISPLAY X3 " - " N. STOP RUN. ]) @@ -2616,7 +2616,7 @@ AT_CLEANUP AT_SETUP([FUNCTION NUMVAL-C DP.COMMA]) -AT_KEYWORDS([functions]) +AT_KEYWORDS([functions NUMVAL]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -2633,9 +2633,7 @@ AT_DATA([prog.cob], [ PROCEDURE DIVISION. MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N IF N NOT = -19876,1234 - DISPLAY N - END-DISPLAY - END-IF + DISPLAY X1 " - " N. STOP RUN. ]) @@ -2646,7 +2644,7 @@ AT_CLEANUP AT_SETUP([FUNCTION NUMVAL-F]) -AT_KEYWORDS([functions]) +AT_KEYWORDS([functions NUMVAL]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -3674,87 +3672,140 @@ AT_DATA([prog.cob], [ PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. + 77 RESULT USAGE BINARY-LONG. + 01 EMPTY. + 03 PIC X OCCURS 0 TO 5 DEPENDING ON RESULT. 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. + MOVE FUNCTION TEST-NUMVAL ("+ 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 1 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" + 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 2 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("- 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 3 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" - 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 4 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("+- 1") TO RESULT + IF RESULT NOT = 2 + DISPLAY "Test 5 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1 +") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 6 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1 -") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 7 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1 +-") TO RESULT + IF RESULT NOT = 4 + DISPLAY "Test 8 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1 -+") TO RESULT + IF RESULT NOT = 4 + DISPLAY "Test 9 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("+ 1.1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 10 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("- 1.1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 11 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1.1 +") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 12 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1.1 -") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 13 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1.1 CR") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 14 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1.1 DB") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 15 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1.1 -CR") TO RESULT + IF RESULT NOT = 6 + DISPLAY "Test 16 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1.1 +DB") TO RESULT + IF RESULT NOT = 6 + DISPLAY "Test 17 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1.1 CDB") TO RESULT + IF RESULT NOT = 6 + DISPLAY "Test 18 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("+1.1 CR") TO RESULT + IF RESULT NOT = 6 + DISPLAY "Test 19 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("+ ") TO RESULT + IF RESULT NOT = 8 + DISPLAY "Test 20 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" 0. ") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 21 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" .0 ") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 22 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" . 0") TO RESULT + IF RESULT NOT = 4 + DISPLAY "Test 23 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" 0 .") TO RESULT + IF RESULT NOT = 5 + DISPLAY "Test 24 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" 0+0") TO RESULT + IF RESULT NOT = 6 + DISPLAY "Test 25 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" 0+ 0") TO RESULT + IF RESULT NOT = 8 + DISPLAY "Test 26 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL ("1.1 D") TO RESULT + IF RESULT NOT = 6 + DISPLAY "Test 27 fail: " RESULT. + + * MOVE FUNCTION TEST-NUMVAL ("") TO RESULT + MOVE 0 TO RESULT + MOVE FUNCTION TEST-NUMVAL (EMPTY) TO RESULT + IF RESULT NOT = 1 + DISPLAY "Test 28 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" ") TO RESULT + IF RESULT NOT = 4 + DISPLAY "Test 29 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" .") TO RESULT + IF RESULT NOT = 4 + DISPLAY "Test 30 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" ") TO RESULT + IF RESULT NOT = 5 + DISPLAY "Test 31 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL (" 1 T") TO RESULT + IF RESULT NOT = 5 + DISPLAY "Test 32 fail: " RESULT. + STOP RUN. ]) @@ -3765,94 +3816,96 @@ AT_CLEANUP AT_SETUP([FUNCTION TEST-NUMVAL-C]) -AT_KEYWORDS([functions]) +AT_KEYWORDS([functions NUMVAL]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. + 77 RESULT USAGE BINARY-LONG. 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. + + MOVE FUNCTION TEST-NUMVAL-C ("+ 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 1 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C (" + 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 2 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("- 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 3 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C (" - 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 4 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("+- 1") TO RESULT + IF RESULT NOT = 2 + DISPLAY "Test 5 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("1 +") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 6 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("1 -") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 7 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("1 +-") TO RESULT + IF RESULT NOT = 4 + DISPLAY "Test 8 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("1 -+") TO RESULT + IF RESULT NOT = 4 + DISPLAY "Test 9 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("+ 1.1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 10 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("- 1.1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 11 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("1.1 +") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 12 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("1.1 -") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 13 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("1.1 CR") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 14 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("1.1 DB") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 15 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("1.1 -CR") TO RESULT + IF RESULT NOT = 6 + DISPLAY "Test 16 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("+ $1.1 ") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 17 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("- $1.1 ") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 18 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("+ X1.1 ", "X") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 19 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-C ("- X1.1 ", "X") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 20 fail: " RESULT. + STOP RUN. ]) @@ -3863,94 +3916,96 @@ AT_CLEANUP AT_SETUP([FUNCTION TEST-NUMVAL-F]) -AT_KEYWORDS([functions]) +AT_KEYWORDS([functions NUMVAL]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. + 77 RESULT USAGE BINARY-LONG. 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 = 0 - DISPLAY "Test 6 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 -") NOT = 0 - DISPLAY "Test 7 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 +-") NOT = 4 - DISPLAY "Test 8 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 -+") NOT = 4 - 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 = 0 - DISPLAY "Test 12 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 -") NOT = 0 - 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 = 6 - 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 E001") NOT = 7 - DISPLAY "Test 20 fail" - END-DISPLAY - END-IF. + + MOVE FUNCTION TEST-NUMVAL-F ("+ 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 1 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F (" + 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 2 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("- 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 3 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F (" - 1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 4 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("+- 1") TO RESULT + IF RESULT NOT = 2 + DISPLAY "Test 5 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1 +") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 6 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1 -") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 7 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1 +-") TO RESULT + IF RESULT NOT = 4 + DISPLAY "Test 8 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1 -+") TO RESULT + IF RESULT NOT = 4 + DISPLAY "Test 9 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("+ 1.1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 10 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("- 1.1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 11 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1.1 +") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 12 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1.1 -") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 13 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1.1 ") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 14 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1.1 ") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 15 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1.1 -CR") TO RESULT + IF RESULT NOT = 6 + DISPLAY "Test 16 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1.1 E+1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 17 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1.1 E -1") TO RESULT + IF RESULT NOT = 0 + DISPLAY "Test 18 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("1.1 EE") TO RESULT + IF RESULT NOT = 6 + DISPLAY "Test 19 fail: " RESULT. + + MOVE FUNCTION TEST-NUMVAL-F ("+1.1 E001") TO RESULT + IF RESULT NOT = 7 + DISPLAY "Test 20 fail: " RESULT. + STOP RUN. ])