> -----Original Message-----
> From: Richard Biener <rguent...@suse.de>
> Sent: Monday, March 24, 2025 05:04
> To: Robert Dubner <rdub...@symas.com>
> Cc: Jakub Jelinek <ja...@redhat.com>; gcc-patches@gcc.gnu.org
> Subject: RE: [PATCH] change cbl_field_data_t::etc_t::value from
_Float128
> to tree
>
> On Sun, 23 Mar 2025, Robert Dubner wrote:
>
> > 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?
>
> That would be nice, it's difficult to keep track of all the things in
> flight. And thanks Jakub for picking up the ball while I was
> weekending in the German wilderness ;)
>
> I was also wondering of adding test coverage for the various paths we're
> touching.
I am creating a process whereby I selectively convert many of our UAT
tests to the DejaGnu format. I just today sent a bug report to Jakub. I
am having trouble making the new gd-output-file directive he so graciously
created work, and I need that for the process.
Bob D.
>
> Richard.
>
> > 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
> >
> >
>
> --
> Richard Biener <rguent...@suse.de>
> SUSE Software Solutions Germany GmbH,
> Frankenstrasse 146, 90461 Nuernberg, Germany;
> GF: Ivo Totev, Andrew McDonald, Werner Knoblich; (HRB 36809, AG
Nuernberg)
