I just pushed another eleven testcases, one of which is inspired by the
original PR.
> -----Original Message-----
> From: Richard Biener <richard.guent...@gmail.com>
> Sent: Thursday, April 10, 2025 01:14
> To: Robert Dubner <rdub...@symas.com>
> Cc: Patches GCC <gcc-patches@gcc.gnu.org>
> Subject: Re: [committed] cobol: Proper comparison of alphanumeric to
> refmoded numeric-display [PR119682]
>
>
>
> > Am 09.04.2025 um 23:19 schrieb Robert Dubner <rdub...@symas.com>:
> >
> > This patch eliminates the error.
> >
> > cobol: Proper comparison of alphanumeric to refmoded numeric-display
> > [PR119682]
>
> Can you add the testcase as part of the fix?
>
> > gcc/cobol
> >
> > PR cobol/119682
> > * genapi.cc: (cobol_compare): Change the call to
> > __gg__compare().
> >
> > libgcobol
> >
> > PR cobol/119682
> > * common-defs.h: Define the REFER_T_REFMOD constant.
> > * intrinsic.cc: (__gg__max): Change the calls to
> > __gg__compare_2(),
> > (__gg__min): Likewise, (__gg__ord_min): Likewise,
> > (__gg__ord_max): Likewise.
> > * libgcobol.cc: (__gg__compare_2): Change definition of
> > calling
> > parameters, eliminate separate flag bit for ALL and
> > ADDRESS_OF,
> > change comparison of alphanumeric to numeric when the numeric
> > is a refmod.
> > * libgcobol.h: Change declaration of __gg__compare_2.
> >
> > diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
> > index c91237bd8d2c..fdf76aad7b14 100644
> > --- a/gcc/cobol/genapi.cc
> > +++ b/gcc/cobol/genapi.cc
> > @@ -2028,10 +2028,12 @@ cobol_compare( tree return_int,
> > {
> > // None of our explicit comparisons up above worked, so we revert to
> > the
> > // general case:
> > - int leftflags = (left_side_ref.all ? REFER_T_MOVE_ALL : 0)
> > - + (left_side_ref.addr_of ? REFER_T_ADDRESS_OF :
> 0);
> > - int rightflags = (right_side_ref.all ? REFER_T_MOVE_ALL : 0)
> > - + (right_side_ref.addr_of ? REFER_T_ADDRESS_OF :
> 0);
> > + int leftflags = (left_side_ref.all ? REFER_T_MOVE_ALL
> :
> > 0)
> > + + (left_side_ref.addr_of ? REFER_T_ADDRESS_OF
> :
> > 0)
> > + + (left_side_ref.refmod.from ? REFER_T_REFMOD
> :
> > 0);
> > + int rightflags = (right_side_ref.all ? REFER_T_MOVE_ALL
> :
> > 0)
> > + + (right_side_ref.addr_of ? REFER_T_ADDRESS_OF
> :
> > 0)
> > + + (right_side_ref.refmod.from ? REFER_T_REFMOD
> :
> > 0);
> > gg_assign( return_int, gg_call_expr(
> > INT,
> > "__gg__compare",
> > @@ -2045,6 +2047,7 @@ cobol_compare( tree return_int,
> > build_int_cst_type(INT, rightflags),
> > integer_zero_node,
> > NULL_TREE));
> > + compared = true;
> > }
> >
> > // gg_printf(" result is %d\n", return_int, NULL_TREE);
> > diff --git a/libgcobol/common-defs.h b/libgcobol/common-defs.h
> > index f9d9c56a0d8d..6bf32ef79cf0 100644
> > --- a/libgcobol/common-defs.h
> > +++ b/libgcobol/common-defs.h
> > @@ -70,6 +70,7 @@
> > #define REFER_T_ALL_FLAGS_MASK 0x0FF // We allow for seven subscripts
> > #define REFER_T_MOVE_ALL 0x100 // This is the move_all flag
> > #define REFER_T_ADDRESS_OF 0x200 // This is the address_of flag
> > +#define REFER_T_REFMOD 0x400 // Indicates to library the refer
> > was a refmod
> >
> > #define MIN_FIELD_BLOCK_SIZE (16)
> >
> > diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc
> > index 4bce481b0c04..e0bd3339708e 100644
> > --- a/libgcobol/intrinsic.cc
> > +++ b/libgcobol/intrinsic.cc
> > @@ -1867,8 +1867,7 @@ __gg__max(cblc_field_t *dest,
> > unsigned char *best_location ;
> > size_t best_length ;
> > int best_attr ;
> > - bool best_move_all ;
> > - bool best_address_of ;
> > + int best_flags ;
> >
> > bool first_time = true;
> > assert(ncount);
> > @@ -1887,8 +1886,7 @@ __gg__max(cblc_field_t *dest,
> > best_location = __gg__treeplet_1f[i]->data +
> > __gg__treeplet_1o[i];
> > best_length = __gg__treeplet_1s[i];
> > best_attr = __gg__treeplet_1f[i]->attr;
> > - best_move_all = !!(__gg__fourplet_flags[i] &
> > REFER_T_MOVE_ALL);
> > - best_address_of = !!(__gg__fourplet_flags[i] &
> > REFER_T_ADDRESS_OF);
> > + best_flags = __gg__fourplet_flags[i];
> > }
> > else
> > {
> > @@ -1896,31 +1894,27 @@ __gg__max(cblc_field_t *dest,
> > unsigned char *candidate_location =
> > __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i];
> > size_t candidate_length = __gg__treeplet_1s[i];
> > int candidate_attr =
> > __gg__treeplet_1f[i]->attr;
> > - bool candidate_move_all =
> > !!(__gg__fourplet_flags[i] & REFER_T_MOVE_ALL);
> > - bool candidate_address_of =
> > !!(__gg__fourplet_flags[i] & REFER_T_ADDRESS_OF);
> > + int candidate_flags =
> __gg__fourplet_flags[i];
> >
> > int compare_result = __gg__compare_2(
> > candidate_field,
> > candidate_location,
> > candidate_length,
> > candidate_attr,
> > - candidate_move_all,
> > - candidate_address_of,
> > + candidate_flags,
> > best_field,
> > best_location,
> > best_length,
> > best_attr,
> > - best_move_all,
> > - best_address_of,
> > + best_flags,
> > 0);
> > if( compare_result >= 0 )
> > {
> > - best_field = candidate_field ;
> > - best_location = candidate_location ;
> > - best_length = candidate_length ;
> > - best_attr = candidate_attr ;
> > - best_move_all = candidate_move_all ;
> > - best_address_of = candidate_address_of ;
> > + best_field = candidate_field ;
> > + best_location = candidate_location ;
> > + best_length = candidate_length ;
> > + best_attr = candidate_attr ;
> > + best_flags = candidate_flags ;
> > }
> > }
> > if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
> > @@ -2129,8 +2123,7 @@ __gg__min(cblc_field_t *dest,
> > unsigned char *best_location ;
> > size_t best_length ;
> > int best_attr ;
> > - bool best_move_all ;
> > - bool best_address_of ;
> > + int best_flags ;
> >
> > bool first_time = true;
> > assert(ncount);
> > @@ -2149,8 +2142,7 @@ __gg__min(cblc_field_t *dest,
> > best_location = __gg__treeplet_1f[i]->data +
> > __gg__treeplet_1o[i];
> > best_length = __gg__treeplet_1s[i];
> > best_attr = __gg__treeplet_1f[i]->attr;
> > - best_move_all = !!(__gg__fourplet_flags[i] &
> > REFER_T_MOVE_ALL);
> > - best_address_of = !!(__gg__fourplet_flags[i] &
> > REFER_T_ADDRESS_OF);
> > + best_flags = __gg__fourplet_flags[i];
> > }
> > else
> > {
> > @@ -2158,31 +2150,27 @@ __gg__min(cblc_field_t *dest,
> > unsigned char *candidate_location =
> > __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i];
> > size_t candidate_length = __gg__treeplet_1s[i];
> > int candidate_attr =
> > __gg__treeplet_1f[i]->attr;
> > - bool candidate_move_all =
> > !!(__gg__fourplet_flags[i] & REFER_T_MOVE_ALL);
> > - bool candidate_address_of =
> > !!(__gg__fourplet_flags[i] & REFER_T_ADDRESS_OF);
> > + int candidate_flags =
> __gg__fourplet_flags[i];
> >
> > int compare_result = __gg__compare_2(
> > candidate_field,
> > candidate_location,
> > candidate_length,
> > candidate_attr,
> > - candidate_move_all,
> > - candidate_address_of,
> > + candidate_flags,
> > best_field,
> > best_location,
> > best_length,
> > best_attr,
> > - best_move_all,
> > - best_address_of,
> > + best_flags,
> > 0);
> > if( compare_result < 0 )
> > {
> > - best_field = candidate_field ;
> > - best_location = candidate_location ;
> > - best_length = candidate_length ;
> > - best_attr = candidate_attr ;
> > - best_move_all = candidate_move_all ;
> > - best_address_of = candidate_address_of ;
> > + best_field = candidate_field ;
> > + best_location = candidate_location ;
> > + best_length = candidate_length ;
> > + best_attr = candidate_attr ;
> > + best_flags = candidate_flags ;
> > }
> > }
> > if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
> > @@ -2991,14 +2979,12 @@ __gg__ord_min(cblc_field_t *dest,
> > unsigned char *best_location;
> > size_t best_length;
> > int best_attr;
> > - bool best_move_all;
> > - bool best_address_of ;
> > + int best_flags;
> >
> > unsigned char *candidate_location;
> > size_t candidate_length;
> > int candidate_attr;
> > - bool candidate_move_all;
> > - bool candidate_address_of;
> > + int candidate_flags;
> >
> > for( size_t i=0; i<ninputs; i++ )
> > {
> > @@ -3016,8 +3002,7 @@ __gg__ord_min(cblc_field_t *dest,
> > best_location = __gg__treeplet_1f[i]->data +
> > __gg__treeplet_1o[i];
> > best_length = __gg__treeplet_1s[i];
> > best_attr = __gg__treeplet_1f[i]->attr;
> > - best_move_all = !!(__gg__fourplet_flags[i] &
> REFER_T_MOVE_ALL);
> > - best_address_of = !!(__gg__fourplet_flags[i] &
> > REFER_T_ADDRESS_OF);
> > + best_flags = __gg__fourplet_flags[i];
> > }
> > else
> > {
> > @@ -3026,8 +3011,7 @@ __gg__ord_min(cblc_field_t *dest,
> > candidate_location = __gg__treeplet_1f[i]->data +
> > __gg__treeplet_1o[i];
> > candidate_length = __gg__treeplet_1s[i];
> > candidate_attr = __gg__treeplet_1f[i]->attr;
> > - candidate_move_all = !!(__gg__fourplet_flags[i] &
> > REFER_T_MOVE_ALL);
> > - candidate_address_of = !!(__gg__fourplet_flags[i] &
> > REFER_T_ADDRESS_OF);
> > + candidate_flags = __gg__fourplet_flags[i];
> >
> > int compare_result =
> > __gg__compare_2(
> > @@ -3035,14 +3019,12 @@ __gg__ord_min(cblc_field_t *dest,
> > candidate_location,
> > candidate_length,
> > candidate_attr,
> > - candidate_move_all,
> > - candidate_address_of,
> > + candidate_flags,
> > best,
> > best_location,
> > best_length,
> > best_attr,
> > - best_move_all,
> > - best_address_of,
> > + best_flags,
> > 0);
> > if( compare_result < 0 )
> > {
> > @@ -3051,8 +3033,7 @@ __gg__ord_min(cblc_field_t *dest,
> > best_location = candidate_location;
> > best_length = candidate_length;
> > best_attr = candidate_attr;
> > - best_move_all = candidate_move_all;
> > - best_address_of = candidate_address_of;
> > + best_flags = candidate_flags;
> > }
> > }
> > if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
> > @@ -3086,14 +3067,12 @@ __gg__ord_max(cblc_field_t *dest,
> > unsigned char *best_location;
> > size_t best_length;
> > int best_attr;
> > - bool best_move_all;
> > - bool best_address_of ;
> > + int best_flags;
> >
> > unsigned char *candidate_location;
> > size_t candidate_length;
> > int candidate_attr;
> > - bool candidate_move_all;
> > - bool candidate_address_of;
> > + int candidate_flags;
> >
> > for( size_t i=0; i<ninputs; i++ )
> > {
> > @@ -3111,8 +3090,7 @@ __gg__ord_max(cblc_field_t *dest,
> > best_location = __gg__treeplet_1f[i]->data +
> > __gg__treeplet_1o[i];
> > best_length = __gg__treeplet_1s[i];
> > best_attr = __gg__treeplet_1f[i]->attr;
> > - best_move_all = !!(__gg__fourplet_flags[i] &
> REFER_T_MOVE_ALL);
> > - best_address_of = !!(__gg__fourplet_flags[i] &
> > REFER_T_ADDRESS_OF);
> > + best_flags = __gg__fourplet_flags[i];
> > }
> > else
> > {
> > @@ -3121,8 +3099,7 @@ __gg__ord_max(cblc_field_t *dest,
> > candidate_location = __gg__treeplet_1f[i]->data +
> > __gg__treeplet_1o[i];
> > candidate_length = __gg__treeplet_1s[i];
> > candidate_attr = __gg__treeplet_1f[i]->attr;
> > - candidate_move_all = !!(__gg__fourplet_flags[i] &
> > REFER_T_MOVE_ALL);
> > - candidate_address_of = !!(__gg__fourplet_flags[i] &
> > REFER_T_ADDRESS_OF);
> > + candidate_flags = __gg__fourplet_flags[i];
> >
> > int compare_result =
> > __gg__compare_2(
> > @@ -3130,14 +3107,12 @@ __gg__ord_max(cblc_field_t *dest,
> > candidate_location,
> > candidate_length,
> > candidate_attr,
> > - candidate_move_all,
> > - candidate_address_of,
> > + candidate_flags,
> > best,
> > best_location,
> > best_length,
> > best_attr,
> > - best_move_all,
> > - best_address_of,
> > + best_flags,
> > 0);
> > if( compare_result > 0 )
> > {
> > @@ -3146,8 +3121,7 @@ __gg__ord_max(cblc_field_t *dest,
> > best_location = candidate_location;
> > best_length = candidate_length;
> > best_attr = candidate_attr;
> > - best_move_all = candidate_move_all;
> > - best_address_of = candidate_address_of;
> > + best_flags = candidate_flags;
> > }
> > }
> > if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
> > diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
> > index c163e2c92f2b..f7fa7a7527b9 100644
> > --- a/libgcobol/libgcobol.cc
> > +++ b/libgcobol/libgcobol.cc
> > @@ -3919,23 +3919,17 @@ __gg__compare_2(cblc_field_t *left_side,
> > unsigned char *left_location,
> > size_t left_length,
> > int left_attr,
> > - bool left_all,
> > - bool left_address_of,
> > + int left_flags,
> > cblc_field_t *right_side,
> > unsigned char *right_location,
> > size_t right_length,
> > int right_attr,
> > - bool right_all,
> > - bool right_address_of,
> > + int right_flags,
> > int second_time_through)
> > {
> > // First order of business: If right_side is a FldClass, pass that
> off
> > // to the speciality squad:
> >
> > - // static size_t converted_initial_size = MINIMUM_ALLOCATION_SIZE;
> > - // static unsigned char *converted_initial =
> > - // (unsigned char
> > *)malloc(converted_initial_size);
> > -
> > if( right_side->type == FldClass )
> > {
> > return compare_field_class( left_side,
> > @@ -3945,8 +3939,17 @@ __gg__compare_2(cblc_field_t *left_side,
> > }
> >
> > // Serene in our conviction that the left_side isn't a FldClass, we
> > - // move on:
> > + // move on.
> > +
> > + // Extract the individual flags from the flag words:
> > + bool left_all = !!(left_flags & REFER_T_MOVE_ALL );
> > + bool left_address_of = !!(left_flags & REFER_T_ADDRESS_OF);
> > + bool right_all = !!(right_flags & REFER_T_MOVE_ALL );
> > + bool right_address_of = !!(right_flags & REFER_T_ADDRESS_OF);
> > +//bool left_refmod = !!(left_flags & REFER_T_REFMOD );
> > + bool right_refmod = !!(right_flags & REFER_T_REFMOD );
> >
> > + // Figure out if we have any figurative constants
> > cbl_figconst_t left_figconst = (cbl_figconst_t)(left_attr &
> > FIGCONST_MASK);
> > cbl_figconst_t right_figconst = (cbl_figconst_t)(right_attr &
> > FIGCONST_MASK);
> >
> > @@ -4302,6 +4305,23 @@ __gg__compare_2(cblc_field_t *left_side,
> > {
> > // We are comparing an alphanumeric to a numeric.
> >
> > + // The right side is numeric. Sometimes people write code where
> > they
> > + // take the refmod of a numeric displays. If somebody did that
> > here,
> > + // just do a complete straight-up character by character
> > comparison:
> > +
> > + if( right_refmod )
> > + {
> > + retval = compare_strings( (char *)left_location,
> > + left_length,
> > + left_all,
> > + (char *)right_location,
> > + right_length,
> > + right_all);
> > + compare = true;
> > + goto fixup_retval;
> > + }
> > +
> > +
> > // The trick here is to convert the numeric to its display form,
> > // and compare that to the alphanumeric. For example, when
> > comparing
> > // a VAL5 PIC X(3) VALUE 5 to literals,
> > @@ -4310,7 +4330,6 @@ __gg__compare_2(cblc_field_t *left_side,
> > // VAL5 EQUAL 005 is TRUE
> > // VAL5 EQUAL "5" is FALSE
> > // VAL5 EQUAL "005" is TRUE
> > -
> > if( left_side->type == FldLiteralA )
> > {
> > left_location = (unsigned char *)left_side->data;
> > @@ -4373,14 +4392,12 @@ fixup_retval:
> > right_location,
> > right_length,
> > right_attr,
> > - right_all,
> > - right_address_of,
> > + right_flags,
> > left_side,
> > left_location,
> > left_length,
> > left_attr,
> > - left_all,
> > - left_address_of,
> > + left_flags,
> > 1);
> > // And reverse the sense of the return value:
> > compare = true;
> > @@ -4428,14 +4445,12 @@ __gg__compare(struct cblc_field_t *left,
> > left->data + left_offset,
> > left_length,
> > left->attr,
> > - !!(left_flags & REFER_T_MOVE_ALL),
> > - !!(left_flags & REFER_T_ADDRESS_OF),
> > + left_flags,
> > right,
> > right->data + right_offset,
> > right_length,
> > right->attr,
> > - !!(right_flags & REFER_T_MOVE_ALL),
> > - !!(right_flags & REFER_T_ADDRESS_OF),
> > + right_flags,
> > second_time_through);
> > return retval;
> > }
> > diff --git a/libgcobol/libgcobol.h b/libgcobol/libgcobol.h
> > index 1fc7abc931a4..246ef5114955 100644
> > --- a/libgcobol/libgcobol.h
> > +++ b/libgcobol/libgcobol.h
> > @@ -54,14 +54,12 @@ extern "C" int __gg__compare_2( cblc_field_t
> > *left_side,
> > unsigned char *left_location,
> > size_t left_length,
> > int left_attr,
> > - bool left_all,
> > - bool left_address_of,
> > + int left_flags,
> > cblc_field_t *right_side,
> > unsigned char *right_location,
> > size_t right_length,
> > int right_attr,
> > - bool right_all,
> > - bool right_address_of,
> > + int right_flags,
> > int second_time_through);
> > extern "C" void __gg__int128_to_field(cblc_field_t *tgt,
> > __int128 value,
> > bob@doobie:~/repos/gcc-cobol$
