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)