From: Robert Dubner mailto:[email protected]
Date: Tue, 19 Aug 2025 23:08:48 -0400
Subject: [PATCH] cobol: Eliminate errors that cause valgrind messages.
gcc/cobol/ChangeLog:
* genutil.cc (get_binary_value): Fix a comment.
* parse.y: udf_args_valid(): Fix loc calculation.
* symbols.cc (assert): extend_66_capacity(): Avoid assert(e < e2)
in
-O0 build until symbol_table expansion is fixed.
libgcobol/ChangeLog:
* libgcobol.cc (format_for_display_internal): Handle
NumericDisplay
properly.
(compare_88): Fix memory access error.
(__gg__unstring): Likewise.
---
gcc/cobol/genutil.cc | 2 +-
gcc/cobol/parse.y | 5 +++-
gcc/cobol/symbols.cc | 10 +++++++
libgcobol/libgcobol.cc | 61 ++++++++++++++++++++++--------------------
4 files changed, 47 insertions(+), 31 deletions(-)
diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index 3682b107c5a..4b296e46e87 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -819,7 +819,7 @@ get_binary_value( tree value,
}
ELSE
{
- // We are dealing with an ordinary NumericEdited value
+ // We are dealing with an ordinary NumericDisplay value
gg_assign(pointer, source_address);
if( rdigits )
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 59cc64ddeca..039cb957de0 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -11959,7 +11959,10 @@ current_t::udf_args_valid( const cbl_label_t *L,
if( arg.field ) { // else omitted
auto tgt = cbl_field_of(symbol_at(udf.linkage_fields.at(i).isym));
if( ! valid_move(tgt, arg.field) ) {
- auto loc = symbol_field_location(field_index(arg.field));
+ auto loc = current_location;
+ if( ! is_temporary(arg.field) ) {
+ loc = symbol_field_location(field_index(arg.field));
+ }
error_msg(loc, "FUNCTION %s argument %zu, '%s' cannot be passed to
%s, type %s",
L->name, i, arg.field->pretty_name(),
tgt->pretty_name(), 3 + cbl_field_type_str(tgt->type) );
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index f2cd1b55f80..bbe99b6801f 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -1598,7 +1598,17 @@ extend_66_capacity( cbl_field_t *alias ) {
symbol_elem_t *e = symbol_at(alias->parent);
symbol_elem_t *e2 =
reinterpret_cast<symbol_elem_t*>(const_cast<char*>(alias->data.picture));
+#ifndef __OPTIMIZE__
+#pragma message "The assert(e < e2) needs fixing"
+ // The following assert fails when valgrind is involved. This is the
known
+ // problem of expecting mmap() to put new memory maps after older
memory
+ // maps; that assumption fails when valgrind is involved.
+
+ // For now I am defeating the assert when using -O0 so that I can run
the
+ // NIST "make valgrind" tests. But this should be fixed so that the
+ // symbol table index is used, not the entry locations.
assert(e < e2);
+#endif
alias->data.picture = NULL;
capacity_of cap;
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 42762536681..1b54cfdc389 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -2990,6 +2990,9 @@ format_for_display_internal(char **dest,
{
// Because a NumericDisplay can have any damned thing as a
character,
// we are going force things that aren't digits to display as '0'
+
+ // 0xFF is an exception, so that a HIGH-VALUE in a numeric display
shows
+ // up in a unique way.
static const uint8_t ascii_chars[256] =
{
'0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0',
'0', '0', '0', // 0x00
@@ -3007,7 +3010,7 @@ format_for_display_internal(char **dest,
'0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0',
'0', '0', '0', // 0xc0
'0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0',
'0', '0', '0', // 0xd0
'0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0',
'0', '0', '0', // 0xe0
- '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0',
'0', '0', '0', // 0xf0
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0',
'0', '0', 0xFF, // 0xf0
};
static const uint8_t ebcdic_chars[256] =
{
@@ -3026,7 +3029,7 @@ format_for_display_internal(char **dest,
0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7,0xf8,0xf9,0xf0,0xf0,0xf0,0xf0,0xf0
,0xf0, // 0xc0
0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7,0xf8,0xf9,0xf0,0xf0,0xf0,0xf0,0xf0
,0xf0, // 0xd0
0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0
,0xf0, // 0xe0
-
0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7,0xf8,0xf9,0xf0,0xf0,0xf0,0xf0,0xf0
,0xf0, // 0xf0
+
0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7,0xf8,0xf9,0xf0,0xf0,0xf0,0xf0,0xf0
,0xFF, // 0xf0
} ;
// We are going to make use of fact that a NumericDisplay's data is
@@ -3114,22 +3117,20 @@ format_for_display_internal(char **dest,
// But when it isn't HIGH-VALUE, we don't want to see the
effects
// of the internal sign.
- if( (*dest)[index-1] != (char)DEGENERATE_HIGH_VALUE )
- {
- // Another tricky thing, though, is that for various reasons
- // the string of digits might not be digits. There can be
- // REDEFINES, or the middle of the number might have been
changed
- // with an INITIALIZE into spaces. But we do want numbers to
- // look like numbers. So, we do what we can:
- if( internal_is_ebcdic )
- {
- ch = ebcdic_chars[ch];
- }
- else
- {
- ch = ascii_chars[ch];
- }
+ // Another tricky thing, though, is that for various reasons
+ // the string of digits might not be digits. There can be
+ // REDEFINES, or the middle of the number might have been
changed
+ // with an INITIALIZE into spaces. But we do want numbers to
+ // look like numbers. So, we do what we can:
+
+ if( internal_is_ebcdic )
+ {
+ ch = ebcdic_chars[ch];
+ }
+ else
+ {
+ ch = ascii_chars[ch];
}
(*dest)[index++] = ch;
}
@@ -3151,16 +3152,13 @@ format_for_display_internal(char **dest,
for(int i=0; i<rdigits; i++ )
{
unsigned char ch = *running_location++;
- if( (*dest)[index-1] != (char)DEGENERATE_HIGH_VALUE )
- {
- if( internal_is_ebcdic )
- {
- ch = ebcdic_chars[ch];
- }
- else
- {
- ch = ascii_chars[ch];
- }
+ if( internal_is_ebcdic )
+ {
+ ch = ebcdic_chars[ch];
+ }
+ else
+ {
+ ch = ascii_chars[ch];
}
(*dest)[index++] = ch;
}
@@ -3664,7 +3662,9 @@ compare_88( const char *list,
cmpval = cstrncmp (test,
PTRCAST(char, conditional_location),
conditional_length);
- if( cmpval == 0 && (int)strlen(test) != conditional_length )
+
+// if( cmpval == 0 && (int)strlen(test) != conditional_length )
+ if( cmpval == 0 && test_len != conditional_length )
{
// When strncmp returns 0, the actual smaller string is the
// the shorter of the two:
@@ -11058,9 +11058,12 @@ __gg__unstring( const cblc_field_t *id1,
// The string being unstring
}
// Update the state variables:
- pointer += examined + id2_s[ifound];
tally += 1;
nreceiver += 1;
+ if( ifound >= 0 )
+ {
+ pointer += examined + id2_s[ifound];
+ }
}
done:
--
2.34.1
