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