This patch eliminates the error.
cobol: Proper comparison of alphanumeric to refmoded numeric-display
[PR119682]
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$
