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.
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 <[email protected]>
> > Sent: Sunday, March 23, 2025 06:43
> > To: Robert Dubner <[email protected]>
> > Cc: Richard Biener <[email protected]>; [email protected]
> > 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 <[email protected]>
SUSE Software Solutions Germany GmbH,
Frankenstrasse 146, 90461 Nuernberg, Germany;
GF: Ivo Totev, Andrew McDonald, Werner Knoblich; (HRB 36809, AG Nuernberg)
