diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 91ff9b50e..e4b8ba7f1 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,25 @@ +2026-04-10 Denis Hugonnard-Roche + + * intrinsic.c (setup_cob_pi, cob_exit_intrinsic): add cob_half_pi + constant + * intrinsic.c (cob_normalize_angle): simplify & optimize, use + cob_halp_pi + * intrinsic.c (cob_mpf_xxxx: sin, cos, acos, asin, atan): use cob_half_pi + +2026-04-04 Denis Hugonnard-Roche + + * intrinsic.c (cob_normalize_angle): new_function + * intrinsic.c (cob_mpf_cos): better performabce with use of + cob_normalize_angle + * intrinsic.c (cob_mpf_sin): better performabce with use of + cob_mpf_sin + +2026-03-02 Fabrice Le Fessant + + * coblocal.h, common.c, profiling.c: rename is_test to cob_is_test + as it is an external value. + 2025-12-04 Simon Sobisch * fileio.c (indexed_open) [WITH_DB]: if open was successful but checking diff --git a/libcob/intrinsic.c b/libcob/intrinsic.c index 0aec31248..7cb57a27d 100644 --- a/libcob/intrinsic.c +++ b/libcob/intrinsic.c @@ -1,6 +1,7 @@ /* - Copyright (C) 2005-2012, 2014-2024 Free Software Foundation, Inc. - Written by Roger While, Simon Sobisch, Edward Hart, Brian Tiffin + Copyright (C) 2005-2012, 2014-2026 Free Software Foundation, Inc. + Written by Roger While, Simon Sobisch, Edward Hart, Brian Tiffin, + Denis Hugonnard-Roche This file is part of GnuCOBOL. @@ -100,6 +101,7 @@ static mpf_t cob_mpft2; static mpf_t cob_mpft_get; static mpf_t cob_pi; +static mpf_t cob_half_pi; static mpf_t cob_sqrt_two; static mpf_t cob_log_half; static mpf_t cob_log_ten; @@ -370,6 +372,8 @@ static const struct winlocale wintable[] = #endif +#define COB_COS_DIVIDE_FACTOR 16 + static COB_NOINLINE void setup_cob_pi (void) { @@ -397,6 +401,11 @@ setup_cob_pi (void) mpf_init2 (cob_pi, COB_PI_LEN); mpf_set_str (cob_pi, cob_pi_str, 10); + + mpf_init2 (cob_half_pi, COB_PI_LEN); + mpf_set (cob_half_pi, cob_pi); + mpf_div_ui (cob_half_pi, cob_pi, 2UL); + set_cob_pi = 1; } @@ -994,102 +1003,150 @@ cob_mpf_log10 (mpf_t dst_val, const mpf_t src_val) mpf_clear (dst_temp); } -/* Sin function */ -/* sin (x) = (reduce to pi/2) */ -/* {n = 0, ...} ( (-1 ^ n) * ( x ^ (2n + 1)) / (2n + 1) ) */ +/* Takes an angle X as input and calculates the angle Y reduced to [0;P2/2] */ +/* such that abs( cos(X) ) = abs( cos(Y) ) and abs( sin(X) ) = abs( sin(Y) ) */ +/* and returns the quadrant to which the initial angle belongs (from 0 to 3) */ -static void -cob_mpf_sin (mpf_t dst_val, const mpf_t src_val) +static cob_u16_t +cob_normalize_angle (mpf_t dst, const mpf_t src_val) { - mpf_t vf1, vf2, vf3, vf4, vf5; - mpf_t dst_temp; - cob_uli_t arcquad; - cob_uli_t n; - int sign; + mpf_t vf1; + mpf_t k ; + mpz_t q ; + unsigned long n ; - mpf_init2 (dst_temp, COB_MPF_PREC); - if (!set_cob_pi) setup_cob_pi (); + const int sign = mpf_sgn (src_val); + if (sign == 0) { + mpf_set_ui (dst, 0UL); + return 0 ; + } - mpf_init2 (vf1, COB_MPF_PREC); - mpf_init2 (vf2, COB_MPF_PREC); - mpf_init2 (vf3, COB_MPF_PREC); - mpf_init2 (vf4, COB_MPF_PREC); - mpf_init2 (vf5, COB_MPF_PREC); - sign = mpf_sgn (src_val); - - mpf_abs (vf4, src_val); - mpf_set (vf3, cob_pi); - mpf_div_2exp (vf3, vf3, 1UL); - mpf_div (vf1, vf4, vf3); - mpf_floor (vf4, vf1); - - if (mpf_cmp_ui (vf4, 4UL) >= 0) { - mpf_div_2exp (vf2, vf4, 2UL); - mpf_floor (vf2, vf2); - mpf_mul_2exp (vf2, vf2, 2UL); - mpf_sub (vf2, vf4, vf2); - } else { - mpf_set (vf2, vf4); + mpf_set (dst, src_val); + if (sign == -1) { + mpf_neg (dst, dst); } + /* Now dst contains abs(src_val) */ - arcquad = mpf_get_ui (vf2); - mpf_sub (vf2, vf1, vf4); - mpf_mul (vf4, vf3, vf2); + mpf_init2 (vf1, COB_MPF_PREC); + mpf_init2 (k, COB_MPF_PREC); + mpz_init2 (q, COB_MPZ_DEF); + + /* Get Quadrant */ + mpf_div (vf1, dst, cob_half_pi); + mpf_trunc (k, vf1); + mpz_set_f(q, k); + mpz_mod_ui (q, q, 4UL); + n = mpz_get_ui (q); + + /* Compute the resulting angle reduce on [0;PI/2] */ + /* dst - k*Pi/2 */ + mpf_mul (vf1, k, cob_half_pi); + mpf_sub (dst, dst, vf1); - if (arcquad > 1) { - sign = -sign; + /* Process quadrant */ + if (n & 1) { + /* if n odd we have to get the complementary angle */ + mpf_sub (dst, cob_half_pi, dst); } - if (arcquad & 1) { - mpf_sub (vf4, vf3, vf4); + + if (sign == -1) { + n = 3 - n ; } - mpf_mul (vf3, vf4, vf4); - mpf_neg (vf3, vf3); + mpf_clear (vf1); + mpf_clear (k); + mpz_clear (q); - n = 1; - mpf_set_ui (vf2, 1UL); - mpf_set_ui (dst_temp, 1UL); + return n; +} + +/* Cos function */ +/* cos(x) = ( 1 - x^2/2 + x^4/4! - x^6/6! ...*/ +/* (x) = (reduced to pi/2) */ +/* The angle is divided by 2^COB_COS_DIVIDE to make it closer to 0 */ +/* We use the equality cos(2X) = 2*cos^2(X)-1 to have the final value*/ + +static void +cob_mpf_cos (mpf_t dst_val, const mpf_t src_val) +{ + mpf_t term, val_serie, angle; + cob_u16_t arcquad; + cob_uli_t n; + if (!set_cob_pi) setup_cob_pi (); + + mpf_init2 (term, COB_MPF_PREC); + mpf_init2 (val_serie, COB_MPF_PREC); + mpf_init2 (angle, COB_MPF_PREC); + + arcquad = cob_normalize_angle (angle, src_val); + + /* Divide nn time by 2 */ + mpf_div_2exp (angle, angle, COB_COS_DIVIDE_FACTOR ); + + mpf_mul (angle, angle, angle); + + mpf_set_si (term, -1L); + + /* compute first term */ + mpf_set (dst_val, angle); + mpf_div_ui (dst_val, dst_val, 2UL); + mpf_neg (dst_val, dst_val); + mpf_set (term, dst_val); /* init first term to -x^2/2 */ + mpf_add_ui (dst_val, dst_val, 1UL); + + n = 4; do { - ++n; - mpf_div_ui (vf2, vf2, n); - ++n; - mpf_div_ui (vf2, vf2, n); - mpf_mul (vf2, vf2, vf3); - mpf_set (vf5, dst_temp); - mpf_add (dst_temp, dst_temp, vf2); - } while (!mpf_eq (vf5, dst_temp, COB_MPF_PREC)); + const cob_uli_t j = (n-1UL) * n; - mpf_mul (dst_temp, dst_temp, vf4); - if (sign < 0) { - mpf_neg (dst_temp, dst_temp); + mpf_set (val_serie, dst_val); + mpf_mul (term, term, angle); + mpf_div_ui (term, term, j); + mpf_neg (term, term); + + mpf_add (dst_val, dst_val, term); + + n += 2; + } while (!mpf_eq (dst_val, val_serie, COB_MPF_PREC)); + + /* compute 2*n^2 -1 n times */ + { + int i ; + for (i = 0 ; i < COB_COS_DIVIDE_FACTOR; i++) { + mpf_mul (dst_val, dst_val, dst_val); + mpf_mul_ui (dst_val, dst_val, 2UL); + mpf_sub_ui (dst_val, dst_val, 1UL); + } } - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); + if (arcquad == 1 || arcquad == 2) { + mpf_neg (dst_val, dst_val); + } - mpf_clear (vf5); - mpf_clear (vf4); - mpf_clear (vf3); - mpf_clear (vf2); - mpf_clear (vf1); + mpf_clear (term); + mpf_clear (angle); + mpf_clear (val_serie); } -/* Cos function */ -/* cos (x) = sin ((pi / 2) - x) */ +/* sin function */ +/* sin(X) = cos( PI/2 - X) */ static void -cob_mpf_cos (mpf_t dst_val, const mpf_t src_val) +cob_mpf_sin (mpf_t dst_val, const mpf_t src_val) { - mpf_t vf1; + mpf_t vf1; - mpf_init2 (vf1, COB_MPF_PREC); if (!set_cob_pi) setup_cob_pi (); - mpf_set (vf1, cob_pi); - mpf_div_2exp (vf1, vf1, 1UL); - mpf_sub (vf1, vf1, src_val); - cob_mpf_sin (dst_val, vf1); + mpf_init2 (vf1, COB_MPF_PREC); + + /* compute complementary angle = PI/2 - Angle */ + mpf_set (vf1, cob_half_pi); + if (mpf_cmp_ui (src_val, 0UL) != 0) { + mpf_sub (vf1, vf1, src_val); + } + + cob_mpf_cos (dst_val, vf1); mpf_clear (vf1); } @@ -1136,15 +1193,14 @@ cob_mpf_atan (mpf_t dst_val, const mpf_t src_val) mpf_add_ui (vf3, cob_sqrt_two, 1UL); if (mpf_cmp (vf1, vf3) > 0) { - mpf_set (dst_temp, cob_pi); - mpf_div_2exp (dst_temp, dst_temp, 1UL); + mpf_set (dst_temp, cob_half_pi); mpf_ui_div (vf1, 1UL, vf1); mpf_neg (vf1, vf1); } else { mpf_sub_ui (vf4, cob_sqrt_two, 1UL); if (mpf_cmp (vf1, vf4) > 0) { - mpf_set (dst_temp, cob_pi); - mpf_div_2exp (dst_temp, dst_temp, 2UL); + mpf_set (dst_temp, cob_half_pi); + mpf_div_2exp (dst_temp, dst_temp, 1UL); mpf_sub_ui (vf3, vf1, 1UL); mpf_add_ui (vf4, vf1, 1UL); mpf_div (vf1, vf3, vf4); @@ -1192,8 +1248,8 @@ cob_mpf_asin (mpf_t dst_val, const mpf_t src_val) if (!set_cob_pi) setup_cob_pi (); if (!mpf_cmp_ui (src_val, 1UL) || !mpf_cmp_si (src_val, -1L)) { - mpf_set (dst_temp, cob_pi); - mpf_div_ui (dst_temp, dst_temp, 2UL); + mpf_set (dst_temp, cob_half_pi); + mpf_div_ui (dst_temp, dst_temp, 1UL); if (mpf_sgn (src_val) < 0) { mpf_neg (dst_temp, dst_temp); } @@ -1240,8 +1296,8 @@ cob_mpf_acos (mpf_t dst_val, const mpf_t src_val) if (!set_cob_pi) setup_cob_pi (); if (!mpf_sgn (src_val)) { - mpf_set (dst_temp, cob_pi); - mpf_div_ui (dst_temp, dst_temp, 2UL); + mpf_set (dst_temp, cob_half_pi); + mpf_div_ui (dst_temp, dst_temp, 1UL); mpf_set (dst_val, dst_temp); mpf_clear (dst_temp); return; @@ -7189,6 +7245,7 @@ cob_exit_intrinsic (void) } if (set_cob_pi) { mpf_clear (cob_pi); + mpf_clear (cob_half_pi); } if (set_cob_log_half) { mpf_clear (cob_log_half); diff --git a/tests/testsuite.src/run_functions.at b/tests/testsuite.src/run_functions.at index 452f65b79..7876ebc7c 100644 --- a/tests/testsuite.src/run_functions.at +++ b/tests/testsuite.src/run_functions.at @@ -1,4 +1,4 @@ -## Copyright (C) 2003-2012, 2014-2023 Free Software Foundation, Inc. +## Copyright (C) 2003-2012, 2014-2026 Free Software Foundation, Inc. ## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart ## ## This file is part of GnuCOBOL. @@ -4657,3 +4657,955 @@ Return value '5'], []) AT_CLEANUP + +AT_SETUP([FUNCTION SIN additionnals tests]) +AT_KEYWORDS([functions SIN]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(37) COMP-3. + 01 N PIC 9(04) COMP-5. + PROCEDURE DIVISION. + * + * SIN TESTS + * + MOVE 1 TO N. + >> IF CHECK-PERF IS DEFINED + MOVE 2500 TO N. + >> END-IF + * + PERFORM DO-TEST N TIMES . + * + GOBACK. + * + DO-TEST . + *--------- + * + PERFORM QUADRANT-1 . + * + PERFORM QUADRANT-1 . + * + PERFORM QUADRANT-2 . + * + PERFORM QUADRANT-3 . + * + PERFORM QUADRANT-4 . + * + PERFORM OTHERS . + * + QUADRANT-1 . + *------------ + * + MOVE + SIN (0) TO Y + IF Y NOT = 0 + THEN + DISPLAY 'Q-1-1 ' '<' Y '> != 0'. + * + MOVE + SIN ( PI() / 6 ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-1-2 ' '<' Y '> != 0.5'. + * + MOVE + SIN ( PI() / 4 ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-1-3 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( PI() / 3 ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-1-4 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() / 2 ) TO Y . + IF Y NOT = 1 + THEN + DISPLAY 'Q-1-5 ' '<' Y '> != 1'. + * + * ROTATE 6*PI + * + MOVE + SIN ( PI() / 6 + 6 * PI() ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-1-6 ' '<' Y '> != 0.5'. + * + MOVE + SIN ( PI() / 4 + 6 * PI() ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-1-7 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( PI() / 3 + 6 * PI() ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-1-8 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() / 2 + 6 * PI() ) TO Y . + IF Y NOT = 1 + THEN + DISPLAY 'Q-1-9 ' '<' Y '> != 1'. + * + QUADRANT-2 . + *------------ + * + MOVE + SIN ( 5/6 * (PI() ) ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-2-1 ' '<' Y '> != 0.5'. + * + MOVE + SIN ( 3 * PI() / 4 ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-2-2 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( 2 * PI() / 3 ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-2-3 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-2-4 ' '<' Y + '> != 0'. + * + MOVE + SIN ( -PI() ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-2-4-1 ' '<' Y + '> != 0'. + * + * ROTATE 4*PI + * + MOVE + SIN ( 5 /6 * PI() + 4 * PI() ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-2-5 ' '<' Y '> != 0.5'. + * + MOVE + SIN ( 3 * PI() / 4 + 4 * PI() ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-2-6 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( 2 * PI() / 3 + 4 * PI) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-2-7 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() + 4 * PI) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-2-8 ' '<' Y + '> != 0'. + * + QUADRANT-3 . + *------------ + * + MOVE + SIN ( 7 * PI() / 6 ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-3-1 ' '<' Y '> != -0.5'. + * + MOVE + SIN ( 5 * PI() / 4 ) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-3-2 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( 4 * PI() / 3 ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-3-3 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + * ROTATE 4*PI + * + MOVE + SIN ( 7 * PI() / 6 + 4 * PI() ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-3-4 ' '<' Y '> != -0.5'. + * + MOVE + SIN ( 5 * PI() / 4 + 4 * PI) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-3-5 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( 4 * PI() / 3 + 4 * PI) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-3-6 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + QUADRANT-4 . + *------------ + * + MOVE + SIN ( 2* PI() ) TO Y + IF Y NOT = 0 + THEN + DISPLAY 'Q-4-1 ' '<' Y '> != 0'. + * + MOVE + SIN ( PI() / -6 ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-4-2 ' '<' Y '> != -0.5'. + * + MOVE + SIN ( PI() / -4 ) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-4-3 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( PI() / -3 ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-4-4 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() / -2 ) TO Y . + IF Y NOT = -1 + THEN + DISPLAY 'Q-4-5 ' '<' Y '> != -1'. + * + * ROTATE 2*PI + * + MOVE + SIN ( 2* PI() + 2 * PI() ) TO Y + IF Y NOT = 0 + THEN + DISPLAY 'Q-4-6 ' '<' Y '> != 0'. + * + MOVE + SIN ( 11 / 6 * PI() ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-4-7 ' '<' Y '> != -0.5'. + * + MOVE + SIN ( PI() / -4 + 2 * PI()) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-4-8 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( PI() / -3 + 2 * PI() ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-4-9 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() / -2 + 2 * PI()) TO Y . + IF Y NOT = -1 + THEN + DISPLAY 'Q-4-10 ' '<' Y '> != -1'. + * + OTHERS . + *-------- + * + MOVE + SIN ( 50 ) TO Y + IF Y NOT = -0.2623748537039287859143936469126225458 + THEN + DISPLAY 'O-1 ' '<' Y + '> != -0.2623748537039287859143936469126225458'. + * + MOVE + SIN ( 102 ) TO Y + IF Y NOT = 0.9948267913584063974966258254280299703 + THEN + DISPLAY 'O-2 ' '<' Y + '> != 0.9948267913584063974966258254280299703'. + * + MOVE + SIN ( -91 ) TO Y + IF Y NOT = -0.1059875117511568500202081631463178801 + THEN + DISPLAY 'O-3 ' '<' Y + '> != -0.1059875117511568500202081631463178801'. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([FUNCTION COS additionnals tests]) +AT_KEYWORDS([functions COS]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(37) COMP-3. + 01 N PIC 9(04) COMP-5. + PROCEDURE DIVISION. + * + * COS TESTS + * + MOVE 1 TO N. + >> IF CHECK-PERF IS DEFINED + MOVE 2500 TO N. + >> END-IF + * + PERFORM DO-TEST N TIMES . + * + GOBACK. + * + DO-TEST . + *--------- + * + PERFORM QUADRANT-1 . + * + PERFORM QUADRANT-2 . + * + PERFORM QUADRANT-3 . + * + PERFORM QUADRANT-4 . + * + PERFORM OTHERS . + * + QUADRANT-1 . + *------------ + * + MOVE + COS (0) TO Y + IF Y NOT = 1 + THEN + DISPLAY 'Q-1-1 ' '<' Y '> != 1'. + * + MOVE + COS ( PI() * (1/6) ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-1-2 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() * (1/4) ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-1-3 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + COS ( PI() * (1/3) ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-1-4 ' '<' Y + '> != 0.5'. + * + MOVE + COS ( PI() * (1/2) ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-1-5 ' '<' Y '> != 0'. + * + * ROTATE 6*PI + * + MOVE + COS ( PI() * (1/6) + 6 * PI() ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-1-6 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() * (1/4) + 6 * PI() ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-1-7 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + COS ( PI() * (1/3) + 6 * PI() ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-1-8 ' '<' Y + '> != 0.5'. + * + MOVE + COS ( PI() * (1/2) + 6 * PI() ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-1-9 ' '<' Y '> != 0'. + * + QUADRANT-2 . + *------------ + * + MOVE + COS ( PI() * (5/6) ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-2-1 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() * (3/4) ) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-2-2 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + COS ( (PI() * 2) / 3 ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-2-3 ' '<' Y + '> != -0.5'. + * + MOVE + COS ( PI() ) TO Y . + IF Y NOT = -1 + THEN + DISPLAY 'Q-2-4 ' '<' Y + '> != -1'. + * + * ROTATE 4*PI + * + MOVE + COS ( PI() * (5/6) + 4 * PI() ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-2-5 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() * (3/4) + 4 * PI()) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-2-6 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + COS ( (PI() * 2) / 3 + 4 * PI) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-2-7 ' '<' Y + '> != -0.5'. + * + MOVE + COS ( PI() + 4 * PI) TO Y . + IF Y NOT = -1 + THEN + DISPLAY 'Q-2-8 ' '<' Y + '> != -1'. + * + QUADRANT-3 . + *------------ + * + MOVE + COS ( (-1/2) * PI() ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-3-0 ' '<' Y + '> != 0'. + * + MOVE + COS ( 7 * PI() / 6 ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-3-1 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + COS ( 5 * PI() / 4 ) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-3-2 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + COS ( 4 * PI() * (1/3) ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-3-3 ' '<' Y + '> != -0.5'. + * + * ROTATE 4*PI + * + MOVE + COS ( 7 * PI() / 6 + 4 * PI() ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-3-4 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + COS ( 5 * PI() / 4 + 4 * PI) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-3-5 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + COS ( 4 * PI() * (1/3) + 4 * PI) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-3-6 ' '<' Y + '> != -0.5'. + * + QUADRANT-4 . + *------------ + * + MOVE + COS ( 2* PI() ) TO Y + IF Y NOT = 1 + THEN + DISPLAY 'Q-4-1 ' '<' Y '> != 1'. + * + MOVE + COS ( PI() / -6 ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-4-2 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() / -4 ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-4-3 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + COS ( PI() * (-1/3) ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-4-4 ' '<' Y + '> != 0.5'. + * + MOVE + COS ( (-1/2) * PI() ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-4-5 ' '<' Y '> != 0'. + * + * ROTATE 2*PI + * + MOVE + COS ( 2* PI() + 2 * PI() ) TO Y + IF Y NOT = 1 + THEN + DISPLAY 'Q-4-6 ' '<' Y '> != 1'. + * + MOVE + COS ( 11 / 6 * PI() ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-4-7 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() / -4 + 2 * PI()) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-4-8 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + COS ( PI() / -3 + 2 * PI() ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-4-9 ' '<' Y + '> != 0.5'. + * + MOVE + COS ( PI() / -2 + 2 * PI()) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-4-10 ' '<' Y '> != 0'. + * + OTHERS . + *-------- + * + MOVE + COS ( 6283 ) TO Y + IF Y NOT = 0.9828796996364299824023342356924739561 + THEN + DISPLAY 'O-1 ' '<' Y + '> != 0.9828796996364299824023342356924739561'. + * + MOVE + COS ( 7853 ) TO Y + IF Y NOT = 0.5556647922689408634262568334887896883 + THEN + DISPLAY 'O-2 ' '<' Y + '> != 0.5556647922689408634262568334887896883'. + * + MOVE + COS ( 9424 ) TO Y + IF Y NOT = 0.7123462077917668361340766590450501725 + THEN + DISPLAY 'O-3 ' '<' Y + '> != 0.7123462077917668361340766590450501725'. + * + MOVE + COS ( 10995 ) TO Y . + IF Y NOT = 0.8395795367483645308029333859038237152 + THEN + DISPLAY 'O-4 ' '<' Y + '> != 0.8395795367483645308029333859038237152'. + MOVE + COS ( -6283 ) TO Y + IF Y NOT = 0.9828796996364299824023342356924739561 + THEN + DISPLAY 'O-5 ' '<' Y + '> != 0.9828796996364299824023342356924739561'. + * + MOVE + COS ( -7853 ) TO Y + IF Y NOT = 0.5556647922689408634262568334887896883 + THEN + DISPLAY 'O-6 ' '<' Y + '> != 0.5556647922689408634262568334887896883'. + * + MOVE + COS ( -9424 ) TO Y + IF Y NOT = 0.7123462077917668361340766590450501725 + THEN + DISPLAY 'O-7 ' '<' Y + '> != 0.7123462077917668361340766590450501725'. + * + MOVE + COS ( -10995 ) TO Y . + IF Y NOT = 0.8395795367483645308029333859038237152 + THEN + DISPLAY 'O-8 ' '<' Y + '> != 0.8395795367483645308029333859038237152'. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([function ATAN additionals tests]) +AT_KEYWORDS([functions ATAN]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 BIG PIC S9(38) COMP-3. + 01 Z PIC S9V9(37) COMP-3. + 01 X PIC S9V9(37) COMP-3. + * + PROCEDURE DIVISION. + * + * ATAN TESTS + * + + MOVE 99999999999999999999999999999999999999 TO BIG. + COMPUTE Z = ATAN(BIG) + IF Z NOT = 1.5707963267948966192313216916397514420 + THEN + DISPLAY '1 : ' Z + ' != 1.5707963267948966192313216916397514420'. + * + MOVE -99999999999999999999999999999999999999 TO BIG. + COMPUTE Z = ATAN(BIG) + IF Z NOT = -1.5707963267948966192313216916397514420 + THEN + DISPLAY '2 : ' Z + ' != -1.5707963267948966192313216916397514420'. + * + MOVE 0 TO BIG. + COMPUTE Z = ATAN(BIG) + IF Z NOT = 0 + THEN + DISPLAY '3 : ' Z + ' != 0'. + * + MOVE 2 TO X. + COMPUTE Z = ATAN(X) + IF Z NOT = 1.1071487177940905030170654601785370400 + THEN + DISPLAY '4 : ' Z + ' != 1.1071487177940905030170654601785370400'. + * + MOVE -2 TO X. + COMPUTE Z = ATAN(X) + IF Z NOT = -1.1071487177940905030170654601785370400 + THEN + DISPLAY '5 : ' Z + ' != -1.1071487177940905030170654601785370400'. + * + MOVE 0.3 TO X. + COMPUTE Z = ATAN(X) + IF Z NOT = 0.2914567944778670919956046214328911935 + THEN + DISPLAY '6 : ' Z + ' != 0.2914567944778670919956046214328911935'. + * + MOVE -0.3 TO X. + COMPUTE Z = ATAN(X) + IF Z NOT = -0.2914567944778670919956046214328911935 + THEN + DISPLAY '7 : ' Z + ' != -0.2914567944778670919956046214328911935'. + * + GOBACK. + +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([function ACOS additionals tests]) +AT_KEYWORDS([functions ACOS]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC S9V9(37) COMP-3. + 01 X PIC S99V9(36) COMP-3. + 01 E-LOC PIC X(50) . + 01 E-LOC-PREV PIC X(50) . + 01 E-STATUS PIC X(50) . + * + PROCEDURE DIVISION. + * + * ACOS TESTS + * + MOVE 2 TO X . + COMPUTE Z = ACOS(X) + MOVE EXCEPTION-STATUS TO E-STATUS . + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-STATUS NOT = 'EC-ARGUMENT-FUNCTION' + THEN + DISPLAY '1-1: Should have raise exception'. + MOVE E-LOC TO E-LOC-PREV. + * + MOVE -2 TO X . + COMPUTE Z = ACOS(X) + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-LOC = E-LOC-PREV + THEN + DISPLAY '2-1: Should have raise exception'. + MOVE E-LOC TO E-LOC-PREV. + * + MOVE 0 TO X . + COMPUTE Z = ACOS(X) + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '3-1 : Should not have raise exception' + END-IF. + IF Z NOT = 1.5707963267948966192313216916397514420 + THEN + DISPLAY '3-2 : <' Z + '> != 1.5707963267948966192313216916397514420' + END-IF. + * + MOVE 1 TO X . + COMPUTE Z = ACOS(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '4-1 : Should not have raise exception' + END-IF. + IF Z NOT = 0 + THEN + DISPLAY '4-2 : <' Z + '> != 0' + END-IF. + * + MOVE -1 TO X . + COMPUTE Z = ACOS(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '5-1 : Should not have raise exception' + END-IF. + IF Z NOT = 3.1415926535897932384626433832795028841 + THEN + DISPLAY '5-2 : <' Z + '> != 3.1415926535897932384626433832795028841' + END-IF. + * + MOVE 0.5 TO X . + COMPUTE Z = ACOS(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '6-1 : Should not have raise exception' + END-IF. + IF Z NOT = 1.0471975511965977461542144610931676280 + THEN + DISPLAY '6-2 : <' Z + '> != 1.0471975511965977461542144610931676280' + END-IF. + * + GOBACK. +]) + +AT_CHECK([$COMPILE -d prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([function ASIN additionals tests]) +AT_KEYWORDS([functions ASIN]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC S9V9(37) COMP-3. + 01 X PIC S99V9(36) COMP-3. + 01 E-LOC PIC X(50) . + 01 E-LOC-PREV PIC X(50) . + 01 E-STATUS PIC X(50) . + * + PROCEDURE DIVISION. + * + * ASIN TESTS + * + MOVE 2 TO X . + COMPUTE Z = ASIN(X) + MOVE EXCEPTION-STATUS TO E-STATUS . + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-STATUS NOT = 'EC-ARGUMENT-FUNCTION' + THEN + DISPLAY '1-1: Should have raise exception'. + MOVE E-LOC TO E-LOC-PREV. + * + MOVE -2 TO X . + COMPUTE Z = ASIN(X) + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-LOC = E-LOC-PREV + THEN + DISPLAY '2-1: Should have raise exception'. + MOVE E-LOC TO E-LOC-PREV. + * + MOVE 0 TO X . + COMPUTE Z = ASIN(X) + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '3-1 : Should not have raise exception' + END-IF. + IF Z NOT = 0 + THEN + DISPLAY '3-2 : <' Z + '> != 0' + END-IF. + * + MOVE 1 TO X . + COMPUTE Z = ASIN(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '4-1 : Should not have raise exception' + END-IF. + IF Z NOT = 1.5707963267948966192313216916397514420 + THEN + DISPLAY '4-2 : <' Z + '> != 1.5707963267948966192313216916397514420' + END-IF. + * + MOVE -1 TO X . + COMPUTE Z = ASIN(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '5-1 : Should not have raise exception' + END-IF. + IF Z NOT = -1.5707963267948966192313216916397514420 + THEN + DISPLAY '5-2 : <' Z + '> != -1.5707963267948966192313216916397514420' + END-IF. + * + MOVE 0.5 TO X . + COMPUTE Z = ASIN(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '6-1 : Should not have raise exception' + END-IF. + IF Z NOT = 0.5235987755982988730771072305465838140 + THEN + DISPLAY '6-2 : <' Z + '> != 0.5235987755982988730771072305465838140' + END-IF. + * + GOBACK. + +]) + +AT_CHECK([$COMPILE -d prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP +