Recode cob_decimal_pow function - Fix for #924, #925, #989 - add test cases for power operator

ChangeLog

@@ -1,4 +1,19 @@
 
+2025-26-01  Denis Hugonnard-Roche <[email protected]>
+
+	* intrinsic.c: Correct #1020 ticket
+
+2024-26-09  Denis Hugonnard-Roche <[email protected]>
+
+	* intrinsic.c: Correct C++ comment style to C style
+
+2024-25-09  Denis Hugonnard-Roche <[email protected]>
+
+	* 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 <[email protected]>
 
 	* README: add documentation for "make checkmanual"

libcob/ChangeLog

@@ -1,4 +1,17 @@
 
+2025-01-26  Denis Hugonnard-Roche <[email protected]>
+
+	* intrinsic.c (cob_decimal_pow) fix #1020 ticket 
+
+2024-09-26  Denis Hugonnard-Roche <[email protected]>
+
+	* intrinsic.c (cob_decimal_pow) Correct c++ comment style to C
+	comment style
+
+2024-09-25  Denis Hugonnard-Roche <[email protected]>
+
+	* intrinsic.c (cob_decimal_pow) fixed Bug #925,#925,#989
+
 2024-09-20  Chuck Haatvedt <[email protected]>
 
 	* screenio.c (cob_screen_get_all) fixed Bug #990

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);
 }