I am enclosing a patch to be applied on top of yours. (Your patch got us
down to zero errors in the "Coughlan" tests, 2 UAT errors, and 4 errors in
the NIST tests. Well done!)
This one passes all of my tests, in both ASCII and EBCDIC forms. It also
passes "make check-cobol". That's on my x_86_64-linux machine.
(That's the good news. The bad news is that this is exposing gaps in
coverage of our test suites. There is stuff that the misnamed numstr2i
routine used to do that isn't being done, but no errors are flagged in any
test.)
Given that this version passes everything that our regression tests cover,
is it time to accumulate all this work into a single patch and have that
committed?
Perhaps I should create that patch, seeing as how at this moment only I
can do all of my known tests.
Bob D.
diff --git a/gcc/cobol/UAT/testsuite.src/syn_definition.at
b/gcc/cobol/UAT/testsuite.src/syn_definition.at
index 787468a194ff..6547b59955ab 100644
--- a/gcc/cobol/UAT/testsuite.src/syn_definition.at
+++ b/gcc/cobol/UAT/testsuite.src/syn_definition.at
@@ -535,7 +535,7 @@ prog.cob:44:20: error: invalid picture for
Alphanumeric-edited
prog.cob:67:22: error: PICTURE '(str-constant)' requires a CONSTANT value
67 | 03 PIC X(str-constant).
| ^
-prog.cob:69:22: error: invalid PICTURE count
'(-1.00000000000000000000000000000000E+00)'
+prog.cob:69:22: error: invalid PICTURE count '(signed-constant)'
69 | 03 PIC X(signed-constant).
| ^
prog.cob:69:21: error: PICTURE count '(-1)' is negative
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index ca86ffa2fc74..f3cab0a4ad1e 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -4897,8 +4897,7 @@ parser_display_internal(tree file_descriptor,
}
else
{
- p += 1;
- int exp = atoi(p);
+ int exp = atoi(p+1);
if( exp >= 6 || exp <= -5 )
{
// We are going to stick with the E notation, so ach has our
result
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 0077863d766b..c2fe2d8d2265 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -6935,6 +6935,17 @@ cce_expr: cce_factor
cce_factor: NUMSTR {
/* ??? real_from_string does not allow arbitrary
radix. */
// $$ = numstr2i($1.string, $1.radix);
+ // When DECIMAL IS COMMA, commas act as decimal points.
+ // What follows is an expedient hack; the numstr2i
routine
+ // actually needs to be fixed.
+ for(size_t i=0; i<strlen($1.string); i++)
+ {
+ if( $1.string[i] == ',' )
+ {
+ $1.string[i] = '.';
+ }
+ }
+ // End of hack
real_from_string3 (&$$, $1.string,
TYPE_MODE (float128_type_node));
}
@@ -12894,14 +12905,14 @@ literal_refmod_valid( YYLTYPE loc, const
cbl_refer_t& r ) {
if( ! is_literal(refmod.len->field) ) return true;
auto edge = real_to_integer (TREE_REAL_CST_PTR
(refmod.len->field->data.value_of()));
if( 0 < edge ) {
- if( --edge < r.field->data.capacity ) return true;
+ if( edge-1 < r.field->data.capacity ) return true;
}
// len < 0 or not: 0 < from + len <= capacity
error_msg(loc, "%s(%s:%zu) out of bounds, "
"size is %u",
r.field->name,
refmod.from->name(),
- size_t(refmod.len->field->data.value_of()),
+ size_t(edge),
static_cast<unsigned int>(r.field->data.capacity) );
return false;
}
@@ -12930,7 +12941,7 @@ literal_refmod_valid( YYLTYPE loc, const
cbl_refer_t& r ) {
// not: 0 < from <= capacity
error_msg(loc,"%s(%zu) out of bounds, size is %u",
r.field->name,
- size_t(refmod.from->field->data.value_of()),
+ size_t(real_to_integer (TREE_REAL_CST_PTR
(refmod.from->field->data.value_of()))),
static_cast<unsigned int>(r.field->data.capacity) );
return false;
}
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index e078412e4eac..f9055c62497e 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -4511,6 +4511,7 @@ cbl_occurs_t::subscript_ok( const cbl_field_t
*subscript ) const {
if( subscript->type != FldLiteralN ) return false;
// ??? This only gets us int64_t
+ // Answer: Array subscripts up to 2^64-1 seem to be a great
sufficiency.
auto sub = real_to_integer (TREE_REAL_CST_PTR
(subscript->data.value_of()));
REAL_VALUE_TYPE csub;
real_from_integer (&csub, VOIDmode, sub, SIGNED);
> -----Original Message-----
> From: Jakub Jelinek <ja...@redhat.com>
> Sent: Sunday, March 23, 2025 06:43
> To: Robert Dubner <rdub...@symas.com>
> Cc: Richard Biener <rguent...@suse.de>; gcc-patches@gcc.gnu.org
> Subject: Re: [PATCH] change cbl_field_data_t::etc_t::value from
_Float128
> to tree
>
> On Sat, Mar 22, 2025 at 11:25:13PM -0500, Robert Dubner wrote:
> > Real progress here. Preliminary report:
> >
> > I am still seeing trouble with a PIC PP9 variable coming back .000
> instead
> > of 0.001.
> >
> > In my 679 UAT tests, the failure count is down from 23 to 4
> >
> > In the NIST tests, the failure count is down from 273 to 35
>
> Nice.
>
> > It's after midnight, and my daily chores are not done, so I can't
really
> > look into all of the failures.
> >
> > Here's one, though:
> >
> > IDENTIFICATION DIVISION.
> > PROGRAM-ID. numeds.
> > DATA DIVISION.
> > WORKING-STORAGE SECTION.
> > 01 VARPP9 PIC PP9 VALUE 0.001.
> > 01 VARP9 PIC P9 VALUE 0.01.
> > 01 VARV9 PIC V9 VALUE 0.1.
> > 01 VAR9 PIC 9 VALUE 1.
> > 01 VAR9P PIC 9P VALUE 10.
> > 01 VAR9PP PIC 9PP VALUE 100.
> > PROCEDURE DIVISION.
> > DISPLAY "VARPP9 should be .001 is " VARPP9
> > DISPLAY "VARP9 should be .01 is " VARP9
> > DISPLAY "VARV9 should be .1 is " VARV9
> > DISPLAY "VAR9 should be 1 is " VAR9
> > DISPLAY "VAR9P should be 10 is " VAR9P
> > DISPLAY "VAR9PP should be 100 is " VAR9PP.
> > END PROGRAM numeds.
> >
> > What I am seeing with your patch is
> >
> > VARPP9 should be .001 is .000
> > VARP9 should be .01 is .01
> > VARV9 should be .1 is .1
> > VAR9 should be 1 is 1
> > VAR9P should be 10 is 10
> > VAR9PP should be 100 is 100
>
> Ok, here is another incremental patch (so you need Richi's patch
> + my incremental you were testing + this one) for this:
>
> --- gcc/cobol/genapi.cc.jj 2025-03-22 08:21:18.287554771 +0100
> +++ gcc/cobol/genapi.cc 2025-03-23 11:38:04.757439095 +0100
> @@ -53,6 +53,7 @@
> #include "../../libgcobol/valconv.h"
> #include "show_parse.h"
> #include "fold-const.h"
> +#include "realmpfr.h"
>
> extern int yylineno;
>
> @@ -15284,22 +15285,36 @@ binary_initial_from_float128(cbl_field_t
> {
> REAL_VALUE_TYPE pow10 = real_powi10 (rdigits);
> real_arithmetic (&value, MULT_EXPR, &value, &pow10);
> - // But make sure to round properly
> - real_roundeven (&value, VOIDmode, &value);
> + real_convert (&value, TYPE_MODE (float128_type_node), &value);
> }
> // We need to make sure that the resulting string will fit into
> // a number with 'digits' digits
> - bool fail = false;
> - FIXED_WIDE_INT(128) i
> - = FIXED_WIDE_INT(128)::from (real_to_integer (&value, &fail, 128),
> SIGNED);
>
> // Keep in mind that pure binary types, like BINARY-CHAR, have no
> digits
> if( field->data.digits )
> {
> - FIXED_WIDE_INT(128) pow10 = get_power_of_ten
(field->data.digits);
> - i = wi::smod_trunc (i, pow10);
> + REAL_VALUE_TYPE pow10 = real_powi10 (field->data.digits);
> + mpfr_t m0, m1;
> +
> + mpfr_inits2 (REAL_MODE_FORMAT (TYPE_MODE
(float128_type_node))->p,
> + m0, m1, NULL);
> + mpfr_from_real (m0, &value, MPFR_RNDN);
> + mpfr_from_real (m1, &pow10, MPFR_RNDN);
> + mpfr_clear_flags ();
> + mpfr_fmod (m0, m0, m1, MPFR_RNDN);
> + real_from_mpfr (&value, m0,
> + REAL_MODE_FORMAT (TYPE_MODE (float128_type_node)),
> + MPFR_RNDN);
> + real_convert (&value, TYPE_MODE (float128_type_node), &value);
> + mpfr_clears (m0, m1, NULL);
> }
>
> + real_roundeven (&value, TYPE_MODE (float128_type_node), &value);
> +
> + bool fail = false;
> + FIXED_WIDE_INT(128) i
> + = FIXED_WIDE_INT(128)::from (real_to_integer (&value, &fail, 128),
> SIGNED);
> +
> /* ??? Use native_encode_* below. */
> retval = (char *)xmalloc(field->data.capacity);
> switch(field->data.capacity)
> @@ -15349,13 +15364,26 @@ digits_from_float128(char *retval, cbl_f
> }
> // We need to make sure that the resulting string will fit into
> // a number with 'digits' digits
> + REAL_VALUE_TYPE pow10 = real_powi10 (field->data.digits);
> + mpfr_t m0, m1;
> +
> + mpfr_inits2 (FLOAT_MODE_FORMAT (TYPE_MODE (float128_type_node))->p,
m0,
> m1,
> + NULL);
> + mpfr_from_real (m0, &value, MPFR_RNDN);
> + mpfr_from_real (m1, &pow10, MPFR_RNDN);
> + mpfr_clear_flags ();
> + mpfr_fmod (m0, m0, m1, MPFR_RNDN);
> + real_from_mpfr (&value, m0,
> + REAL_MODE_FORMAT (TYPE_MODE (float128_type_node)),
> + MPFR_RNDN);
> + real_convert (&value, TYPE_MODE (float128_type_node), &value);
> + mpfr_clears (m0, m1, NULL);
> + real_roundeven (&value, TYPE_MODE (float128_type_node), &value);
> +
> bool fail = false;
> FIXED_WIDE_INT(128) i
> = FIXED_WIDE_INT(128)::from (real_to_integer (&value, &fail, 128),
> SIGNED);
>
> - FIXED_WIDE_INT(128) pow10 = get_power_of_ten (field->data.digits);
> - i = wi::smod_trunc (i, pow10);
> -
> // We convert it to a integer string of digits:
> print_dec (i, ach, SIGNED);
>
>
>
> Jakub
