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

Reply via email to