diff --git a/NEWS b/NEWS index e8eef8483..a0a265531 100644 --- a/NEWS +++ b/NEWS @@ -361,6 +361,12 @@ Open Plans: 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 @@ -473,6 +479,8 @@ Open Plans: 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 @@ -556,6 +564,8 @@ Open Plans: * 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 93b64251b..4933e02e8 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -37,6 +37,56 @@ * error.c, cobc.c (print_program_trailer), flag.def: implemented -fmax-errors=0 as unlimited +2023-07-24 Simon Sobisch + + * parser.y (entry_statement): don't check parameter address + directly on ENTRY, because it just assigns it + * codegen.c (output_internal_function, output_entry_function): moved + setting of non-passed parameters to NULL to entry function as we only + have ordinal CALL numbers available there; set BY VALUE parameters to + zero instead of NULL + * codegen.c (output_field_no_target): extracted to reduce code duplication + * typeck.c (cb_emit_call): fixed skipping memory-fence generation for + EXTERNAL/BASED sub-fields + +2023-07-13 Simon Sobisch + + * pplex.l (cb_ppecho_direct, output_pending_newlines): output only up + to 9 empty lines, for more empty lines in the preparsed output file + generate a matching #line directive, this saves both space and serves + as a workaround for an unclear scanner bug that may happen with huge + amounts of empty lines + * pplex.l (switch_to_buffer): don't re-strdup the filename + * parser.y (emit_statement): changed from define to inline function + * codegen.c: complete output of program's end source location if requested + * scanner.l: handle line directive in any state + +2023-07-11 Fabrice Le Fessant + + * parser.y: fix code generation for OPEN/CLOSE with multiple + filenames, where DECLARATIVES for all arguments were called when + only one argument failed + +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 @@ -2603,7 +2653,8 @@ 2020-09-27 Robert Dubner - * codegen.c (output_cobol_info): emit doubled backslashes for source file + * codegen.c (output_cobol_info): emit doubled backslashes for source file, + fixing bug #698 problem with #line directives 2020-09-14 Simon Sobisch @@ -3020,9 +3071,10 @@ 2020-04-26 Ron Norman - * codeoptim.def,codeoptim.c: New routines to convert DISPLAY into - binary values - * codegen.c: Use new get_numdisps/64/s64 routines + * codeoptim.def (COB_GET_NUMDISPS), codeoptim.c, codegen.c: new routine + to convert signed DISPLAY into binary value; + * codeoptim.def (cob_get_numdisp, cob_get_numdisps): use of register + attribute and skipping of leading zeroes * typeck.c: Check for integer expression and emit faster arithmetic code by using the C language to do the arithmetic * flag.def: New flag -fno-fast-math to disable these changes diff --git a/cobc/cobc.c b/cobc/cobc.c index 6f1b27edb..8b98ca858 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -105,8 +105,9 @@ 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_GETOPT_SQLSCHEMA 16 -#define CB_FLAG_GETOPT_FILE_FORMAT 17 +#define CB_FLAG_MEMORY_CHECK 16 +#define CB_FLAG_GETOPT_SQLSCHEMA 17 +#define CB_FLAG_GETOPT_FILE_FORMAT 18 /* Info display limits */ @@ -1246,11 +1247,9 @@ void * cobc_plex_strsub (const char *s, const int len) { void *p; - int n; - - n = strlen (s); #ifdef COB_TREE_DEBUG + int n = strlen (s); /* LCOV_EXCL_START */ if ( len>n ) { cobc_err_msg ("call to %s with bad argument len=%d>%d=strlen(s)", @@ -1856,6 +1855,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) @@ -3265,6 +3300,7 @@ process_command_line (const int argc, char **argv) cb_flag_stack_extended = 1; cb_flag_stack_check = 1; cb_flag_symbols = 1; + cb_flag_memory_check = CB_MEMCHK_ALL; cobc_wants_debug = 1; break; @@ -3869,7 +3905,7 @@ process_command_line (const int argc, char **argv) cobc_deciph_funcs (cob_optarg); break; - case CB_FLAG_GETOPT_SQLSCHEMA: /* 16 */ + case CB_FLAG_GETOPT_SQLSCHEMA: /* 17 */ /* -fsqlschema= : Database schema name for XFD */ cb_sqldb_schema = cobc_main_strdup (cob_optarg); cb_flag_sql_xfd = 1; @@ -3892,7 +3928,7 @@ process_command_line (const int argc, char **argv) #endif break; - case CB_FLAG_GETOPT_FILE_FORMAT: /* 17 */ + case CB_FLAG_GETOPT_FILE_FORMAT: /* 18 */ /* -ffile-format= : Default file format */ if (cb_strcasecmp (cob_optarg, "mf") == 0) { cb_mf_files = 1; @@ -3919,6 +3955,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 9a491dd59..42849c1c5 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -137,6 +137,8 @@ struct base_list { const char *curr_prog; }; +/* variable set in cobc.c during option parsing, see tree.h */ +int cb_flag_memory_check = 0; /* Local variables */ @@ -1972,6 +1974,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[8];\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", @@ -1982,6 +1992,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[8];\n"); + } if (static_call_cache) { const char *convention_modifier; static_call_cache = static_call_list_reverse (static_call_cache); @@ -2549,29 +2563,47 @@ output_local_base_cache (void) ws_id++; ws_used = 0; 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[8]%s;\n", + CB_PREFIX_BASE, fld->id, COB_ALIGN); +#else + output_local ("%scob_u8_t%s %s%d_fence_pre[8];\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)) { if (!cb_align_record - || blp->f->memory_size >= COB_MAX_CHAR_SIZE) { + || fld->memory_size >= COB_MAX_CHAR_SIZE) { #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 #if defined(COB_ALIGN_PRAGMA_8) - output_local ("#pragma align 8 (%s%d)\n", CB_PREFIX_BASE, blp->f->id); + output_local ("#pragma align 8 (%s%d)\n", CB_PREFIX_BASE, fld->id); #endif 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); + COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, CB_PREFIX_BASE, + fld->id, fld->memory_size); #endif } else { - fs = compute_align_size (blp->f->memory_size, 1); + fs = compute_align_size (fld->memory_size, 1); if (ws_used + fs > COB_MAX_CHAR_SIZE) { output_local_ws_group (); ws_id++; @@ -2579,11 +2611,24 @@ output_local_base_cache (void) } output_local ("#define %s%d\t(%s%d + %ld)", - CB_PREFIX_BASE, blp->f->id, CB_PREFIX_WS_GROUP, ws_id, (long)ws_used); + CB_PREFIX_BASE, fld->id, CB_PREFIX_WS_GROUP, ws_id, (long)ws_used); ws_used += fs; } } - output_local ("\t/* %s */\n", get_field_name (blp->f)); + output_local ("\t/* %s */\n", get_field_name (fld)); + 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[8]%s;\n", + CB_PREFIX_BASE, fld->id, COB_ALIGN); +#else + output_local ("%scob_u8_t%s %s%d_fence_post[8];\n", + COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, + CB_PREFIX_BASE, fld->id); +#endif + } } output_local_ws_group (); @@ -2605,30 +2650,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[8]%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[8];\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[8]%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[8];\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"); @@ -4416,6 +4492,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]); + } output ("func_%s.funcfld (&cob_dyn_%u", func, gen_dynamic); gen_dynamic++; if (ip->intr_field || ip->args) { @@ -4478,6 +4559,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; } @@ -5861,6 +5947,7 @@ static void output_c_info (void) { if (cb_flag_c_line_directives) { + /* note: output name is already escaped for C string */ output ("#line %d \"%s\"", output_line_number + 1, output_name); output_newline (); } @@ -5886,7 +5973,7 @@ output_cobol_info (cb_tree x) sprintf (q, "\""); } output ("#line %d \"", x->source_line); - + /* escape COBOL file name for C string */ while (*p) { if (*p == '\\') { output ("%c",'\\'); @@ -7121,6 +7208,59 @@ output_field_constant (cb_tree x, int n, const char *flagname) output_newline (); } +/* 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\\x00\\x00\\x00\", 8) == 0) {", + CB_PREFIX_BASE, fchck->id); + output_indent_level += indent_adjust_level; + output_line ("memcpy (%s%d_fence_pre, \"\\xFF\\xFE\\xFD\\xFC\\xFB\\xFA\\xFF\", 8);", + CB_PREFIX_BASE, fchck->id); + output_line ("memcpy (%s%d_fence_post, \"\\xFA\\xFB\\xFC\\xFD\\xFE\\xFF\\xFA\", 8);", + 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) { @@ -7524,6 +7664,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 */ @@ -7826,6 +7971,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); } @@ -8585,8 +8735,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); } @@ -8651,9 +8801,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 { @@ -8843,14 +8993,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 ("}"); } } @@ -12889,10 +13039,24 @@ 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; local_mem += compute_align_size (f->memory_size, 16); +#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 } } @@ -13210,10 +13374,23 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) /* Output source location as code */ if (cb_flag_source_location) { - l = CB_TREE (prog); + struct cb_tree_common loc; + loc.source_file = prog->common.source_file; + loc.source_line = prog->last_source_line; + loc.source_column = 0; + output_newline (); + output_line ("/* Line: %-10d: last source line :%s */", + prog->last_source_line, prog->common.source_file); + if (cb_flag_c_line_directives) { + output_cobol_info (&loc); + } output_line ("module->module_stmt = 0x%08X;", COB_SET_LINE_FILE (prog->last_source_line, - lookup_source (l->source_file))); + lookup_source (prog->common.source_file))); + if (cb_flag_c_line_directives) { + output_c_info (); + output_line ("cob_nop ();"); + } output_newline (); } @@ -13417,6 +13594,15 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list) output_module_init (prog); } + /* 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\\xFB\\xFA\\xFF\", 8);"); + output_line ("memcpy (call_fence_post, \"\\xFA\\xFB\\xFC\\xFD\\xFE\\xFF\\xFA\", 8);"); + 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 16cac1e50..cc9d00b0d 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\\xFB\\xFA\\xFF\", 8)"); + output_storage (" || memcmp (fence_post, \"\\xFA\\xFB\\xFC\\xFD\\xFE\\xFF\\xFA\", 8)) {"); + 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 (" }"); /* Improve performance by skipping leading ZEROs */ output_storage (" for (n = 0; n < size; ++n, ++p) {"); output_storage (" if (*p > '0' && *p <= '9')"); @@ -240,7 +259,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 = size - 1;"); - + /* 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 b9b8d5245..a716098f6 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 294e55ab7..46cbb2cb6 100644 --- a/cobc/flag.def +++ b/cobc/flag.def @@ -81,7 +81,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, @@ -130,7 +131,7 @@ CB_FLAG_ON (cb_flag_fast_math, 0, "fast-math", _(" -ffast-math Disables emitting faster arithmetic logic")) 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 */ @@ -174,6 +175,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/parser.y b/cobc/parser.y index 119ccfff5..d79d5fb78 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -51,13 +51,6 @@ #define YYSTYPE cb_tree #define yyerror(x) cb_error_always ("%s", x) -#define emit_statement(x) \ -do { \ - if (!skip_statements) { \ - CB_ADD_TO_CHAIN (x, current_program->exec_list); \ - } \ -} ONCE_COB - #define push_expr(type, node) \ current_expr = cb_build_list (cb_int (type), node, current_expr) @@ -412,6 +405,14 @@ build_colseq (enum cb_colseq colseq) /* Statements */ +static COB_INLINE COB_A_INLINE void +emit_statement (cb_tree x) +{ + if (!skip_statements) { + CB_ADD_TO_CHAIN (x, current_program->exec_list); + } +} + static void begin_statement_internal (enum cob_statement statement, const unsigned int term, const char *file, const int line) @@ -453,17 +454,23 @@ begin_statement_at_tree_pos (enum cob_statement statement, const unsigned int te cobc_in_area_a = backup_in_area_a; } -/* create a new statement with base attributes of current_statement - and set this as new current_statement */ +/* create a new statement with base attributes of real_statement, the + location of pos and set this as new current_statement */ static void -begin_implicit_statement (void) +begin_implicit_statement (struct cb_statement* real_statement, cb_tree pos) { struct cb_statement *new_statement; - new_statement = cb_build_statement (current_statement->statement); + new_statement = cb_build_statement (real_statement->statement); new_statement->common = current_statement->common; new_statement->flag_in_debug = !!in_debugging; new_statement->flag_implicit = 1; - current_statement->body = cb_list_add (current_statement->body, + if (pos){ + cb_tree stmt_tree; + stmt_tree = CB_TREE (new_statement); + stmt_tree->source_file = pos->source_file; + stmt_tree->source_line = pos->source_line; + } + real_statement->body = cb_list_add (real_statement->body, CB_TREE (new_statement)); current_statement = new_statement; } @@ -12953,15 +12960,21 @@ close_body: close_files: file_name _close_option { -#if 0 /* CHECKME: likely not needed */ - begin_implicit_statement (); -#endif + /* We need to create a list with a CLOSE statement for every file + within the current_statement instead of nesting them, which + is what would happen if we don't save the current statement + and restore it. */ + struct cb_statement * saved_current_statement = current_statement ; + begin_implicit_statement (current_statement, $1); cb_emit_close ($1, $2); + current_statement = saved_current_statement ; } | close_files file_name _close_option { - begin_implicit_statement (); + struct cb_statement * saved_current_statement = current_statement ; + begin_implicit_statement (current_statement, $2); cb_emit_close ($2, $3); + current_statement = saved_current_statement ; } ; @@ -13128,15 +13141,17 @@ delete_body: delete_file_list: file_name { -#if 0 /* CHECKME: likely not needed */ - begin_implicit_statement (); -#endif + struct cb_statement * saved_current_statement = current_statement ; + begin_implicit_statement (current_statement, $1); cb_emit_delete_file ($1); + current_statement = saved_current_statement ; } | delete_file_list file_name { - begin_implicit_statement (); + struct cb_statement * saved_current_statement = current_statement ; + begin_implicit_statement (current_statement, $2); cb_emit_delete_file ($2); + current_statement = saved_current_statement ; } ; @@ -14535,7 +14550,7 @@ generate_body: qualified_word { #if 0 /* CHECKME: likely not needed */ - begin_implicit_statement (); + begin_implicit_statement (current_statement, $1); #endif if ($1 != cb_error_node) { cb_emit_generate ($1); @@ -14789,7 +14804,7 @@ initiate_body: report_name { #if 0 /* CHECKME: likely not needed */ - begin_implicit_statement (); + begin_implicit_statement (current_statement, $1); #endif if ($1 != cb_error_node) { cb_emit_initiate ($1); @@ -14797,7 +14812,7 @@ initiate_body: } | initiate_body report_name { - begin_implicit_statement (); + begin_implicit_statement (current_statement, $2); if ($2 != cb_error_node) { cb_emit_initiate ($2); } @@ -15380,6 +15395,7 @@ open_file_entry: cb_tree x; cb_tree retry; int retry_times, retry_seconds, retry_forever; + struct cb_statement * top_statement = current_statement ; if (($1 && $3) || ($1 && $6) || ($3 && $6)) { cb_error_x (CB_TREE (current_statement), @@ -15399,7 +15415,7 @@ open_file_entry: for (l = $5; l; l = CB_CHAIN (l)) { if (CB_VALID_TREE (CB_VALUE (l))) { - begin_implicit_statement (); + begin_implicit_statement (top_statement, CB_VALUE(l)); current_statement->retry = retry; current_statement->flag_retry_times = retry_times; current_statement->flag_retry_seconds = retry_seconds; @@ -17075,7 +17091,7 @@ terminate_body: report_name { #if 0 /* CHECKME: likely not needed */ - begin_implicit_statement (); + begin_implicit_statement (current_statement, $1); #endif if ($1 != cb_error_node) { cb_emit_terminate ($1); @@ -17083,7 +17099,7 @@ terminate_body: } | terminate_body report_name { - begin_implicit_statement (); + begin_implicit_statement (current_statement, $2); if ($2 != cb_error_node) { cb_emit_terminate ($2); } diff --git a/cobc/pplex.l b/cobc/pplex.l index 97090a113..20be4c4a8 100644 --- a/cobc/pplex.l +++ b/cobc/pplex.l @@ -146,6 +146,7 @@ static size_t comment_allowed; static unsigned int plex_skip_input = 0; static unsigned int plex_nest_depth = 0; static int quotation_mark = 0; +static int echo_newline = 0; static int listing_line = 0; static int requires_listing_line; static enum cb_format source_format = CB_FORMAT_AUTO; @@ -175,6 +176,7 @@ static void skip_to_eol (void); static void count_newlines (const char *); static void display_finish (void); static void get_new_listing_file (void); +static void output_pending_newlines (FILE *); static struct cb_text_list *pp_text_list_add (struct cb_text_list *, const char *, const size_t); @@ -229,6 +231,7 @@ MAYBE_AREA_A [ ]?#? ^{MAYBE_AREA_A}[ ]*">>"[ ]?"COBOL-WORDS" { /* 202x+: directive for setting source format */ BEGIN COBOL_WORDS_DIRECTIVE_STATE; + output_pending_newlines (ppout); return COBOL_WORDS_DIRECTIVE; } @@ -236,6 +239,7 @@ MAYBE_AREA_A [ ]?#? /* 2002+: definition of compiler constants display message during compilation */ /* Define here to preempt next debug rule below */ BEGIN DEFINE_DIRECTIVE_STATE; + output_pending_newlines (ppout); return DEFINE_DIRECTIVE; } @@ -243,12 +247,14 @@ MAYBE_AREA_A [ ]?#? /* previous OpenCOBOL/GnuCOBOL 2.x extension, added in COBOL 202x with slightly different syntax: display message during compilation --> needs a dialect option to switch to the appropriate state */ display_msg[0] = 0; + output_pending_newlines (ppout); BEGIN DISPLAY_DIRECTIVE_STATE; } ^{MAYBE_AREA_A}[ ]*">>"[ ]?"REF-MOD-ZERO-LENGTH" { /* 202x: directive to allow zero ref-mod */ BEGIN ON_OFF_DIRECTIVE_STATE; + output_pending_newlines (ppout); return REFMOD_DIRECTIVE; } @@ -273,30 +279,35 @@ MAYBE_AREA_A [ ]?#? ON implied for empty value Note: further checks in ppparse.y, processed in cobc.c */ BEGIN ON_OFF_DIRECTIVE_STATE; + output_pending_newlines (ppout); return LISTING_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*">>"[ ]?"SOURCE" { /* 2002+: directive for setting source format */ BEGIN SOURCE_DIRECTIVE_STATE; + output_pending_newlines (ppout); return SOURCE_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*">>"[ ]?"SET" { /* OpenCOBOL/GnuCOBOL 2.0 extension: MF SET directive in 2002+ style format */ BEGIN SET_DIRECTIVE_STATE; + output_pending_newlines (ppout); return SET_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*">>"[ ]?"TURN" { /* 2002+: directive for (de-)activating exception checks */ BEGIN TURN_DIRECTIVE_STATE; + output_pending_newlines (ppout); return TURN_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*">>"[ ]?"IF" { /* 2002+: conditional compilation */ BEGIN IF_DIRECTIVE_STATE; + output_pending_newlines (ppout); return IF_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*">>"[ ]?"ELIF" | @@ -304,16 +315,19 @@ MAYBE_AREA_A [ ]?#? /* OpenCOBOL extension: conditional compilation combined ELSE IF, 2002+ style format */ BEGIN IF_DIRECTIVE_STATE; + output_pending_newlines (ppout); return ELIF_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*">>"[ ]?"ELSE" { /* 2002+: conditional compilation */ BEGIN ELSE_DIRECTIVE_STATE; + output_pending_newlines (ppout); return ELSE_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*">>"[ ]?"END-IF" { /* 2002+: conditional compilation */ BEGIN ENDIF_DIRECTIVE_STATE; + output_pending_newlines (ppout); return ENDIF_DIRECTIVE; } @@ -321,12 +335,14 @@ MAYBE_AREA_A [ ]?#? /* 2002+: more then 60 seconds per minute (currently always set to off), OFF implied for empty value */ BEGIN ON_OFF_DIRECTIVE_STATE; + output_pending_newlines (ppout); return LEAP_SECOND_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*">>"[ ]?"CALL-CONVENTION" { /* 2002+: convention for CALL/CANCEL */ BEGIN CALL_DIRECTIVE_STATE; + output_pending_newlines (ppout); return CALL_DIRECTIVE; } @@ -365,18 +381,21 @@ MAYBE_AREA_A [ ]?#? /* MF extension: display message during compilation */ display_msg[0] = 0; BEGIN DISPLAY_DIRECTIVE_STATE; + output_pending_newlines (ppout); } ^{MAYBE_AREA_A}[ ]*$[ \t]*"SET" { /* MF extension: SET directive */ /* TODO: check position of the $SET directive */ BEGIN SET_DIRECTIVE_STATE; + output_pending_newlines (ppout); return SET_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*$[ \t]*"IF" { /* MF extension: conditional compilation */ BEGIN IF_DIRECTIVE_STATE; + output_pending_newlines (ppout); return IF_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*$[ \t]*"ELIF" | @@ -384,17 +403,20 @@ MAYBE_AREA_A [ ]?#? /* OpenCOBOL/GnuCOBOL 2.0 extension: conditional compilation combined ELSE IF, MF style format */ BEGIN IF_DIRECTIVE_STATE; + output_pending_newlines (ppout); return ELIF_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*$[ \t]*"ELSE" { /* MF extension: conditional compilation */ BEGIN ELSE_DIRECTIVE_STATE; + output_pending_newlines (ppout); return ELSE_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*$[ \t]*"END" | ^{MAYBE_AREA_A}[ ]*$[ \t]*"END-IF" { /* MF extension: conditional compilation, second undocumented */ BEGIN ENDIF_DIRECTIVE_STATE; + output_pending_newlines (ppout); return ENDIF_DIRECTIVE; } ^{MAYBE_AREA_A}[ ]*$[ \t]*"REGION" | @@ -426,7 +448,7 @@ MAYBE_AREA_A [ ]?#? ^{MAYBE_AREA_A}[ ]*("PROCESS"|"CBL")[ ,;]*[\n] { /* IBM COBOL extension for specifying compiler options */ /* TODO: The CBL (PROCESS) statement must be placed before any - comment lines, IDENTIFICATIO DIVISION, or other + comment lines, IDENTIFICATION DIVISION, or other compiler-directing statements. */ /* empty - so ignored */ skip_to_eol (); @@ -435,7 +457,7 @@ MAYBE_AREA_A [ ]?#? ^{MAYBE_AREA_A}[ ]*("PROCESS"|"CBL")[ ][A-Z0-9() ,;'"=]* { /* IBM COBOL extension for specifying compiler options */ /* TODO: The CBL (PROCESS) statement must be placed before any - comment lines, IDENTIFICATIO DIVISION, or other + comment lines, IDENTIFICATION DIVISION, or other compiler-directing statements. */ char *s = yytext; while (*s == ' ') s++; @@ -488,6 +510,7 @@ MAYBE_AREA_A [ ]?#? ^{MAYBE_AREA_A}.{6}[ ]*"*CONTROL" | ^{MAYBE_AREA_A}.{6}[ ]*"*CBL" { BEGIN CONTROL_STATEMENT_STATE; + output_pending_newlines (ppout); return CONTROL_STATEMENT; } @@ -622,6 +645,7 @@ SUBSTITUTION_SECTION_STATE> if (cb_verify (cb_title_statement, yytext)) { /* handle as listing-directive statement */ BEGIN ALNUM_LITERAL_STATE; + output_pending_newlines (ppout); return TITLE_STATEMENT; } else if (cb_title_statement == CB_SKIP) { /* handle later (normal reserved / user defined word) */ @@ -657,7 +681,7 @@ SUBSTITUTION_SECTION_STATE> } "(" { - inside_bracket++; + inside_bracket++; ppecho (yytext, NULL); } @@ -1146,6 +1170,7 @@ ENDIF_DIRECTIVE_STATE>{ /* Terminate at the end of all input */ if (current_copy_info->next == NULL) { + output_pending_newlines (ppout); /* CHECKME: do we want to drop those? */ /* Check dangling IF/ELSE */ for (; plex_nest_depth > 0; --plex_nest_depth) { cb_source_line = plex_cond_stack[plex_nest_depth].line; @@ -1162,7 +1187,7 @@ ENDIF_DIRECTIVE_STATE>{ newline_count = 0; inside_bracket = 0; comment_allowed = 1; - cb_free_replace (); + cb_free_replace (); copy_stack = NULL; quotation_mark = 0; consecutive_quotation = 0; @@ -1511,12 +1536,33 @@ ppcopy_find_file (char *name, int has_ext) return NULL; } +static COB_INLINE COB_A_INLINE void +output_pending_newlines (FILE *stream) +{ + if (echo_newline > 9) { + /* too much newlines (likely becaue of conditional compilation or + long comment blocks, for example from EXEC SQL preparsers), + so generate source directive from the already adjusted static vars + instead of spitting out possibly hundreds of empty lines */ + fprintf (stream, "\n#line %d \"%s\"\n", cb_source_line, cb_source_file); + echo_newline = 0; + } else { + while (echo_newline > 1) { + fputc ('\n', stream); + echo_newline--; + } + echo_newline = 0; + } +} + int ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list) { const char *filename = NULL; const int has_ext = (strchr (name, '.') != NULL); + output_pending_newlines (yyout); + if (cb_current_file) { cb_current_file->copy_line = cb_source_line; } @@ -1769,6 +1815,7 @@ plex_clear_vars (void) memset (plex_cond_stack, 0, sizeof(plex_cond_stack)); requires_listing_line = 1; comment_allowed = 1; + echo_newline = 0; } void @@ -1957,6 +2004,8 @@ cb_set_print_replace_list (struct cb_replace_list *list) static void switch_to_buffer (const int line, const char *file, const YY_BUFFER_STATE buffer) { + output_pending_newlines (yyout); + /* Reset file/line */ cb_source_line = line; cb_source_file = cobc_plex_strdup (file); @@ -2036,10 +2085,10 @@ next_word_is_comment_paragraph_name (const char *buff) break; case 8: if (memcmp (p, "SECURITY", len)) return 0; break; - case 12: if ( memcmp (p, "DATE-WRITTEN", len) + case 12: if (memcmp (p, "DATE-WRITTEN", len) && memcmp (p, "INSTALLATION", len)) return 0; break; - case 13: if ( memcmp (p, "DATE-MODIFIED", len) + case 13: if (memcmp (p, "DATE-MODIFIED", len) && memcmp (p, "DATE-COMPILED", len)) return 0; break; default: return 0; @@ -2101,6 +2150,7 @@ start: #endif } if (newline_count < max_size) { + /* FIXME: this doesn't check the buffer size ! */ memset (buff, '\n', newline_count); buff[newline_count] = 0; ipchar = (int)newline_count; @@ -2138,6 +2188,7 @@ start: if (newline_count == 0) { return YY_NULL; } + /* FIXME: this doesn't check the buffer size ! */ memset (buff, '\n', newline_count); buff[newline_count] = 0; ipchar = (int)newline_count; @@ -2332,7 +2383,8 @@ start: ipchar = 0; for (; *bp; bp++) { if (*bp != ' ') { - if ((*bp == '$' && bp[1] != ' ') || (*bp == '>' && bp[1] == '>')) { + if ((*bp == '$' && bp[1] != ' ') + || (*bp == '>' && bp[1] == '>')) { /* Directive */ ipchar = 1; } else if (*bp == '*' && bp[1] == '>') { @@ -2351,6 +2403,7 @@ start: || is_condition_directive_clause (bp))) { /* Directive - pass complete line with NL to ppparse */ if (newline_count) { + /* FIXME: this doesn't check the buffer size ! */ /* Move including NL and NULL byte */ memmove (buff + newline_count, buff, (size_t)n + 1); memset (buff, '\n', newline_count); @@ -2721,9 +2774,18 @@ display_finish (void) unput ('\n'); } -void cb_ppecho_direct (const char *text, const char *token ) +void cb_ppecho_direct (const char *text, const char *token ) { - fputs (text, ppout); + if (text[0] == '\n' && text[1] == 0) { + if (echo_newline == 0) { + /* always keep one trailing \n */ + fputc ('\n', ppout); + } + echo_newline++; + } else { + output_pending_newlines (ppout); + fputs (text, ppout); + } if (cb_listing_file) { check_listing (token != NULL ? token : text, 0); } diff --git a/cobc/replace.c b/cobc/replace.c index 42e44f80a..82f30b48b 100644 --- a/cobc/replace.c +++ b/cobc/replace.c @@ -49,7 +49,7 @@ parsed on the input stream *before* any COPY-REPLACING could have been applied. - The general entry point is `add_text_to_replace(stream, prequeue, + The general entry point is `add_text_to_replace (stream, prequeue, token)`, it adds `token` to `stream`, `prequeue` is 1 if the token should not be treated immediately (because it may be merged with other following tokens if they are of the same kind), 0 @@ -174,9 +174,9 @@ char * string_of_##kind##_list(const struct cb_##kind##_list *list) \ text_list_string[0] = '['; \ \ for(; list != NULL; list = list->next){ \ - size_t len = strlen(list->text); \ + size_t len = strlen (list->text); \ text_list_string[pos++] = '"'; \ - memcpy( text_list_string + pos, list->text, len ); \ + memcpy (text_list_string + pos, list->text, len); \ pos += len; \ text_list_string[pos++] = '"'; \ text_list_string[pos++] = ','; \ @@ -226,7 +226,7 @@ token_list_add (WITH_DEPTH struct cb_token_list *list, const char *text, const char *token) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%stoken_list_add(%s,'%s')\n", + fprintf (stderr, "%stoken_list_add(%s,'%s')\n", DEPTH, string_of_token_list(list), text); #endif struct cb_token_list *p; @@ -259,7 +259,7 @@ const void pop_token (WITH_DEPTH struct cb_replacement_state *repls, const struct cb_token_list *q = repls->token_queue ; repls->token_queue = q->next ; #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%spop_token(%s) -> '%s'\n", + fprintf (stderr, "%spop_token(%s) -> '%s'\n", DEPTH, repls->name, q->text); #endif if (text) *text = q->text ; @@ -271,13 +271,13 @@ void ppecho_switch (WITH_DEPTH struct cb_replacement_state *repls, const char* text, const char* token) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%sppecho_switch(%s, '%s')\n", + fprintf (stderr, "%sppecho_switch(%s, '%s')\n", DEPTH, repls->name, text); #endif switch( repls->ppecho ){ case CB_PPECHO_DIRECT: #ifdef DEBUG_REPLACE - fprintf(stderr, "%s ppecho_direct('%s')\n", DEPTH, text); + fprintf (stderr, "%s ppecho_direct('%s')\n", DEPTH, text); #endif return cb_ppecho_direct (text, token); case CB_PPECHO_REPLACE: @@ -290,7 +290,7 @@ void ppecho_switch_text_list (WITH_DEPTH struct cb_replacement_state *repls, const struct cb_text_list *p) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%sppecho_switch_text_list(%s, %s)\n", + fprintf (stderr, "%sppecho_switch_text_list(%s, %s)\n", DEPTH, repls->name, string_of_text_list(p)); #endif @@ -305,7 +305,7 @@ void ppecho_switch_token_list (WITH_DEPTH struct cb_replacement_state *repls, const struct cb_token_list *p) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%sppecho_switch_token_list(%s, %s)\n", + fprintf (stderr, "%sppecho_switch_token_list(%s, %s)\n", DEPTH, repls->name, string_of_token_list(p)); #endif @@ -335,7 +335,7 @@ int is_leading_or_trailing (WITH_DEPTH int leading, result = 0; } #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, + fprintf (stderr, "%sis_leading_or_trailing(%d, '%s', input='%s', %d) -> %d\n", DEPTH, leading, src_text, text, strict, result); #endif @@ -352,7 +352,7 @@ void ppecho_leading_or_trailing (WITH_DEPTH struct cb_replacement_state *repls, const struct cb_text_list * new_text) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, + fprintf (stderr, "%sppecho_leading_or_trailing(%s, %d, '%s', input='%s', ...)\n", DEPTH, repls->name, leading, src_text, text); #endif @@ -391,7 +391,7 @@ void check_replace (WITH_DEPTH struct cb_replacement_state* repls, const struct cb_replace_list *replace_list) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%scheck_replace(%s, ...)\n", DEPTH, + fprintf (stderr, "%scheck_replace(%s, ...)\n", DEPTH, repls->name); #endif repls->current_list = replace_list; @@ -482,15 +482,15 @@ void check_replace_all (WITH_DEPTH const struct cb_replace_list *replace_list) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%scheck_replace_all(%s,", + fprintf (stderr, "%scheck_replace_all(%s,", DEPTH, repls->name); - fprintf(stderr, "%s new_text = %s,\n", DEPTH, + fprintf (stderr, "%s new_text = %s,\n", DEPTH, string_of_text_list(new_text)); - fprintf(stderr, "%s texts = %s,\n", DEPTH, + fprintf (stderr, "%s texts = %s,\n", DEPTH, string_of_token_list(texts)); - fprintf(stderr, "%s src = %s,\n", DEPTH, + fprintf (stderr, "%s src = %s,\n", DEPTH, string_of_text_list(src)); - fprintf(stderr, "%s)\n", DEPTH); + fprintf (stderr, "%s)\n", DEPTH); #endif if (src==NULL){ @@ -515,7 +515,7 @@ void check_replace_all (WITH_DEPTH * for more texts to be added on the * stream */ #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%s check_replace_all --> PARTIAL MATCH\n", DEPTH); + fprintf (stderr, "%s check_replace_all --> PARTIAL MATCH\n", DEPTH); #endif } else { const char* text = texts->text; @@ -559,7 +559,7 @@ static void check_replace_after_match (WITH_DEPTH struct cb_replacement_state *repls) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%scheck_replace_after_match(%s)\n", + fprintf (stderr, "%scheck_replace_after_match(%s)\n", DEPTH, repls->name); #endif repls->current_list = NULL; @@ -580,7 +580,7 @@ static void do_replace (WITH_DEPTH struct cb_replacement_state* repls) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%sdo_replace(%s)\n",DEPTH, repls->name); + fprintf (stderr, "%sdo_replace(%s)\n",DEPTH, repls->name); #endif if (repls->current_list == NULL){ if (repls->replace_list == NULL){ @@ -602,87 +602,78 @@ void do_replace (WITH_DEPTH struct cb_replacement_state* repls) /* Whether a word matches the definition of WORD in pplex.l */ static -int is_word (WITH_DEPTH const char* s){ +int is_word (WITH_DEPTH const char* s) { int i; size_t len = strlen (s); - - for( i = 0; i= '0' && c <= '9' ) - || ( c >= 'A' && c <= 'Z' ) - || ( c >= 'a' && c <= 'z' ) - || ( c >= 128 && c <= 255 ) - ){ - + if (c == '_' + || c == '-' + || ( c >= '0' && c <= '9' ) + || ( c >= 'A' && c <= 'Z' ) + || ( c >= 'a' && c <= 'z' ) + || ( c >= 128 && c <= 255 ) ) { + /* word character, just go on */ } else { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%sis_word('%s') -> 0\n", DEPTH, s); + fprintf (stderr, "%sis_word('%s') -> 0\n", DEPTH, s); #endif return 0; } } #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%sis_word('%s') -> 1\n", DEPTH, s); + fprintf (stderr, "%sis_word('%s') -> 1\n", DEPTH, s); #endif return 1; } static void add_text_to_replace (WITH_DEPTH struct cb_replacement_state *repls, - int prequeue, - const char* text, - const char* token + int prequeue, const char* text, const char* token ) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "%sadd_text_to_replace(%s%s, '%s')\n", DEPTH, + fprintf (stderr, "%sadd_text_to_replace (%s%s, '%s')\n", DEPTH, repls->name, prequeue ? ", PREQUEUE" : "", text); #endif - if( prequeue ){ + if (prequeue) { - if( is_word (MORE_DEPTH text) ) { + if (is_word (MORE_DEPTH text) ) { if( repls->text_prequeue == NULL ){ /* a word should be kept in the prequeue */ repls->text_prequeue = cobc_plex_strdup (text); } else { - /* two following words should be - * merged, and keep waiting in the - * prequeue */ + /* two following words should be merged, + and keep waiting in the prequeue */ repls->text_prequeue = cobc_plex_stradd (repls->text_prequeue, text); } + } else if ( repls->text_prequeue == NULL ){ + /* not a word, and empty prequeue, + just perform replacements */ + add_text_to_replace (MORE_DEPTH repls, 0, text, token); } else { - if( repls->text_prequeue == NULL ){ - /* not a word, and empty prequeue, - * just perform replacements */ - add_text_to_replace(MORE_DEPTH repls, 0, text, token); - } else { - /* not a word, one word in the - * prequeue, flush the word from the - * prequeue and pass the current text - * to the replacements */ - const char* pretext = repls->text_prequeue; - repls->text_prequeue = NULL; - add_text_to_replace(MORE_DEPTH repls, - 0, pretext, NULL); - add_text_to_replace(MORE_DEPTH repls, - 0, text, token); - } + /* not a word, one word in the prequeue, + flush the word from the prequeue and pass the + current text to the replacements */ + const char *pretext = repls->text_prequeue; + repls->text_prequeue = NULL; + add_text_to_replace (MORE_DEPTH repls, 0, pretext, NULL); + add_text_to_replace (MORE_DEPTH repls, 0, text, token); } - } - else { - if( repls->token_queue == NULL && - ( is_space_or_nl (text[0])) ) { + + } else { + + if (repls->token_queue == NULL + && is_space_or_nl (text[0]) ) { ppecho_switch (MORE_DEPTH repls, text, token); } else { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, - "%s add_text_to_replace() -> push_text()\n", + fprintf (stderr, + "%s add_text_to_replace () -> push_text()\n", DEPTH); #endif repls->token_queue = @@ -701,9 +692,9 @@ static void add_text_to_replace (WITH_DEPTH struct cb_replacement_state *repls, static void ppecho_replace (WITH_DEPTH const char *text, const char *token) { #ifdef DEBUG_REPLACE - fprintf(stderr, "%sppecho_replace('%s')\n", DEPTH, text); + fprintf (stderr, "%sppecho_replace('%s')\n", DEPTH, text); #endif - add_text_to_replace(MORE_DEPTH replace_repls, 1, text, token); + add_text_to_replace (MORE_DEPTH replace_repls, 1, text, token); } /* pass a text to the copy-replacing stream (called from ppecho() in @@ -713,14 +704,14 @@ static void ppecho_replace (WITH_DEPTH const char *text, const char *token) void cb_ppecho_copy_replace (const char *text, const char *token) { #ifdef DEBUG_REPLACE - fprintf(stderr, "cb_ppecho_copy_replace('%s')\n", text); + fprintf (stderr, "cb_ppecho_copy_replace('%s')\n", text); #endif - add_text_to_replace(INIT_DEPTH copy_repls, 0, text, token); + add_text_to_replace (INIT_DEPTH copy_repls, 0, text, token); } static -struct cb_replacement_state * create_replacements( enum cb_ppecho ppecho ) +struct cb_replacement_state * create_replacements (enum cb_ppecho ppecho) { struct cb_replacement_state * s; @@ -729,8 +720,8 @@ struct cb_replacement_state * create_replacements( enum cb_ppecho ppecho ) s->text_prequeue = NULL; s->token_queue = NULL; s->replace_list = NULL ; - s->current_list = NULL ; - s->ppecho = ppecho; + s->current_list = NULL ; + s->ppecho = ppecho; #ifdef DEBUG_REPLACE if( ppecho == CB_PPECHO_REPLACE ){ @@ -743,7 +734,7 @@ struct cb_replacement_state * create_replacements( enum cb_ppecho ppecho ) return s; } -static void reset_replacements( struct cb_replacement_state * s ) +static void reset_replacements (struct cb_replacement_state * s) { s->text_prequeue = NULL; s->token_queue = NULL; @@ -763,10 +754,10 @@ void init_replace( void ) } static -void reset_replace( void ) +void reset_replace (void) { - reset_replacements( copy_repls ); - reset_replacements( replace_repls ); + reset_replacements (copy_repls); + reset_replacements (replace_repls); } /* Called by pplex.l at EOF of top file */ @@ -797,18 +788,18 @@ void cb_set_copy_replacing_list (struct cb_replace_list *list) copy_repls->current_list = NULL; copy_repls->replace_list = list ; #ifdef DEBUG_REPLACE - fprintf(stderr, "set_copy_replacing_list(\n"); + fprintf (stderr, "set_copy_replacing_list(\n"); for(;list != NULL; list=list->next){ - fprintf(stderr, " repl = {\n"); - fprintf(stderr, " src = %s\n", + fprintf (stderr, " repl = {\n"); + fprintf (stderr, " src = %s\n", string_of_text_list(list->src->text_list)); - fprintf(stderr, " leading = %d\n", + fprintf (stderr, " leading = %d\n", list->src->lead_trail); - fprintf(stderr, " new_text = %s\n", + fprintf (stderr, " new_text = %s\n", string_of_text_list(list->new_text)); - fprintf(stderr, " };\n"); + fprintf (stderr, " };\n"); } - fprintf(stderr, " )\n"); + fprintf (stderr, " )\n"); #endif } @@ -824,7 +815,7 @@ void cb_set_replace_list (struct cb_replace_list *list, const int is_pushpop) { #ifdef DEBUG_REPLACE_TRACE - fprintf(stderr, "set_replace_list(...)\n"); + fprintf (stderr, "set_replace_list(...)\n"); #endif if (!list) { /* REPLACE [LAST] OFF */ diff --git a/cobc/scanner.l b/cobc/scanner.l index 517a9fa3e..e24b65a4b 100644 --- a/cobc/scanner.l +++ b/cobc/scanner.l @@ -373,7 +373,7 @@ AREA_A "#AREA_A"\n cb_source_line++; } -^"#LINE"[ ]?[0-9]+" ".* { +<*>^"#LINE"[ ]?[0-9]+" ".* { /* Line directive */ char *p1; char *p2; diff --git a/cobc/tree.c b/cobc/tree.c index f480bc838..8b55d2268 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -4352,7 +4352,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) { @@ -4362,6 +4363,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 a022ece29..118db958b 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1009,6 +1009,9 @@ struct cb_field { unsigned int flag_internal_register : 1; /* Is an internally generated register */ + 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_sql_binary : 1; /* Store field as BINARY */ unsigned int flag_sql_char : 1; /* Store field as CHAR */ unsigned int flag_sql_varchar : 1; /* Store field as VARCHAR */ @@ -2670,6 +2673,13 @@ extern struct cb_field *chk_field_variable_size (struct cb_field *f); extern unsigned int chk_field_variable_address (struct cb_field *fld); extern struct cb_field *cb_code_field (cb_tree x); 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 05e97d3f1..6177424f4 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -9175,8 +9175,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; @@ -9187,7 +9187,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 { @@ -9197,7 +9197,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 { @@ -9207,7 +9207,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 { @@ -9217,7 +9217,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; } @@ -9279,10 +9279,7 @@ 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 */ - cobc_abort ("should be not be a field", 1); - } - if ((CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value))) { + 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)); @@ -9294,6 +9291,18 @@ 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 = cb_field_founder (f); + if (f->redefines) { + f = f->redefines; + } + if (!f->flag_external + && !f->flag_item_based) { + 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)); @@ -9308,15 +9317,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; } } } @@ -9528,6 +9540,12 @@ cb_emit_delete_file (cb_tree file) if (file == cb_error_node) { return; } + /* Note: we should uncomment the following statement to have errors in DELETE FILE + run DECLARATIVES handlers. The problem is that such a change would probably break + existing programs. + + current_statement->file = file; + */ if (CB_FILE (file)->organization == COB_ORG_SORT) { cb_error_x (CB_TREE (current_statement), _("%s not allowed on %s files"), "DELETE FILE", "SORT"); diff --git a/doc/ChangeLog b/doc/ChangeLog index 17f504bf2..dfa343e00 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -3,10 +3,15 @@ * cbrunt.tex.gen: fix for missing "@end verbatim" +2023-07-10 Simon Sobisch + + * gnucobol.texi: updated "Build target" (change of -P / -E), + updated "Debug switches" (changed -g and new memory-check) + 2023-05-24 Simon Sobisch * gnucobol.texi: document warning and optimization options - related to unreachable code; add node on core dumps + related to unreachable code; add note on core dumps 2023-01-31 Fabrice Le Fessant diff --git a/doc/gnucobol.texi b/doc/gnucobol.texi index ee5350214..b4a5bcfd7 100644 --- a/doc/gnucobol.texi +++ b/doc/gnucobol.texi @@ -353,6 +353,9 @@ The special input name @file{-} takes input from @file{stdin} which is assumed to be COBOL source, and uses a default output name of @file{a.out} (or @file{a.so/c/o/i}, selected as appropriate) for the build type. +You may also use @file{-} as output name for the listing file or the preprocessor +result, for example with @code{cobc -t - prog.cob} / @code{cobc -P- prog.cob}. + By default, the compiler builds a dynamically loadable module. The following options specify the target type produced by the compiler: @@ -361,12 +364,17 @@ The following options specify the target type produced by the compiler: @item -E Preprocess only: compiler directives are executed, comment lines are removed and @code{COPY} statements are expanded. -The output is saved in file @file{*.i}. +The output is sent to stdout, allowing you to directly use it as input for +another process. You can manually set an output file using @option{-o}. @item -C Translation only. COBOL source files are translated into C files. The output is saved in file @file{*.c}. +@item --save-temps +Normal compilation with additional storing the preprocessed files as @file{*.i} +and the translated C files as file @file{*.c}. + @item -S Compile only. Translated C files are compiled by the C compiler to assembler code. The output is saved in file @file{*.s}. @@ -878,13 +886,17 @@ Produce C debugging information in the output. @item --debug, -d Enable all run-time error checks. +@item -fmemory-check=scope +Enable checking of internal storage during CALL (implied by @option{--debug}. + @item -fec=exception-name, -fno=ec=exception-name Enable/disable specified exception checks, -@pxref{Appendix F, Exception Names, Exception Names}. +@pxref{Appendix F, Exception Names, Exception Names}; +@option{--debug} implies @option{-fec=ALL}. @item -fsource-location -Generate source location code (implied by @option{--debug}, @option{-g} and -@option{-fec}); @option{--debug} implies @option{-fec=ALL}. +Generate source location code (implied by @option{--debug}, @option{-fdump} and +@option{-fec}). @item -fstack-check Enable @code{PERFORM} stack checking (implied by @option{--debug} or @option{-g}). @@ -1674,7 +1686,7 @@ In addition, setting the option @code{binary-size} to @code{2-4-8} or The compiler option @option{--debug} can be used, especially during the development of your programs. It enables all run-time error checking, such as -subscript boundary checks and numeric data checks, and displays +subscript boundary checks and numeric data checks, and leads to display of run-time errors with source locations. Exceptions may also be enabled/disabled separately. @xref{Debug switches, Debug switches,,,}. diff --git a/libcob/ChangeLog b/libcob/ChangeLog index fb870cd9c..c35960955 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -68,6 +68,13 @@ * fisam.c: Updated to set index field type for 'short' & 'int' Enabled support for variable length records is using V-ISAM/D-ISAM +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 @@ -77,6 +84,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 440173678..83719059f 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -351,17 +351,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) @@ -4506,6 +4512,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\xFB\xFA\xFF", 8) + || memcmp (fence_post, "\xFA\xFB\xFC\xFD\xFE\xFF\xFA", 8)) { + /* 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) { @@ -4657,22 +4688,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 (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 06b4482f5..993d61b28 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -2121,6 +2121,8 @@ COB_EXPIMP void cob_check_ref_mod (const char *, const int, const int, COB_EXPIMP void cob_check_ref_mod_minimal (const char *, const int, const int); 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/ChangeLog b/tests/ChangeLog index 190b55288..b87627f6c 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -6,6 +6,16 @@ under MSVC Release, by forcing a flush of stdout with fflush and using cob_free instead of free in C codes +2023-07-10 Simon Sobisch + + * atlocal_win: updated to current atlocal.in + * atlocal.in: include valgrind (memcheck, sgcheck) testing, enabled + by specifying VGSUFFIX in the environment + * atlocal_valgrind: deleted + * Makefile.am (dist): distributing valgrind.supp (for use in the testsuite) + * Makefile.am (clean): clean folders created while running the testsuite + though various tools + 2023-07-04 Fabrice Le Fessant * atlocal.in: add variables LISTING_FLAGS, COMPILE_LISTING and @@ -16,7 +26,7 @@ * atlocal.in: to allow running some test parts thousands of time for performance checks without burning energy on every build, add define - "CHECK-PERF" of one of PERFSUFFIX or CGSUFFIX are set, + "CHECK-PERF" if one of PERFSUFFIX or CGSUFFIX are set, or if --enable-debug was specified during configure * testsuite.src: adjusted several tests to use that option @@ -849,7 +859,7 @@ * testsuite.src/*.at: Added check for cobc's exit code and stderr where missing -2014-14-04 Philipp Böhme +2014-14-04 Philipp Böhme * testsuite.src/run_extensions.at: Added tests for getopt. diff --git a/tests/Makefile.am b/tests/Makefile.am index bf593b273..e0bf65972 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -1,7 +1,7 @@ # # Makefile gnucobol/tests # -# Copyright (C) 2003-2012, 2014-2020, 2022 Free Software Foundation, Inc. +# Copyright (C) 2003-2012, 2014-2020, 2022-2023 Free Software Foundation, Inc. # Written by Keisuke Nishida, Roger While, Simon Sobisch # # This file is part of GnuCOBOL. @@ -70,6 +70,7 @@ testsuite_manual_sources = \ EXTRA_DIST = $(srcdir)/package.m4 \ $(srcdir)/testsuite.at $(srcdir)/testsuite_manual.at \ + $(srcdir)/valgrind.supp \ $(testsuite_sources) $(testsuite_manual_sources) DISTCLEANFILES = atconfig @@ -98,7 +99,7 @@ prereq-manual: $(TESTSUITE_MANUAL) atlocal run_prog_manual.sh @rm -rf testsuite_manual.dir clean-local: - rm -rf *.dir *.log *.out valgrind + rm -rf *.dir *.log *.out valgrind callgrind perf checkmanual: prereq-manual @$(TESTSUITE_MANUAL) $(TESTSUITEFLAGS) || (rm -f testsuite_manual.dir/at-job-fifo; exit 1) diff --git a/tests/atlocal.in b/tests/atlocal.in index 0ba615cf7..94a0c2dc6 100644 --- a/tests/atlocal.in +++ b/tests/atlocal.in @@ -65,14 +65,16 @@ unset LANG # define for performance checks (running code several thousand times) if test "x$PERFSUFFIX" != "x" -o "x$CGSUFFIX" != "x" -o "@COB_ENABLE_DEBUG@" == yes; then - COBOL_FLAGS="-DCHECK-PERF ${COBOL_FLAGS}" + if test "x$VGSUFFIX" = "x"; then + COBOL_FLAGS="-DCHECK-PERF ${COBOL_FLAGS}" + fi fi FLAGS="-debug -Wall ${COBOL_FLAGS} -fdiagnostics-plain-output" # workaround to adjust the testsuite later: FLAGS="${FLAGS} -fno-diagnostics-show-option" -COBC="${COBC} -std=default -fdiagnostics-plain-output" +COBC="${COBC} -std=default" COMPILE="${COBC} -x ${FLAGS}" COMPILE_ONLY="${COBC} -fsyntax-only ${FLAGS} -Wno-unsupported" COMPILE_MODULE="${COBC} -m ${FLAGS}" @@ -81,21 +83,21 @@ COMPILE_LISTING="${COMPILE_ONLY} ${LISTING_FLAGS}" COMPILE_LISTING0="${COMPILE_LISTING} -tlines=0" # get performance counters for compiler and/or runtime -if test "x$PERFSUFFIX" != "x"; then +if test "x${PERFSUFFIX}" != "x"; then export PATH="@abs_top_builddir@/cobc/.libs:@abs_top_builddir@/bin.libs:${PATH}" LOG_DIR="@abs_builddir@/perf" LOG_DIR_COMP="${LOG_DIR}/cobc" LOG_DIR_RUN="${LOG_DIR}/cobcrun" PERF="perf stat -e instructions --append" + # most reasonable: check actual COBOL runtime performance (only) + COBC="${COBC} -g" #mkdir -p "${LOG_DIR_COMP}" # COBC="${PERF} --output ${LOG_DIR_COMP}/${PERFSUFFIX}.log ${COBC} -O0" # note: full check including C compiler! # COMPILE_ONLY="${PERF} --output ${LOG_DIR_COMP}/${PERFSUFFIX}.log ${COMPILE_ONLY}" # more reasonable - checks cobc only, but misses codegen - # most reasonable: check actual COBOL runtime performance - COBC="${COBC} -g" mkdir -p "${LOG_DIR_RUN}" COBCRUN="${PERF} --output ${LOG_DIR_RUN}/${PERFSUFFIX}.log ${COBCRUN}" COBCRUN_DIRECT="${PERF} --output ${LOG_DIR_RUN}/${PERFSUFFIX}.log ${COBCRUN_DIRECT}" -elif test "x$CGSUFFIX" != "x"; then +elif test "x${CGSUFFIX}" != "x"; then export PATH="@abs_top_builddir@/cobc/.libs:@abs_top_builddir@/bin.libs:${PATH}" LOG_DIR="@abs_builddir@/callgrind/${CGSUFFIX}" LOG_DIR_COMP="${LOG_DIR}/cobc" @@ -110,13 +112,65 @@ elif test "x$CGSUFFIX" != "x"; then CG_NAME=callgrind.out.${CG_PREFIX} # callgrind takes a while - so we only trace COBOL runtime by default + COBC="${COBC} -g" #mkdir -p "${LOG_DIR_COMP}" #COBC="${CG} --log-file=${LOG_DIR_COMP}/${LOG_NAME} --callgrind-out-file=${LOG_DIR_COMP}/${CG_NAME} ${COBC}" - COBC="${COBC} -g" mkdir -p "${LOG_DIR_RUN}" CG_RUNTIME="${CG} --log-file=${LOG_DIR_RUN}/${LOG_NAME} --callgrind-out-file=${LOG_DIR_RUN}/${CG_NAME} --dump-before=cob_terminate_routines" COBCRUN="${CG_RUNTIME} ${COBCRUN}" COBCRUN_DIRECT="${CG_RUNTIME} ${COBCRUN_DIRECT}" + +elif test "x${VGSUFFIX}" != "x"; then + + # To check with valgrind: + # * ideally: reconfigure with `./configure --enable-debug & make` + # * if your system ships with valgrind suppression files (default.supp is always active) you likely + # want to activate at least the suppressions below (adjusted to your directory); + # some additional common suppressions (bash + BDB) are found in valgrind.supp and added by default + # * if you stumble over (other) system library errors you likely want to suppress some of them + # --> re-run single tests with --gen-suppressions=yes # when it seems to be stuck press [Y]+[RETURN]... + # --> inspect and modify the suppression file + # --> add to $VG_SUPPR below (in "local" tests/atlocal) + # * choose below (in "local" tests/atlocal) the valgrind tool you want to use and + # choose if to run valgrind only for the compiler, runtime, or both + # * then run with `make check[all] VGSUFFIX (logs will be saved in valgrind/$VGSUFFIX + + export PATH="${abs_top_builddir}/cobc/.libs:${abs_top_builddir}/bin.libs:${PATH}" + LOG_DIR="${abs_builddir}/valgrind/${VGSUFFIX}" + LOG_DIR_COMP="${LOG_DIR}/cobc" + LOG_DIR_RUN="${LOG_DIR}" + + if test "x$at_group" = "x"; then + at_group="valgrind" # must be set as it is part of VG_PREFIX + fi + export at_group + VG_PREFIX="%q{at_group}_%p" + LOG_NAME=${VG_PREFIX}.log + + # if you stumble over system library errors you may want to suppress some of them + # re-run with --gen-suppressions=yes and then point to the file (after inspecting and + # modifying it via --suppressions=${abs_builddir}/local.supp) + #VG_SUPPR_DIR="/usr/lib/valgrind" + #VG_SUPPR="--suppressions=${VG_SUPPR_DIR}/debian.supp ${VG_SUPPR}" + #VG_SUPPR="--suppressions=${VG_SUPPR_DIR}/ncurses.supp ${VG_SUPPR}" + VG_SUPPR="--suppressions=${abs_srcdir}/valgrind.supp ${VG_SUPPR}" + # Note: other issue, not suppressible is that some COBOL storage is local + # and can currently not be freed on STOP RUN (or abort). + # It applies to the following elements in the local include files (prog.l*.h) + # and dynamically allocated LOCAL-STORAGE (cob_loc_ptr), temporary decimals, + # frame_stack, cob_procedure_params. + + MEMCHECK="valgrind --tool=memcheck --read-var-info=yes --track-origins=yes --leak-check=full --show-leak-kinds=all ${VG_SUPPR}" + SGCHECK="valgrind --tool=exp-sgcheck --read-var-info=yes ${VG_SUPPR}" + + #COBC="${COBC} -g" + mkdir -p "${LOG_DIR_COMP}" + COBC="${MEMCHECK} --log-file=${LOG_DIR_COMP}/${LOG_NAME} ${COBC}" + + mkdir -p "${LOG_DIR_RUN}" + VG_RUNTIME="${MEMCHECK} --log-file=${LOG_DIR_RUN}/${LOG_NAME}" + COBCRUN="${VG_RUNTIME} ${COBCRUN}" + COBCRUN_DIRECT="${VG_RUNTIME} ${COBCRUN_DIRECT}" fi # Helper script to unify listings (replace version, date, time) diff --git a/tests/atlocal_valgrind b/tests/atlocal_valgrind deleted file mode 100644 index 3a357fddd..000000000 --- a/tests/atlocal_valgrind +++ /dev/null @@ -1,297 +0,0 @@ -# -# atlocal_valgrind gnucobol/tests -# -# This script is a special variant of the atlocal script for testing -# with Valgrind. -# -# Copyright (C) 2003-2012, 2014-2023 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -TEMPLATE="${abs_srcdir}/testsuite.src" - -COBC="cobc@COB_EXE_EXT@" -COBCRUN="cobcrun@COB_EXE_EXT@" -COBCRUN_DIRECT="" # used for running created executables through tools - -LOCAL_ENV="${abs_top_builddir}/pre-inst-env" - -# prepend PATH with the actual binaries to let the testsuite find them for -# general check and version output, otherwise not needed -#PATH="${abs_top_builddir}/libcob/.libs:${PATH}" -PATH="${abs_top_builddir}:${abs_top_builddir}/cobc:${abs_top_builddir}/bin:${PATH}" -export PATH -ABS_COBC="${abs_top_builddir}/cobc/cobc@COB_EXE_EXT@" -ABS_COBCRUN="${abs_top_builddir}/bin/cobcrun@COB_EXE_EXT@" - -# -- BEGIN OF VALGRIND SPECIFIC PARTS --- - -# -# To check with valgrind: -# * ideally: reconfigure with `./configure --enable-debug & make` -# * temporarily rename atlocal.in to atlocal.bak and atlocal_valgrind to atlocal.in, -# then go to top_builddir and `config.status tests/atlocal`; -# - or as a longer altarnative: diff these parts into your atlocal -# * set switches you need to the following lines and set the tool accordingly (template has MEMCHECK) -# * if your system ships with valgrind suppression files (default.supp is always active) you likely -# want to activate at least the suppressions below (adjusted to your directory); -# some additional common suppressions (bash + BDB) are found in valgrind.supp and added by default -# * if you stumble over (other) system library errors you likely want to suppress some of them -# --> re-run single tests with --gen-suppressions=yes # when it seems to be stuck press [Y]+[RETURN]... -# --> inspect and modify the suppression file -# --> add to $VG_SUPPR below - -#VG_SUPPR_DIR="/usr/lib/valgrind" -#VG_SUPPR="--suppressions=$VG_SUPPR_DIR/debian.supp --suppressions=$VG_SUPPR_DIR/ncurses.supp" -VG_SUPPR="--suppressions=${abs_srcdir}/valgrind.supp $VG_SUPPR" - -# Note: other issue, not suppressible is that some COBOL storage is local -# and can currently not be freed on STOP RUN (or abort). -# It applies to the following elements in the local include files (prog.l*.h) -# and dynamically allocated LOCAL-STORAGE (cob_loc_ptr), temporary decimals, -# frame_stack, cob_procedure_params. - -# Variable part in valgrind log file name via %q (must contain something!) -# Note: at_group contains the testsuite number in automake generated testsuites -# and is (to be) also set when this file is used in other tests for more -# useful log file name -if test "x$at_group" = "x"; then - at_group="valgrind" # default: use "valgrind" -fi -export at_group # export needed as valgrind resolves that variable later - -VG_LOG_DIR="${abs_builddir}/valgrind" -mkdir -p "${VG_LOG_DIR}" -VG_LOG_PREFIX="${VG_LOG_DIR}/%q{at_group}_%p" - -VG_COBC_LOG="$VG_LOG_PREFIX-cobc.log" -VG_COBCRUN_LOG="$VG_LOG_PREFIX-cobcrun.log" -VG_COBCRUN_DIRECT_LOG="$VG_LOG_PREFIX-cobcrun_direct.log" - -# if you stumble over system library errors you may want to suppress some of them -# re-run with --gen-suppressions=yes and then point to the file (after inspecting and -# modifying it via --suppressions=${abs_builddir}/local.supp) -MEMCHECK="valgrind --tool=memcheck --read-var-info=yes --track-origins=yes --leak-check=full --show-leak-kinds=all $VG_SUPPR" -SGCHECK="valgrind --tool=exp-sgcheck --read-var-info=yes $VG_SUPPR" - -#LT_EXEC="${abs_top_builddir}/libtool --mode=execute" -#COBC="${LT_EXEC} $MEMCHECK --log-file=$VG_COBC_LOG ${COBC}" -#COBCRUN="${LT_EXEC} $MEMCHECK --log-file=$VG_COBCRUN_LOG ${COBCRUN}" - -export PATH="${abs_top_builddir}/cobc/.libs:${abs_top_builddir}/bin.libs:${PATH}" -COBC="$MEMCHECK --log-file=$VG_COBC_LOG ${COBC}" -COBCRUN="$MEMCHECK --log-file=$VG_COBCRUN_LOG ${COBCRUN}" -COBCRUN_DIRECT="$MEMCHECK --log-file=$VG_COBCRUN_DIRECT_LOG ${COBCRUN_DIRECT}" - -# -- END OF VALGRIND SPECIFIC PARTS --- - -AWK=@AWK@ -GREP=@GREP@ -SED=@SED@ -export AWK GREP SED - -# be sure to use the English messages -LC_ALL=C -export LC_ALL -unset LANG - -# workaround to adjust the testsuite later: -# FLAGS="-debug -Wall ${COBOL_FLAGS}" -FLAGS="-debug -Wall ${COBOL_FLAGS} -fno-diagnostics-show-option" -COBC="${COBC} -std=default" -COMPILE="${COBC} -x ${FLAGS}" -COMPILE_ONLY="${COBC} -fsyntax-only ${FLAGS} -Wno-unsupported" -COMPILE_MODULE="${COBC} -m ${FLAGS}" - -# test runner for manual tests, content may be adjusted by the user -RUN_PROG_MANUAL="${abs_builddir}/run_prog_manual.sh" - -# unset option if not internally set in this script - or external -_unset_option () { - if test "$1" != "COB_CONFIG_DIR" \ - -a "$1" != "COB_COPY_DIR" \ - -a "$1" != "COB_RUNTIME_CONFIG" \ - -a "$1" != "COB_LIBRARY_PATH" \ - -a "$1" != "COB_CFLAGS" \ - -a "$1" != "COB_LDFLAGS" \ - -a "$1" != "COB_LIBS" \ - -a "$1" != "COB_UNIX_LF" \ - -a "$1" != "OS"; then - unset $1 - fi -} - -# possible path conversion for running the testsuite in an environment -# that doesn't match the one where the tested binaries were built -# Note: not needed for running the testsuite with MSYS as this translates the path -# if MSYS_NO_PATHCONV=1 is not set -_return_path () { - echo "$1" -} - -# Note: we explicit do not set COB_ON_CYGWIN here, -# as this is file is about running non-cygwin binaries - -# Note: we explicit do not handle PATHSEP here, -# as this is file is about running non-windows binaries -PATHSEP='@PATH_SEPARATOR@' - -# entries likely referenced in the LIBS entries below -prefix="@prefix@" -exec_prefix="@exec_prefix@" - -# options that are also used in pre-inst-env (always add to both) -# but not directly in the testsuite -COB_CFLAGS="-I${abs_top_srcdir} @COB_CFLAGS@" -COB_LDFLAGS="-L\"${abs_top_builddir}/libcob/.libs\" @COB_LDFLAGS@" -COB_LIBS="-L${abs_top_builddir}/libcob/.libs @COB_LIBS@" -COB_CONFIG_DIR="${abs_top_srcdir}/config" -COB_COPY_DIR="${abs_top_srcdir}/copy" -LD_LIBRARY_PATH="${abs_top_builddir}/libcob/.libs:$LD_LIBRARY_PATH" -DYLD_LIBRARY_PATH="${abs_top_builddir}/libcob/.libs:$DYLD_LIBRARY_PATH" -SHLIB_PATH="${abs_top_builddir}/libcob/.libs:$SHLIB_PATH" -LIBPATH="${abs_top_builddir}/libcob/.libs:$LIBPATH" -COB_LIBRARY_PATH="${abs_top_builddir}/extras" - -export COB_CFLAGS COB_LIBS -export COB_CONFIG_DIR COB_COPY_DIR -export LD_LIBRARY_PATH DYLD_LIBRARY_PATH SHLIB_PATH LIBPATH -export COB_LIBRARY_PATH -COB_UNIX_LF=1 -export COB_UNIX_LF - -# unset all environment variables that are used in libcob -# for runtime configuration ... -COB_RUNTIME_CONFIG="${abs_top_srcdir}/config/runtime_empty.cfg" -export COB_RUNTIME_CONFIG -for cobenv in $(${LOCAL_ENV} ${ABS_COBCRUN} --runtime-conf \ - | grep " env:" | cut -d: -f2 | cut -d= -f1 \ - | grep -v "PATH" | grep -v "TERM"); \ - do _unset_option $cobenv; \ -done - -# prevent multiple calls by caching the output -${LOCAL_ENV} ${ABS_COBC} --verbose --info > info.out - -# ... and also unset for the compiler -if test "$GNUCOBOL_TEST_LOCAL" != "1"; then - for cobenv in $(grep "env:" info.out | cut -d: -f2 | cut -d= -f1 \ - | grep -v "PATH"); \ - do _unset_option $cobenv; \ - done -fi - -COB_STACKTRACE=0 -export COB_STACKTRACE - - -# different flags checked in the testsuite -if test "$GNUCOBOL_TEST_LOCAL" != "1"; then - COB_OBJECT_EXT="@COB_OBJECT_EXT@" - COB_EXE_EXT="@COB_EXE_EXT@" - COB_MODULE_EXT="@COB_MODULE_EXT@" - COB_BIGENDIAN="@COB_BIGENDIAN@" - COB_HAS_64_BIT_POINTER="@COB_HAS_64_BIT_POINTER@" - COB_HAS_ISAM="@COB_HAS_ISAM@" - COB_HAS_XML2="@COB_HAS_XML2@" - COB_HAS_JSON="@COB_HAS_JSON@" - COB_HAS_CURSES="@COB_HAS_CURSES@" -else - - COB_OBJECT_EXT="$(grep COB_OBJECT_EXT info.out | cut -d: -f2 | cut -b2-)" - COB_EXE_EXT="$(grep COB_EXE_EXT info.out | cut -d: -f2 | cut -b2-)" - COB_MODULE_EXT="$(grep COB_MODULE_EXT info.out | cut -d: -f2 | cut -b2-)" - - if test $(grep -i -c "little-endian" info.out) = 0; then - COB_BIGENDIAN="yes" - else - COB_BIGENDIAN="no" - fi - COB_HAS_64_BIT_POINTER=$(grep "64bit-mode" info.out | cut -d: -f2 | cut -b2-) - - cob_indexed=$(grep -i "indexed file" info.out | cut -d: -f2) - if test "x$cob_indexed" = "x"; then - cob_indexed=$(grep ISAM info.out | cut -d: -f2) - fi - case "$cob_indexed" in - " disabled") COB_HAS_ISAM="no";; - " BDB") COB_HAS_ISAM="db";; - " VBISAM"*) COB_HAS_ISAM="vbisam";; - " D-ISAM") COB_HAS_ISAM="disam";; - " C-ISAM") COB_HAS_ISAM="cisam";; - " V-ISAM") COB_HAS_ISAM="visam";; - " EXTFH") COB_HAS_ISAM="index_extfh";; - *) echo "unknown entry for indexed handler: '"$cob_indexed"' please report" && exit 1;; - esac - - if test $(grep -i -c "XML library.*disabled" info.out) = 0; then - COB_HAS_XML2="yes" - else - COB_HAS_XML2="no" - fi - if test $(grep -i -c "JSON library.*disabled" info.out) = 0; then - COB_HAS_JSON="yes" - else - COB_HAS_JSON="no" - fi - # see note below - if test $(grep -i -c " screen .*disabled" info.out) = 0; then - COB_HAS_CURSES="yes" - else - COB_HAS_CURSES="no" - fi -fi - -if test "x$MSYSTEM" != "x" -o "$OSTYPE" = "cygwin"; then - # running MSYS builds as not-visible child processes result in - # "Redirection is not supported" (at least with PDCurses "wincon" port) - # --> disabling the tests for this feature - # ncurses is known to work as long as TERM is appropriate - if test $(grep -i -c "ncurses" info.out) != 0; then - if test "x$MSYSTEM" != "x"; then - TERM="" - else - TERM="xterm" - fi - export TERM - # no change here... COB_HAS_CURSES="yes" - else - # manual tests are executed in separate window - # and are visible - so no need to handle it there - echo "$at_help_all" | grep -q "run_manual_screen" 2>/dev/null - if test $? -ne 0; then - COB_HAS_CURSES="no" - fi - fi -fi - -rm -rf info.out - -# NIST tests (tests/cobol85) are executed in a separate perl process with a new environment --> export needed -export COB_HAS_ISAM COB_HAS_XML2 COB_HAS_JSON COB_HAS_CURSES COB_HAS_64_BIT_POINTER -export COBC COBCRUN COBCRUN_DIRECT RUN_PROG_MANUAL -export COB_OBJECT_EXT COB_EXE_EXT COB_MODULE_EXT - -# to ensure that no external COB_SCHEMA_DIR is polluted: set to local -COB_SCHEMA_DIR="." && export COB_SCHEMA_DIR - -# to ensure that no external DB_HOME is polluted: unset -DB_HOME="" && export DB_HOME - -# For the very rare cases where cobc/libcob may need to know if they're running in test mode: -COB_IS_RUNNING_IN_TESTMODE=1 && export COB_IS_RUNNING_IN_TESTMODE diff --git a/tests/atlocal_win b/tests/atlocal_win index ff30656b1..25f0a3180 100644 --- a/tests/atlocal_win +++ b/tests/atlocal_win @@ -47,11 +47,15 @@ LC_ALL=C export LC_ALL unset LANG +# define for performance checks (running code several thousand times) +# comment manually if not needed +COBOL_FLAGS="-DCHECK-PERF ${COBOL_FLAGS}" + FLAGS="-debug -Wall ${COBOL_FLAGS} -fdiagnostics-plain-output" # workaround to adjust the testsuite later: FLAGS="${FLAGS} -fno-diagnostics-show-option" -COBC="${COBC} -std=default -fdiagnostics-plain-output" +COBC="${COBC} -std=default" COMPILE="${COBC} -x ${FLAGS}" COMPILE_ONLY="${COBC} -fsyntax-only ${FLAGS} -Wno-unsupported" COMPILE_MODULE="${COBC} -m ${FLAGS}" diff --git a/tests/testsuite.src/listings.at b/tests/testsuite.src/listings.at index 0faf9e6f3..db0c1a373 100644 --- a/tests/testsuite.src/listings.at +++ b/tests/testsuite.src/listings.at @@ -2066,8 +2066,8 @@ AT_CHECK([$COBC $LISTING_FLAGS -q -fsyntax-only -t- -fno-theader -ftcmd prog.cob 000011 END FUNCTION WITHPAR. @&t@ command line: - cobc -std=default -fdiagnostics-plain-output -fttitle=GnuCOBOL_V.R.P -+ -fno-ttimestamp -q -fsyntax-only -t- -fno-theader -ftcmd prog.cob + cobc -std=default -fttitle=GnuCOBOL_V.R.P -fno-ttimestamp -q -fsyntax-only ++ -t- -fno-theader -ftcmd prog.cob 0 warnings in compilation group 0 errors in compilation group ]) @@ -2091,8 +2091,8 @@ LINE PG/LN A...B............................................................ GnuCOBOL V.R.P prog.cob Page 0002 command line: - cobc -std=default -fdiagnostics-plain-output -fttitle=GnuCOBOL_V.R.P -+ -fno-ttimestamp -q -std=default -Wall -fno-tmessages -fsyntax-only -t- -fno-t + cobc -std=default -fttitle=GnuCOBOL_V.R.P -fno-ttimestamp -q -std=default ++ -Wall -fno-tmessages -fsyntax-only -t- -fno-tsymbols -ftcmd prog.cob ]) AT_CLEANUP diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index fc953f58d..1dd6814a5 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -27812,3 +27812,134 @@ ERROR ON FILE-EXT EXITING NESTED-PROGRAM-1-2 ], []) AT_CLEANUP + +AT_SETUP([OPEN / CLOSE with multiple filenames]) +AT_KEYWORDS([DECLARATIVES file error]) + +AT_DATA([prog1.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. DOUBLE-OPEN. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE1 ASSIGN TO "./file1.txt" + FILE STATUS STAT-FILE1. + SELECT FILE2 ASSIGN TO "./file2.txt" + FILE STATUS STAT-FILE2. + DATA DIVISION. + FILE SECTION. + FD FILE1. + 01 FS-FILE1 PIC X(10). + FD FILE2. + 01 FS-FILE2 PIC X(10). + WORKING-STORAGE SECTION. + 01 STAT-FILE1 PIC XX. + 01 STAT-FILE2 PIC XX. + PROCEDURE DIVISION. + DECLARATIVES. + F-FILE1 SECTION. USE AFTER ERROR PROCEDURE ON FILE1. + DEB-FILE1. + DISPLAY "ERROR ON FILE1". + DISPLAY " STAT-FILE1: " STAT-FILE1. + DISPLAY " STAT-FILE2: " STAT-FILE2. + F-FILE2 SECTION. USE AFTER ERROR PROCEDURE ON FILE2. + DEB-FILE2. + DISPLAY "ERROR ON FILE2". + DISPLAY " STAT-FILE1: " STAT-FILE1. + DISPLAY " STAT-FILE2: " STAT-FILE2. + END DECLARATIVES. + PROGRAMME SECTION. + MAIN. + OPEN INPUT FILE1 + OPEN INPUT FILE2. + DISPLAY "READ FILE1". + READ FILE1. + DISPLAY "READ FILE2". + READ FILE2. + DISPLAY "CLOSE FILES". + CLOSE FILE1. + CLOSE FILE2. + DISPLAY "DELETE FILES". + DELETE FILE FILE1. + DELETE FILE FILE2. + STOP RUN. +]) +AT_DATA([prog2.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. DOUBLE-OPEN. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE1 ASSIGN TO "./file1.txt" + FILE STATUS STAT-FILE1. + SELECT FILE2 ASSIGN TO "./file2.txt" + FILE STATUS STAT-FILE2. + DATA DIVISION. + FILE SECTION. + FD FILE1. + 01 FS-FILE1 PIC X(10). + FD FILE2. + 01 FS-FILE2 PIC X(10). + WORKING-STORAGE SECTION. + 01 STAT-FILE1 PIC XX. + 01 STAT-FILE2 PIC XX. + PROCEDURE DIVISION. + DECLARATIVES. + F-FILE1 SECTION. USE AFTER ERROR PROCEDURE ON FILE1. + DEB-FILE1. + DISPLAY "ERROR ON FILE1". + DISPLAY " STAT-FILE1: " STAT-FILE1. + DISPLAY " STAT-FILE2: " STAT-FILE2. + F-FILE2 SECTION. USE AFTER ERROR PROCEDURE ON FILE2. + DEB-FILE2. + DISPLAY "ERROR ON FILE2". + DISPLAY " STAT-FILE1: " STAT-FILE1. + DISPLAY " STAT-FILE2: " STAT-FILE2. + END DECLARATIVES. + PROGRAMME SECTION. + MAIN. + OPEN INPUT FILE1 + FILE2. + DISPLAY "READ FILE1". + READ FILE1. + DISPLAY "READ FILE2". + READ FILE2. + DISPLAY "CLOSE FILES". + CLOSE FILE1 + FILE2. + DISPLAY "DELETE FILES". + DELETE FILE FILE1 + FILE2. + STOP RUN. +]) + +AT_DATA([expected.txt], +[ERROR ON FILE2 + STAT-FILE1: 00 + STAT-FILE2: 35 +READ FILE1 +ERROR ON FILE1 + STAT-FILE1: 10 + STAT-FILE2: 35 +READ FILE2 +ERROR ON FILE2 + STAT-FILE1: 10 + STAT-FILE2: 47 +CLOSE FILES +ERROR ON FILE2 + STAT-FILE1: 00 + STAT-FILE2: 42 +DELETE FILES +]) + +AT_CHECK([$COMPILE prog1.cob]) +AT_DATA([file1.txt], []) +AT_CHECK([$COBCRUN_DIRECT ./prog1 > prog1.txt]) +AT_CHECK([diff expected.txt prog1.txt]) + +AT_CHECK([$COMPILE prog2.cob]) +AT_DATA([file1.txt], []) +AT_CHECK([$COBCRUN_DIRECT ./prog2 > prog2.txt]) +AT_CHECK([diff expected.txt prog2.txt]) + +AT_CLEANUP diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 4eb28a12a..303cd5c0b 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -14118,6 +14118,7 @@ ANY NUMERIC is 4510.66CR Length 0000000011 AT_CLEANUP + AT_SETUP([Test COBOL-C interface (2)]) AT_KEYWORDS([CALL]) @@ -18009,18 +18010,18 @@ AT_DATA([prog.cob], [ IF T16-PRGM(VAR) = T15-PRGM(VAR2) DISPLAY 'WRONG RESULT OCCURS'. - + IF MYTAB(VAR:VAR2) = MYTAB(VAR2:VAR) DISPLAY 'WRONG RESULT REFMOD'. - - INITIALIZE mytab - GOBACK. + INITIALIZE mytab + + 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], [ @@ -18047,7 +18048,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], [], []) @@ -18081,7 +18082,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], [], []) @@ -18093,6 +18094,201 @@ AT_CHECK([$COBCRUN_DIRECT ./prog3b], [1], [], AT_CLEANUP +AT_SETUP([runtime check: write to internal storage (1)]) +AT_KEYWORDS([runmisc CALL bounds exceptions]) + +# 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. + 01 vars. + 03 filler PIC X. + 03 vars-field PIC X. + + 01 varg GLOBAL. + 03 filler PIC X. + 03 varg-field PIC X. + 01 vare EXTERNAL. + 03 filler PIC X. + 03 vare-field PIC X. + 01 varb BASED. + 03 filler PIC X. + 03 varb-field PIC X. + LINKAGE SECTION. + 01 varl PIC X. + 01 varls. + 03 filler PIC X. + 03 varls-field PIC X. + + PROCEDURE DIVISION. + * + CALL "callee" USING var + * without the check this second call would SIGSEGV + CALL "callee" USING var + + * the following are mostly in to co-test the codegen + CALL "callee" USING vars + CALL "callee" USING varg + CALL "callee" USING vare + CALL "callee" USING varb + CALL "callee" USING varl + CALL "callee" USING varls + CALL "callee" USING vars-field + CALL "callee" USING varg-field + CALL "callee" USING vare-field + CALL "callee" USING varb-field + CALL "callee" USING varls-field + + GOBACK. +]) + +AT_DATA([callee.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. callee. + + DATA DIVISION. + LINKAGE SECTION. + + 77 var PIC X. + 01 lrec. + 03 lvar PIC X(32). + 03 lvar2 PIC X(32). + + PROCEDURE DIVISION USING var. + * + SET ADDRESS OF lrec TO ADDRESS OF var + SET ADDRESS OF lrec DOWN BY 32 + 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:30: 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:30: 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:30: 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:30: error: memory violation detected for 'var' after CALL +]) + +AT_CLEANUP + + +AT_SETUP([runtime check: write to internal storage (2)]) +AT_KEYWORDS([runmisc CALL bounds exceptions]) + +# 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 DUMMY-STORAGE PIC X(128). + + PROCEDURE DIVISION. + * using the var so cobc cannot easily optimize that out + IF DUMMY-STORAGE (1:1) <> SPACE INITIALIZE DUMMY-STORAGE. + + * We use a simple wrapper to make it _less_ likely that the + * following "real test" SIGSEGVs during MOVE + CALL STATIC "progt". + + * we don't expect to ever get here - but this creates more + * memory space to decrease the likelyness of a SIGSEGV more + CALL STATIC "dummy". + + GOBACK. + END PROGRAM prog. + + IDENTIFICATION DIVISION. + PROGRAM-ID. progt. + + DATA DIVISION. + WORKING-STORAGE SECTION. + + 77 PNT USAGE POINTER EXTERNAL. + + 01 REC. + 03 VAR PIC X. + 03 VAR2 PIC X. + + LINKAGE SECTION. + 01 LREC. + 03 LVAR PIC X(64). + 03 LVAR2 PIC X(64). + + 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 2 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. + END PROGRAM progt. + + IDENTIFICATION DIVISION. + PROGRAM-ID. dummy. + + DATA DIVISION. + WORKING-STORAGE SECTION. + + 01 DUMMY-STORAGE PIC X(128). + + PROCEDURE DIVISION. + * using the var so cobc cannot easily optimize that out + IF DUMMY-STORAGE (1:1) <> SPACE INITIALIZE DUMMY-STORAGE. + + GOBACK. + END PROGRAM dummy. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) + +# skipping the (nonportable) test - hardened GCC SIGSEGVs on the bad MOVE, +# clang use a different memory layout so we never actually break +# the call-pointers +AT_SKIP_IF([true]) + +AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], +[libcob: prog.cob:52: error: memory violation detected after INIT CALL +]) + +AT_CLEANUP + + AT_SETUP([libcob version check]) AT_KEYWORDS([runmisc]) diff --git a/tests/testsuite.src/syn_misc.at b/tests/testsuite.src/syn_misc.at index 89f269653..513d9ffc7 100644 --- a/tests/testsuite.src/syn_misc.at +++ b/tests/testsuite.src/syn_misc.at @@ -6676,7 +6676,7 @@ AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. STOP RUN. ]) -AT_CHECK([$COBC -x -std=mf -w prog.cob ], [1], [], +AT_CHECK([$COBC -fdiagnostics-plain-output -x -std=mf -w prog.cob ], [1], [], [prog.cob:11: error: TSTGRP3 USAGE COMP-3 incompatible with COM3-FLD1 USAGE COMP prog.cob:15: error: TSTGRP3 USAGE COMP-3 incompatible with COM3-FLD3 USAGE DISPLAY prog.cob:18: error: TSTGRP3 USAGE COMP-3 incompatible with FILLER USAGE COMP-1