From ccd3b7ffffa7959aecd331ad02c10da9fdf2ffc6 Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Mon, 10 Jul 2023 21:19:16 +0000 Subject: [PATCH] check for internal memory bounds with new flag "memory-check" (implied with --debug) related to [bugs:#896] some validation of internal memory used during CALL; this can help in finding otherwise hard to diagnose overwrite of memory and as it is only done on CALL has a much smaller footprint than -fec=bounds (as both check different aspects at different places it is also reasonable to use both) cobc: * flag.def, cobc.c (cobc_deciph_memory_check), tree.h: new compile flag -fmemory-check, implied with --debug * typeck.c (cb_emit_call), tree.h (cb_field): new field attribute flag_used_in_call * codegen.c (output_local_base_cache, output_nonlocal_base_cache): generate fencing data fields for fields with flag_used_in_call * codegen.c (output_call_cache): generate fencing data fields for cob_call_union fields (call pointers) * codegen.c (output_memory_check_call): new function to output generate fencing data fields for flag_used_in_call * codeoptim.def, codeoptim.c, codegen.c: new entry COB_CHK_MEMORYFENCE additional: * codegen.c: only increment/decrement output_indent_level by indent_adjust_level * restored some parts of codeoptim.c done by Ron in [r3542] which somehow got lost in 3.x libcob: * common.c (cob_check_fence), common.h: new function to check for writing outside of COBOL data, triggered with compile option -fmemory-check * statement.def (STMT_BEFORE_CALL, STMT_BEFORE_UDF): new internal statements, currently used for cob_check_fence additional: * common.c (b2i): include marker for invalid data (previously not set) --- NEWS | 10 ++ cobc/ChangeLog | 23 +++- cobc/cobc.c | 47 +++++++ cobc/codegen.c | 221 ++++++++++++++++++++++++++++---- cobc/codeoptim.c | 23 +++- cobc/codeoptim.def | 1 + cobc/flag.def | 10 +- cobc/tree.c | 11 +- cobc/tree.h | 9 ++ cobc/typeck.c | 55 +++++--- libcob/ChangeLog | 8 ++ libcob/common.c | 69 ++++++---- libcob/common.h | 2 + libcob/statement.def | 5 +- tests/testsuite.src/run_misc.at | 127 +++++++++++++++++- 15 files changed, 537 insertions(+), 84 deletions(-) diff --git a/NEWS b/NEWS index 573d9e8b2..31ffd88bf 100644 --- a/NEWS +++ b/NEWS @@ -296,6 +296,12 @@ NEWS - user visible changes -*- outline -*- the origin of entrypoints and PERFORM, this is used for the internal stack trace on abort and can be used for improved source level debugging +** new flag -fmemory-check (implied with --debug) to do some validation + of internal memory used during CALL; this can help in finding otherwise + hard to diagnose overwrite of memory and as it is only done on CALL + has a much smaller footprint than -fec=bounds (as both check different + aspects at different places it is also reasonable to use both) + ** the option -g does no longer imply -fno-remove-unreachable; if you want to keep those in you need to explicit specify this @@ -408,6 +414,8 @@ NEWS - user visible changes -*- outline -*- or to use an explicit format (cut at 26 characters, may raise false-positives in listing tests) e.g. date only `-DLISTING_TIMESTAMP_FORMAT="%Y-%m-%d"` +** new compile options to adjust the listing, see above + * More notable changes ** in 64-bit environments, the maximum field size was increased from @@ -494,6 +502,8 @@ NEWS - user visible changes -*- outline -*- * compile from stdin * NIST: OBNC1M.CBL false positive (the test runner uses a nonportable way of emulating a program kill) + * if build with -fsanitize, then some tests will fail; while we accept patches + to improve that, we don't consider the failing tests as bug in GnuCOBOL ** the recent additions of ">> TURN" and "variable LIKE variable" may not work as expected in all cases diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 2c373635f..91e5c4718 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,24 @@ +2023-07-10 Simon Sobisch + + check for internal memory bounds with new flag "memory-check" + * flag.def, cobc.c (cobc_deciph_memory_check), tree.h: new compile + flag -fmemory-check, implied with --debug + * typeck.c (cb_emit_call), tree.h (cb_field): new field attribute + flag_used_in_call + * codegen.c (output_local_base_cache, output_nonlocal_base_cache): + generate fencing data fields for fields with flag_used_in_call + * codegen.c (output_call_cache): generate fencing data fields for + cob_call_union fields (call pointers) + * codegen.c (output_memory_check_call): new function to output + generate fencing data fields for flag_used_in_call + * codeoptim.def, codeoptim.c, codegen.c: new entry + COB_CHK_MEMORYFENCE + + additional + * codegen.c: only increment/decrement output_indent_level by + indent_adjust_level + 2023-07-07 Simon Sobisch common preparser cleanup @@ -2635,7 +2655,8 @@ * codeoptim.def (COB_GET_NUMDISPS), codeoptim.c, codegen.c: new routine to convert signed DISPLAY into binary value; - use of register attribute for cob_get_numdisp + cob_get_numdisps + * codeoptim.def (cob_get_numdisp, cob_get_numdisps): use of register + attribute and skipping of leading zeroes 2020-04-23 Simon Sobisch diff --git a/cobc/cobc.c b/cobc/cobc.c index 3c1ceb401..c2ed7930a 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -105,6 +105,7 @@ enum compile_level { #define CB_FLAG_GETOPT_NO_DUMP 13 #define CB_FLAG_GETOPT_EBCDIC_TABLE 14 #define CB_FLAG_GETOPT_DEFAULT_COLSEQ 15 +#define CB_FLAG_MEMORY_CHECK 16 /* Info display limits */ @@ -1954,6 +1955,42 @@ cobc_deciph_optarg (const char *p, const int allow_quote) return (int)n; } +/* decipher a value for the memory-check flag, + directly setting cb_flag_memory_check, + returns -1 on error */ +static int +cobc_deciph_memory_check (const char *p) +{ + char buff[8] = { 0 }; + const size_t len = strlen (p); + size_t i; + + if (len > sizeof(buff)) { + return -1; + } + for (i = 0; i < len; ++i) { + buff[i] = cb_toupper (p[i]); + } + + if (len == 3 && memcmp ("ALL", buff, 3) == 0) { + cb_flag_memory_check = CB_MEMCHK_ALL; + return 0; + } + if (len == 4 && memcmp ("NONE", buff, 4) == 0) { + cb_flag_memory_check = CB_MEMCHK_NONE; + return 0; + } + if (len == 5 && memcmp ("USING", buff, 5) == 0) { + cb_flag_memory_check = CB_MEMCHK_USING; + return 0; + } + if (len == 7 && memcmp ("POINTER", buff, 7) == 0) { + cb_flag_memory_check = CB_MEMCHK_POINTER; + return 0; + } + return -1; +} + /* exit to OS before processing a COBOL/C source file */ DECLNORET static void COB_A_NORETURN cobc_early_exit (int ret_code) @@ -3231,6 +3268,7 @@ process_command_line (const int argc, char **argv) cb_flag_source_location = 1; cb_flag_stack_extended = 1; cb_flag_stack_check = 1; + cb_flag_memory_check = CB_MEMCHK_ALL; cobc_wants_debug = 1; break; @@ -3842,6 +3880,15 @@ process_command_line (const int argc, char **argv) } break; + case CB_FLAG_MEMORY_CHECK: /* 16 */ + /* -fmemory-check= : */ + if (!cob_optarg) { + cb_flag_memory_check = CB_MEMCHK_ALL; + } else if (cobc_deciph_memory_check (cob_optarg)) { + cobc_err_exit (COBC_INV_PAR, "-fmemory-check"); + } + break; + case 'A': /* -A : Add options to C compile phase */ COBC_ADD_STR (cobc_cflags, " ", cob_optarg, NULL); diff --git a/cobc/codegen.c b/cobc/codegen.c index 1707cc5b9..c9696af08 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -169,6 +169,9 @@ struct base_list { field access */ int cb_wants_dump_comments; +/* variable set in cobc.c during option parsing, see tree.h */ +int cb_flag_memory_check = 0; + /* static to handle recursive processing */ static int output_as_comment = 0; @@ -1846,6 +1849,14 @@ output_call_cache (void) if (needs_unifunc) { output_local ("cob_call_union\t\tcob_unifunc;\n"); } + if ((call_cache || func_call_cache) + && (cb_flag_memory_check & CB_MEMCHK_POINTER)) { + optimize_defs[COB_CHK_MEMORYFENCE] = 1; + /* note: we explicit do _not_ initialize it directly as that + will more likely lead to a non-consecutive memory layout, + which makes the whole purpose of the fence useless */ + output_local ("static char\tcall_fence_pre[5];\n"); + } call_cache = call_list_reverse (call_cache); for (call = call_cache; call; call = call->next) { output_local ("static cob_call_union\tcall_%s;\n", @@ -1856,6 +1867,10 @@ output_call_cache (void) output_local ("static cob_call_union\tfunc_%s;\n", call->call_name); } + if ((call_cache || func_call_cache) + && (cb_flag_memory_check & CB_MEMCHK_POINTER)) { + output_local ("static char\tcall_fence_post[5];\n"); + } if (static_call_cache) { const char *convention_modifier; static_call_cache = static_call_list_reverse (static_call_cache); @@ -2073,24 +2088,55 @@ output_local_base_cache (void) local_base_cache = list_cache_sort (local_base_cache, &base_cache_cmp); for (blp = local_base_cache; blp; blp = blp->next) { - if (blp->f->index_type == CB_INT_INDEX) { + const struct cb_field *fld = blp->f; + if (fld->flag_used_in_call) { + if (fld->index_type != CB_INT_INDEX) { + output_local ("static "); + } +#ifdef HAVE_ATTRIBUTE_ALIGNED + output_local ("cob_u8_t %s%d_fence_pre[5]%s;\n", + CB_PREFIX_BASE, fld->id, COB_ALIGN); +#else + output_local ("%scob_u8_t%s %s%d_fence_pre[5];\n", + COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, + CB_PREFIX_BASE, fld->id); +#endif + optimize_defs[COB_CHK_MEMORYFENCE] = 1; + /* note: we explicit do _not_ initialize it directly as that + will more likely lead to a non-consecutive memory layout, + which makes the whole purpose of the fence useless */ + } + if (fld->index_type == CB_INT_INDEX) { output_local ("int %s%d;", - CB_PREFIX_BASE, blp->f->id); - } else if (blp->f->index_type == CB_STATIC_INT_INDEX) { + CB_PREFIX_BASE, fld->id); + } else if (fld->index_type == CB_STATIC_INT_INDEX) { output_local ("static int %s%d;", - CB_PREFIX_BASE, blp->f->id); - } else if( !(blp->f->report_flag & COB_REPORT_REF_EMITTED)) { + CB_PREFIX_BASE, fld->id); + } else if( !(fld->report_flag & COB_REPORT_REF_EMITTED)) { #ifdef HAVE_ATTRIBUTE_ALIGNED output_local ("static cob_u8_t %s%d[%d]%s;", - CB_PREFIX_BASE, blp->f->id, - blp->f->memory_size, COB_ALIGN); + CB_PREFIX_BASE, fld->id, + fld->memory_size, COB_ALIGN); #else output_local ("static %scob_u8_t%s %s%d[%d];", COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, CB_PREFIX_BASE, - blp->f->id, blp->f->memory_size); + fld->id, fld->memory_size); +#endif + } + output_local ("\t/* %s */\n", fld->name); + if (fld->flag_used_in_call) { + if (fld->index_type != CB_INT_INDEX) { + output_local ("static "); + } +#ifdef HAVE_ATTRIBUTE_ALIGNED + output_local ("cob_u8_t %s%d_fence_post[5]%s;\n", + CB_PREFIX_BASE, fld->id, COB_ALIGN); +#else + output_local ("%scob_u8_t%s %s%d_fence_post[5];\n", + COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, + CB_PREFIX_BASE, fld->id); #endif } - output_local ("\t/* %s */\n", blp->f->name); } output_local ("\n/* End of local data storage */\n\n"); @@ -2110,30 +2156,61 @@ output_nonlocal_base_cache (void) base_cache = list_cache_sort (base_cache, &base_cache_cmp); for (blp = base_cache; blp; blp = blp->next) { + const struct cb_field *fld = blp->f; if (blp->curr_prog != prev_prog) { prev_prog = blp->curr_prog; output_storage ("\n/* PROGRAM-ID : %s */\n", prev_prog); } - if (blp->f->index_type != CB_NORMAL_INDEX) { + if (fld->flag_used_in_call) { +#ifdef HAVE_ATTRIBUTE_ALIGNED + output_storage ("static cob_u8_t %s%d_fence_pre[5]%s;\n", + CB_PREFIX_BASE, fld->id, COB_ALIGN); +#else +#if defined(COB_ALIGN_PRAGMA_8) + output_storage ("#pragma align 8 (%s%d_fence_pre)\n", CB_PREFIX_BASE, fld->id); +#endif + output_storage ("static %scob_u8_t%s %s%d_fence_pre[5];\n", + COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, + CB_PREFIX_BASE, fld->id); +#endif + optimize_defs[COB_CHK_MEMORYFENCE] = 1; + /* note: we explicit do _not_ initialize it directly as that + will more likely lead to a non-consecutive memory layout, + which makes the whole purpose of the fence useless */ + } + if (fld->index_type != CB_NORMAL_INDEX) { output_storage ("static int %s%d;", - CB_PREFIX_BASE, blp->f->id); + CB_PREFIX_BASE, fld->id); } else { #ifdef HAVE_ATTRIBUTE_ALIGNED output_storage ("static cob_u8_t %s%d[%d]%s;", - CB_PREFIX_BASE, blp->f->id, - blp->f->memory_size, COB_ALIGN); + CB_PREFIX_BASE, fld->id, + fld->memory_size, COB_ALIGN); #else #if defined(COB_ALIGN_PRAGMA_8) - output_storage ("#pragma align 8 (%s%d)\n", CB_PREFIX_BASE, blp->f->id); + output_storage ("#pragma align 8 (%s%d)\n", CB_PREFIX_BASE, fld->id); #endif output_storage ("static %scob_u8_t%s %s%d[%d];", COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, CB_PREFIX_BASE, - blp->f->id, blp->f->memory_size); + fld->id, fld->memory_size); +#endif + } + output_storage ("\t/* %s */\n", fld->name); + if (fld->flag_used_in_call) { +#ifdef HAVE_ATTRIBUTE_ALIGNED + output_storage ("static cob_u8_t %s%d_fence_post[5]%s;\n", + CB_PREFIX_BASE, fld->id, COB_ALIGN); +#else +#if defined(COB_ALIGN_PRAGMA_8) + output_storage ("#pragma align 8 (%s%d_fence_post)\n", CB_PREFIX_BASE, fld->id); +#endif + output_storage ("static %scob_u8_t%s %s%d_fence_post[5];\n", + COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, + CB_PREFIX_BASE, fld->id); #endif } - output_storage ("\t/* %s */\n", blp->f->name); } output_storage ("\n/* End of data storage */\n\n"); @@ -3793,6 +3870,11 @@ output_param (cb_tree x, int id) /* always convert function names to upper case */ func = cb_encode_program_id (CB_PROTOTYPE (l)->ext_name, 0, COB_FOLD_UPPER); lookup_func_call (func); + if ((call_cache || func_call_cache) + && (cb_flag_memory_check & CB_MEMCHK_POINTER)) { + output ("(cob_check_fence (call_fence_pre, call_fence_post, %s, NULL), ", + cb_statement_enum_name[STMT_BEFORE_UDF]); + } #if 0 /* RXWRXW Func */ output ("cob_user_function (func_%s, &cob_dyn_%u, ", func, gen_dynamic); @@ -3861,6 +3943,11 @@ output_param (cb_tree x, int id) output (", "); } } + if (ip->isuser + && (call_cache || func_call_cache) + && (cb_flag_memory_check & CB_MEMCHK_POINTER)) { + output (")"); + } output (")"); break; } @@ -6353,6 +6440,59 @@ find_nested_prog_with_id (const char *encoded_id) return nlp; } +/* output memory fence code for a given CALL 'p', + 'stmt' specifies the before/after part */ +static void +output_memory_check_call (struct cb_call *p, const enum cob_statement stmt) +{ + /* fencing for used BY REFERENCE fields, + to prevent use of invalid data in the caller before the CALL and + to check for overwrite in the caller after the CALL */ + if (cb_flag_memory_check & CB_MEMCHK_USING) { + cb_tree x, l; + for (l = p->args; l; l = CB_CHAIN (l)) { + if (CB_PURPOSE_INT (l) != CB_CALL_BY_REFERENCE) { + continue; + } + x = CB_VALUE (l); + if (CB_REFERENCE_P (x)) { + x = cb_ref (x); + } + if (CB_FIELD_P (x)) { + const struct cb_field *fchck = cb_field_founder (CB_FIELD (x)); + if (fchck->flag_used_in_call) { + if (stmt == STMT_BEFORE_CALL) { + output_line ("if (memcmp (%s%d_fence_pre, \"\\x00\\x00\\x00\\x00\", 5) == 0) {", + CB_PREFIX_BASE, fchck->id); + output_indent_level += indent_adjust_level; + output_line ("memcpy (%s%d_fence_pre, \"\\xFF\\xFE\\xFD\\xFC\", 5);", + CB_PREFIX_BASE, fchck->id); + output_line ("memcpy (%s%d_fence_post, \"\\xFA\\xFB\\xFC\\xFD\", 5);", + CB_PREFIX_BASE, fchck->id); + output_indent_level -= indent_adjust_level; + output_line ("} else {"); + output_indent_level += indent_adjust_level; + } + output_line ("cob_check_fence (%s%d_fence_pre, %s%d_fence_post, %s, \"%s\");", + CB_PREFIX_BASE, fchck->id, CB_PREFIX_BASE, fchck->id, + cb_statement_enum_name[stmt], + fchck->name); + if (stmt == STMT_BEFORE_CALL) { + output_indent_level -= indent_adjust_level; + output_line ("}"); + } + } + } + } + } + /* fencing for internal pointer, to prevent SIGSEGV on CALL out-of-bound-data-in-ptr */ + if ((call_cache || func_call_cache) + && (cb_flag_memory_check & CB_MEMCHK_POINTER)) { + output_line ("cob_check_fence (call_fence_pre, call_fence_post, %s, NULL);", + cb_statement_enum_name[stmt]); + } +} + static void output_call (struct cb_call *p) { @@ -6699,6 +6839,11 @@ output_call (struct cb_call *p) CB_EXCEPTION_CODE (COB_EC_PROGRAM), CB_EXCEPTION_CODE (COB_EC_PROGRAM)); } + /* fence check before the CALL to ensure it works and gets untrashed 01/77 */ + if (cb_flag_memory_check) { + output_memory_check_call (p, STMT_BEFORE_CALL); + } + /* Function name */ output_prefix (); /* Special for program pointers */ @@ -6982,6 +7127,11 @@ output_call (struct cb_call *p) } output_block_close (); } + /* fence check after the CALL (to hint at the callee trashing memory) */ + if (cb_flag_memory_check) { + output_memory_check_call (p, STMT_CALL); + } + /* output of "NOT ON EXCEPTION" code */ if (p->stmt2) { output_stmt (p->stmt2); } @@ -7705,8 +7855,8 @@ output_goto_1 (cb_tree x) p = NULL; } for (; p; p = p->next) { - if (p->para->segment > 49 && - p->para->flag_alter) { + if (p->para->segment > 49 + && p->para->flag_alter) { output_line ("label_%s%d = 0;", CB_PREFIX_LABEL, p->para->id); } @@ -7771,9 +7921,9 @@ output_goto (struct cb_goto *p) for (l = p->target; l; l = CB_CHAIN (l)) { cb_tree target = CB_VALUE (l); cb_tree ref = cb_try_ref (target); - output_indent_level -= 2; + output_indent_level -= indent_adjust_level; output_line ("case %d:", i++); - output_indent_level += 2; + output_indent_level += indent_adjust_level; if (ref != cb_error_node) { output_goto_1 (ref); } else { @@ -7968,7 +8118,7 @@ output_if (const struct cb_if *ip) output_line ("else"); } output_line ("{"); - output_indent_level += 2; + output_indent_level += indent_adjust_level; } if (ip->statement == STMT_IF) { output_line ("/* ELSE */"); @@ -7977,7 +8127,7 @@ output_if (const struct cb_if *ip) } output_stmt (ip->stmt2); if (gen_if_level <= cb_if_cutoff) { - output_indent_level -= 2; + output_indent_level -= indent_adjust_level; output_line ("}"); } else { output_line ("%s%d:;", CB_PREFIX_LABEL, code); @@ -7987,14 +8137,14 @@ output_if (const struct cb_if *ip) output_line ("else"); } output_line ("{"); - output_indent_level += 2; + output_indent_level += indent_adjust_level; if (ip->statement == STMT_IF) { output_line ("/* ELSE */"); } else { output_line ("/* WHEN */"); } output_stmt (ip->stmt2); - output_indent_level -= 2; + output_indent_level -= indent_adjust_level; output_line ("}"); #endif } @@ -11759,6 +11909,13 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) COBC_ABORT (); } /* LCOV_EXCL_STOP */ +#if 0 /* TODO: add data fence for LOCAL STORAGE */ + if (f->flag_used_in_call) { + /* buffer for data fence */ + local_mem += ((5 + COB_MALLOC_ALIGN) & + ~COB_MALLOC_ALIGN); + } +#endif f->flag_local_storage = 1; f->flag_local_alloced = 1; f->mem_offset = local_mem; @@ -11766,6 +11923,13 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) /* Caters for current types */ local_mem += ((f->memory_size + COB_MALLOC_ALIGN) & ~COB_MALLOC_ALIGN); +#if 0 /* TODO: add data fence for LOCAL STORAGE */ + if (f->flag_used_in_call) { + /* buffer for data fence */ + local_mem += ((5 + COB_MALLOC_ALIGN) & + ~COB_MALLOC_ALIGN); + } +#endif } } @@ -12355,6 +12519,15 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) } #endif + /* Setup up CANCEL callback */ + if ((call_cache || func_call_cache) + && (cb_flag_memory_check & CB_MEMCHK_POINTER)) { + output_line ("/* Initialize call-pointer memory fence */"); + output_line ("memcpy (call_fence_pre, \"\\xFF\\xFE\\xFD\\xFC\", 5);"); + output_line ("memcpy (call_fence_post, \"\\xFA\\xFB\\xFC\\xFD\", 5);"); + output_newline (); + } + /* Setup up CANCEL callback */ if (!prog->nested_level && prog->prog_type == COB_MODULE_TYPE_PROGRAM) { output_line ("/* Initialize cancel callback */"); diff --git a/cobc/codeoptim.c b/cobc/codeoptim.c index 0583f022d..82593ba67 100644 --- a/cobc/codeoptim.c +++ b/cobc/codeoptim.c @@ -189,6 +189,21 @@ cob_gen_optim (const enum cb_optim val) output_storage ("#define cob_check_ref_mod_minimal" "\t" "cob_check_ref_mod_minimal_inline"); return; + case COB_CHK_MEMORYFENCE: + /* no need for an expensive function call (at least prevented if inline is honored) + if we know the memory fence to be valid */ + output_storage ("static void COB_INLINE COB_A_INLINE"); + output_storage ("cob_check_fence_inline (const char *fence_pre, const char *fence_post,"); + output_storage (" const enum cob_statement stmt, const char *name)"); + output_storage ("{"); + output_storage (" if (memcmp (fence_pre, \"\\xFF\\xFE\\xFD\\xFC\", 5)"); + output_storage (" || memcmp (fence_post, \"\\xFA\\xFB\\xFC\\xFD\", 5)) {"); + output_storage (" cob_check_fence (fence_pre, fence_post, stmt, name);"); + output_storage (" }"); + output_storage ("}"); + output_storage ("#define cob_check_fence" "\t" "cob_check_fence_inline"); + return; + case COB_NOP: /* cob_nop is only used to force something the optimizer does not remove to have "something" to call; a fast check (module is normally always set) @@ -219,7 +234,11 @@ cob_gen_optim (const enum cb_optim val) output_storage (" register const unsigned char *p = (const unsigned char *)data;"); output_storage (" register int n;"); output_storage (" register int val = 0;"); - + /* Improve performance by skipping leading ZEROs */ + output_storage (" for (n = 0; n < val; ++n, ++p) {"); + output_storage (" if (*p > '0' && *p <= '9')"); + output_storage (" break;"); + output_storage (" }"); output_storage (" for (n = 0; n < size; ++n, ++p) {"); output_storage (" val = (val * 10)"); output_storage (" + (*p & 0x0F);"); @@ -235,7 +254,7 @@ cob_gen_optim (const enum cb_optim val) output_storage (" register const unsigned char *p = (const unsigned char *)data;"); output_storage (" register int n;"); output_storage (" register int val = 0;"); - + /* Improve performance by skipping leading ZEROs */ output_storage (" for (n = 0; n < val; ++n, ++p) {"); output_storage (" if (*p > '0' && *p <= '9')"); output_storage (" break;"); diff --git a/cobc/codeoptim.def b/cobc/codeoptim.def index 3605591e8..c48f0c01c 100644 --- a/cobc/codeoptim.def +++ b/cobc/codeoptim.def @@ -30,6 +30,7 @@ CB_OPTIM_DEF (COB_CHK_SUBSCRIPT) CB_OPTIM_DEF (COB_CHK_ODO) CB_OPTIM_DEF (COB_CHK_REFMOD_MIN) CB_OPTIM_DEF (COB_CHK_REFMOD) +CB_OPTIM_DEF (COB_CHK_MEMORYFENCE) CB_OPTIM_DEF (COB_NOP) CB_OPTIM_DEF (COB_POINTER_MANIP) diff --git a/cobc/flag.def b/cobc/flag.def index 6d035cb27..4850daa60 100644 --- a/cobc/flag.def +++ b/cobc/flag.def @@ -86,7 +86,8 @@ CB_FLAG_NQ (1, "dump", CB_FLAG_GETOPT_DUMP, " a combination of: ALL, WS, LS, RD, FD, SC, LO")) CB_FLAG_OP (0, "no-dump", CB_FLAG_GETOPT_NO_DUMP, _(" -fno-dump= exclude data fields from dumping on abort, may\n" - " be a combination of: ALL, WS, LS, RD, FD, SC, LO")) + " be a combination of: ALL, WS, LS, RD, FD, SC, LO\n" + " default if no scope specified: ALL")) CB_FLAG_NQ (1, "callfh", CB_FLAG_GETOPT_CALLFH, @@ -126,7 +127,7 @@ CB_FLAG (cb_flag_stack_extended, 1, "stack-extended", " * turned on by --debug/-fdump")) CB_FLAG_ON (cb_flag_fast_compare, 0, "fast-compare", - _(" -fno-fast-compare disables inline comparisions\n")) + _(" -fno-fast-compare disables inline comparisions")) /* Normal flags */ @@ -164,6 +165,11 @@ CB_FLAG (cb_flag_stack_check, 1, "stack-check", _(" -fstack-check PERFORM stack checking\n" " * turned on by --debug/-g")) +CB_FLAG_OP (1, "memory-check", CB_FLAG_MEMORY_CHECK, + _(" -fmemory-check= checks for invalid writes to internal storage,\n" + " may be one of: all, pointer, using, none\n" + " * default: none, set to all by --debug")) + CB_FLAG (cb_flag_section_exit_check, 1, "section-exit-check", _(" -fsection-exit-check check that code execution does not leave the scope of SECTIONs")) diff --git a/cobc/tree.c b/cobc/tree.c index dcda51493..3ef441b1a 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -4151,7 +4151,8 @@ cb_field_size (const cb_tree x) /* LCOV_EXCL_STOP */ } -/* returns the record field (level 01) of 'f' */ +/* returns the record field (level 01) of 'f', note that the + record field may still have a REDEFINES */ struct cb_field * cb_field_founder (const struct cb_field * const f) { @@ -4161,6 +4162,14 @@ cb_field_founder (const struct cb_field * const f) while (ff->parent) { ff = ff->parent; } + +#if 0 /* CHECKME: is something like that needed? */ + if (ff->level == 0 + && ff->sister + && strstr (ff->name, " Record")) { /* Skip to First 01 within FD */ + ff = ff->sister; + } +#endif return (struct cb_field *)ff; } diff --git a/cobc/tree.h b/cobc/tree.h index 8763a1f80..3649e42ae 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -986,6 +986,8 @@ struct cb_field { unsigned int flag_constant : 1; /* Is 01 AS CONSTANT */ unsigned int flag_internal_constant : 1; /* Is an internally generated CONSTANT */ + unsigned int flag_used_in_call : 1; /* Is used in CALL (only set for level 01/77), + currently not set for EXTERNAL item or when in LOCAL-STORAGE / LINKAGE */ unsigned int flag_sync_left : 1; /* SYNCHRONIZED LEFT */ unsigned int flag_sync_right : 1; /* SYNCHRONIZED RIGHT */ unsigned int flag_internal_register : 1; /* Is an internally generated register */ @@ -2594,6 +2596,13 @@ extern void cob_gen_optim (const enum cb_optim); extern void codegen (struct cb_program *, const char *); extern void clear_local_codegen_vars (void); extern int cb_wants_dump_comments; /* likely to be removed later */ + +#define CB_MEMCHK_NONE 0 +#define CB_MEMCHK_POINTER (1 << 0) +#define CB_MEMCHK_USING (1 << 1) +#define CB_MEMCHK_ALL (CB_MEMCHK_POINTER | CB_MEMCHK_USING) +extern int cb_flag_memory_check; + extern const char * cb_open_mode_to_string (const enum cob_open_mode); /* scanner.l */ diff --git a/cobc/typeck.c b/cobc/typeck.c index 75a173de1..183f89cb9 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -8677,8 +8677,8 @@ cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, if (CB_PURPOSE_INT (l) != CB_CALL_BY_VALUE) { continue; } - if (CB_SIZES_INT_UNSIGNED(l) && - CB_LITERAL (x)->sign < 0) { + if (CB_SIZES_INT_UNSIGNED (l) + && CB_LITERAL (x)->sign < 0) { cb_error_x (x, _("numeric literal is negative")); error_ind = 1; continue; @@ -8689,7 +8689,7 @@ cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, switch (CB_SIZES_INT (l)) { case CB_SIZE_1: val = cb_get_long_long (x); - if (CB_SIZES_INT_UNSIGNED(l)) { + if (CB_SIZES_INT_UNSIGNED (l)) { valmin = 0; valmax = UCHAR_MAX; } else { @@ -8699,7 +8699,7 @@ cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, break; case CB_SIZE_2: val = cb_get_long_long (x); - if (CB_SIZES_INT_UNSIGNED(l)) { + if (CB_SIZES_INT_UNSIGNED (l)) { valmin = 0; valmax = USHRT_MAX; } else { @@ -8709,7 +8709,7 @@ cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, break; case CB_SIZE_4: val = cb_get_long_long (x); - if (CB_SIZES_INT_UNSIGNED(l)) { + if (CB_SIZES_INT_UNSIGNED (l)) { valmin = 0; valmax = UINT_MAX; } else { @@ -8719,7 +8719,7 @@ cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, break; case CB_SIZE_8: case CB_SIZE_AUTO: - if (CB_SIZES_INT_UNSIGNED(l)) { + if (CB_SIZES_INT_UNSIGNED (l)) { if (CB_LITERAL (x)->size < 20) { break; } @@ -8778,10 +8778,12 @@ cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, continue; } } - if (CB_FIELD_P (x)) { /* TODO: remove after 3.1 RC1 */ +#if 0 /* TODO: remove after 3.1 RC1 */ + if (CB_FIELD_P (x)) { cobc_abort ("should be not be a field", 1); } - if ((CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value))) { +#endif + if ((CB_REFERENCE_P (x) && CB_FIELD_P (CB_REFERENCE(x)->value))) { f = CB_FIELD (cb_ref (x)); if (f->level == 88) { cb_error_x (x, _("'%s' is not a valid data name"), CB_NAME (x)); @@ -8793,6 +8795,16 @@ cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, cb_warning_x (cb_warn_call_params, x, _("'%s' is not a 01 or 77 level item"), CB_NAME (x)); } + if ((cb_flag_memory_check & CB_MEMCHK_USING) + && f->storage != CB_STORAGE_LINKAGE + && f->storage != CB_STORAGE_LOCAL + && !f->flag_external) { + f = cb_field_founder (f); + if (f->redefines) { + f = f->redefines; + } + f->flag_used_in_call = 1; + } check_list = cb_list_add (check_list, x); } else if (f->flag_any_length) { cb_error_x (x, _("'%s' ANY LENGTH item not passed BY REFERENCE"), CB_NAME (x)); @@ -8807,15 +8819,18 @@ cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, for (l = check_list; l; l = CB_CHAIN (l)) { cb_tree l2 = CB_VALUE (l); x = cb_ref (l2); - if (x != cb_error_node) { - for (l2 = check_list; l2 != l; l2 = CB_CHAIN (l2)) { - if (cb_ref (CB_VALUE (l2)) == x) { - cb_warning_x (COBC_WARN_FILLER, l, - _("duplicate USING BY REFERENCE item '%s'"), - cb_name (CB_VALUE (l))); - CB_VALUE (l) = cb_error_node; - break; - } +#if 0 /* Note: we only add validated items so no need to check for valid x here */ + if (x == cb_error_node) { + continue; + } +#endif + for (l2 = check_list; l2 != l; l2 = CB_CHAIN (l2)) { + if (cb_ref (CB_VALUE (l2)) == x) { + cb_warning_x (COBC_WARN_FILLER, l, + _("duplicate USING BY REFERENCE item '%s'"), + cb_name (CB_VALUE (l))); + CB_VALUE (l) = cb_error_node; + break; } } } @@ -12618,9 +12633,9 @@ cb_emit_open (cb_tree file, cb_tree mode, cb_tree sharing) } /* Check for file debugging */ - if (current_program->flag_debugging && - !current_statement->flag_in_debug && - f->flag_fl_debug) { + if (current_program->flag_debugging + && !current_statement->flag_in_debug + && f->flag_fl_debug) { cb_emit (cb_build_debug (cb_debug_name, f->name, NULL)); cb_emit (cb_build_move (cb_space, cb_debug_contents)); cb_emit (cb_build_debug_call (f->debug_section)); diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 342c4b8b4..f8c6b2563 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,11 @@ +2023-07-10 Simon Sobisch + + * common.c (cob_check_fence), common.h: new function to check for writing + outside of COBOL data, triggered with compile option -fmemory-check + * statement.def (STMT_BEFORE_CALL, STMT_BEFORE_UDF): new internal + statements, currently used for cob_check_fence + 2023-06-22 Simon Sobisch * numeric.c (cob_decimal_set_packed): backport pack_to_bin change while @@ -8,6 +15,7 @@ * move.c (cob_packed_get_int, packed_get_long_long): apply optimizations from (cob_decimal_set_packed) including skipping leading zeros and pack_to_bin + * common.c (b2i): include marker for invalid data (previously not set) 2023-06-21 Simon Sobisch diff --git a/libcob/common.c b/libcob/common.c index a2b3363de..c5a6eb320 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -397,17 +397,23 @@ static const int cob_exception_tab_code[] = { static int cob_switch[COB_SWITCH_MAX + 1]; /* BCD to Integer translation (full byte -> 0 - 99) */ -static unsigned char b2i[256]= - { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 255, 255, 255, 255, 255, 255, - 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 255, 255, 255, 255, 255, 255, - 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 255, 255, 255, 255, 255, 255, - 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 255, 255, 255, 255, 255, 255, - 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 255, 255, 255, 255, 255, 255, - 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 255, 255, 255, 255, 255, 255, - 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 255, 255, 255, 255, 255, 255, - 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 255, 255, 255, 255, 255, 255, - 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 255, 255, 255, 255, 255, 255, - 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 255, 255, 255, 255, 255, 255 }; +static unsigned char b2i[]= { + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 255, 255, 255, 255, 255, 255, + 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 255, 255, 255, 255, 255, 255, + 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 255, 255, 255, 255, 255, 255, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 255, 255, 255, 255, 255, 255, + 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 255, 255, 255, 255, 255, 255, + 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 255, 255, 255, 255, 255, 255, + 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 255, 255, 255, 255, 255, 255, + 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 255, 255, 255, 255, 255, 255, + 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 255, 255, 255, 255, 255, 255, + 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255 }; #define IS_INVALID_BCD_DATA(c) (b2i[(unsigned char)c] == 255) @@ -4135,6 +4141,31 @@ cob_check_based (const unsigned char *x, const char *name) } } +/* internal test for writing outside of storage iduring CALL / UDF invocation, + checking 'fence_pre'/'fence_post' to contain 0xFFFEFDFC00 / 0xFAFBFCFD00; + 'statement' specifies the place where that happened, which may + include psuedo-statements "INIT CALL" and "INIT UDF", + 'name' (optional) specifies the variable where this was recognized */ +void +cob_check_fence (const char *fence_pre, const char *fence_post, + const enum cob_statement stmt, const char *name) +{ + if (memcmp (fence_pre, "\xFF\xFE\xFD\xFC", 5) + || memcmp (fence_post, "\xFA\xFB\xFC\xFD", 5)) { + /* LCOV_EXCL_START */ + if (name) { + /* note: reserved, currently not generated in libcob */ + cob_runtime_error (_("memory violation detected for '%s' after %s"), + name, cob_statement_name[stmt]); + } else { + cob_runtime_error (_("memory violation detected after %s"), + cob_statement_name[stmt]); + } + /* LCOV_EXCL_STOP */ + cob_hard_failure (); + } +} + void cob_check_linkage (const unsigned char *x, const char *name, const int check_type) { @@ -4312,22 +4343,6 @@ cob_check_subscript (const int i, const int max, } } -#if 0 /* TODO: add codegen for "subscript-check: record" getting here (FR #437); - along with an optimization inline variant as done for COB_CHK_SUBSCRIPT */ -/* check for "subscript leaves field founder / group" via offset as documented - by IBM - not checking the subscript itself (which may even be negative) */ -void -cob_check_field_offset (const int offset, const int max_offset, - const char *record_name, const char *field_name, const int subscript) -{ - if (offset < 0 || offset > max_offset) { - cob_set_exception (COB_EC_BOUND_SUBSCRIPT); - cob_runtime_error (_("'%s (%d)' not in range of '%s'"), field_name, subscript, record_name); - cob_hard_failure (); - } -} -#endif - void cob_check_ref_mod_detailed (const char *name, const int abend, const int zero_allowed, const int size, const int offset, const int length) diff --git a/libcob/common.h b/libcob/common.h index 2bb79628e..d643bc565 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -1887,6 +1887,8 @@ COB_EXPIMP void cob_check_ref_mod_minimal (const char *, COB_EXPIMP void cob_check_ref_mod (const int, const int, const int, const char *); COB_EXPIMP void cob_check_beyond_exit (const char *); +COB_EXPIMP void cob_check_fence (const char *, const char *, + const enum cob_statement, const char *); /* Comparison functions */ diff --git a/libcob/statement.def b/libcob/statement.def index 3d43f5e3d..1f8482c80 100644 --- a/libcob/statement.def +++ b/libcob/statement.def @@ -166,5 +166,6 @@ COB_STATEMENT (STMT_JSON_PARSE, "JSON GENERATE") COB_STATEMENT (STMT_XML_GENERATE, "XML GENERATE") COB_STATEMENT (STMT_XML_PARSE, "XML GENERATE") -/* codegen intern only */ -COB_STATEMENT (STMT_INIT_STORAGE, "INIT STORAGE") +COB_STATEMENT (STMT_INIT_STORAGE, "INIT STORAGE") /* codegen intern only */ +COB_STATEMENT (STMT_BEFORE_CALL, "INIT CALL") /* codegen intern only (runtime checks) */ +COB_STATEMENT (STMT_BEFORE_UDF, "INIT UDF") /* codegen intern only (runtime checks) */ diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 54fd71883..7cab45b92 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -14020,13 +14020,13 @@ AT_DATA([prog.cob], [ = MYTAB(VAR2:VAR) DISPLAY 'WRONG RESULT REFMOD'. - INITIALIZE mytab + INITIALIZE mytab - GOBACK. + GOBACK. ]) AT_CHECK([$COMPILE prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -# note: we mostly are interessted in a good codegen here... +# note: we mostly are interested in a good codegen here... AT_DATA([prog2.cob], [ @@ -14053,7 +14053,7 @@ AT_DATA([prog2.cob], [ = T15-PRGM(VAR2) DISPLAY 'WRONG RESULT OCCURS'. - GOBACK. + GOBACK. ]) AT_CHECK([$COBC -x prog2.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) @@ -14087,7 +14087,7 @@ AT_DATA([prog3.cob], [ = MYTAB(VAR:VAR ) DISPLAY 'WRONG RESULT REFMOD'. - GOBACK. + GOBACK. ]) AT_CHECK([$COBC -x prog3.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) @@ -14099,6 +14099,123 @@ AT_CHECK([$COBCRUN_DIRECT ./prog3b], [1], [], AT_CLEANUP +AT_SETUP([runtime check: write to internal storage (1)]) +AT_KEYWORDS([runmisc CALL bounds]) + +# note: this check is likely unportable and therefore will likely be adjusted/skipped, +# mainly because the memory layout of consecutive variables is not guaranteed; +# it is expected to raise a crash if C bound checking is enabled + +AT_DATA([caller.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. caller. + + DATA DIVISION. + WORKING-STORAGE SECTION. + + 01 var PIC x. + + PROCEDURE DIVISION. + * + CALL "callee" USING var + * without the check this second call would SIGSEGV + CALL "callee" USING var + + GOBACK. +]) + +AT_DATA([callee.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. callee. + + DATA DIVISION. + LINKAGE SECTION. + + 77 var PIC X. + 01 lrec. + 03 lvar PIC X(64). + 03 lvar2 PIC X(64). + + PROCEDURE DIVISION USING var. + * + SET ADDRESS OF lrec TO ADDRESS OF var + SET ADDRESS OF lrec DOWN BY 64 + MOVE SPACES TO lrec + GOBACK. +]) + +AT_CHECK([$COMPILE -fno-ec=program-arg-mismatch -fmemory-check=pointer caller.cob], [0], [], []) +AT_CHECK([$COMPILE_MODULE -fno-ec=program-arg-mismatch callee.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./caller], [1], [], +[libcob: caller.cob:12: error: memory violation detected after CALL +]) + +AT_CHECK([$COMPILE -fno-ec=program-arg-mismatch -fmemory-check=using caller.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./caller], [1], [], +[libcob: caller.cob:12: error: memory violation detected for 'var' after CALL +]) + +AT_CHECK([$COMPILE -fno-ec=program-arg-mismatch -fmemory-check caller.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./caller], [1], [], +[libcob: caller.cob:12: error: memory violation detected for 'var' after CALL +]) + +AT_CHECK([$COMPILE -fno-ec=program-arg-mismatch -fmemory-check=all caller.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./caller], [1], [], +[libcob: caller.cob:12: error: memory violation detected for 'var' after CALL +]) + +AT_CLEANUP + + +AT_SETUP([runtime check: write to internal storage (2)]) +AT_KEYWORDS([runmisc CALL bounds]) + +# PROG A (WS 16 bytes) has its WS overwritten and calls PROG B +# because of the write outside of WS the internal storage is broken +# and the call pointer contains an invalid address +# note: this check is possibly unportable and therefore will likely be adjusted/skipped +# it is expected to raise a crash if C bound checking is enabled + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + DATA DIVISION. + WORKING-STORAGE SECTION. + + 01 REC. + 03 VAR PIC X(16). + 03 VAR2 PIC X(16). + 77 PNT USAGE POINTER. + + LINKAGE SECTION. + 01 LREC. + 03 LVAR PIC X(32). + 03 LVAR2 PIC X(32). + + PROCEDURE DIVISION. + * using a (not working) call prevents the C compiler + * to know that we (do not) change the pointer variable + * and therefore disallows it to check + * "that points to VAR2, you only have 32 bytes" (done with gcc -O) + SET PNT TO ADDRESS OF VAR2. + CALL "notthere" USING PNT ON EXCEPTION CONTINUE. + SET ADDRESS OF LREC TO PNT. + MOVE SPACES TO LREC. + CALL "broken". + + GOBACK. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], +[libcob: prog.cob:27: error: memory violation detected after INIT CALL +]) + +AT_CLEANUP + + AT_SETUP([libcob version check]) AT_KEYWORDS([runmisc])