diff --git a/ChangeLog b/ChangeLog index c914f08a1..3140d4a50 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,19 @@ +2025-26-01 Denis Hugonnard-Roche + + * intrinsic.c: Correct #1020 ticket + +2024-26-09 Denis Hugonnard-Roche + + * intrinsic.c: Correct C++ comment style to C style + +2024-25-09 Denis Hugonnard-Roche + + * intrinsic.c: recode cob_decimal_pow function + in order to fix #924,#925 and #989 + fix macos compile error + * run_fundamental.at: add all the tests case for power function + 2024-09-09 Simon Sobisch * README: add documentation for "make checkmanual" diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 6db0c9c7c..c171c4c3a 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,17 @@ +2025-01-26 Denis Hugonnard-Roche + + * intrinsic.c (cob_decimal_pow) fix #1020 ticket + +2024-09-26 Denis Hugonnard-Roche + + * intrinsic.c (cob_decimal_pow) Correct c++ comment style to C + comment style + +2024-09-25 Denis Hugonnard-Roche + + * intrinsic.c (cob_decimal_pow) fixed Bug #925,#925,#989 + 2024-09-20 Chuck Haatvedt * screenio.c (cob_screen_get_all) fixed Bug #990 diff --git a/libcob/intrinsic.c b/libcob/intrinsic.c index 785fa3b1b..a6a62d88a 100644 --- a/libcob/intrinsic.c +++ b/libcob/intrinsic.c @@ -97,6 +97,7 @@ static mpz_t cob_mpzt; static mpf_t cob_mpft; static mpf_t cob_mpft2; +static mpf_t cob_mpft3; static mpf_t cob_mpft_get; static mpf_t cob_pi; @@ -3153,97 +3154,170 @@ cob_switch_value (const int id) void cob_decimal_pow (cob_decimal *pd1, cob_decimal *pd2) { - cob_uli_t n; - const int sign = mpz_sgn (pd1->value); + int negat_result = 0 ; - if (unlikely (pd1->scale == COB_DECIMAL_NAN)) { + if (unlikely(pd1->scale == COB_DECIMAL_NAN)) { return; } - if (unlikely (pd2->scale == COB_DECIMAL_NAN)) { + if (unlikely(pd2->scale == COB_DECIMAL_NAN)) { pd1->scale = COB_DECIMAL_NAN; return; } - if (mpz_sgn (pd2->value) == 0) { - /* Exponent is zero */ - if (sign == 0) { - /* 0 ^ 0 */ - cob_set_exception (COB_EC_SIZE_EXPONENTIATION); + cob_trim_decimal (pd2); + cob_trim_decimal (pd1); + + const int sign_nbr = mpz_sgn (pd1->value); + const int sign_exp = mpz_sgn (pd2->value); + const int power_case = sign_nbr * sign_exp; + + + if (!power_case) { + /* Exponent OR Number are = 0 */ + if (sign_nbr == 0) { + if ( sign_exp == 1) { + /* case 0 ^ Positive number --> zero */ + mpz_set_ui (pd1->value, 0UL); + pd1->scale = 0; + + } + else { + /* FIX #924 : 0 raised to negative number or 0 */ + pd1->scale = COB_DECIMAL_NAN; + cob_set_exception (COB_EC_SIZE_EXPONENTIATION); + } + } + else { + /* Exponent is 0 and Nbr != 0 ---> 1 */ + mpz_set_ui (pd1->value, 1UL); + pd1->scale = 0; } - mpz_set_ui (pd1->value, 1UL); - pd1->scale = 0; + return; } - if (sign == 0) { - /* Value is zero */ - pd1->scale = 0; + + if (pd2->scale != 0 && sign_nbr == -1) { + /* Case number < 0 and decimal exponent --> Error */ + pd1->scale = COB_DECIMAL_NAN; + cob_set_exception (COB_EC_SIZE_EXPONENTIATION); return; } - cob_trim_decimal (pd2); + /* First Check result size */ + /* Fix #925 : Avoid GMPLIB CRASH */ + + cob_decimal_get_mpf (cob_mpft , pd1); + + + mpf_set (cob_mpft3,cob_mpft) ; + if (sign_nbr == -1) { + mpf_abs (cob_mpft3, cob_mpft3) ; + } + cob_mpf_log10 (cob_mpft3, cob_mpft3) ; - if (sign == -1 && pd2->scale) { - /* Negative exponent and non-integer power */ + cob_decimal_get_mpf (cob_mpft2, pd2) ; + mpf_mul (cob_mpft3, cob_mpft3, cob_mpft2) ; + mpf_abs (cob_mpft3, cob_mpft3) ; + + if ( ! (mpf_cmp_ui (cob_mpft3,COB_MAX_INTERMEDIATE_FLOATING_SIZE + 1) < 0) ) { pd1->scale = COB_DECIMAL_NAN; cob_set_exception (COB_EC_SIZE_EXPONENTIATION); - return; + + return ; } - cob_trim_decimal (pd1); + /* End Check */ + + if (!(pd2->scale)) { + /* Integer Power */ - if (!pd2->scale) { - /* Integer power */ + cob_uli_t n ; + if (!mpz_cmp_ui (pd2->value, 1UL)) { - /* Power is 1 */ + /* Power is 1 leave as is */ return; } - if (mpz_sgn (pd2->value) == -1 - && mpz_fits_slong_p (pd2->value)) { + + if (sign_exp == -1) { /* Negative power */ - mpz_abs (pd2->value, pd2->value); - n = mpz_get_ui (pd2->value); - mpz_pow_ui (pd1->value, pd1->value, n); - if (pd1->scale) { - pd1->scale *= n; - cob_trim_decimal (pd1); - } - mpz_set (pd2->value, pd1->value); - pd2->scale = pd1->scale; - mpz_set_ui (pd1->value, 1UL), - pd1->scale = 0; - cob_decimal_div (pd1, pd2); - cob_trim_decimal (pd1); - return; + mpz_abs (pd2->value, pd2->value); + + mpf_ui_div (cob_mpft, 1UL, cob_mpft) ; } + if (mpz_fits_ulong_p (pd2->value)) { /* Positive power */ n = mpz_get_ui (pd2->value); - mpz_pow_ui (pd1->value, pd1->value, n); - if (pd1->scale) { - pd1->scale *= n; - cob_trim_decimal (pd1); + + mpf_pow_ui (cob_mpft, cob_mpft, n); + + cob_decimal_set_mpf (pd1, cob_mpft); + + cob_trim_decimal (pd1); + + if (sign_exp == -1) { + /* Keep exponent value unchanged --> FIX #1020 */ + mpz_mul_si (pd2->value, pd2->value, -1L) ; + } + + return; + } + + /* + * At this point we know that : + * + * 1) the result will not crash gmp + * 2) Exponent is integer + * 3) the absolute value of exponent is too large + * to fits ulong + * --> Compute the result sign and Fallthrough to Taylor series compute + * + */ + + if (sign_nbr == -1) { + /* Fix #989 */ + if (mpz_odd_p (pd2->value)) { + negat_result = 1; } - return; } } + + /* + * At this stage : + * exponent is non integer OR integer that does not fits tu ulong/slong + * --> Compute with log and exp + * The result sign may only be negative in case of integer exponent + * and is calculated before + */ + + /* Compute a ^ b */ + mpz_abs (pd1->value, pd1->value); + mpz_abs (pd2->value, pd2->value); - if (sign == -1) { - mpz_abs (pd1->value, pd1->value); - } cob_decimal_get_mpf (cob_mpft, pd1); - if (pd2->scale == 1 && !mpz_cmp_ui (pd2->value, 5UL)) { - /* Square root short cut */ - mpf_sqrt (cob_mpft2, cob_mpft); - } else { - cob_decimal_get_mpf (cob_mpft2, pd2); - cob_mpf_log (cob_mpft, cob_mpft); - mpf_mul (cob_mpft, cob_mpft, cob_mpft2); - cob_mpf_exp (cob_mpft2, cob_mpft); + cob_decimal_get_mpf (cob_mpft2, pd2); + + cob_mpf_log (cob_mpft, cob_mpft); + mpf_mul (cob_mpft, cob_mpft, cob_mpft2); + + cob_mpf_exp (cob_mpft2, cob_mpft); + + /* if negative exponent compute 1 / (a^b) */ + if (sign_exp == -1) { + mpf_set_ui (cob_mpft, 1UL); + mpf_div (cob_mpft2, cob_mpft, cob_mpft2); + /* Keep exponent value unchanged --> FIX #1020 */ + mpz_mul_si (pd2->value, pd2->value, -1L) ; } + cob_decimal_set_mpf (pd1, cob_mpft2); - if (sign == -1) { + + if (negat_result) { mpz_neg (pd1->value, pd1->value); } + + cob_trim_decimal (pd1); + } /* Indirect field get/put functions */ @@ -7231,6 +7305,7 @@ cob_init_intrinsic (cob_global *lptr) mpf_init2 (cob_mpft, COB_MPF_PREC); mpf_init2 (cob_mpft2, COB_MPF_PREC); + mpf_init2 (cob_mpft3, COB_MPF_PREC); mpf_init2 (cob_mpft_get, COB_MPF_PREC); } diff --git a/tests/testsuite.src/run_fundamental.at b/tests/testsuite.src/run_fundamental.at index 7d450ef6a..8443a45fd 100644 --- a/tests/testsuite.src/run_fundamental.at +++ b/tests/testsuite.src/run_fundamental.at @@ -11193,3 +11193,1071 @@ AT_CHECK([$COMPILE prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP + + +AT_SETUP([COMPUTE Power exception case]) +AT_KEYWORDS([COMPUTE POWER]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID . power_excep. + *>---------------------------------------------------------------- + *> This program test the case where a^b raise exception + *>---------------------------------------------------------------- + *> + ENVIRONMENT DIVISION. + DATA DIVISION . + WORKING-STORAGE SECTION. + + 01 EXPONENT PIC S9(09)V9999 COMP-3 . + 01 FIELD-01 PIC S9(09)V9999 COMP-3 . + 01 RESULT PIC S9(15)V9(10) COMP-3 . + + *> + PROCEDURE DIVISION . + *> -------------------------------------------------------------- + *> Exponent = 0 ^ 0 + *> -------------------------------------------------------------- + *> + *> Exponent 0 with field = 0 + *> + MOVE 0 TO FIELD-01 . + MOVE 0 TO EXPONENT . + + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY 'Case 1: 0 ^ 0 should size error' + END-COMPUTE . + IF FIELD-01 NOT = 0 + THEN + DISPLAY 'Case 1 : nbr have been changed' + END-IF . + IF EXPONENT NOT = 0 + THEN + DISPLAY 'Case 1 : exponent have been changed' + END-IF . + *> + *> -------------------------------------------------------------- + *> Zero raised to a negative number + *> -------------------------------------------------------------- + *> + *> Exponent < 0 with field = 0 + *> + MOVE 0 TO FIELD-01 . + MOVE -5 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY 'Case 2 : 0 ^ Negative should size error' + END-COMPUTE . + IF EXPONENT NOT = -5 + THEN + DISPLAY 'Case 2 : exponent have been changed' + END-IF . + *> + MOVE 0 TO FIELD-01 . + MOVE -5.23 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY 'Case 3 : 0 ^ Negative should size error' + END-COMPUTE . + IF EXPONENT NOT = -5.23 + THEN + DISPLAY 'Case 3 : exponent have been changed' + END-IF . + *> + *> -------------------------------------------------------------- + *> A negative number raised to a fractional power + *> -------------------------------------------------------------- + *> + MOVE -3 TO FIELD-01 . + MOVE 1.4 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY 'Case 4 : should size error' + ' negative number raised to non integer' + END-COMPUTE . + IF EXPONENT NOT = 1.4 + THEN + DISPLAY 'Case 4 : exponent have been changed' + END-IF . + *> + MOVE -54321.9 TO FIELD-01 . + MOVE 1.23 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY 'Case 5 : should size error' + ' negative non integer number raised to non integer' + END-COMPUTE . + IF EXPONENT NOT = 1.23 + THEN + DISPLAY 'Case 5 : exponent have been changed' + END-IF . + *> + MOVE -3 TO FIELD-01 . + MOVE -1.4 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY 'Case 6 : should size error' + ' negative number raised to non integer' + END-COMPUTE . + IF EXPONENT NOT = -1.4 + THEN + DISPLAY 'Case 6 : exponent have been changed' + END-IF . + *> + MOVE -54321.9 TO FIELD-01 . + MOVE -1.23 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY 'Case 7 : should size error' + ' negative non integer number raised to non integer' + END-COMPUTE . + IF EXPONENT NOT = -1.23 + THEN + DISPLAY 'Case 7 : exponent have been changed' + END-IF . + *> + MOVE -1 TO FIELD-01 . + MOVE -1.23 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY 'Case 8 : should size error' + ' negative non integer number raised to non integer' + END-COMPUTE . + IF EXPONENT NOT = -1.23 + THEN + DISPLAY 'Case 8 : exponent have been changed' + END-IF . + *> + STOP RUN . +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([Compute Power a^b with a > 0]) +AT_KEYWORDS([COMPUTE POWER]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID . pow_nb_pos . + *>---------------------------------------------------------------- + *> + *> Test program for a^b where a > 0 + *> + *>---------------------------------------------------------------- + *> + ENVIRONMENT DIVISION. + DATA DIVISION . + WORKING-STORAGE SECTION. + + 01 EXPONENT PIC S9(10)V9999 COMP-3 . + 01 FIELD-01 PIC S9(20)V9999 COMP-3 . + 01 RESULT PIC S9(25)V9(10) COMP-3 . + 01 EXPO-INT PIC S9(01) COMP-3. + + *> + PROCEDURE DIVISION . + *>------------------- + *> + PERFORM TEST-EXPONENT-POS . + *> + PERFORM TEST-EXPONENT-NEG . + *> + PERFORM TEST-NBR-ZERO . + *> + PERFORM TEST-POWER-ONE . + *> + GOBACK . + *> + TEST-EXPONENT-POS. + *>----------------- + *> + *> -------------------------------------------------------------- + *> Positive integer exponent Nbr Integer + *> -------------------------------------------------------------- + *> + MOVE 25 TO FIELD-01 . + MOVE 7 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.1 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 6103515625 + THEN + DISPLAY '1.1 Result <' + RESULT '> != 6103515625' + END-IF + END-COMPUTE . + IF EXPONENT NOT = 7 + THEN + DISPLAY 'Case 1.1 : exponent have been changed' + END-IF . + *> + *> -------------------------------------------------------------- + *> Positive integer exponent Nbr Rational + *> -------------------------------------------------------------- + *> + MOVE 25.1234 TO FIELD-01 . + MOVE 7 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.2 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 6317552954.0721344578 + THEN + DISPLAY '1.2 Result <' + RESULT '> != 6317552954.0721344578' + END-IF + END-COMPUTE . + IF EXPONENT NOT = 7 + THEN + DISPLAY 'Case 1.2 : exponent have been changed' + END-IF . + *> -------------------------------------------------------------- + *> Positive rational exponent Nbr integer + *> -------------------------------------------------------------- + *> + MOVE 12 TO FIELD-01 . + MOVE 2.2345 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.3 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 257.8876200820 + THEN + DISPLAY '1.3 Result <' + RESULT '> != 257.8876200820' + END-IF + END-COMPUTE . + IF EXPONENT NOT = 2.2345 + THEN + DISPLAY 'Case 1.3 : exponent have been changed' + END-IF . + *> + *> -------------------------------------------------------------- + *> Positive Rational exponent Nbr Rational + *> -------------------------------------------------------------- + *> + MOVE 25.1234 TO FIELD-01 . + MOVE 7.5678 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.4 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 39401559716.7732993207 + THEN + DISPLAY '1.4 Result <' + RESULT '> != 39401559716.7732993207' + END-IF + END-COMPUTE . + IF EXPONENT NOT = 7.5678 + THEN + DISPLAY 'Case 1.4 : exponent have been changed' + END-IF . + *> + *> -------------------------------------------------------------- + *> Positive Rational exponent Nbr Rational between 0 and 1 + *> -------------------------------------------------------------- + *> + MOVE 0.1234 TO FIELD-01 . + MOVE 3.5678 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.5 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0.0005727884 + THEN + DISPLAY '1.5 Result <' + RESULT '> != 0.0005727884' + END-IF + END-COMPUTE . + IF EXPONENT NOT = 3.5678 + THEN + DISPLAY 'Case 1.5 : exponent have been changed' + END-IF . + *> + *> -------------------------------------------------------------- + *> exponent between 0 and 1 Nbr Rational between 0 and 1 + *> -------------------------------------------------------------- + *> + MOVE 0.1234 TO FIELD-01 . + MOVE 0.5678 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.6 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0.3048237121 + THEN + DISPLAY '1.6 Result <' + RESULT '> != 0.3048237121' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> SQRT + *> -------------------------------------------------------------- + *> + MOVE 1.5 TO FIELD-01 . + MOVE 0.5 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.7 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 1.2247448713 + THEN + DISPLAY '1.7 Result <' + RESULT '> != 1.2247448713' + END-IF + END-COMPUTE . + *> + TEST-EXPONENT-NEG. + *>----------------- + *> + *> -------------------------------------------------------------- + *> Nbr Integer exponent integer + *> -------------------------------------------------------------- + *> + MOVE 23 TO FIELD-01 . + MOVE -3 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '2.1 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0.0000821895 + THEN + DISPLAY '2.1 Result <' + RESULT '> != 0.0000821895' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> integer exponent Nbr Rational + *> -------------------------------------------------------------- + *> + MOVE 5.1234 TO FIELD-01 . + MOVE -7 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '2.2 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0.0000107917 + THEN + DISPLAY '2.2 Result <' + RESULT '> != 0.0000107917' + END-IF + END-COMPUTE . + *> -------------------------------------------------------------- + *> rational exponent Nbr integer + *> -------------------------------------------------------------- + *> + MOVE 12 TO FIELD-01 . + MOVE -2.2345 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '2.3 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0.0038776580 + THEN + DISPLAY '2.3 Result <' + RESULT '> != 0.0038776580' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> Positive Rational exponent Nbr Rational + *> -------------------------------------------------------------- + *> + MOVE 2.5123 TO FIELD-01 . + MOVE -7.5678 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '2.4 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0.0009382939 + THEN + DISPLAY '2.4 Result <' + RESULT '> != 0.0009382939' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> Rational exponent Nbr Rational between 0 and 1 + *> -------------------------------------------------------------- + *> + MOVE 0.1234 TO FIELD-01 . + MOVE -3.5678 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '2.5 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 1745.8453609145 + THEN + DISPLAY '2.5 Result <' + RESULT '> != 1745.8453609145' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> exponent between -1 and 0 Nbr Rational between 0 and 1 + *> -------------------------------------------------------------- + *> + MOVE 0.1234 TO FIELD-01 . + MOVE -0.5678 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '2.6 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 3.2805846790 + THEN + DISPLAY '2.6 Result <' + RESULT '> != 3.2805846790' + END-IF + END-COMPUTE . + *> + TEST-NBR-ZERO. + *>------------- + *> -------------------------------------------------------------- + *> exponent positive integer + *> -------------------------------------------------------------- + *> + MOVE 0 TO FIELD-01 . + MOVE 12 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '3.1 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0 + THEN + DISPLAY '3.1 Result <' + RESULT '> != 0' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> exponent genative integer + *> -------------------------------------------------------------- + *> + MOVE 0 TO FIELD-01 . + MOVE 12.1234 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '3.2 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0 + THEN + DISPLAY '3.2 Result <' + RESULT '> != 0' + END-IF + END-COMPUTE . + *> + TEST-POWER-ONE. + *>-------------- + *> + MOVE 1234.567 TO FIELD-01 . + MOVE 1 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '4.1 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT =1234.567 + THEN + DISPLAY '4.1 Result <' + RESULT '> != 1234.567' + END-IF + END-COMPUTE . + *> +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([COMPUTE Power a^b with a < 0]) +AT_KEYWORDS([COMPUTE POWER]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID . pow_nb_neg . + *>---------------------------------------------------------------- + *> + *> Test program for a^b where a < 0 + *> + *>---------------------------------------------------------------- + *> + ENVIRONMENT DIVISION. + DATA DIVISION . + WORKING-STORAGE SECTION. + + 01 EXPONENT PIC S9(10)V9999 COMP-3 . + 01 FIELD-01 PIC S9(20)V9999 COMP-3 . + 01 RESULT PIC S9(25)V9(10) COMP-3 . + + *> + PROCEDURE DIVISION . + *>------------------- + *> + PERFORM TEST-EXPONENT-POS . + *> + PERFORM TEST-EXPONENT-NEG . + *> + PERFORM TEST-POWER-ONE . + *> + GOBACK . + *> + TEST-EXPONENT-POS. + *>----------------- + *> + *> -------------------------------------------------------------- + *> Odd integer exponent Nbr Integer + *> -------------------------------------------------------------- + *> + MOVE -25 TO FIELD-01 . + MOVE 7 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.1 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = -6103515625 + THEN + DISPLAY '1.1 Result <' + RESULT '> != -6103515625' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> even integer exponent Nbr Integer + *> -------------------------------------------------------------- + *> + MOVE -25 TO FIELD-01 . + MOVE 6 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.2 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 244140625 + THEN + DISPLAY '1.2 Result <' + RESULT '> != 244140625' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> odd Positive integer exponent Nbr Rational + *> -------------------------------------------------------------- + *> + MOVE -25.1234 TO FIELD-01 . + MOVE 7 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.3 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = -6317552954.0721344578 + THEN + DISPLAY '1.3 Result <' + RESULT '> != -6317552954.0721344578' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> even Positive integer exponent Nbr Rational + *> -------------------------------------------------------------- + *> + MOVE -25.1234 TO FIELD-01 . + MOVE 6 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '1.4 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 251460907.1253148243 + THEN + DISPLAY '1.4 Result <' + RESULT '> != 251460907.1253148243' + END-IF + END-COMPUTE . + *> + TEST-EXPONENT-NEG. + *>----------------- + *> + *> -------------------------------------------------------------- + *> Odd Nbr Integer exponent integer + *> -------------------------------------------------------------- + *> + MOVE -23 TO FIELD-01 . + MOVE -3 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '2.1 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = -0.0000821895 + THEN + DISPLAY '2.1 Result <' + RESULT '> != -0.0000821895' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> Even integer exponent Nbr Rational + *> -------------------------------------------------------------- + *> + MOVE -23 TO FIELD-01 . + MOVE -4 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '2.2 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0.0000035734 + THEN + DISPLAY '2.2 Result <' + RESULT '> != 0.0000035734' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> Odd Nbr Rational exponent integer + *> -------------------------------------------------------------- + *> + MOVE -23.1234 TO FIELD-01 . + MOVE -3 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '2.3 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = -0.0000808807 + THEN + DISPLAY '2.3 Result <' + RESULT '> != -0.0000808807' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> Even integer exponent Nbr Rational + *> -------------------------------------------------------------- + *> + MOVE -23.1234 TO FIELD-01 . + MOVE -4 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '2.4 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0.0000034977 + THEN + DISPLAY '2.4 Result <' + RESULT '> != 0.0000034977' + END-IF + END-COMPUTE . + *> + TEST-POWER-ONE. + *>-------------- + *> + MOVE -234.567 TO FIELD-01 . + MOVE 1 TO EXPONENT . + COMPUTE RESULT = FIELD-01 ** EXPONENT + ON SIZE ERROR + DISPLAY '3.1 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT =-234.567 + THEN + DISPLAY '3.1 Result <' + RESULT '> != -234.567' + END-IF + END-COMPUTE . +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([COMPUTE Power size error and limits cases]) +AT_KEYWORDS([COMPUTE POWER]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID . power . + *>---------------------------------------------------------------- + *> + *> Test program test limits for power computing + *> + *>---------------------------------------------------------------- + *> + ENVIRONMENT DIVISION. + DATA DIVISION . + WORKING-STORAGE SECTION. + + 01 EXPO-INT PIC S9(31) COMP-3 . + 01 EXPO-DEC PIC S9(10)V9999 COMP-3 . + 01 FIELD-02 PIC S9(04)V9(20) COMP-3 . + 01 FIELD-03 PIC S9(01)V9(37) COMP-3 . + 01 RESULT PIC S9(21)V9(10) COMP-3 . + 01 RESULT-HUDGE PIC S9(38) COMP-3 . + 01 RESULT-MIN PIC S9V9(37) COMP-3 . + 01 FIELD-HUDGE PIC S9(35)V9(02) COMP-3 . + 01 FIELD-MAX PIC S9(38) COMP-3 . + 01 EXPO-MIN PIC S9(01)V9(37) COMP-3 . + + *> + PROCEDURE DIVISION . + *> -------------------------------------------------------------- + *> + MOVE 1.000000001 TO FIELD-02 . + MOVE 4294967297 TO EXPO-INT . + COMPUTE RESULT = FIELD-02 ** EXPO-INT + ON SIZE ERROR + DISPLAY '1 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 73.3298161433 + THEN + DISPLAY + '1: Result <' RESULT '> != 73.3298161433' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE -1.1 TO FIELD-02 . + MOVE -111 TO EXPO-INT . + COMPUTE RESULT = FIELD-02 ** EXPO-INT + ON SIZE ERROR + DISPLAY '2 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = -0.0000254338 + THEN + DISPLAY + '2: Result <' RESULT '> != -0.0000254338' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE -1.1 TO FIELD-02 . + MOVE -112 TO EXPO-INT . + COMPUTE RESULT = FIELD-02 ** EXPO-INT + ON SIZE ERROR + DISPLAY '3 : Should not size error' + NOT ON SIZE ERROR + IF RESULT NOT = 0.0000231216 + THEN + DISPLAY + '3: Result <' RESULT '> != 00.0000231216' + END-IF + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE 18446744073709551619 TO FIELD-HUDGE. + MOVE 2 TO EXPO-INT . + COMPUTE RESULT-HUDGE = FIELD-HUDGE ** EXPO-INT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY '4: Result SHOULD SIZE ERROR' + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE -18446744073709551619 TO FIELD-HUDGE. + MOVE 2 TO EXPO-INT . + COMPUTE RESULT-HUDGE = FIELD-HUDGE ** EXPO-INT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY '5: SHOULD SIZE ERROR' + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE 1.0001 TO FIELD-02 . + MOVE 18446744073709551619 TO EXPO-INT . + COMPUTE RESULT-HUDGE = FIELD-02 ** EXPO-INT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY '6: SHOULD SIZE ERROR' + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE -123.456 TO FIELD-02 . + MOVE -18446744073709551619 TO EXPO-INT . + COMPUTE RESULT-HUDGE = FIELD-02 ** EXPO-INT + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY '7: SHOULD SIZE ERROR' + display 'RES = ' RESULT-HUDGE + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE -1.0000000000000000000000000000000000001 TO FIELD-03 . + MOVE -9223372036854776134 TO EXPO-INT . + COMPUTE RESULT-MIN = FIELD-03 ** EXPO-INT + ON SIZE ERROR + DISPLAY '8 : Should not size error' + NOT ON SIZE ERROR + IF RESULT-MIN NOT = + 0.9999999999999999990776627963145223870 + THEN + DISPLAY + '8: Result <' RESULT-MIN + '> != 0.9999999999999999990776627963145223870' + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE -1.0000000000000000000000000000000000001 TO FIELD-03 . + MOVE -9223372036854776135 TO EXPO-INT . + COMPUTE RESULT-MIN = FIELD-03 ** EXPO-INT + ON SIZE ERROR + DISPLAY '8.1 : Should not size error' + NOT ON SIZE ERROR + IF RESULT-MIN NOT = + -0.9999999999999999990776627963145223869 + THEN + DISPLAY + '8.1: Result <' RESULT-MIN + '> != 0.9999999999999999990776627963145223869' + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE 99999999999999999999999999999999999999 TO FIELD-MAX . + MOVE 1.0000000000000000000000000000000000001 TO EXPO-MIN . + COMPUTE RESULT-HUDGE = FIELD-MAX ** EXPO-MIN + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY '9: SHOULD SIZE ERROR' + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE 35 TO FIELD-02 . + MOVE 26.1234 TO EXPO-DEC . + COMPUTE RESULT-HUDGE = FIELD-02 ** EXPO-DEC + ON SIZE ERROR + CONTINUE + NOT ON SIZE ERROR + DISPLAY '10: SHOULD SIZE ERROR' + END-COMPUTE . + *> + *> -------------------------------------------------------------- + *> + MOVE 35.1234 TO FIELD-02 . + MOVE 0 TO EXPO-DEC . + COMPUTE RESULT-HUDGE = FIELD-02 ** EXPO-DEC + ON SIZE ERROR + DISPLAY '11: SHOULD NOT SIZE ERROR' + NOT ON SIZE ERROR + CONTINUE + END-COMPUTE . + IF RESULT-HUDGE NOT = 1 + THEN + DISPLAY '11: RESULT <' RESULT-HUDGE '> != 1' + END-IF . + *> + *> -------------------------------------------------------------- + *> + MOVE -53.1234 TO FIELD-02 . + MOVE 0 TO EXPO-DEC . + COMPUTE RESULT-HUDGE = FIELD-02 ** EXPO-DEC + ON SIZE ERROR + DISPLAY '12: SHOULD NOT SIZE ERROR' + NOT ON SIZE ERROR + CONTINUE + END-COMPUTE . + IF RESULT-HUDGE NOT = 1 + THEN + DISPLAY '12: RESULT <' RESULT-HUDGE '> != 1' + END-IF . + *> + STOP RUN . +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([COMPUTE Power size error and limits cases 2]) +AT_KEYWORDS([COMPUTE POWER]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID . tstpow . + *>---------------------------------------------------------------- + *> + *> Test program test limits for power computing + *> + *>---------------------------------------------------------------- + *> + ENVIRONMENT DIVISION. + DATA DIVISION . + WORKING-STORAGE SECTION. + + 01 EXPONENT PIC 9(38) COMP-3 . + 01 FIELD-01 PIC S9(1)V9(37) COMP-3 . + 01 RESULT PIC S9(38) COMP-3 . + + *> + PROCEDURE DIVISION . + *>------------------- + *> + move 6.1896581 to field-01 . + move 48 to exponent . + compute result = field-01 ** exponent + on size error + display '1: Should not size error' + not on size error + * 12345678901234567890123456789012345678 + if result not = + 99999931049445726660449493948965344047 + then + display '1: result <' + result + '> != 99999931049445726660449493948965344047' + end-compute . + *> + move 6.1896582 to field-01 . + move 48 to exponent . + compute result = field-01 ** exponent + on size error + continue + not on size error + display '2: Should size error' + end-compute . + *> + move 1.0000000000000000047432887442980750246 to field-01 . + move 18446744073709551616 to exponent . + compute result = field-01 ** exponent + on size error + display '3: Should not size error' + not on size error + if result NOT = 99999999999999999882232070383165808731 + THEN + DISPLAY '3: result <' + result + '> != 99999999999999999882232070383165808731' + END-IF + end-compute . + *> + move -1.0000000000000000047432887442980750246 to field-01 . + move 18446744073709551616 to exponent . + compute result = field-01 ** exponent + on size error + display '4: Should not size error' + not on size error + if result NOT = 99999999999999999882232070383165808731 + THEN + DISPLAY '4: result <' + result + '> != 99999999999999999882232070383165808731' + END-IF + end-compute . + *> + move -1.0000000000000000047432887442980750244 to field-01 . + move 18446744073709551617 to exponent . + compute result = field-01 ** exponent + on size error + display '5: Should not size error' + not on size error + if result NOT = + -99999999999999999987626063338782279407 + THEN + DISPLAY '5: result <' + result + '> != -99999999999999999987626063338782279407' + END-IF + end-compute . + *> + GOBACK . + *> +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([Compute Power with constant]) +AT_KEYWORDS([COMPUTE POWER]) + +AT_DATA([prog.cob], [ + PROGRAM-ID. testpower. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 AAA PIC -9999.9999. + PROCEDURE DIVISION. + COMPUTE AAA = 2 ** 3 + ON SIZE ERROR + DISPLAY '1: 2 ** 3 SHOULD NOT SIZE ERROR' + NOT ON SIZE ERROR + IF AAA NOT = ' 0008.0000' + THEN + DISPLAY '1: <' AAA '> != 8' + END-IF + END-COMPUTE + * + compute AAA = -2 ** 3 + on size error + display '2: -2 ** 3 should not size error' + not on size error + if AAA NOT = '-0008.0000' + then + display '2: <' AAA '> != -8' + end-if + end-compute + * + compute AAA = 2 ** -3 + on size error + display '3: 2 ** -3 should not size error' + not on size error + if AAA NOT = ' 0000.1250' + then + display '3: <' AAA '> != 0.125' + end-if + end-compute + * + compute AAA = -2 ** -3 + on size error + display '4: -2 ** -3 should not size error' + not on size error + if AAA NOT = '-0000.1250' + then + display '4: <' AAA '> != -0.125' + end-if + end-compute + * + goback . +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP +