mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-22 03:47:02 -05:00
cobol: Expose warnings as command-line options.
Introduce 45 warning options, integrated with dialects. Update documentation with warning options and syntax supported by each dialect. gcc/cobol/ChangeLog: PR cobol/119329 PR cobol/119331 PR cobol/120786 * Make-lang.in: Add cobol/messages.o to cobol1 sources. * cbldiag.h (yywarn): Remove function. (struct cbl_loc_t): Introduce new location type independent of Bison. (enum cbl_diag_id_t): Enumerate diagnostic messages. (cbl_message): New function. (dialect_ok): Test for dialect, emit standard message. (dialect_not_ok): Emit standard message if syntax excluded by dialect. (dialect_error): Remove function. (cbl_unimplementedw): Use cbl_diag_id_t. (cbl_unimplemented): Whitespace. * cdf.y: Update token values. * cobol1.cc (enable_exceptions): Use cbl_message. (cobol_warning): Declare function. (cobol_langhook_handle_option): Add 44 new warning options. (cobol_langhook_type_for_mode): Remove function. * except.cc (cbl_enabled_exception_t::dump): Remove function. * exceptg.h (class exception_turn_t): Use cbl_diag_id_t. * gcobol.1: Document dialect syntax and new warning options. * genapi.cc (parser_label_label): Remove unused warning. * gengen.cc (gg_find_field_in_struct): Use cbl_internal_error. (gg_printf): Same. (gg_fprintf): Same. (gg_define_function): Same. (gg_get_function_decl): Same. (gg_call_expr): Same. (gg_call): Same. * lang-specs.h: Add warning options. * lang.opt: Add ISO dialect and options. * lexio.cc (parse_replacing_term): Use cbl_message. (parse_replacing_pair): Same. (preprocess_filter_add): Same. (cdftext::echo_input): Same. (cdftext::lex_open): Same. (cdftext::open_input): Same. * messages.cc: New file implements cbl_message. * parse.y: Use cbl_message. * parse_ante.h (dialect_proscribed): Remove function. (parser_move_carefully): Use dialect_ok. (goodnight_gracie): Convert warning to debug message. * scan.l: Use dialect_ok. * scan_ante.h (scanner_parsing): Use cbl_diag_id_t. (scanner_parsing_toggle): Same. (scanner_parsing_pop): Same. (verify_ws): Same. (level_of): Same. (typed_name): Same. (integer_of): Same. * scan_post.h (datetime_format_of): Use cbl_internal_error. (prelex): Emit only debug messages. * show_parse.h: Use cbl_internal_error. * symbols.cc (symbols_update): Remove dialect test because parser's problem. (cbl_field_t::internalize): Use cbl_message. * symbols.h (enum cbl_dialect_t): Add ISO to cbl_dialect_t. (cbl_dialect_str): Recognize ISO dialect. (dialect_has): New function. (cbl_diagnostic_kind): New function. (cbl_dialect_kind): New function. (struct cbl_alphabet_t): Emit only debug message. * token_names.h: Regenerate. * util.cc (gb4): Emit only debug message. (current_token_location): Add overload to set token_location. (yywarn): Remove function. (cobol_fileline_set): Use cbl_message. (cobol_parse_files): Same. (cbl_message): New diagnostic message function uses cbl_diag_id_t. (cbl_diagnostic_kind): New function. (cbl_diagnostic_option): New function. (cbl_unimplementedw): Use cbl_diag_id_t. (dialect_error): Remove function. * util.h (cbl_message): Remove obsolete prototype for cbl_message.
This commit is contained in:
James K. Lowden
@@ -71,6 +71,7 @@ cobol1_OBJS = \
|
||||
cobol/genmath.o \
|
||||
cobol/gengen.o \
|
||||
cobol/lexio.o \
|
||||
cobol/messages.o \
|
||||
cobol/parse.o \
|
||||
cobol/scan.o \
|
||||
cobol/structs.o \
|
||||
|
||||
@@ -46,7 +46,6 @@ const char * cobol_filename();
|
||||
* diagnostic framework and use text that can be localized.
|
||||
*/
|
||||
void yyerror( const char fmt[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2);
|
||||
bool yywarn( const char fmt[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2);
|
||||
|
||||
/* Location type. Borrowed from parse.h as generated by Bison. */
|
||||
#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
|
||||
@@ -78,6 +77,110 @@ struct YDFLTYPE
|
||||
|
||||
#endif
|
||||
|
||||
struct cbl_loc_t {
|
||||
int first_line;
|
||||
int first_column;
|
||||
int last_line;
|
||||
int last_column;
|
||||
|
||||
cbl_loc_t( const YYLTYPE& loc )
|
||||
: first_line(loc.first_line)
|
||||
, first_column(loc.first_column)
|
||||
, last_line(loc.last_line)
|
||||
, last_column(loc.last_column)
|
||||
{}
|
||||
|
||||
operator YYLTYPE() const {
|
||||
return { first_line, first_column, last_line, last_column };
|
||||
}
|
||||
};
|
||||
|
||||
/*
|
||||
* Naming Convention: Names end with a letter that indicates
|
||||
* their kind:
|
||||
* F fatal, "fatal error: "
|
||||
* I ice, "internal compiler error: "
|
||||
* E error, "error: "
|
||||
* S sorry, "sorry, unimplemented: "
|
||||
* W warning, "warning: "
|
||||
* A anachronism, "anachronism: "
|
||||
* N note, "note: "
|
||||
* D debug, "debug: "
|
||||
*/
|
||||
enum cbl_diag_id_t : uint64_t {
|
||||
CdfNotFoundW,
|
||||
CdfParameterW,
|
||||
|
||||
EcUnknownW,
|
||||
|
||||
LexIncludeE,
|
||||
LexIncludeOkN,
|
||||
LexIndicatorE,
|
||||
LexInputN,
|
||||
LexLineE,
|
||||
LexPreprocessE,
|
||||
LexReplaceE,
|
||||
LexSeparatorE,
|
||||
|
||||
IbmEjectE,
|
||||
IbmEqualAssignE,
|
||||
IbmLengthOf,
|
||||
IbmProcedurePointer,
|
||||
IbmSectionNegE,
|
||||
IbmSectionRangeE,
|
||||
IbmSectionSegmentW,
|
||||
IbmStopNumber,
|
||||
IbmVolatileE,
|
||||
IbmVolatileW, // dialect warning for ignored syntax
|
||||
|
||||
IsoResume,
|
||||
|
||||
MfBinaryLongLong,
|
||||
MfCallGiving,
|
||||
MfCdfDollar,
|
||||
MfComp6,
|
||||
MfCompX,
|
||||
MfLevel_1_Occurs,
|
||||
MfLevel78,
|
||||
MfMovePointer,
|
||||
MfReturningNum,
|
||||
MfUsageTypename,
|
||||
MfTrailing,
|
||||
|
||||
Par78CdfDefinedW,
|
||||
ParIconvE,
|
||||
ParInfoI,
|
||||
ParLangInfoW,
|
||||
ParLiteral2W,
|
||||
ParLocaleW,
|
||||
ParNoCorrespondingW,
|
||||
ParNumstrW,
|
||||
ParUnresolvedProcE,
|
||||
|
||||
SynApplyCommit,
|
||||
SynFileCodeSet,
|
||||
SynHighOrderBit,
|
||||
SynRecordingMode,
|
||||
SynSetLocaleTo,
|
||||
SynSetToLocale,
|
||||
|
||||
DiagDiagDiag // always last
|
||||
};
|
||||
|
||||
bool cbl_message( cbl_diag_id_t id, const char msg[], ... )
|
||||
ATTRIBUTE_GCOBOL_DIAG(2, 3);
|
||||
|
||||
bool cbl_message( cbl_loc_t loc, cbl_diag_id_t id, const char msg[], ... )
|
||||
ATTRIBUTE_GCOBOL_DIAG(3, 4);
|
||||
|
||||
bool
|
||||
dialect_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[], bool ok = true );
|
||||
|
||||
static inline bool
|
||||
dialect_not_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[] ) {
|
||||
return dialect_ok(loc, id, term, false);
|
||||
}
|
||||
|
||||
// Diagnostic format specifiers are documented in gcc/pretty-print.cc
|
||||
// an error at a location, called from the parser for semantic errors
|
||||
void error_msg( const YYLTYPE& loc, const char gmsgid[], ... )
|
||||
@@ -91,16 +194,15 @@ warn_msg( const YYLTYPE& loc, const char gmsgid[], ... )
|
||||
void error_msg_direct( const char gmsgid[], ... )
|
||||
ATTRIBUTE_GCOBOL_DIAG(1, 2);
|
||||
|
||||
void dialect_error( const YYLTYPE& loc, const char term[], const char dialect[] );
|
||||
|
||||
|
||||
// for CDF and other warnings that refer back to an earlier line
|
||||
// (not in diagnostic framework yet)
|
||||
void yyerrorvl( int line, const char *filename, const char fmt[], ... )
|
||||
ATTRIBUTE_PRINTF_3;
|
||||
|
||||
void cbl_unimplementedw(const char *gmsgid, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2); // warning
|
||||
void cbl_unimplemented(const char *gmsgid, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2); // error
|
||||
void cbl_unimplementedw(cbl_diag_id_t id, const char *gmsgid, ...)
|
||||
ATTRIBUTE_GCOBOL_DIAG(2, 3); // warning
|
||||
void cbl_unimplemented(const char *gmsgid, ...)
|
||||
ATTRIBUTE_GCOBOL_DIAG(1, 2); // error
|
||||
void cbl_unimplemented_at( const YYLTYPE& loc, const char *gmsgid, ... )
|
||||
ATTRIBUTE_GCOBOL_DIAG(2, 3);
|
||||
|
||||
|
||||
@@ -201,7 +201,7 @@ apply_cdf_turn( const exception_turn_t& turn ) {
|
||||
%type <cdfarg> namelit name_any name_one
|
||||
%type <string> name subscript subscripts inof
|
||||
%token <boolean> BOOL
|
||||
%token <number> FEATURE 366 NUMBER 303 EXCEPTION_NAME 280 "EXCEPTION NAME"
|
||||
%token <number> FEATURE 367 NUMBER 304 EXCEPTION_NAME 280 "EXCEPTION NAME"
|
||||
|
||||
%type <cdfval> cdf_expr
|
||||
%type <cdfval> cdf_relexpr cdf_reloper cdf_and cdf_bool_expr
|
||||
@@ -213,52 +213,52 @@ apply_cdf_turn( const exception_turn_t& turn ) {
|
||||
|
||||
%type <number> cdf_stackable
|
||||
|
||||
%token BY 487
|
||||
%token COPY 363
|
||||
%token CDF_DISPLAY 385 ">>DISPLAY"
|
||||
%token BY 488
|
||||
%token COPY 364
|
||||
%token CDF_DISPLAY 386 ">>DISPLAY"
|
||||
%token IN 606
|
||||
%token NAME 286
|
||||
%token NUMSTR 305 "numeric literal"
|
||||
%token NUMSTR 306 "numeric literal"
|
||||
%token OF 687
|
||||
%token PSEUDOTEXT 723
|
||||
%token REPLACING 745
|
||||
%token LITERAL 298
|
||||
%token SUPPRESS 377
|
||||
%token LITERAL 299
|
||||
%token SUPPRESS 378
|
||||
|
||||
%token LSUB 368 "("
|
||||
%token SUBSCRIPT 376 RSUB 373 ")"
|
||||
%token LSUB 369 "("
|
||||
%token SUBSCRIPT 377 RSUB 374 ")"
|
||||
|
||||
%token CDF_DEFINE 384 ">>DEFINE"
|
||||
%token CDF_IF 386 ">>IF"
|
||||
%token CDF_ELSE 387 ">>ELSE"
|
||||
%token CDF_END_IF 388 ">>END-IF"
|
||||
%token CDF_EVALUATE 389 ">>EVALUATE"
|
||||
%token CDF_WHEN 390 ">>WHEN"
|
||||
%token CDF_END_EVALUATE 391 ">>END-EVALUATE"
|
||||
%token CDF_DEFINE 385 ">>DEFINE"
|
||||
%token CDF_IF 387 ">>IF"
|
||||
%token CDF_ELSE 388 ">>ELSE"
|
||||
%token CDF_END_IF 389 ">>END-IF"
|
||||
%token CDF_EVALUATE 390 ">>EVALUATE"
|
||||
%token CDF_WHEN 391 ">>WHEN"
|
||||
%token CDF_END_EVALUATE 392 ">>END-EVALUATE"
|
||||
|
||||
%token ALL 451
|
||||
%token CALL_CONVENTION 392 ">>CALL-CONVENTION"
|
||||
%token COBOL_WORDS 381 ">>COBOL-WORDS"
|
||||
%token CDF_PUSH 395 ">>PUSH"
|
||||
%token CDF_POP 396 ">>POP"
|
||||
%token SOURCE_FORMAT 397 ">>SOURCE FORMAT"
|
||||
%token ALL 452
|
||||
%token CALL_CONVENTION 393 ">>CALL-CONVENTION"
|
||||
%token COBOL_WORDS 382 ">>COBOL-WORDS"
|
||||
%token CDF_PUSH 396 ">>PUSH"
|
||||
%token CDF_POP 397 ">>POP"
|
||||
%token SOURCE_FORMAT 398 ">>SOURCE FORMAT"
|
||||
|
||||
%token AS 469 CONSTANT 362 DEFINED 364
|
||||
%token AS 470 CONSTANT 363 DEFINED 365
|
||||
%type <boolean> DEFINED
|
||||
%token OTHER 699 PARAMETER_kw 369 "PARAMETER"
|
||||
%token OFF 688 OVERRIDE 370
|
||||
%token OTHER 699 PARAMETER_kw 370 "PARAMETER"
|
||||
%token OFF 688 OVERRIDE 371
|
||||
%token THRU 950
|
||||
%token TRUE_kw 815 "True"
|
||||
|
||||
%token CALL_COBOL 393 "CALL"
|
||||
%token CALL_VERBATIM 394 "CALL (as C)"
|
||||
%token CALL_COBOL 394 "CALL"
|
||||
%token CALL_VERBATIM 395 "CALL (as C)"
|
||||
|
||||
%token TURN 817 CHECKING 497 LOCATION 650 ON 690 WITH 844
|
||||
%token TURN 817 CHECKING 498 LOCATION 650 ON 690 WITH 844
|
||||
|
||||
%left OR 951
|
||||
%left AND 952
|
||||
%right NOT 953
|
||||
%left '<' '>' '=' NE 954 LE 955 GE 956
|
||||
%left '<' '>' EQ 298 "EQUAL" NE 954 LE 955 GE 956
|
||||
%left '-' '+'
|
||||
%left '*' '/'
|
||||
%right NEG 958
|
||||
@@ -362,7 +362,7 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override
|
||||
}
|
||||
|
||||
}
|
||||
| CDF_DEFINE cdf_constant NAME '=' cdf_expr[value] override
|
||||
| CDF_DEFINE cdf_constant NAME EQ cdf_expr[value] override
|
||||
{ /* accept, but as error */
|
||||
if( scanner_parsing() ) {
|
||||
error_msg(@NAME, "CDF error: %s = value invalid", $NAME);
|
||||
@@ -382,8 +382,9 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override
|
||||
*/
|
||||
{
|
||||
if( 0 == cdf_dictionary().count($NAME) ) {
|
||||
yywarn("CDF: '%s' is defined AS PARAMETER "
|
||||
"but was not defined", $NAME);
|
||||
cbl_message(@NAME, CdfParameterW,
|
||||
"CDF: '%s' is defined AS PARAMETER "
|
||||
"but was not defined", $NAME);
|
||||
}
|
||||
}
|
||||
| CDF_DEFINE FEATURE as ON {
|
||||
@@ -563,7 +564,7 @@ cdf_reloper: cdf_relexpr
|
||||
|
||||
cdf_relexpr: cdf_relexpr '<' cdf_expr { $$ = $1(@1) < $3(@3); }
|
||||
| cdf_relexpr LE cdf_expr { $$ = $1(@1) <= $3(@3); }
|
||||
| cdf_relexpr '=' cdf_expr {
|
||||
| cdf_relexpr EQ cdf_expr {
|
||||
$$ = cdfval_t(false);
|
||||
if( ( $1.string && $3.string) ||
|
||||
(!$1.string && !$3.string) )
|
||||
@@ -612,7 +613,8 @@ cdf_factor: NAME {
|
||||
$$ = that->second;
|
||||
} else {
|
||||
if( ! scanner_parsing() ) {
|
||||
yywarn("CDF skipping: no such variable '%s' (ignored)", $1);
|
||||
cbl_message(CdfNotFoundW,
|
||||
"CDF skipping: no such variable '%s'", $1);
|
||||
} else {
|
||||
error_msg(@NAME, "CDF error: no such variable '%s'", $1);
|
||||
}
|
||||
|
||||
@@ -317,7 +317,7 @@ enable_exceptions( bool enable ) {
|
||||
NULL != (name = strtok(name, ",")); name = NULL ) {
|
||||
ec_type_t type = ec_type_of(name);
|
||||
if( type == ec_none_e ) {
|
||||
yywarn("unrecognized exception '%s' was ignored", name);
|
||||
cbl_message(EcUnknownW, "unrecognized exception '%s'", name);
|
||||
continue;
|
||||
}
|
||||
ec_disposition_t disposition = ec_type_disposition(type);
|
||||
@@ -328,17 +328,21 @@ enable_exceptions( bool enable ) {
|
||||
}
|
||||
}
|
||||
|
||||
void cobol_warning( cbl_diag_id_t id, int yn, bool );
|
||||
|
||||
static bool
|
||||
cobol_langhook_handle_option (size_t scode,
|
||||
const char *arg ATTRIBUTE_UNUSED,
|
||||
const char *arg,
|
||||
HOST_WIDE_INT value,
|
||||
int kind ATTRIBUTE_UNUSED,
|
||||
int kind,
|
||||
location_t loc ATTRIBUTE_UNUSED,
|
||||
const struct
|
||||
cl_option_handlers *handlers ATTRIBUTE_UNUSED)
|
||||
{
|
||||
// process_command (decoded_options_count, decoded_options);
|
||||
enum opt_code code = (enum opt_code) scode;
|
||||
auto super_kind = diagnostics::kind(kind);
|
||||
bool warning_as_error = super_kind == diagnostics::kind::error;
|
||||
|
||||
switch(code)
|
||||
{
|
||||
@@ -403,6 +407,8 @@ cobol_langhook_handle_option (size_t scode,
|
||||
return true;
|
||||
|
||||
case OPT_dialect:
|
||||
// gcc disallows 0 as an enumerated value, so we used 0x10 for iso.
|
||||
if( cobol_dialect == 0x100 ) cobol_dialect = 0;
|
||||
cobol_dialect_set(cbl_dialect_t(cobol_dialect));
|
||||
return true;
|
||||
|
||||
@@ -439,6 +445,194 @@ cobol_langhook_handle_option (size_t scode,
|
||||
cobol_gcobol_feature_set(feature_internal_ebcdic_e);
|
||||
return true;
|
||||
|
||||
// Warnings and errors
|
||||
|
||||
case OPT_Wbinary_long_long:
|
||||
cobol_warning(MfBinaryLongLong, binary_long_long, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wcall_giving:
|
||||
cobol_warning(MfCallGiving, call_giving, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wcdf_dollar:
|
||||
cobol_warning(MfCdfDollar, cdf_dollar, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wcomp_6:
|
||||
cobol_warning(MfComp6, comp_6, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wcomp_x:
|
||||
cobol_warning(MfCompX, comp_x, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Winspect_trailing:
|
||||
cobol_warning(MfTrailing, inspect_trailing, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wlevel_1_occurs:
|
||||
cobol_warning(MfLevel_1_Occurs, level_1_occurs, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wlevel_78_defined:
|
||||
cobol_warning(Par78CdfDefinedW, level_78_defined, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wmove_pointer:
|
||||
cobol_warning(MfMovePointer, move_pointer, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wlevel_78:
|
||||
cobol_warning(MfLevel78, level_78, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wreturning_number:
|
||||
cobol_warning(MfReturningNum, returning_number, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wusage_typename:
|
||||
cobol_warning(MfUsageTypename, usage_typename, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wbad_line_directive:
|
||||
cobol_warning(LexLineE, bad_line_directive, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wequal_assign:
|
||||
cobol_warning(IbmEqualAssignE, equal_assign, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wbad_numeric:
|
||||
cobol_warning(ParNumstrW, bad_numeric, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wcdf_invalid_parameter:
|
||||
cobol_warning(CdfParameterW, cdf_invalid_parameter, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wcdf_name_not_found:
|
||||
cobol_warning(CdfNotFoundW, cdf_name_not_found, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wcopybook_found:
|
||||
cobol_warning(LexInputN, copybook_found, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wec_unknown:
|
||||
cobol_warning(EcUnknownW, ec_unknown, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wentry_convention:
|
||||
cobol_warning(ParInfoI, entry_convention, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wiconv_error:
|
||||
cobol_warning(ParIconvE, iconv_error, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Winclude_file_found:
|
||||
cobol_warning(LexIncludeOkN, include_file_found, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Winclude_file_not_found:
|
||||
cobol_warning(LexIncludeE, include_file_not_found, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wliteral_concat:
|
||||
cobol_warning(ParLiteral2W, literal_concat, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wlocale_error:
|
||||
cobol_warning(ParLocaleW, locale_error, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wmove_corresponding:
|
||||
cobol_warning(ParNoCorrespondingW, warn_corresponding, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wnllanginfo_error:
|
||||
cobol_warning(ParLangInfoW, nllanginfo_error, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wlength_of:
|
||||
cobol_warning(IbmLengthOf, cobol_length_of, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wpreprocessor_error:
|
||||
cobol_warning(ParLangInfoW, preprocessor_error, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wprocedure_pointer:
|
||||
cobol_warning(IbmProcedurePointer, procedure_pointer, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wprocedure_not_found:
|
||||
cobol_warning(ParUnresolvedProcE, procedure_not_found, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wreplace_error:
|
||||
cobol_warning(LexReplaceE, replace_error, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wsegment_error:
|
||||
cobol_warning(IbmSectionRangeE, segment_error, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wsegment_negative:
|
||||
cobol_warning(IbmSectionNegE, segment_negative, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wsegment:
|
||||
cobol_warning(IbmSectionSegmentW, cobol_segment, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wcobol_eject:
|
||||
cobol_warning(IbmEjectE, cobol_eject, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Woperator_space:
|
||||
cobol_warning(LexSeparatorE, operator_space, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wstop_number:
|
||||
cobol_warning(IbmStopNumber, stop_number, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wstray_indicator:
|
||||
cobol_warning(LexIndicatorE, stray_indicator, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wcobol_volatile:
|
||||
// If arg is true, the error becoomes a warning
|
||||
cobol_warning(IbmVolatileE, cobol_volatile, warning_as_error);
|
||||
cobol_warning(IbmVolatileW, cobol_volatile, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wcobol_resume:
|
||||
cobol_warning(IsoResume, cobol_resume, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wapply_commit:
|
||||
cobol_warning(SynApplyCommit, apply_commit, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Whigh_order_bit:
|
||||
cobol_warning(SynHighOrderBit, high_order_bit, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wfile_code_set:
|
||||
cobol_warning(SynFileCodeSet, file_code_set, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wset_locale_to:
|
||||
cobol_warning(SynSetLocaleTo, set_locale_to, warning_as_error);
|
||||
return true;
|
||||
|
||||
case OPT_Wset_to_locale:
|
||||
cobol_warning(SynSetToLocale, set_to_locale, warning_as_error);
|
||||
return true;
|
||||
|
||||
default:
|
||||
break;
|
||||
}
|
||||
@@ -514,14 +708,6 @@ cobol_langhook_type_for_mode (enum machine_mode mode, int unsignedp)
|
||||
return NULL;
|
||||
}
|
||||
|
||||
////static tree
|
||||
////cobol_langhook_type_for_size (unsigned int bits ATTRIBUTE_UNUSED,
|
||||
//// int unsignedp ATTRIBUTE_UNUSED)
|
||||
//// {
|
||||
//// gcc_unreachable ();
|
||||
//// return NULL;
|
||||
//// }
|
||||
|
||||
/* Record a builtin function. We just ignore builtin functions. */
|
||||
|
||||
static tree
|
||||
|
||||
@@ -75,15 +75,6 @@ ec_level( ec_type_t ec ) {
|
||||
return 3;
|
||||
}
|
||||
|
||||
void
|
||||
cbl_enabled_exception_t::dump( int i ) const {
|
||||
cbl_message(2, "cbl_enabled_exception_t: %2d {%s, %s, %zu}",
|
||||
i,
|
||||
location? "location" : " none",
|
||||
ec_type_str(ec),
|
||||
file );
|
||||
}
|
||||
|
||||
void
|
||||
cbl_enabled_exceptions_t::dump() const {
|
||||
extern int yydebug;
|
||||
|
||||
@@ -77,7 +77,7 @@ class exception_turn_t {
|
||||
bool add_exception( ec_type_t type, const filelist_t& files = filelist_t() ) {
|
||||
ec_disposition_t disposition = ec_type_disposition(type);
|
||||
if( disposition != ec_implemented(disposition) ) {
|
||||
cbl_unimplementedw("CDF: exception '%s'", ec_type_str(type));
|
||||
cbl_unimplementedw(EcUnknownW, "exception %qs", ec_type_str(type));
|
||||
}
|
||||
auto elem = exceptions.find(type);
|
||||
if( elem != exceptions.end() ) return false; // cannot add twice
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
.ds lang COBOL
|
||||
.ds lang COBOL
|
||||
.ds gcobol GCC\ \*[lang]\ Front-end
|
||||
.ds isostd ISO/IEC 1989:2023
|
||||
.Dd \& February 2025
|
||||
@@ -31,12 +31,58 @@
|
||||
.Op Fl preprocess Ar preprocess-filter
|
||||
.Op Fl fflex-debug
|
||||
.Op Fl fyacc-debug
|
||||
.\" warnings
|
||||
.Op Fl Wno-apply-commit
|
||||
.Op Fl Wno-file-code-set
|
||||
.Op Fl Wno-high-order-bit
|
||||
.Op Fl Wno-bad-line-directive
|
||||
.Op Fl Wno-bad-numeric
|
||||
.Op Fl Wno-binary-long-long
|
||||
.Op Fl Wno-call-giving
|
||||
.Op Fl Wno-cdf-dollar
|
||||
.Op Fl Wno-cdf-invalid-parameter
|
||||
.Op Fl Wno-cdf-name-not-found
|
||||
.Op Fl Wno-cobol-eject
|
||||
.Op Fl Wno-cobol-resume
|
||||
.Op Fl Wno-cobol-volatile
|
||||
.Op Fl Wno-comp-6
|
||||
.Op Fl Wno-comp-x
|
||||
.Op Fl Wno-copybook-found
|
||||
.Op Fl Wno-ec-unknown
|
||||
.Op Fl Wno-entry-convention
|
||||
.Op Fl Wno-iconv-error
|
||||
.Op Fl Wno-include-file-found
|
||||
.Op Fl Wno-include-file-not-found
|
||||
.Op Fl Wno-inspect-trailing
|
||||
.Op Fl Wno-length-of
|
||||
.Op Fl Wno-level-1-occurs
|
||||
.Op Fl Wno-level-78
|
||||
.Op Fl Wno-level-78-defined
|
||||
.Op Fl Wno-literal-concat
|
||||
.Op Fl Wno-locale-error
|
||||
.Op Fl Wno-move-corresponding
|
||||
.Op Fl Wno-move-pointer
|
||||
.Op Fl Wno-nllanginfo-error
|
||||
.Op Fl Wno-operator-space
|
||||
.Op Fl Wno-preprocessor-error
|
||||
.Op Fl Wno-procedure-not-found
|
||||
.Op Fl Wno-procedure-pointer
|
||||
.Op Fl Wno-replace-error
|
||||
.Op Fl Wno-returning-number
|
||||
.Op Fl Wno-segment-error
|
||||
.Op Fl Wno-segment-negative
|
||||
.Op Fl Wno-stop-number
|
||||
.Op Fl Wno-stray-indicator
|
||||
.Op Fl Wno-usage-typename
|
||||
.Op Fl Wno-recording-mode
|
||||
.Op Fl Wno-set-locale-to
|
||||
.Op Fl Wno-set-to-locale
|
||||
.Ar filename Op ...
|
||||
.
|
||||
.Sh DESCRIPTION
|
||||
.Nm
|
||||
compiles \*[lang] source code to object code, and optionally produces an
|
||||
executable binary or shared object. As a GCC component, it accepts
|
||||
compiles \*[lang] source code to object code, and optionally produces
|
||||
an executable binary or shared object. As a GCC component, it accepts
|
||||
all options that affect code-generation and linking. Options specific
|
||||
to \*[lang] are listed below.
|
||||
.Bl -tag -width "\0\0debug"
|
||||
@@ -283,30 +329,66 @@ because its value is determined at run time.
|
||||
By default,
|
||||
.Nm
|
||||
accepts \*[lang] syntax as defined by \*[isostd], with some
|
||||
extensions for backward compatibility with COBOL-85. To make the
|
||||
compiler more generally useful, some additional syntax is supported by
|
||||
this option.
|
||||
.Pp
|
||||
The value of
|
||||
extensions for backward compatibility with COBOL-85. Additional syntax is supported with this option. The value of
|
||||
.Ar dialect-name
|
||||
may be
|
||||
.Bl -tag -compact
|
||||
.Bl -tag
|
||||
.It ibm
|
||||
to indicate IBM COBOL 6.3 syntax, specifically
|
||||
.D1 STOP <number>.
|
||||
.It gnu
|
||||
to indicate GnuCOBOL syntax
|
||||
.It mf
|
||||
to indicate MicroFocus syntax, specifically
|
||||
.Sy LEVEL 78
|
||||
constants.
|
||||
to indicate IBM COBOL 6.4 syntax:
|
||||
.Bl -bullet -compact
|
||||
.It
|
||||
.Sy EJECT
|
||||
.It
|
||||
.Sy EQUAL
|
||||
as assignment operator
|
||||
.It
|
||||
.Sy "LENGTH OF"
|
||||
.It
|
||||
.Sy "PROCEDURE POINTER"
|
||||
.It
|
||||
.Sy SECTION
|
||||
segment
|
||||
.It
|
||||
.Sy STOP
|
||||
<number>
|
||||
.It
|
||||
.Sy VOLATILE
|
||||
.El
|
||||
.It gnu
|
||||
to indicate GnuCOBOL syntax, generally compatible with MicroFocus.
|
||||
.It mf
|
||||
to indicate MicroFocus syntax:
|
||||
.Bl -bullet -compact
|
||||
.It
|
||||
.Sy BINARY-LONG-LONG
|
||||
.It
|
||||
.Sy CALL ... GIVING
|
||||
.It
|
||||
.Sy CDF \[Do]IF
|
||||
.It
|
||||
.Sy COMPUTATIONAL-6
|
||||
.It
|
||||
.Sy COMPUTATIONAL
|
||||
used with
|
||||
.Sy PICTURE X
|
||||
.It
|
||||
.Sy INSPECT ... TRAILING
|
||||
.It
|
||||
.Sy OCCURS
|
||||
at
|
||||
.Sy "LEVEL 01"
|
||||
.It
|
||||
.Sy LEVEL 78
|
||||
constants
|
||||
.It
|
||||
.Sy MOVE POINTER
|
||||
.It
|
||||
.Sy RETURNING
|
||||
<number>
|
||||
.It
|
||||
.Sy USAGE IS TYPENAME
|
||||
.El
|
||||
.El
|
||||
.Pp
|
||||
Only a few such non-standard constructs are accepted, and
|
||||
.Nm
|
||||
makes no claim to emulate other compilers. But to the extent that a
|
||||
feature is popular but nonstandard, this option provides a way to
|
||||
support it, or add it.
|
||||
.
|
||||
.It Fl include Ar filename
|
||||
Process
|
||||
@@ -371,13 +453,117 @@ The
|
||||
should return a zero exit status, indicating success. If it returns a
|
||||
nonzero exit status, an error is reported and the compiler is not
|
||||
invoked.
|
||||
.
|
||||
.It Fl fflex-debug Ns Li , Fl fyacc-debug
|
||||
produce messages useful for compiler development. The
|
||||
.Fl fflex-debug
|
||||
option prints the tokenized input stream. The
|
||||
.Fl fyacc-debug
|
||||
option shows the shift and reduce actions taken by the parser.
|
||||
.El
|
||||
.Ss Diagnostic Messages
|
||||
.Pp
|
||||
Many warning options can be used to convert error messages to
|
||||
warnings, or to suppress messages related to \*[lang] dialects. The
|
||||
user may mix and match. A group of features may be enabled by
|
||||
indicating a dialect (or more than one dialect) and individual
|
||||
features may be enabled as a warning, or error, or suppressed.
|
||||
.Bl -tag -width Wno-cdf-name-not-found\0\0 -compact
|
||||
.It Fl Wno-apply-commit
|
||||
Warn if APPLY COMMIT is used.
|
||||
.It Fl Wno-bad-line-directive
|
||||
Warn if malformed %<#line%> directive is encountered.
|
||||
.It Fl Wno-binary-long-long
|
||||
Warn if BINARY-LONG-LONG is used.
|
||||
.It Fl Wno-call_giving
|
||||
Warn if CALL ... GIVING is used.
|
||||
.It Fl Wno-cdf-dollar
|
||||
Warn if CDF \[Do]IF is used.
|
||||
.It Fl Wno-comp-6
|
||||
Warn if COMPUTATIONAL-6 is used.
|
||||
.It Fl Wno-comp-x
|
||||
Warn if COMPUTATIONAL is used with PICTURE X.
|
||||
.It Fl Wno-file-code-set
|
||||
Warn if FILE CODE SET is used.
|
||||
.It Fl Wno-inspect-trailing
|
||||
Warn if INSPECT ... TRAILING is used.
|
||||
.It Fl Wno-level-1-occurs
|
||||
Warn if Level 01 is used with OCCURS.
|
||||
.It Fl Wno-level-78-defined
|
||||
Warn if CDF defines Level 78 constant.
|
||||
.It Fl Wno-move-pointer
|
||||
Warn if MOVE POINTER is used.
|
||||
.It Fl Wno-returning-number
|
||||
Warn if RETURNING <number> is used.
|
||||
.It Fl Wno-usage-typename
|
||||
Warn if USAGE IS TYPENAME is used.
|
||||
.It Fl Wno-bad-numeric
|
||||
Warn if numeric string is invalid.
|
||||
.It Fl Wno-cdf-invalid-parameter
|
||||
Warn if referenced CDF PARAMETER is not defined.
|
||||
.It Fl Wno-cdf-name-not-found
|
||||
Warn if referenced CDF name is not defined.
|
||||
.It Fl Wno-cobol-eject
|
||||
Warn if IBM-style EJECT is used (instead of error).
|
||||
.It Fl Wno-cobol-resume
|
||||
Warn if ISO RESUME is used with \-dialect ibm (instead of error).
|
||||
.It Fl Wno-cobol-volatile
|
||||
Warn if VOLATILE is used (instead of error if -dialect ibm).
|
||||
.It Fl Wno-copybook-found
|
||||
Print message when copybook is processed.
|
||||
.It Fl Wno-ec-unknown
|
||||
Warn if unimplemented/unknown exception condition is referenced.
|
||||
.It Fl Wno-entry-convention
|
||||
Print message when ENTRY CONVENTION is specified.
|
||||
.It Fl Wno-high-order-bit
|
||||
Warn if HIGH-ORDER-LEFT HIGH-ORDER-RIGHT is used.
|
||||
.It Fl Wno-include-file-found
|
||||
Print message when include file is processed.
|
||||
.It Fl Wno-length-of
|
||||
Warn if LENGTH OF is used.
|
||||
.It Fl Wno-level-78
|
||||
Warn if Level 78 is used.
|
||||
.It Fl Wno-literal-concat
|
||||
Warn if concatenated literals use different encodings.
|
||||
.It Fl Wno-locale-error
|
||||
Warn if locale(3) fails.
|
||||
.It Fl Wno-move-corresponding
|
||||
Warn if COBOL MOVE has no corresponding fields.
|
||||
.It Fl Wno-nllanginfo-error
|
||||
Warn if nlanglanginfo(3) fails.
|
||||
.It Fl Wno-recording-mode
|
||||
Warn if RECORDING MODE is used.
|
||||
.It Fl Wno-segment
|
||||
Warn if SECTION segments are used.
|
||||
.It Fl Wno-set-locale-to
|
||||
Warn if SET LOCALE ... TO is used.
|
||||
.It Fl Wno-set-to-locale
|
||||
Warn if SET ... TO LOCALE is used.
|
||||
.
|
||||
`.\" convert errors to warnings
|
||||
Warn if a line directive is malformed (instead of error).
|
||||
.It Fl Wno-iconv-error
|
||||
Warn if iconv(3) cannot convert between encodings (instead of error).
|
||||
.It Fl Wno-include-file-not-found
|
||||
Warn if include file is not found (instead of error).
|
||||
.It Fl Wno-operator-space
|
||||
Warn if relational operator not followed by space (instead of error).
|
||||
.It Fl Wno-preprocessor-error
|
||||
Warn if a preprocessor fails (instead of error).
|
||||
.It Fl Wno-procedure-pointer
|
||||
Warn if PROCEDURE POINTER is used.
|
||||
.It Fl Wno-procedure-not-found
|
||||
Warn if a referenced procedure is not found (instead of error).
|
||||
.It Fl Wno-replace-error
|
||||
Warn if REPLACE cannot be processed (instead of error).
|
||||
.It Fl Wno-segment-error
|
||||
Warn if a SEGMENT section is invalid (instead of error).
|
||||
.It Fl Wno-segment-negative
|
||||
Warn if a SEGMENT range is negative (instead of error).
|
||||
.It Fl Wno-stop-number
|
||||
Warn if IBM-style STOP <number> is used (instead of error).
|
||||
.It Fl Wno-stray-indicator
|
||||
Warn if indicator column has no recognized meaning (instead of error).
|
||||
|
||||
.El
|
||||
.
|
||||
.Sh COMPILATION SCENARIOS
|
||||
|
||||
@@ -4002,12 +4002,11 @@ public:
|
||||
dangling.insert(index_of(label));
|
||||
}
|
||||
}
|
||||
bool lay( const cbl_label_t *label ) {
|
||||
void lay( const cbl_label_t *label ) {
|
||||
auto ok = lain.insert(index_of(label));
|
||||
if( ok.second ) {
|
||||
dangling.erase(index_of(label));
|
||||
}
|
||||
return true;
|
||||
}
|
||||
bool vet() const { // be always agreeable, for now.
|
||||
return dangling.empty();
|
||||
@@ -8222,17 +8221,7 @@ parser_label_label(struct cbl_label_t *label)
|
||||
|
||||
CHECK_LABEL(label);
|
||||
|
||||
#if 1
|
||||
// At the present time, label_verify.lay is returning true, so I edited
|
||||
// out the if( !... ) to quiet cppcheck
|
||||
label_verify.lay(label);
|
||||
#else
|
||||
if( ! label_verify.lay(label) )
|
||||
{
|
||||
yywarn("%s: label %qs already exists", __func__, label->name);
|
||||
gcc_unreachable();
|
||||
}
|
||||
#endif
|
||||
|
||||
if(strcmp(label->name, "_end_declaratives") == 0 )
|
||||
{
|
||||
|
||||
@@ -523,10 +523,9 @@ gg_find_field_in_struct(const tree base, const char *field_name)
|
||||
|
||||
if( !field_decl )
|
||||
{
|
||||
yywarn("Somebody asked for the field %s.%s, which does not exist",
|
||||
cbl_internal_error("Somebody asked for the field %s.%s, which does not exist",
|
||||
IDENTIFIER_POINTER(DECL_NAME(base)),
|
||||
field_name);
|
||||
gcc_unreachable();
|
||||
}
|
||||
|
||||
return field_decl;
|
||||
@@ -2153,17 +2152,15 @@ gg_printf(const char *format_string, ...)
|
||||
{
|
||||
if(nargs >= ARG_LIMIT)
|
||||
{
|
||||
yywarn("You *must* be joking");
|
||||
gcc_unreachable();
|
||||
cbl_internal_error("You *must* be joking");
|
||||
}
|
||||
|
||||
if( TREE_CODE(arg) >= NUM_TREE_CODES)
|
||||
{
|
||||
// Warning: This test is not completely reliable, because a garbage
|
||||
// byte could have a valid TREE_CODE. But it does help.
|
||||
yywarn("You forgot to put a %<NULL_TREE%> at the end of a "
|
||||
"%<gg_printf()%> again");
|
||||
gcc_unreachable();
|
||||
cbl_internal_error("You forgot to put a %<NULL_TREE%> at the end of a "
|
||||
"%<gg_printf()%> again");
|
||||
}
|
||||
|
||||
args[nargs++] = arg;
|
||||
@@ -2208,8 +2205,7 @@ gg_fprintf(tree fd, int nargs, const char *format_string, ...)
|
||||
{
|
||||
if(argc >= ARG_LIMIT)
|
||||
{
|
||||
yywarn("You *must* be joking");
|
||||
gcc_unreachable();
|
||||
cbl_internal_error("You *must* be joking");
|
||||
}
|
||||
|
||||
args[argc++] = arg;
|
||||
@@ -2587,9 +2583,8 @@ gg_define_function( tree return_type,
|
||||
{
|
||||
// Warning: This test is not completely reliable, because a garbage
|
||||
// byte could have a valid TREE_CODE. But it does help.
|
||||
yywarn("You forgot to put a %<NULL_TREE%> at the end of a "
|
||||
cbl_internal_error("You forgot to put a %<NULL_TREE%> at the end of a "
|
||||
"%<gg_define_function()%> again");
|
||||
gcc_unreachable();
|
||||
}
|
||||
|
||||
const char *name = va_arg(params, const char *);
|
||||
@@ -2599,8 +2594,7 @@ gg_define_function( tree return_type,
|
||||
nparams += 1;
|
||||
if(nparams > ARG_LIMIT)
|
||||
{
|
||||
yywarn("%d parameters? Really? Are you insane?", ARG_LIMIT+1);
|
||||
gcc_unreachable();
|
||||
cbl_internal_error("%d parameters? Really? Are you insane?", ARG_LIMIT+1);
|
||||
}
|
||||
}
|
||||
va_end(params);
|
||||
@@ -2748,9 +2742,8 @@ gg_get_function_decl(tree return_type, const char *funcname, ...)
|
||||
{
|
||||
// Warning: This test is not completely reliable, because a garbage
|
||||
// byte could have a valid TREE_CODE. But it does help.
|
||||
yywarn("You forgot to put a %<NULL_TREE%> at the end of a "
|
||||
cbl_internal_error("You forgot to put a %<NULL_TREE%> at the end of a "
|
||||
"%<gg_define_function()%> again");
|
||||
gcc_unreachable();
|
||||
}
|
||||
|
||||
const char *name = va_arg(params, const char *);
|
||||
@@ -2760,9 +2753,8 @@ gg_get_function_decl(tree return_type, const char *funcname, ...)
|
||||
nparams += 1;
|
||||
if(nparams > ARG_LIMIT)
|
||||
{
|
||||
yywarn("%d parameters? Really? Are you insane?",
|
||||
cbl_internal_error("%d parameters? Really? Are you insane?",
|
||||
ARG_LIMIT+1);
|
||||
gcc_unreachable();
|
||||
}
|
||||
}
|
||||
va_end(params);
|
||||
@@ -3040,8 +3032,7 @@ gg_call_expr(tree return_type, const char *function_name, ...)
|
||||
{
|
||||
if(nargs >= ARG_LIMIT)
|
||||
{
|
||||
yywarn("You *must* be joking");
|
||||
gcc_unreachable();
|
||||
cbl_internal_error("You *must* be joking");
|
||||
}
|
||||
|
||||
tree arg = va_arg(ap, tree);
|
||||
@@ -3096,8 +3087,7 @@ gg_call(tree return_type, const char *function_name, ...)
|
||||
{
|
||||
if(nargs >= ARG_LIMIT)
|
||||
{
|
||||
yywarn("You *must* be joking");
|
||||
gcc_unreachable();
|
||||
cbl_internal_error("You *must* be joking");
|
||||
}
|
||||
|
||||
tree arg = va_arg(ap, tree);
|
||||
|
||||
@@ -42,6 +42,52 @@
|
||||
"%{preprocess} "
|
||||
"%{dialect} "
|
||||
"%{include} "
|
||||
"%{Wno-apply-commit} "
|
||||
"%{Wno-file-code-set} "
|
||||
"%{Wno-high-order-bit} "
|
||||
"%{Wno-bad-line-directive} "
|
||||
"%{Wno-bad-numeric} "
|
||||
"%{Wno-binary-long-long} "
|
||||
"%{Wno-call-giving} "
|
||||
"%{Wno-cdf-dollar} "
|
||||
"%{Wno-cdf-invalid-parameter} "
|
||||
"%{Wno-cdf-name-not-found} "
|
||||
"%{Wno-cobol-eject} "
|
||||
"%{Wno-cobol-resume} "
|
||||
"%{Wno-cobol-volatile} "
|
||||
"%{Wno-comp-6} "
|
||||
"%{Wno-comp-x} "
|
||||
"%{Wno-copybook-found} "
|
||||
"%{Wno-ec-unknown} "
|
||||
"%{Wno-entry-convention} "
|
||||
"%{Wno-iconv-error} "
|
||||
"%{Wno-include-file-found} "
|
||||
"%{Wno-include-file-not-found} "
|
||||
"%{Wno-inspect-trailing} "
|
||||
"%{Wno-length-of} "
|
||||
"%{Wno-level-1-occurs} "
|
||||
"%{Wno-level-78} "
|
||||
"%{Wno-level-78-defined} "
|
||||
"%{Wno-literal-concat} "
|
||||
"%{Wno-locale-error} "
|
||||
"%{Wno-move-corresponding} "
|
||||
"%{Wno-move-pointer} "
|
||||
"%{Wno-nllanginfo-error} "
|
||||
"%{Wno-operator-space} "
|
||||
"%{Wno-preprocessor-error} "
|
||||
"%{Wno-procedure-not-found} "
|
||||
"%{Wno-procedure-pointer} "
|
||||
"%{Wno-replace-error} "
|
||||
"%{Wno-returning-number} "
|
||||
"%{Wno-segment-error} "
|
||||
"%{Wno-segment-negative} "
|
||||
"%{Wno-stop-number} "
|
||||
"%{Wno-stray-indicator} "
|
||||
"%{Wno-usage-typename} "
|
||||
"%{Wno-recording-mode} "
|
||||
"%{Wno-set-locale-to} "
|
||||
"%{Wno-set-to-locale} "
|
||||
"%{nomain} "
|
||||
"%{!fsyntax-only:%(invoke_as)} "
|
||||
, 0, 0, 0},
|
||||
|
||||
|
||||
@@ -51,16 +51,19 @@ Enum
|
||||
Name(dialect_type) Type(int) UnknownError(Unrecognized COBOL dialect name: %qs)
|
||||
|
||||
EnumValue
|
||||
Enum(dialect_type) String(gcc) Value(0x04) Canonical
|
||||
Enum(dialect_type) String(iso) Value(0x100)
|
||||
|
||||
EnumValue
|
||||
Enum(dialect_type) String(ibm) Value(0x01)
|
||||
Enum(dialect_type) String(gcc) Value(0x01) Canonical
|
||||
|
||||
EnumValue
|
||||
Enum(dialect_type) String(mf) Value(0x02)
|
||||
Enum(dialect_type) String(ibm) Value(0x02)
|
||||
|
||||
EnumValue
|
||||
Enum(dialect_type) String(gnu) Value(0x04)
|
||||
Enum(dialect_type) String(mf) Value(0x04)
|
||||
|
||||
EnumValue
|
||||
Enum(dialect_type) String(gnu) Value(0x08)
|
||||
|
||||
fcobol-exceptions
|
||||
Cobol Joined Separate Var(cobol_exceptions)
|
||||
@@ -70,6 +73,249 @@ copyext
|
||||
Cobol Joined Separate Var(cobol_copyext) Init(0)
|
||||
Define alternative implicit copybook filename extension
|
||||
|
||||
;; warnings
|
||||
|
||||
; Par78CdfDefinedW
|
||||
Wlevel-78-defined
|
||||
Cobol Warning Var(level_78_defined, 1) Init(1)
|
||||
Warn if CDF defines Level 78 constant
|
||||
|
||||
; MfBinaryLongLong
|
||||
Wbinary-long-long
|
||||
Cobol Warning Var(binary_long_long, 1) Init(1)
|
||||
Warn if BINARY-LONG-LONG is used
|
||||
|
||||
; MfCallGiving
|
||||
Wcall-giving
|
||||
Cobol Warning Var(call_giving, 1) Init(1)
|
||||
Warn if CALL ... GIVING is used
|
||||
|
||||
; MfCdfDollar
|
||||
Wcdf-dollar
|
||||
Cobol Warning Var(cdf_dollar, 1) Init(1)
|
||||
Warn if CDF %<$IF%> is used
|
||||
|
||||
; MfComp6
|
||||
Wcomp-6
|
||||
Cobol Warning Var(comp_6, 1) Init(1)
|
||||
Warn if COMPUTATIONAL-6 is used
|
||||
|
||||
; MfCompX
|
||||
Wcomp-x
|
||||
Cobol Warning Var(comp_x, 1) Init(1)
|
||||
Warn if COMPUTATIONAL is used with PICTURE X
|
||||
|
||||
; MfTrailing
|
||||
Winspect-trailing
|
||||
Cobol Warning Var(inspect_trailing, 1) Init(1)
|
||||
Warn if INSPECT ... TRAILING is used
|
||||
|
||||
; MfLevel_1_Occurs
|
||||
Wlevel-1-occurs
|
||||
Cobol Warning Var(level_1_occurs, 1) Init(1)
|
||||
Warn if Level 01 is used with OCCURS
|
||||
|
||||
; MfLevel78
|
||||
Wlevel-78
|
||||
Cobol Warning Var(level_78, 1) Init(1)
|
||||
Warn if Level 78 is used
|
||||
|
||||
; MfMovePointer
|
||||
Wmove-pointer
|
||||
Cobol Warning Var(move_pointer, 1) Init(1)
|
||||
Warn if MOVE POINTER is used
|
||||
|
||||
; MfReturningNum
|
||||
Wreturning-number
|
||||
Cobol Warning Var(returning_number, 1) Init(1)
|
||||
Warn if RETURNING <number> is used
|
||||
|
||||
; MfUsageTypename
|
||||
Wusage-typename
|
||||
Cobol Warning Var(usage_typename, 1) Init(1)
|
||||
Warn if USAGE IS TYPENAME is used
|
||||
|
||||
; ParNumstrW
|
||||
Wbad-numeric
|
||||
Cobol Warning Var(bad_numeric, 1) Init(1)
|
||||
Warn if numeric string is invalid
|
||||
|
||||
; CdfParameterW
|
||||
Wcdf-invalid-parameter
|
||||
Cobol Warning Var(cdf_invalid_parameter, 1) Init(1)
|
||||
Warn if referenced CDF PARAMETER is not defined
|
||||
|
||||
; CdfNotFoundW
|
||||
Wcdf-name-not-found
|
||||
Cobol Warning Var(cdf_name_not_found, 1) Init(1)
|
||||
Warn if referenced CDF name is not defined
|
||||
|
||||
; LexInputN
|
||||
Wcopybook-found
|
||||
Cobol Warning Var(copybook_found, 1) Init(1)
|
||||
Print message when copybook is processed
|
||||
|
||||
; EcUnknownW
|
||||
Wec-unknown
|
||||
Cobol Warning Var(ec_unknown, 1) Init(1)
|
||||
Warn if unimplemented/unknown exception condition is referenced
|
||||
|
||||
; ParInfoI
|
||||
Wentry-convention
|
||||
Cobol Warning Var(entry_convention, 1) Init(1)
|
||||
Print message when ENTRY CONVENTION is specified
|
||||
|
||||
; LexIncludeOkN
|
||||
Winclude-file-found
|
||||
Cobol Warning Var(include_file_found, 1) Init(1)
|
||||
Print message when include file is processed
|
||||
|
||||
; ParLiteral2W
|
||||
Wliteral-concat
|
||||
Cobol Warning Var(literal_concat, 1) Init(1)
|
||||
Warn if concatenated literals use different encodings
|
||||
|
||||
; ParLocaleW
|
||||
Wlocale-error
|
||||
Cobol Warning Var(locale_error, 1) Init(1)
|
||||
Warn if locale(3) fails
|
||||
|
||||
; ParNoCorrespondingW
|
||||
Wmove-corresponding
|
||||
Cobol Warning Var(warn_corresponding, 1) Init(1)
|
||||
Warn if COBOL MOVE has no corresponding fields.
|
||||
|
||||
; ParLangInfoW
|
||||
Wnllanginfo-error
|
||||
Cobol Warning Var(nllanginfo_error, 1) Init(1)
|
||||
Warn if nlanglanginfo(3) fails
|
||||
|
||||
; IbmLengthOf
|
||||
Wlength-of
|
||||
Cobol Warning Var(cobol_length_of, 1) Init(1)
|
||||
Warn if LENGTH OF is used
|
||||
|
||||
; IbmProcedurePointer
|
||||
Wprocedure-pointer
|
||||
Cobol Warning Var(procedure_pointer, 1) Init(1)
|
||||
Warn if PROCEDURE POINTER is used
|
||||
|
||||
; IbmSectionSegmentW
|
||||
Wsegment
|
||||
Cobol Warning Var(cobol_segment, 1) Init(1)
|
||||
Warn if SECTION segments are used
|
||||
|
||||
; IsoResume
|
||||
Wcobol-resume
|
||||
Cobol Warning Var(cobol_resume, 1) Init(1)
|
||||
Warn if resume is used (instead of error for IBM)
|
||||
|
||||
;; unimplemented syntax
|
||||
|
||||
; SynApplyCommit
|
||||
Wapply-commit
|
||||
Cobol Warning Var(apply_commit, 1) Init(1)
|
||||
Warn if APPLY COMMIT is used
|
||||
|
||||
; SynHighOrderBit
|
||||
Whigh-order-bit
|
||||
Cobol Warning Var(high_order_bit, 1) Init(1)
|
||||
Warn if HIGH-ORDER-LEFT HIGH-ORDER-RIGHT is used
|
||||
|
||||
; SynFileCodeSet
|
||||
Wfile-code-set
|
||||
Cobol Warning Var(file_code_set, 1) Init(1)
|
||||
Warn if FILE CODE SET is used
|
||||
|
||||
; SynRecordingMode
|
||||
Wrecording-mode
|
||||
Cobol Warning Var(recording_mode, 1) Init(1)
|
||||
Warn if RECORDING MODE is used
|
||||
|
||||
; SynSetLocaleTo
|
||||
Wset-locale-to
|
||||
Cobol Warning Var(set_locale_to, 1) Init(1)
|
||||
Warn if SET LOCALE ... TO is used
|
||||
|
||||
; SynSetToLocale
|
||||
Wset-to-locale
|
||||
Cobol Warning Var(set_to_locale, 1) Init(1)
|
||||
Warn if SET ... TO LOCALE is used
|
||||
|
||||
;; errors to warnings
|
||||
|
||||
; LexLineE
|
||||
Wbad-line-directive
|
||||
Cobol Warning Var(bad_line_directive, 1) Init(1)
|
||||
Warn if a line directive is malformed (instead of error)
|
||||
|
||||
; IbmEqualAssignE
|
||||
Wequal-assign
|
||||
Cobol Warning Var(equal_assign, 1) Init(1)
|
||||
Warn if EQUAL used as assignment operator (instead of error)
|
||||
|
||||
; ParIconvE
|
||||
Wiconv-error
|
||||
Cobol Warning Var(iconv_error, 1) Init(1)
|
||||
Warn if iconv(3) cannot convert between encodings (instead of error)
|
||||
|
||||
; LexIncludeE
|
||||
Winclude-file-not-found
|
||||
Cobol Warning Var(include_file_not_found, 1) Init(1)
|
||||
Warn if include file is not found (instead of error)
|
||||
|
||||
; LexPreprocessE
|
||||
Wpreprocessor-error
|
||||
Cobol Warning Var(preprocessor_error, 1) Init(1)
|
||||
Warn if a preprocessor fails (instead of error)
|
||||
|
||||
; ParUnresolvedProcE
|
||||
Wprocedure-not-found
|
||||
Cobol Warning Var(procedure_not_found, 1) Init(1)
|
||||
Warn if a referenced procedure is not found (instead of error)
|
||||
|
||||
; LexReplaceE
|
||||
Wreplace-error
|
||||
Cobol Warning Var(replace_error, 1) Init(1)
|
||||
Warn if REPLACE cannot be processed (instead of error)
|
||||
|
||||
; IbmSectionRangeE
|
||||
Wsegment-error
|
||||
Cobol Warning Var(segment_error, 1) Init(1)
|
||||
Warn if a SEGMENT section is invalid (instead of error)
|
||||
|
||||
; IbmSectionNegE
|
||||
Wsegment-negative
|
||||
Cobol Warning Var(segment_negative, 1) Init(1)
|
||||
Warn if a SEGMENT range is negative (instead of error)
|
||||
|
||||
; LexIndicatorE
|
||||
Wstray-indicator
|
||||
Cobol Warning Var(stray_indicator, 1) Init(1)
|
||||
Warn if indicator column has no recognized meaning (instead of error)
|
||||
|
||||
; LexSeparatorE
|
||||
Woperator-space
|
||||
Cobol Warning Var(operator_space, 1) Init(1)
|
||||
Warn if relational operator not followed by space (instead of error)
|
||||
|
||||
; IbmEjectE
|
||||
Wcobol-eject
|
||||
Cobol Warning Var(cobol_eject, 1) Init(1)
|
||||
Warn if IBM-style EJECT is used (instead of error)
|
||||
|
||||
; IbmStopNumber
|
||||
Wstop-number
|
||||
Cobol Warning Var(stop_number, 1) Init(1)
|
||||
Warn if IBM-style STOP <number> is used (instead of error)
|
||||
|
||||
; IbmVolatileE
|
||||
Wcobol-volatile
|
||||
Cobol Warning Var(cobol_volatile, 1) Init(1)
|
||||
Warn if VOLATILE is used (instead of error if -dialect ibm)
|
||||
|
||||
;; end error-suppression options
|
||||
|
||||
fdefaultbyte
|
||||
Cobol RejectNegative Joined Separate UInteger Var(cobol_default_byte)
|
||||
Set Working-Storage data items to the supplied value
|
||||
|
||||
@@ -681,7 +681,8 @@ parse_replacing_term( const char *stmt, const char *estmt ) {
|
||||
}
|
||||
if( extraneous_replacing ) {
|
||||
update_yylloc( cm[0], cm[8] );
|
||||
yywarn("syntax error: invalid '%.*s'", cm[8].length(), cm[8].first);
|
||||
cbl_message(LexReplaceE, "syntax error: invalid '%.*s'",
|
||||
cm[8].length(), cm[8].first);
|
||||
output.matched = false;
|
||||
return output;
|
||||
}
|
||||
@@ -797,11 +798,11 @@ parse_replacing_pair( const char *stmt, const char *estmt ) {
|
||||
}
|
||||
}
|
||||
if( pair.stmt.p ) {
|
||||
yywarn("CDF syntax error '%.*s'", (int)pair.stmt.size(), pair.stmt.p);
|
||||
cbl_message(LexReplaceE, "LEX syntax error '%.*s'", (int)pair.stmt.size(), pair.stmt.p);
|
||||
}
|
||||
else {
|
||||
// This eliminated a compiler warning about "format-overflow"
|
||||
yywarn("CDF syntax error");
|
||||
cbl_message(LexReplaceE, "LEX syntax error");
|
||||
}
|
||||
pair.stmt = span_t(size_t(0), stmt);
|
||||
pair.replace = replace_t();
|
||||
@@ -1466,7 +1467,8 @@ preprocess_filter_add( const char input[] ) {
|
||||
|
||||
auto filename = find_filter(filter.c_str());
|
||||
if( !filename ) {
|
||||
yywarn("preprocessor '%s/%s' not found", getcwd(NULL, 0), filter.c_str());
|
||||
cbl_message(LexPreprocessE, "preprocessor '%s/%s' not found",
|
||||
getcwd(NULL, 0), filter.c_str());
|
||||
return false;
|
||||
}
|
||||
preprocessor_filters.push_back( std::make_pair(xstrdup(filename), options) );
|
||||
@@ -1477,22 +1479,22 @@ void
|
||||
cdftext::echo_input( int input, const char filename[] ) {
|
||||
int fd;
|
||||
if( -1 == (fd = dup(input)) ) {
|
||||
yywarn( "could not open preprocessed file %s to echo to standard output",
|
||||
filename );
|
||||
cbl_message(LexPreprocessE, "could not open preprocessed file "
|
||||
"%s to echo to standard output", filename );
|
||||
return;
|
||||
}
|
||||
|
||||
auto mfile = map_file(fd);
|
||||
|
||||
if( -1 == write(STDOUT_FILENO, mfile.data, mfile.size()) ) {
|
||||
yywarn( "could not write preprocessed file %s to standard output",
|
||||
cbl_message(LexPreprocessE, "could not write preprocessed file %s to standard output",
|
||||
filename );
|
||||
}
|
||||
if( -1 == munmap(mfile.data, mfile.size()) ) {
|
||||
yywarn( "could not release mapped file" );
|
||||
cbl_message(LexPreprocessE, "could not release mapped file" );
|
||||
}
|
||||
if( -1 == close(fd) ) {
|
||||
yywarn( "could not close mapped file" );
|
||||
cbl_message(LexPreprocessE, "could not close mapped file" );
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1515,7 +1517,7 @@ cdftext::lex_open( const char filename[] ) {
|
||||
// Process any files supplied by the -include command-line option.
|
||||
for( auto name : included_files ) {
|
||||
if( -1 == (input = open(name, O_RDONLY)) ) {
|
||||
yyerrorvl(1, "", "cannot open -include file %s", name);
|
||||
cbl_message(LexIncludeE, "cannot open %<-include%> file %qs", name);
|
||||
continue;
|
||||
}
|
||||
cobol_filename(name, inode_of(input));
|
||||
@@ -1569,7 +1571,7 @@ cdftext::lex_open( const char filename[] ) {
|
||||
}
|
||||
int erc;
|
||||
if( -1 == (erc = execv(filter, argv.data())) ) {
|
||||
yywarn("could not execute %s", filter);
|
||||
cbl_message(LexPreprocessE, "could not execute %s", filter);
|
||||
}
|
||||
_exit(erc);
|
||||
}
|
||||
@@ -1588,7 +1590,7 @@ cdftext::lex_open( const char filename[] ) {
|
||||
filter, status);
|
||||
}
|
||||
}
|
||||
yywarn( "applied %s", filter );
|
||||
cbl_message(LexIncludeOkN, "applied %s", filter );
|
||||
}
|
||||
|
||||
return fdopen( output, "r");
|
||||
@@ -1604,7 +1606,7 @@ cdftext::open_input( const char filename[] ) {
|
||||
verbose_file_reader = NULL != getenv("GCOBOL_TEMPDIR");
|
||||
|
||||
if( verbose_file_reader ) {
|
||||
yywarn("verbose: opening %s for input", filename);
|
||||
cbl_message(LexInputN, "verbose: opening %s for input", filename);
|
||||
}
|
||||
return fd;
|
||||
}
|
||||
|
||||
388
gcc/cobol/messages.cc
Normal file
388
gcc/cobol/messages.cc
Normal file
@@ -0,0 +1,388 @@
|
||||
/*
|
||||
* Copyright (c) 2021-2025 Symas Corporation
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are
|
||||
* met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* * Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following disclaimer
|
||||
* in the documentation and/or other materials provided with the
|
||||
* distribution.
|
||||
* * Neither the name of the Symas Corporation nor the names of its
|
||||
* contributors may be used to endorse or promote products derived from
|
||||
* this software without specific prior written permission.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*/
|
||||
|
||||
/*
|
||||
* Define a table of diagnositic messages, each uniquely identified and
|
||||
* grouped into dialects. The user can select on the command line which
|
||||
* ones are in effect.
|
||||
*/
|
||||
|
||||
#include <cobol-system.h>
|
||||
#include <coretypes.h>
|
||||
#include <tree.h>
|
||||
#undef yy_flex_debug
|
||||
|
||||
#include <langinfo.h>
|
||||
|
||||
#include <coretypes.h>
|
||||
#include <version.h>
|
||||
#include <demangle.h>
|
||||
#include <intl.h>
|
||||
#include <backtrace.h>
|
||||
#include <diagnostic.h>
|
||||
#include <opts.h>
|
||||
#include "util.h"
|
||||
|
||||
#include "cbldiag.h"
|
||||
#include "cdfval.h"
|
||||
#include "lexio.h"
|
||||
|
||||
#include "../../libgcobol/ec.h"
|
||||
#include "../../libgcobol/common-defs.h"
|
||||
#include "symbols.h"
|
||||
#include "inspect.h"
|
||||
#include "../../libgcobol/io.h"
|
||||
#include "genapi.h"
|
||||
#include "genutil.h"
|
||||
#include "../../libgcobol/charmaps.h"
|
||||
|
||||
|
||||
|
||||
/*
|
||||
* As of now, every diagnositc has one id, one message, one kind, and is
|
||||
* associated with "one" dialect. The dialect could be ORed. If it is, that
|
||||
* means among the dialects it belongs to, it is always of the same kind.
|
||||
*
|
||||
* The diagnositic mask in force during compilation may include/exclude
|
||||
* features based on their associated dialect and/or by id. It may stipulate
|
||||
* that a warning is treated as an error, too, but that's up the diagnostic
|
||||
* framework. If a feature requires a dialect and is not specifically enabled,
|
||||
* gcobol emits of message of the associated kind, and names the dialect
|
||||
* required.
|
||||
*/
|
||||
struct cbl_diag_t {
|
||||
cbl_diag_id_t id;
|
||||
cbl_name_t option;
|
||||
diagnostics::kind kind;
|
||||
cbl_dialect_t dialect;
|
||||
|
||||
explicit cbl_diag_t( cbl_diag_id_t id )
|
||||
: id(id), option(""), kind(diagnostics::kind::ignored), dialect(dialect_gcc_e)
|
||||
{}
|
||||
|
||||
cbl_diag_t( cbl_diag_id_t id,
|
||||
const char option[],
|
||||
diagnostics::kind kind,
|
||||
cbl_dialect_t dialect = dialect_iso_e )
|
||||
: id(id), option(""), kind(kind), dialect(dialect)
|
||||
{
|
||||
gcc_assert(strlen(option) < sizeof(this->option));
|
||||
strcpy(this->option, option);
|
||||
}
|
||||
|
||||
bool operator<( const cbl_diag_t& that ) const {
|
||||
return id < that.id;
|
||||
}
|
||||
};
|
||||
|
||||
/*
|
||||
* Initially, errors and warnings are set per the default, dialect gcc. If the
|
||||
* user chooses dialect iso, all dialect-enabled features are turned into
|
||||
* errors. If the user selects a more generous dialect, features associated
|
||||
* with it are set to be ignored.
|
||||
*
|
||||
* Individual features may also be suppressed, and all warnings may be elevated
|
||||
* to errors.
|
||||
*/
|
||||
const static auto dialect_mf_gnu = cbl_dialect_t(dialect_mf_e | dialect_gnu_e);
|
||||
const static auto dialect_ibm_mf_gnu = cbl_dialect_t(dialect_ibm_e |
|
||||
dialect_mf_e |
|
||||
dialect_gnu_e);
|
||||
|
||||
std::set<cbl_diag_t> cbl_diagnostics {
|
||||
{ CdfNotFoundW, "-Wcdf-name-not-found", diagnostics::kind::warning },
|
||||
{ CdfParameterW, "-Wcdf-invalid-parameter", diagnostics::kind::warning },
|
||||
|
||||
{ EcUnknownW, "-Wec-unknown", diagnostics::kind::warning },
|
||||
|
||||
{ IbmEjectE, "-Wcobol-eject", diagnostics::kind::error, dialect_ibm_e },
|
||||
{ IbmLengthOf, "-Wlength-of", diagnostics::kind::error, dialect_ibm_mf_gnu },
|
||||
{ IbmEqualAssignE, "-Wequal-assign", diagnostics::kind::error, dialect_ibm_e },
|
||||
{ IbmProcedurePointer, "-Wprocedure-pointer", diagnostics::kind::error, dialect_ibm_mf_gnu },
|
||||
{ IbmSectionNegE, "-Wsegment-negative", diagnostics::kind::error, dialect_ibm_e },
|
||||
{ IbmSectionRangeE, "-Wsegment-error", diagnostics::kind::error, dialect_ibm_e },
|
||||
{ IbmSectionSegmentW, "-Wsegment", diagnostics::kind::warning, dialect_ibm_e },
|
||||
{ IbmStopNumber, "-Wstop-number", diagnostics::kind::error, dialect_ibm_e },
|
||||
{ IbmVolatileE, "-Wcobol-volatile", diagnostics::kind::error, dialect_ibm_e },
|
||||
{ IbmVolatileW, "-Wcobol-volatile", diagnostics::kind::warning, dialect_ibm_e },
|
||||
|
||||
// RESUME not supported by IBM
|
||||
{ IsoResume, "-Wcobol-resume", diagnostics::kind::error, dialect_ibm_e },
|
||||
|
||||
{ MfBinaryLongLong, "-Wbinary-long-long", diagnostics::kind::error, dialect_mf_gnu },
|
||||
{ MfCallGiving, "-Wcall-giving", diagnostics::kind::error, dialect_mf_gnu },
|
||||
{ MfCdfDollar, "-Wcdf-dollar", diagnostics::kind::error, dialect_mf_gnu },
|
||||
{ MfComp6, "-Wcomp-6", diagnostics::kind::error, dialect_mf_gnu },
|
||||
{ MfCompX, "-Wcomp-x", diagnostics::kind::error, dialect_mf_gnu },
|
||||
{ MfLevel_1_Occurs, "Wlevel-1-occurs", diagnostics::kind::error, dialect_mf_gnu },
|
||||
{ MfLevel78, "-Wlevel-78", diagnostics::kind::error, dialect_mf_gnu },
|
||||
{ MfMovePointer, "-Wmove-pointer", diagnostics::kind::error, dialect_mf_gnu },
|
||||
{ MfReturningNum, "-Wreturning-number", diagnostics::kind::error, dialect_mf_gnu },
|
||||
{ MfUsageTypename, "-Wusage-typename", diagnostics::kind::error, dialect_mf_gnu },
|
||||
{ MfTrailing, "-Winspect-trailing", diagnostics::kind::error, dialect_mf_gnu },
|
||||
|
||||
{ LexIncludeE, "-Winclude-file-not-found", diagnostics::kind::error },
|
||||
{ LexIncludeOkN, "-Winclude-file-found", diagnostics::kind::note },
|
||||
{ LexIndicatorE, "-Wstray-indicator", diagnostics::kind::error },
|
||||
{ LexInputN, "-Wcopybook-found", diagnostics::kind::note },
|
||||
{ LexLineE, "-Wbad-line-directive", diagnostics::kind::error },
|
||||
{ LexPreprocessE, "-Wpreprocessor-error", diagnostics::kind::error },
|
||||
{ LexReplaceE, "-Wreplace-error", diagnostics::kind::error },
|
||||
// mf and gnu do not require whitespace after relational operators
|
||||
{ LexSeparatorE, "-Woperator-space", diagnostics::kind::error, dialect_mf_gnu },
|
||||
|
||||
{ Par78CdfDefinedW, "-Wlevel-78-defined", diagnostics::kind::warning },
|
||||
{ ParIconvE, "-Wiconv-error", diagnostics::kind::note },
|
||||
{ ParInfoI, "-Wentry-convention", diagnostics::kind::note },
|
||||
{ ParLangInfoW, "-Wnllanginfo-error", diagnostics::kind::warning },
|
||||
{ ParLiteral2W, "-Wliteral-concat", diagnostics::kind::warning },
|
||||
{ ParLocaleW, "-Wlocale-error", diagnostics::kind::warning },
|
||||
{ ParNoCorrespondingW, "-Wmove-corresponding", diagnostics::kind::warning },
|
||||
{ ParNumstrW, "-Wbad-numeric", diagnostics::kind::warning },
|
||||
{ ParUnresolvedProcE, "-Wprocedure-not-found", diagnostics::kind::error },
|
||||
|
||||
// unimplmeneted syntax warnings
|
||||
{ SynApplyCommit, "-Wapply-commit", diagnostics::kind::warning },
|
||||
{ SynFileCodeSet, "-Wfile-code-set", diagnostics::kind::warning },
|
||||
{ SynHighOrderBit, "-Whigh-order-bit", diagnostics::kind::warning },
|
||||
{ SynRecordingMode, "-Wrecording-mode", diagnostics::kind::warning },
|
||||
{ SynSetLocaleTo, "-Wset-locale-to", diagnostics::kind::warning },
|
||||
{ SynSetToLocale, "-Wset-to-locale", diagnostics::kind::warning },
|
||||
|
||||
};
|
||||
|
||||
static struct set_verify {
|
||||
set_verify() {
|
||||
gcc_assert(cbl_diagnostics.size() == DiagDiagDiag);
|
||||
auto p = std::find_if(cbl_diagnostics.begin(), cbl_diagnostics.end(),
|
||||
[]( const auto& diag ) {
|
||||
return '?' == cbl_dialect_str(diag.dialect)[0];
|
||||
} );
|
||||
if( p != cbl_diagnostics.end() ) {
|
||||
fprintf(stderr, "unregconized dialect '%04x (~%04x)'", p->dialect, ~p->dialect);
|
||||
}
|
||||
gcc_assert( std::none_of(cbl_diagnostics.begin(), cbl_diagnostics.end(),
|
||||
[]( const auto& diag ) {
|
||||
return '?' == cbl_dialect_str(diag.dialect)[0];
|
||||
} ) );
|
||||
}
|
||||
} verify_consistent_message_count;
|
||||
|
||||
static inline diagnostics::kind
|
||||
kind_of( cbl_diag_id_t id ) {
|
||||
auto diag = cbl_diagnostics.find(cbl_diag_t(id));
|
||||
if( diag != cbl_diagnostics.end() ) {
|
||||
return diag->kind;
|
||||
}
|
||||
return diagnostics::kind::ice;
|
||||
}
|
||||
|
||||
diagnostics::kind
|
||||
cbl_diagnostic_kind( cbl_diag_id_t id ) {
|
||||
return kind_of(id);
|
||||
}
|
||||
|
||||
bool
|
||||
cbl_diagnostic_kind( cbl_diag_id_t id, diagnostics::kind kind ) {
|
||||
auto p = cbl_diagnostics.find( cbl_diag_t{id} );
|
||||
if( p != cbl_diagnostics.end() ) {
|
||||
auto diag(*p);
|
||||
diag.kind = kind;
|
||||
cbl_diagnostics.erase(p);
|
||||
return cbl_diagnostics.insert(diag).second;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
bool
|
||||
cbl_diagnostic_kind( cbl_dialect_t dialect, diagnostics::kind kind ) {
|
||||
bool ok = true;
|
||||
for( auto diag : cbl_diagnostics ) {
|
||||
if( diag.dialect == dialect ) {
|
||||
if( ! cbl_diagnostic_kind(diag.id, kind) ) ok = false;
|
||||
}
|
||||
}
|
||||
return ok;
|
||||
}
|
||||
|
||||
void
|
||||
cobol_warning( cbl_diag_id_t id, int yn, bool warning_as_error ) {
|
||||
gcc_assert( 0 <= yn && yn <= 1 );
|
||||
|
||||
diagnostics::kind kind = yn?
|
||||
diagnostics::kind::warning : diagnostics::kind::ignored;
|
||||
|
||||
if( warning_as_error ) {
|
||||
kind = diagnostics::kind::error;
|
||||
}
|
||||
|
||||
cbl_diagnostic_kind(id, kind);
|
||||
}
|
||||
|
||||
static inline const char *
|
||||
option_of( cbl_diag_id_t id ) {
|
||||
auto diag = cbl_diagnostics.find(cbl_diag_t(id));
|
||||
if( diag != cbl_diagnostics.end() && diag->option[0] ) {
|
||||
return diag->option;
|
||||
}
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
const char *
|
||||
cbl_diagnostic_option( cbl_diag_id_t id ) {
|
||||
return option_of(id);
|
||||
}
|
||||
|
||||
/*
|
||||
* This is the general message looker-upper. It determines whether the
|
||||
* diagnositic is in force, at what level, and the message text, and invokes
|
||||
* the framework.
|
||||
*/
|
||||
extern int yychar;
|
||||
extern YYLTYPE yylloc;
|
||||
|
||||
static const diagnostics::option_id option_zero;
|
||||
|
||||
location_t current_token_location();
|
||||
location_t current_token_location(const location_t& loc);
|
||||
|
||||
bool
|
||||
cbl_message( cbl_diag_id_t id, const char gmsgid[], ... ) {
|
||||
auto_diagnostic_group d;
|
||||
const char *option;
|
||||
char *msg = nullptr;
|
||||
|
||||
diagnostics::kind kind = kind_of(id);
|
||||
if( kind == diagnostics::kind::ignored ) return false;
|
||||
|
||||
if( (option = option_of(id)) != nullptr ) {
|
||||
msg = xasprintf("%s [%s]", gmsgid, option);
|
||||
gmsgid = msg;
|
||||
}
|
||||
|
||||
va_list ap;
|
||||
|
||||
va_start (ap, gmsgid);
|
||||
auto ret = emit_diagnostic_valist( kind, current_token_location(),
|
||||
option_zero, gmsgid, &ap );
|
||||
va_end (ap);
|
||||
free(msg);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
bool cbl_message( cbl_loc_t loc, cbl_diag_id_t id, const char gmsgid[], ... ) {
|
||||
class temp_loc_t { // copied from util.cc
|
||||
location_t orig;
|
||||
public:
|
||||
temp_loc_t() : orig(current_token_location()) {
|
||||
if( yychar < 3 ) return;
|
||||
|
||||
gcc_location_set(yylloc); // use lookahead location
|
||||
}
|
||||
explicit temp_loc_t( const YYLTYPE& loc) : orig(current_token_location()) {
|
||||
gcc_location_set(loc);
|
||||
}
|
||||
explicit temp_loc_t( const YDFLTYPE& loc) : orig(current_token_location()) {
|
||||
gcc_location_set(loc);
|
||||
}
|
||||
~temp_loc_t() {
|
||||
if( orig != current_token_location() ) {
|
||||
current_token_location(orig);
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
auto_diagnostic_group d;
|
||||
const char *option;
|
||||
char *msg = nullptr;
|
||||
|
||||
diagnostics::kind kind = kind_of(id);
|
||||
if( kind == diagnostics::kind::ignored ) return false;
|
||||
|
||||
if( (option = option_of(id)) != nullptr ) {
|
||||
msg = xasprintf("%s [%s]", gmsgid, option);
|
||||
gmsgid = msg;
|
||||
}
|
||||
|
||||
temp_loc_t looker(loc);
|
||||
va_list ap;
|
||||
|
||||
va_start (ap, gmsgid);
|
||||
rich_location richloc (line_table, current_token_location());
|
||||
auto ret = emit_diagnostic_valist( kind,
|
||||
current_token_location(),
|
||||
option_zero, gmsgid, &ap );
|
||||
va_end (ap);
|
||||
free(msg);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
/*
|
||||
* Verify the dialect associated with the id (and thus term) is covered by the
|
||||
* dialects currently in effect. If not, issue a standard message of the kind
|
||||
* defined by the id. Possible combinations:
|
||||
* dialect required: ok, dialect matches feature dialect
|
||||
* dialect prohibits not_ok, dialect matches feature ~dialect
|
||||
*
|
||||
* If ok is false, then a match means the dialect prohibits the feature.
|
||||
*/
|
||||
bool
|
||||
dialect_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[], bool ok ) {
|
||||
auto diag = cbl_diagnostics.find(cbl_diag_t(id));
|
||||
|
||||
const char *verb = "requires";
|
||||
|
||||
if( diag == cbl_diagnostics.end() ) {
|
||||
gcc_unreachable();
|
||||
}
|
||||
|
||||
if( diag->kind == diagnostics::kind::ignored ) return true;
|
||||
|
||||
if( dialect_has(diag->dialect) ) {
|
||||
if( ok ) {
|
||||
return true;
|
||||
} else {
|
||||
verb = "prohibits";
|
||||
}
|
||||
} else {
|
||||
if( !ok ) return true; // current dialect correctly does not match the feature
|
||||
}
|
||||
|
||||
cbl_message(loc, id, "%qs %s %<-dialect %s%>",
|
||||
term, verb, cbl_dialect_str(diag->dialect));
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -359,7 +359,7 @@ class locale_tgt_t {
|
||||
NUMED_CR "NUMERIC-EDITED CR picture"
|
||||
NUMED_DB "NUMERIC-EDITED DB picture"
|
||||
%token <number> NINEDOT NINES NINEV PIC_P ONES
|
||||
%token <string> SPACES
|
||||
%token <string> SPACES EQ "EQUAL"
|
||||
%token <literal> LITERAL
|
||||
%token <number> END EOP
|
||||
%token <string> FILENAME
|
||||
@@ -477,8 +477,8 @@ class locale_tgt_t {
|
||||
DOWN DUPLICATES
|
||||
DYNAMIC
|
||||
|
||||
E EBCDIC EC EGCS ENCODING ENTRY ENVIRONMENT EQUAL EVERY
|
||||
EXAMINE EXHIBIT EXP EXP10 EXTEND EXTERNAL
|
||||
E EBCDIC EC EGCS ENCODING ENTRY ENVIRONMENT
|
||||
EVERY EXAMINE EXHIBIT EXP EXP10 EXTEND EXTERNAL
|
||||
|
||||
EXCEPTION_FILE "EXCEPTION-FILE"
|
||||
EXCEPTION_FILE_N "EXCEPTION-FILE-N"
|
||||
@@ -1130,7 +1130,7 @@ class locale_tgt_t {
|
||||
DYNAMIC
|
||||
|
||||
E EBCDIC EC EGCS ELEMENT
|
||||
ENTRY ENVIRONMENT EQUAL ERROR EVERY
|
||||
ENTRY ENVIRONMENT ERROR EVERY
|
||||
EXAMINE EXCEPTION EXHIBIT EXP EXP10 EXTEND EXTERNAL
|
||||
|
||||
EXCEPTION_FILE
|
||||
@@ -1336,7 +1336,7 @@ class locale_tgt_t {
|
||||
%left OR
|
||||
%left AND
|
||||
%right NOT
|
||||
%left '<' '>' '=' NE LE GE
|
||||
%left '<' '>' EQ NE LE GE
|
||||
%left '-' '+'
|
||||
%left '*' '/'
|
||||
%right POW
|
||||
@@ -1658,21 +1658,25 @@ opt_round: DEFAULT ROUNDED mode is rounded_type[type] {
|
||||
}
|
||||
;
|
||||
opt_entry: ENTRY_CONVENTION is COBOL {
|
||||
yywarn("ENTRY-CONVENTION IS COBOL, check");
|
||||
cbl_message(ParInfoI, "ENTRY-CONVENTION IS COBOL");
|
||||
}
|
||||
;
|
||||
opt_binary: FLOAT_BINARY default_kw is HIGH_ORDER_LEFT
|
||||
{
|
||||
cbl_unimplementedw("HIGH-ORDER-LEFT was ignored");
|
||||
cbl_unimplementedw(SynHighOrderBit,
|
||||
"HIGH-ORDER-LEFT was ignored");
|
||||
if( ! current.option_binary(cbl_options_t::high_order_left_e) ) {
|
||||
error_msg(@3, "unable to set %<HIGH_ORDER_LEFT%>");
|
||||
cbl_message(@3, SynHighOrderBit,
|
||||
"unable to set %<HIGH_ORDER_LEFT%>");
|
||||
}
|
||||
}
|
||||
| FLOAT_BINARY default_kw is HIGH_ORDER_RIGHT[opt]
|
||||
{
|
||||
cbl_unimplementedw("HIGH-ORDER-RIGHT was ignored");
|
||||
cbl_unimplementedw(SynHighOrderBit,
|
||||
"HIGH-ORDER-RIGHT was ignored");
|
||||
if( ! current.option_binary(cbl_options_t::high_order_right_e) ) {
|
||||
error_msg(@opt, "unable to set HIGH-ORDER-RIGHT");
|
||||
cbl_message(@opt, SynHighOrderBit,
|
||||
"unable to set HIGH-ORDER-RIGHT");
|
||||
}
|
||||
}
|
||||
;
|
||||
@@ -1681,30 +1685,38 @@ default_kw: %empty
|
||||
;
|
||||
opt_decimal: FLOAT_DECIMAL default_kw is HIGH_ORDER_LEFT[opt]
|
||||
{
|
||||
cbl_unimplementedw("HIGH-ORDER-LEFT was ignored");
|
||||
cbl_unimplementedw(SynHighOrderBit,
|
||||
"HIGH-ORDER-LEFT was ignored");
|
||||
if( ! current.option_decimal(cbl_options_t::high_order_left_e) ) {
|
||||
error_msg(@opt, "unable to set HIGH-ORDER-LEFT");
|
||||
cbl_message(@opt, SynHighOrderBit,
|
||||
"unable to set HIGH-ORDER-LEFT");
|
||||
}
|
||||
}
|
||||
| FLOAT_DECIMAL default_kw is HIGH_ORDER_RIGHT[opt]
|
||||
{
|
||||
cbl_unimplementedw("HIGH-ORDER-RIGHT was ignored");
|
||||
cbl_unimplementedw(SynHighOrderBit,
|
||||
"HIGH-ORDER-RIGHT was ignored");
|
||||
if( ! current.option_decimal(cbl_options_t::high_order_right_e) ) {
|
||||
error_msg(@opt, "unable to set HIGH-ORDER-RIGHT");
|
||||
cbl_message(@opt, SynHighOrderBit,
|
||||
"unable to set HIGH-ORDER-RIGHT");
|
||||
}
|
||||
}
|
||||
| FLOAT_DECIMAL default_kw is BINARY_ENCODING[opt]
|
||||
{
|
||||
cbl_unimplementedw("BINARY-ENCODING was ignored");
|
||||
cbl_unimplementedw(SynHighOrderBit,
|
||||
"BINARY-ENCODING was ignored");
|
||||
if( ! current.option(cbl_options_t::binary_encoding_e) ) {
|
||||
error_msg(@opt, "unable to set BINARY-ENCODING option");
|
||||
cbl_message(@opt, SynHighOrderBit,
|
||||
"unable to set BINARY-ENCODING option");
|
||||
}
|
||||
}
|
||||
| FLOAT_DECIMAL default_kw is DECIMAL_ENCODING[opt]
|
||||
{
|
||||
cbl_unimplementedw("DECIMAL-ENCODING was ignored");
|
||||
cbl_unimplementedw(SynHighOrderBit,
|
||||
"DECIMAL-ENCODING was ignored");
|
||||
if( ! current.option(cbl_options_t::decimal_encoding_e) ) {
|
||||
error_msg(@opt, "unable to set DECIMAL-ENCODING option");
|
||||
cbl_message(@opt, SynHighOrderBit,
|
||||
"unable to set DECIMAL-ENCODING option");
|
||||
}
|
||||
}
|
||||
;
|
||||
@@ -1888,7 +1900,8 @@ io_control_clause:
|
||||
}
|
||||
| APPLY COMMIT on field_list
|
||||
{
|
||||
cbl_unimplementedw("I-O-CONTROL APPLY COMMIT");
|
||||
cbl_unimplementedw(SynApplyCommit,
|
||||
"I-O-CONTROL APPLY COMMIT ignored");
|
||||
}
|
||||
;
|
||||
area: %empty
|
||||
@@ -3160,14 +3173,16 @@ fd_clause: record_desc
|
||||
error_msg(@NAME, "invalid RECORDING MODE '%s'", $NAME);
|
||||
YYERROR;
|
||||
}
|
||||
cbl_unimplementedw("RECORDING MODE was ignored, not defined by ISO 2023");
|
||||
cbl_unimplementedw(SynRecordingMode,
|
||||
"RECORDING MODE ignored");
|
||||
}
|
||||
| VALUE OF fd_values
|
||||
| CODESET is codeset_name[codeset] {
|
||||
auto f = cbl_file_of(symbol_at(file_section_fd));
|
||||
f->codeset = cbl_file_t::codeset_t($codeset.encoding,
|
||||
$codeset.isym);
|
||||
cbl_unimplementedw("sorry, unimplemented CODE-SET");
|
||||
cbl_unimplementedw(SynFileCodeSet,
|
||||
"sorry, unimplemented CODE-SET");
|
||||
}
|
||||
| CODESET for alphanational is codeset_name[codeset]
|
||||
{
|
||||
@@ -3758,24 +3773,23 @@ data_descr1: level_name
|
||||
|
||||
| LEVEL78 NAME[name] VALUE is value78[data]
|
||||
{
|
||||
if( ! (dialect_mf() || dialect_gnu()) ) {
|
||||
dialect_error(@1, "level 78", "mf or gnu");
|
||||
YYERROR;
|
||||
}
|
||||
dialect_ok(@1, MfLevel78, "LEVEL 78");
|
||||
cbl_field_t field = { FldLiteralA, constant_e, *$data.data,
|
||||
78, $name, @name.first_line };
|
||||
if( field.data.initial ) {
|
||||
field.attr |= quoted_e;
|
||||
field.codeset.set($data.encoding);
|
||||
if( !cdf_value(field.name, field.data.initial) ) {
|
||||
yywarn("%s was defined by CDF", field.name);
|
||||
cbl_message(Par78CdfDefinedW,
|
||||
"%s was defined by CDF", field.name);
|
||||
}
|
||||
} else {
|
||||
field.type = FldLiteralN;
|
||||
field.data.initial = string_of(field.data.value_of());
|
||||
field.codeset.set($data.encoding);
|
||||
if( !cdf_value(field.name, field.as_integer()) ) {
|
||||
yywarn("%s was defined by CDF", field.name);
|
||||
cbl_message(Par78CdfDefinedW,
|
||||
"%s was defined by CDF", field.name);
|
||||
}
|
||||
}
|
||||
if( ($$ = field_add(@name, &field)) == NULL ) {
|
||||
@@ -4062,8 +4076,9 @@ literalism: LITERAL { $$ = $1; }
|
||||
|
||||
if( $second.prefix[0] ) { strcpy(output.prefix, $second.prefix); }
|
||||
if( ! $first.compatible_prefix($second) ) {
|
||||
yywarn("dissimilar literals, '%s' prevails",
|
||||
output.prefix);
|
||||
cbl_message(@$, ParLiteral2W,
|
||||
"dissimilar literals, '%s' prevails",
|
||||
output.prefix);
|
||||
}
|
||||
}
|
||||
;
|
||||
@@ -4173,13 +4188,11 @@ data_clauses: data_clause
|
||||
if( field->is_binary_integer() && field->data.capacity == 4) {
|
||||
auto redefined = symbol_redefines(field);
|
||||
if( redefined && redefined->type == FldPointer ) {
|
||||
if( yydebug ) {
|
||||
yywarn("expanding %s size from %u bytes to %wd "
|
||||
"because it redefines %s with %<USAGE POINTER%>",
|
||||
field->name, field->size(),
|
||||
int_size_in_bytes(ptr_type_node),
|
||||
redefined->name);
|
||||
}
|
||||
dbgmsg("expanding %s size from %u bytes to %lu "
|
||||
"because it redefines %s with USAGE POINTER",
|
||||
field->name, field->size(),
|
||||
int_size_in_bytes(ptr_type_node),
|
||||
redefined->name);
|
||||
field->embiggen();
|
||||
}
|
||||
}
|
||||
@@ -4213,7 +4226,7 @@ data_clause: any_length { $$ = any_length_e; }
|
||||
cbl_field_t *field = current_field();
|
||||
switch( field->level ) {
|
||||
case 1:
|
||||
if( dialect_mf() ) break;
|
||||
if( dialect_ok(@$, MfLevel_1_Occurs, "LEVEL 01 for OCCURS") ) break;
|
||||
__attribute__((fallthrough));
|
||||
case 77:
|
||||
case 88:
|
||||
@@ -4336,7 +4349,7 @@ picture_clause: PIC signed nps[fore] nines nps[aft]
|
||||
|
||||
if( field->type == FldNumericBin5 &&
|
||||
field->data.capacity == 0xFF &&
|
||||
(dialect_gnu() || dialect_mf()) )
|
||||
dialect_ok(@2, MfCompX, "alphanumeric PICTURE with numeric USAGE") )
|
||||
{ // PIC X COMP-X or COMP-9
|
||||
if( ! field->has_attr(all_x_e) ) {
|
||||
error_msg(@2, "COMP PICTURE requires all X%'s or all 9%'s");
|
||||
@@ -4568,22 +4581,15 @@ usage_clause1: usage BIT
|
||||
case FldAlphanumeric: // PIC X COMP-5 or COMP-X
|
||||
assert( field->data.digits == 0 );
|
||||
assert( field->data.rdigits == 0 );
|
||||
if( (dialect_mf() || dialect_gnu()) ) {
|
||||
field->type = $comp.type;
|
||||
field->clear_attr(signable_e);
|
||||
} else {
|
||||
error_msg(@comp, "numeric USAGE invalid "
|
||||
"with Alphanumeric PICTURE");
|
||||
dialect_error(@1, "Alphanumeric COMP-5 or COMP-X", "mf or gnu");
|
||||
YYERROR;
|
||||
}
|
||||
dialect_ok(@2, MfCompX, "alphanumeric PICTURE with numeric USAGE");
|
||||
|
||||
field->type = $comp.type;
|
||||
field->clear_attr(signable_e);
|
||||
break;
|
||||
case FldNumericDisplay: // PIC 9 COMP-5 or COMP-X
|
||||
if( $comp.capacity == 0xFF ) { // comp-x is a bit like comp-5
|
||||
assert( field->data.digits == field->data.capacity );
|
||||
if( ! (dialect_mf() || dialect_gnu()) ) {
|
||||
dialect_error(@1, "COMP-X", "mf or gnu");
|
||||
}
|
||||
dialect_ok(@2, MfCompX, "alphanumeric PICTURE with numeric USAGE");
|
||||
}
|
||||
field->type = $comp.type;
|
||||
field->data.capacity = type_capacity(field->type,
|
||||
@@ -4596,9 +4602,7 @@ usage_clause1: usage BIT
|
||||
case FldPacked: // comp-6 is unsigned comp-3
|
||||
assert(! $comp.signable); // else PACKED_DECIMAL from scanner
|
||||
field->attr |= separate_e;
|
||||
if( ! dialect_mf() ) {
|
||||
dialect_error(@1, "COMP-6", "mf");
|
||||
}
|
||||
dialect_ok(@2, MfComp6, "COMP-6");
|
||||
if( field->type == FldNumericDisplay ) {// PICTURE before USAGE
|
||||
infer = false;
|
||||
assert(field->data.capacity > 0);
|
||||
@@ -4649,22 +4653,14 @@ usage_clause1: usage BIT
|
||||
case FldAlphanumeric: // PIC X COMP-5 or COMP-X
|
||||
assert( field->data.digits == 0 );
|
||||
assert( field->data.rdigits == 0 );
|
||||
if( (dialect_mf() || dialect_gnu()) ) {
|
||||
field->type = $comp.type;
|
||||
field->clear_attr(signable_e);
|
||||
} else {
|
||||
error_msg(@comp, "numeric USAGE invalid "
|
||||
"with Alphanumeric PICTURE");
|
||||
dialect_error(@1, "Alphanumeric COMP-5 or COMP-X", "mf or gnu");
|
||||
YYERROR;
|
||||
}
|
||||
dialect_ok(@2, MfCompX, "alphanumeric PICTURE with numeric USAGE");
|
||||
field->type = $comp.type;
|
||||
field->clear_attr(signable_e);
|
||||
break;
|
||||
case FldNumericDisplay: // PIC 9 COMP-5 or COMP-X
|
||||
if( $comp.capacity == 0xFF ) { // comp-x is a bit like comp-5
|
||||
assert( field->data.digits == field->data.capacity );
|
||||
if( ! (dialect_mf() || dialect_gnu()) ) {
|
||||
dialect_error(@1, "COMP-X", "mf or gnu");
|
||||
}
|
||||
dialect_ok(@2, MfCompX, "alphanumeric PICTURE with numeric USAGE");
|
||||
}
|
||||
field->type = $comp.type;
|
||||
field->data.capacity = type_capacity(field->type,
|
||||
@@ -4677,9 +4673,7 @@ usage_clause1: usage BIT
|
||||
case FldPacked: // comp-6 is unsigned comp-3
|
||||
assert(! $comp.signable); // else PACKED_DECIMAL from scanner
|
||||
field->attr |= separate_e;
|
||||
if( ! dialect_mf() ) {
|
||||
dialect_error(@1, "COMP-6", "mf");
|
||||
}
|
||||
dialect_ok(@2, MfComp6, "COMP-6");
|
||||
if( field->type == FldNumericDisplay ) {// PICTURE before USAGE
|
||||
infer = false;
|
||||
assert(field->data.capacity > 0);
|
||||
@@ -5074,10 +5068,7 @@ type_clause: TYPE to typename
|
||||
}
|
||||
| USAGE is typename
|
||||
{
|
||||
if( ! dialect_mf() ) {
|
||||
dialect_error(@typename, "USAGE TYPENAME", "mf");
|
||||
YYERROR;
|
||||
}
|
||||
dialect_ok(@typename, MfUsageTypename, "USAGE TYPENAME");
|
||||
cbl_field_t *field = current_field();
|
||||
if( $typename ) {
|
||||
const auto e = symbol_field_same_as(field, $typename);
|
||||
@@ -5112,10 +5103,8 @@ typedef_clause: is TYPEDEF strong
|
||||
volatile_clause:
|
||||
VOLATILE
|
||||
{
|
||||
if( dialect_ibm() ) {
|
||||
yywarn("VOLATILE has no effect");
|
||||
} else {
|
||||
dialect_error(@1, "VOLATILE", "ibm");
|
||||
if( dialect_ok(@1, IbmVolatileE, "VOLATILE") ) {
|
||||
cbl_message(@1, IbmVolatileW, "VOLATILE has no effect");
|
||||
}
|
||||
}
|
||||
;
|
||||
@@ -5272,10 +5261,9 @@ sentence: statements '.'
|
||||
std::set<std::string> externals = current.end_program();
|
||||
if( !externals.empty() ) {
|
||||
for( const auto& name : externals ) {
|
||||
yywarn("%s calls external symbol '%s'",
|
||||
dbgmsg("%s calls external symbol '%s'",
|
||||
prog->name, name.c_str());
|
||||
}
|
||||
YYERROR;
|
||||
}
|
||||
// pointer still valid because name is in symbol table
|
||||
ast_end_program(prog->name);
|
||||
@@ -5692,9 +5680,10 @@ add_body: sum TO rnames
|
||||
corresponding_arith_fields( $sum->refers.front().field,
|
||||
rhs.front().refer.field );
|
||||
if( pairs.empty() ) {
|
||||
yywarn( "%s and %s have no corresponding fields",
|
||||
$sum->refers.front().field->name,
|
||||
rhs.front().refer.field->name );
|
||||
cbl_message( @$, ParNoCorrespondingW,
|
||||
"%s and %s have no corresponding fields",
|
||||
$sum->refers.front().field->name,
|
||||
rhs.front().refer.field->name );
|
||||
}
|
||||
// First src/tgt elements are templates.
|
||||
// Their subscripts apply to the correspondents.
|
||||
@@ -5854,21 +5843,16 @@ compute_body: rnames { statement_begin(@$, COMPUTE); } compute_expr[expr] {
|
||||
$$.expr = $expr;
|
||||
}
|
||||
;
|
||||
compute_expr: '=' {
|
||||
compute_expr: EQ {
|
||||
if( $1[0] == 'E' ) { // lexer found EQUALS keyword
|
||||
dialect_ok(@1, IbmEqualAssignE,
|
||||
"EQUAL as assignment operator" );
|
||||
}
|
||||
current.compute_begin();
|
||||
} expr {
|
||||
$$ = $expr;
|
||||
}
|
||||
;
|
||||
| EQUAL {
|
||||
if( ! dialect_ibm() ) {
|
||||
dialect_error(@1, "EQUAL invalid as assignment operator", "ibm");
|
||||
}
|
||||
current.compute_begin();
|
||||
} expr {
|
||||
$$ = $expr;
|
||||
}
|
||||
;
|
||||
|
||||
display: disp_body end_display[advance]
|
||||
{
|
||||
@@ -6079,9 +6063,8 @@ end_program: end_program1[end] '.'
|
||||
std::set<std::string> externals = current.end_program();
|
||||
if( !externals.empty() ) {
|
||||
for( const auto& name : externals ) {
|
||||
yywarn("%s calls external symbol '%s'", prog->name, name.c_str());
|
||||
dbgmsg("%s calls external symbol '%s'", prog->name, name.c_str());
|
||||
}
|
||||
YYERROR;
|
||||
}
|
||||
// pointer still valid because name is in symbol table
|
||||
ast_end_program(prog->name);
|
||||
@@ -6192,9 +6175,7 @@ exit_with: %empty
|
||||
}
|
||||
| RETURNING stop_status
|
||||
{
|
||||
if( ! dialect_mf() ) {
|
||||
dialect_error(@2, "RETURNING <number>", "mf");
|
||||
}
|
||||
dialect_ok(@$, MfReturningNum, "RETURNING <number>");
|
||||
$$ = $stop_status? $stop_status : new_reference(literally_one);
|
||||
}
|
||||
;
|
||||
@@ -7229,8 +7210,9 @@ move: MOVE scalar TO move_tgts[tgts]
|
||||
}
|
||||
|
||||
if( !move_corresponding(*$to, *$from) ) {
|
||||
yywarn( "%s and %s have no corresponding fields",
|
||||
$from->field->name, $to->field->name );
|
||||
cbl_message( @$, ParNoCorrespondingW,
|
||||
"%s and %s have no corresponding fields",
|
||||
$from->field->name, $to->field->name );
|
||||
}
|
||||
}
|
||||
;
|
||||
@@ -7407,7 +7389,7 @@ arith_err: SIZE_ERROR
|
||||
|
||||
relop: '<' { $$ = '<'; }
|
||||
| LE { $$ = LE; }
|
||||
| '=' { $$ = '='; }
|
||||
| EQ { $$ = EQ; }
|
||||
| NE { $$ = NE; }
|
||||
| GE { $$ = GE; }
|
||||
| '>' { $$ = '>'; }
|
||||
@@ -7442,25 +7424,19 @@ num_value: scalar // might actually be a string
|
||||
| LENGTH_OF binary_type[size] {
|
||||
location_set(@1);
|
||||
$$ = new cbl_refer_t( new_tempnumeric(none_e) );
|
||||
if( dialect_gcc() ) {
|
||||
dialect_error(@1, "LENGTH OF", "ibm");
|
||||
}
|
||||
dialect_ok(@1, IbmLengthOf, "LENGTH OF");
|
||||
parser_set_numeric($$->field, $size);
|
||||
}
|
||||
| LENGTH_OF name[val] {
|
||||
location_set(@1);
|
||||
$$ = new cbl_refer_t( new_tempnumeric(none_e) );
|
||||
if( dialect_gcc() ) {
|
||||
dialect_error(@1, "LENGTH OF", "ibm");
|
||||
}
|
||||
dialect_ok(@1, IbmLengthOf, "LENGTH OF");
|
||||
parser_set_numeric($$->field, $val->data.capacity);
|
||||
}
|
||||
| LENGTH_OF name[val] subscripts[subs] {
|
||||
location_set(@1);
|
||||
$$ = new cbl_refer_t( new_tempnumeric(none_e) );
|
||||
if( dialect_gcc() ) {
|
||||
dialect_error(@1, "LENGTH OF", "ibm");
|
||||
}
|
||||
dialect_ok(@1, IbmLengthOf, "LENGTH OF");
|
||||
if( 0 == dimensions($val) ) {
|
||||
cbl_refer_t r1($val);
|
||||
subscript_dimension_error( @subs, $subs->refers.size(), &r1 );
|
||||
@@ -7488,7 +7464,7 @@ num_value: scalar // might actually be a string
|
||||
/* cce_relexpr: cce_expr */
|
||||
/* | cce_relexpr '<' cce_expr { $$ = $1 < $3; } */
|
||||
/* | cce_relexpr LE cce_expr { $$ = $1 <= $3; } */
|
||||
/* | cce_relexpr '=' cce_expr { $$ = $1 == $3; } */
|
||||
/* | cce_relexpr EQ cce_expr { $$ = $1 == $3; } */
|
||||
/* | cce_relexpr NE cce_expr { $$ = $1 != $3; } */
|
||||
/* | cce_relexpr GE cce_expr { $$ = $1 >= $3; } */
|
||||
/* | cce_relexpr '>' cce_expr { $$ = $1 > $3; } */
|
||||
@@ -7553,23 +7529,19 @@ section_name: NAME section_kw '.'
|
||||
|
||||
section_kw: SECTION
|
||||
{
|
||||
if( $1 ) {
|
||||
if( $1 && dialect_ok(@1, IbmSectionSegmentW, "SECTION segment") ) {
|
||||
cbl_message(@1, IbmSectionSegmentW,
|
||||
"SECTION segment %qs was ignored", $1);
|
||||
if( *$1 == '-' ) {
|
||||
error_msg(@1, "SECTION segment %qs is negative", $1);
|
||||
cbl_message(@1, IbmSectionNegE,
|
||||
"SECTION segment %qs is negative", $1);
|
||||
} else {
|
||||
if( dialect_ibm() ) {
|
||||
int sectno;
|
||||
sscanf($1, "%d", §no);
|
||||
if( ! (0 <= sectno && sectno <= 99) ) {
|
||||
error_msg(@1, "SECTION segment %qs must be 0-99", $1);
|
||||
} else {
|
||||
if(false) { // stand-in for warning, someday.
|
||||
yywarn("SECTION segment %qs was ignored", $1);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
cbl_unimplemented("SECTION segment %qs is not ISO syntax", $1);
|
||||
}
|
||||
int sectno;
|
||||
sscanf($1, "%d", §no);
|
||||
if( ! (0 <= sectno && sectno <= 99) ) {
|
||||
cbl_message(@1, IbmSectionRangeE,
|
||||
"SECTION segment %qs must be 0-99", $1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -7587,10 +7559,7 @@ stop: STOP RUN exit_with
|
||||
| STOP NUMSTR[status] // IBM syntax
|
||||
{
|
||||
statement_begin(@1, STOP);
|
||||
if( ! dialect_ibm() ) {
|
||||
dialect_error(@2, "STOP <number> is not ISO syntax,", "ibm");
|
||||
YYERROR;
|
||||
}
|
||||
dialect_ok(@2, IbmStopNumber, "STOP <number>");
|
||||
cbl_refer_t status( new_literal($status.string, $status.radix) );
|
||||
parser_see_stop_run( status, NULL );
|
||||
}
|
||||
@@ -7674,25 +7643,19 @@ signed_literal: num_literal
|
||||
| LENGTH_OF binary_type[size] {
|
||||
location_set(@1);
|
||||
$$ = new_tempnumeric(none_e);
|
||||
if( dialect_gcc() ) {
|
||||
dialect_error(@1, "LENGTH OF", "ibm");
|
||||
}
|
||||
dialect_ok(@1, IbmLengthOf, "LENGTH OF");
|
||||
parser_set_numeric($$, $size);
|
||||
}
|
||||
| LENGTH_OF name[val] {
|
||||
location_set(@1);
|
||||
$$ = new_tempnumeric(none_e);
|
||||
if( dialect_gcc() ) {
|
||||
dialect_error(@1, "LENGTH OF", "ibm");
|
||||
}
|
||||
dialect_ok(@1, IbmLengthOf, "LENGTH OF");
|
||||
parser_set_numeric($$, $val->data.capacity);
|
||||
}
|
||||
| LENGTH_OF name[val] subscripts[subs] {
|
||||
location_set(@1);
|
||||
$$ = new_tempnumeric(none_e);
|
||||
if( dialect_gcc() ) {
|
||||
dialect_error(@1, "LENGTH OF", "ibm");
|
||||
}
|
||||
dialect_ok(@1, IbmLengthOf, "LENGTH OF");
|
||||
if( 0 == dimensions($val) ) {
|
||||
cbl_refer_t r1($val);
|
||||
subscript_dimension_error( @subs, $subs->refers.size(), &r1 );
|
||||
@@ -8198,9 +8161,10 @@ subtract_body: sum FROM rnames
|
||||
corresponding_arith_fields( $sum->refers.front().field,
|
||||
rhs.front().refer.field );
|
||||
if( pairs.empty() ) {
|
||||
yywarn( "%s and %s have no corresponding fields",
|
||||
$sum->refers.front().field->name,
|
||||
rhs.front().refer.field->name );
|
||||
cbl_message(ParNoCorrespondingW,
|
||||
"%s and %s have no corresponding fields",
|
||||
$sum->refers.front().field->name,
|
||||
rhs.front().refer.field->name );
|
||||
}
|
||||
// First src/tgt elements are templates.
|
||||
// Their subscripts apply to the correspondents.
|
||||
@@ -8241,25 +8205,19 @@ varg1a: ADDRESS OF scalar {
|
||||
| LENGTH_OF binary_type[size] {
|
||||
location_set(@1);
|
||||
$$ = new cbl_refer_t( new_tempnumeric(none_e) );
|
||||
if( dialect_gcc() ) {
|
||||
dialect_error(@1, "LENGTH OF", "ibm");
|
||||
}
|
||||
dialect_ok(@1, IbmLengthOf, "LENGTH OF");
|
||||
parser_set_numeric($$->field, $size);
|
||||
}
|
||||
| LENGTH_OF name[val] {
|
||||
location_set(@1);
|
||||
$$ = new cbl_refer_t( new_tempnumeric(none_e) );
|
||||
if( dialect_gcc() ) {
|
||||
dialect_error(@1, "LENGTH OF", "ibm");
|
||||
}
|
||||
dialect_ok(@1, IbmLengthOf, "LENGTH OF");
|
||||
parser_set_numeric($$->field, $val->size());
|
||||
}
|
||||
| LENGTH_OF name[val] subscripts[subs] {
|
||||
location_set(@1);
|
||||
$$ = new cbl_refer_t( new_tempnumeric(none_e) );
|
||||
if( dialect_gcc() ) {
|
||||
dialect_error(@1, "LENGTH OF", "ibm");
|
||||
}
|
||||
dialect_ok(@1, IbmLengthOf, "LENGTH OF");
|
||||
if( 0 == dimensions($val) ) {
|
||||
cbl_refer_t r1($val);
|
||||
subscript_dimension_error( @subs, $subs->refers.size(), &r1 );
|
||||
@@ -8879,10 +8837,7 @@ start_body: filename[file]
|
||||
int size = key == 0 ? 0 : $file->keys[key - 1].size();
|
||||
auto ksize = new_tempnumeric();
|
||||
parser_set_numeric(ksize, size);
|
||||
if( yydebug ) {
|
||||
yywarn("START: key #%d '%s' has size %d",
|
||||
key, $key->name, size);
|
||||
}
|
||||
dbgmsg("START: key #%d '%s' has size %d", key, $key->name, size);
|
||||
$$ = file_start_args.init(@file, $file);
|
||||
parser_file_start( $file, relop_of($relop), key, ksize );
|
||||
}
|
||||
@@ -9069,7 +9024,8 @@ set: SET set_tgts[tgts] TO set_operand[src]
|
||||
default:
|
||||
gcc_unreachable();
|
||||
}
|
||||
cbl_unimplementedw("unimplemented: SET TO LOCALE");
|
||||
cbl_unimplementedw(SynSetToLocale,
|
||||
"unimplemented: %<SET ... TO LOCALE%>");
|
||||
}
|
||||
;
|
||||
| SET set_tgts[tgts] UP BY num_operand[src]
|
||||
@@ -9139,7 +9095,8 @@ set: SET set_tgts[tgts] TO set_operand[src]
|
||||
} else {
|
||||
// do something $tgt->lc_categories()
|
||||
}
|
||||
cbl_unimplementedw("unimplemented: SET LOCALE");
|
||||
cbl_unimplementedw(SynSetLocaleTo,
|
||||
"unimplemented: %<SET LOCALE ... TO%>");
|
||||
}
|
||||
;
|
||||
|
||||
@@ -9260,7 +9217,7 @@ search_1_cases: search_1_case
|
||||
lookahead = keyword_str(yychar);
|
||||
}
|
||||
}
|
||||
yywarn("Just one case, lookahead is '%s'", lookahead);
|
||||
dbgmsg("Just one case, lookahead is '%s'", lookahead);
|
||||
}
|
||||
}
|
||||
| search_1_cases search_1_case
|
||||
@@ -9314,7 +9271,7 @@ search_stmts: statements %prec ADD
|
||||
search_terms: search_term
|
||||
| search_terms AND search_term
|
||||
;
|
||||
search_term: scalar[key] '=' search_expr[sarg]
|
||||
search_term: scalar[key] EQ search_expr[sarg]
|
||||
{
|
||||
if( $key->nsubscript() == 0 ) {
|
||||
error_msg(@1, "no index for key");
|
||||
@@ -9764,9 +9721,7 @@ tally_forth: CHARACTERS insp_mtqual[q] scalar[next_tally]
|
||||
| TRAILING tally_matches[q]
|
||||
{ $q->bound = bound_trailing_e;
|
||||
$$ = $q;
|
||||
if( ! dialect_mf() ) {
|
||||
dialect_error(@1, "TRAILING", "mf");
|
||||
}
|
||||
dialect_ok(@1, MfTrailing, "TRAILING");
|
||||
}
|
||||
;
|
||||
|
||||
@@ -9897,9 +9852,7 @@ first_leading: FIRST { $$ = bound_first_e; }
|
||||
| ALL { $$ = bound_all_e; }
|
||||
| LEADING { $$ = bound_leading_e; }
|
||||
| TRAILING { $$ = bound_trailing_e;
|
||||
if( ! dialect_mf() ) {
|
||||
dialect_error(@1, "TRAILING", "mf");
|
||||
}
|
||||
dialect_ok(@1, MfTrailing, "TRAILING");
|
||||
}
|
||||
;
|
||||
|
||||
@@ -10089,9 +10042,7 @@ call_body: ffi_name
|
||||
;
|
||||
call_returning: RETURNING
|
||||
| GIVING {
|
||||
if( !dialect_mf() ) {
|
||||
dialect_error(@1, "CALL ... GIVING", "mf");
|
||||
}
|
||||
dialect_ok(@1, MfCallGiving, "CALL ... GIVING");
|
||||
}
|
||||
;
|
||||
|
||||
@@ -10343,13 +10294,13 @@ go_to: GOTO labels[args]
|
||||
resume: RESUME NEXT STATEMENT
|
||||
{
|
||||
statement_begin(@1, RESUME);
|
||||
if( dialect_proscribed( @1, dialect_ibm_e, "RESUME") ) YYERROR;
|
||||
dialect_not_ok( @1, IsoResume, "RESUME");
|
||||
parser_clear_exception();
|
||||
}
|
||||
| RESUME label_1[tgt]
|
||||
{
|
||||
statement_begin(@1, RESUME);
|
||||
if( dialect_proscribed( @1, dialect_ibm_e, "RESUME") ) YYERROR;
|
||||
dialect_not_ok( @1, IsoResume, "RESUME");
|
||||
parser_clear_exception();
|
||||
$tgt->used = @1.first_line;
|
||||
parser_goto( cbl_refer_t(), 1, &$tgt );
|
||||
@@ -12289,7 +12240,7 @@ relop_of(int token) {
|
||||
switch(token) {
|
||||
case '<': return lt_op;
|
||||
case LE: return le_op;
|
||||
case '=': return eq_op;
|
||||
case EQ: return eq_op;
|
||||
case NE: return ne_op;
|
||||
case GE: return ge_op;
|
||||
case '>': return gt_op;
|
||||
@@ -12322,7 +12273,7 @@ relop_debug_str(int token) {
|
||||
case 0: return "zilch";
|
||||
case '<': return "<";
|
||||
case LE: return "LE";
|
||||
case '=': return "=";
|
||||
case EQ: return "=";
|
||||
case NE: return "NE";
|
||||
case GE: return "GE";
|
||||
case '>': return ">";
|
||||
@@ -12336,7 +12287,7 @@ token_of(enum relop_t op) {
|
||||
switch(op) {
|
||||
case lt_op: return '<';
|
||||
case le_op: return LE;
|
||||
case eq_op: return '=';
|
||||
case eq_op: return EQ;
|
||||
case ne_op: return NE;
|
||||
case ge_op: return GE;
|
||||
case gt_op: return '>';
|
||||
@@ -12807,7 +12758,7 @@ struct stringify_src_t : public cbl_string_src_t {
|
||||
|
||||
protected:
|
||||
static void dump_input( const cbl_refer_t& refer ) {
|
||||
yywarn( "%s: %s", __func__, field_str(refer.field) );
|
||||
dbgmsg( "%s: %s", __func__, field_str(refer.field) );
|
||||
}
|
||||
};
|
||||
|
||||
@@ -12817,13 +12768,13 @@ stringify( refer_collection_t *inputs,
|
||||
cbl_label_t *on_error,
|
||||
cbl_label_t *not_error )
|
||||
{
|
||||
std::vector <stringify_src_t> sources(inputs->lists.size());
|
||||
|
||||
if( inputs->lists.back().marker == NULL ) {
|
||||
inputs->lists.back().marker = cbl_refer_t::empty();
|
||||
}
|
||||
assert( inputs->lists.back().marker );
|
||||
std::copy( inputs->lists.begin(), inputs->lists.end(), sources.begin() );
|
||||
|
||||
std::vector <stringify_src_t> sources(inputs->lists.begin(), inputs->lists.end());
|
||||
|
||||
parser_string( into, pointer, sources.size(), sources.data(), on_error, not_error );
|
||||
}
|
||||
|
||||
@@ -13114,7 +13065,7 @@ numstr2i( const char input[], radix_t radix ) {
|
||||
case boolean_e:
|
||||
for( const char *p = input; *p != '\0'; p++ ) {
|
||||
if( ssize_t(8 * sizeof(integer) - 1) < p - input ) {
|
||||
yywarn("'%s' was accepted as %zu", input, integer);
|
||||
dbgmsg("'%s' was accepted as %lu", input, (unsigned long)integer);
|
||||
break;
|
||||
}
|
||||
switch(*p) {
|
||||
@@ -13124,7 +13075,7 @@ numstr2i( const char input[], radix_t radix ) {
|
||||
integer |= ((*p) == '0' ? 0 : 1);
|
||||
break;
|
||||
default:
|
||||
yywarn("'%s' was accepted as %zu", input, integer);
|
||||
dbgmsg("'%s' was accepted as %lu", input, (unsigned long)integer);
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -13132,7 +13083,7 @@ numstr2i( const char input[], radix_t radix ) {
|
||||
return output;
|
||||
}
|
||||
if( erc == -1 ) {
|
||||
yywarn("'%s' was accepted as %zu", input, integer);
|
||||
cbl_message(ParNumstrW, "'%s' was accepted as %zu", input, integer);
|
||||
}
|
||||
return output;
|
||||
}
|
||||
@@ -13843,6 +13794,7 @@ mode_syntax_only() {
|
||||
void
|
||||
cobol_dialect_set( cbl_dialect_t dialect ) {
|
||||
switch(dialect) {
|
||||
case dialect_iso_e:
|
||||
case dialect_gcc_e:
|
||||
break;
|
||||
case dialect_ibm_e:
|
||||
|
||||
@@ -189,16 +189,6 @@ has_clause( int data_clauses, data_clause_t clause ) {
|
||||
return clause == (data_clauses & clause);
|
||||
}
|
||||
|
||||
static bool
|
||||
dialect_proscribed( const YYLTYPE& loc, cbl_dialect_t dialect, const char msg[] ) {
|
||||
if( dialect == cbl_dialects ) {
|
||||
error_msg(loc, "dialect %s does not allow syntax: %qs",
|
||||
cbl_dialect_str(dialect), msg);
|
||||
return true;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
static bool
|
||||
is_cobol_charset( const char name[] ) {
|
||||
auto eoname = name + strlen(name);
|
||||
@@ -2072,21 +2062,14 @@ static class current_t {
|
||||
parser_leave_section( programs.top().section );
|
||||
programs.pop();
|
||||
|
||||
#if 0
|
||||
if( programs.empty() ) {
|
||||
// The default encoding can be changed only with -finternal-ebcdic, and
|
||||
// remains in effect for all programs while the compiler runs.
|
||||
// This comment here to remind us.
|
||||
default_encoding = prog_descr_t::encoding_t::encoding_base_t();
|
||||
}
|
||||
#endif
|
||||
debugging_clients.clear();
|
||||
error_clients.clear();
|
||||
exception_clients.clear();
|
||||
|
||||
if( ref ) {
|
||||
yywarn("could not resolve paragraph (or section) '%s' at line %d",
|
||||
ref->paragraph(), ref->line_number());
|
||||
cbl_message(ParUnresolvedProcE,
|
||||
"could not resolve paragraph (or section) '%s' at line %d",
|
||||
ref->paragraph(), ref->line_number());
|
||||
// add string to indicate ambiguity error
|
||||
externals.insert(":ambiguous:");
|
||||
}
|
||||
@@ -2227,11 +2210,10 @@ static class current_t {
|
||||
}
|
||||
|
||||
void antecedent_dump() const {
|
||||
if( ! yydebug ) return;
|
||||
if( ! antecedent_cache.operand ) {
|
||||
yywarn( "Antecedent: none" );
|
||||
dbgmsg( "Antecedent: none" );
|
||||
} else {
|
||||
yywarn( "Antecedent: %c %s %s %c",
|
||||
dbgmsg( "Antecedent: %c %s %s %c",
|
||||
antecedent_cache.invert? '!':' ',
|
||||
name_of(antecedent_cache.operand->field),
|
||||
relop_str(antecedent_cache.relop),
|
||||
@@ -3139,8 +3121,7 @@ parser_move_carefully( const char */*F*/, int /*L*/,
|
||||
if( ! valid_move( tgt.field, src.field ) ) {
|
||||
if( src.field->type == FldPointer &&
|
||||
tgt.field->type == FldPointer ) {
|
||||
if( dialect_mf() || dialect_gnu() ) return true;
|
||||
dialect_error(src.loc, "MOVE POINTER", "mf");
|
||||
dialect_ok(src.loc, MfMovePointer, "MOVE POINTER");
|
||||
}
|
||||
if( ! is_index ) {
|
||||
char ach[16];
|
||||
@@ -3612,7 +3593,7 @@ goodnight_gracie() {
|
||||
|
||||
if( !externals.empty() ) {
|
||||
for( const auto& name : externals ) {
|
||||
yywarn("%s calls external symbol '%s'",
|
||||
dbgmsg("%s calls external symbol '%s'",
|
||||
prog->name, name.c_str());
|
||||
}
|
||||
return false;
|
||||
|
||||
@@ -762,7 +762,9 @@ EVERY { return EVERY; }
|
||||
ERROR { return ERROR; }
|
||||
EVALUATE { return EVALUATE; }
|
||||
|
||||
EQUALS? { return '='; }
|
||||
EQUALS? { ydflval.string = yylval.string = xstrdup(yytext);
|
||||
return '='; }
|
||||
|
||||
ENVIRONMENT[[:blank:]]+DIVISION { return ENVIRONMENT_DIV; }
|
||||
|
||||
ENTRY { return ENTRY; }
|
||||
@@ -900,11 +902,7 @@ ACCESS { return ACCESS; }
|
||||
ACCEPT { return ACCEPT; }
|
||||
|
||||
DELETE { return DELETE; }
|
||||
EJECT{DOTEOL}? {
|
||||
if( ! dialect_ibm() ) {
|
||||
dialect_error(yylloc, "EJECT is not ISO syntax,", "ibm");
|
||||
}
|
||||
}
|
||||
EJECT{DOTEOL}? { dialect_ok(yylloc, IbmEjectE, "EJECT"); }
|
||||
INSERTT { return INSERTT; }
|
||||
LABEL { return LABEL; }
|
||||
PROCESS { return PROCESS; }
|
||||
@@ -1007,9 +1005,7 @@ USE({SPC}FOR)? { return USE; }
|
||||
BINARY-SHORT { return bcomputable(FldNumericBin5, 2); }
|
||||
BINARY-LONG { return bcomputable(FldNumericBin5, 4); }
|
||||
BINARY-DOUBLE { return bcomputable(FldNumericBin5, 8); }
|
||||
BINARY-LONG-LONG { if( ! dialect_mf() ) {
|
||||
dialect_error(yylloc, yytext, "mf");
|
||||
}
|
||||
BINARY-LONG-LONG { dialect_ok(yylloc, MfBinaryLongLong, "BINARY-LONG-LONG");
|
||||
return bcomputable(FldNumericBin5, 8);
|
||||
}
|
||||
|
||||
@@ -1044,9 +1040,8 @@ USE({SPC}FOR)? { return USE; }
|
||||
PROGRAM-POINTER { yylval.field_attr = prog_ptr_e; return POINTER; }
|
||||
POINTER { yylval.field_attr = none_e; return POINTER; }
|
||||
|
||||
PROCEDURE-POINTER { if( dialect_gcc() ) {
|
||||
dialect_error(yylloc, yytext, "ibm or mf");
|
||||
}
|
||||
PROCEDURE-POINTER {
|
||||
dialect_ok(yylloc, IbmProcedurePointer, yytext);
|
||||
yylval.field_attr = prog_ptr_e;
|
||||
return POINTER; // return it anyway
|
||||
}
|
||||
@@ -1086,13 +1081,11 @@ USE({SPC}FOR)? { return USE; }
|
||||
DEPENDING { return DEPENDING; }
|
||||
DESCENDING { return DESCENDING; }
|
||||
DISPLAY { return DISPLAY; }
|
||||
EJECT{DOTEOL}? {
|
||||
if( ! dialect_ibm() ) {
|
||||
dialect_error(yylloc, "EJECT is not ISO syntax,", "ibm");
|
||||
}
|
||||
auto len = yyleng - 1;
|
||||
if( yytext[len] == '\f' ) myless(--len);
|
||||
}
|
||||
EJECT{DOTEOL}? {
|
||||
dialect_ok(yylloc, IbmEjectE, "EJECT");
|
||||
auto len = yyleng - 1;
|
||||
if( yytext[len] == '\f' ) myless(--len);
|
||||
}
|
||||
EXTERNAL { return EXTERNAL; }
|
||||
FALSE { return FALSE_kw; }
|
||||
FROM { return FROM; }
|
||||
@@ -1506,16 +1499,21 @@ USE({SPC}FOR)? { return USE; }
|
||||
<cdf_state,procedure_div>{
|
||||
(IS{SPC})?"<" { return '<'; }
|
||||
(IS{SPC})?"<=" { return LE; }
|
||||
(IS{SPC})?"=" { return '='; }
|
||||
(IS{SPC})?"=" { static char eq[] = "=";
|
||||
ydflval.string = yylval.string = eq;
|
||||
return EQ; }
|
||||
(IS{SPC})?"<>" { return NE; }
|
||||
(IS{SPC})?">=" { return GE; }
|
||||
(IS{SPC})?">" { return '>'; }
|
||||
|
||||
{LESS_THAN} { return '<'; }
|
||||
{LESS_THAN} { return '<'; }
|
||||
{LESS_THAN}{SPC}{OR_EQUAL}/[[:space:]] { return LE; }
|
||||
(IS{SPC})?EQUALS?({SPC}TO)?/[[:space:]] { return '='; }
|
||||
(IS{SPC})?EQUALS?({SPC}TO)?/[[:space:]] {
|
||||
static char eq[] = "EQUAL";
|
||||
ydflval.string = yylval.string = eq;
|
||||
return EQ; }
|
||||
{GREATER_THAN}{SPC}{OR_EQUAL}/[[:space:]] { return GE; }
|
||||
{GREATER_THAN} { return '>'; }
|
||||
{GREATER_THAN} { return '>'; }
|
||||
|
||||
{ISNT}{OSPC}">=" { verify_ws(yytext[yyleng - 3]); return '<'; }
|
||||
{ISNT}{OSPC}">" { verify_ws(yytext[yyleng - 2]); return LE; }
|
||||
@@ -1992,7 +1990,8 @@ BASIS { yy_push_state(basis); return BASIS; }
|
||||
{STRING} { yy_pop_state();
|
||||
yypush_buffer_state( yy_create_buffer(yyin, YY_BUF_SIZE) );
|
||||
if( (yyin = cdftext::lex_open(yytext)) == NULL ) {
|
||||
yywarn("could not open BASIS file '%s'", yytext);
|
||||
cbl_message(yylloc, LexIncludeE,
|
||||
"could not open BASIS file '%s'", yytext);
|
||||
yyterminate();
|
||||
}
|
||||
}
|
||||
@@ -2003,7 +2002,8 @@ BASIS { yy_push_state(basis); return BASIS; }
|
||||
}
|
||||
|
||||
<procedure_div>{
|
||||
EQUALS?{OSPC}/[(] { return '='; }
|
||||
EQUALS?{OSPC}/[(] { ydflval.string = yylval.string = xstrdup(yytext);
|
||||
return EQ; }
|
||||
|
||||
{NAME}{OSPC}/[(] { /* If /{OSPC}, "dangerous trailing context" "*/
|
||||
if( is_integer_token() ) return numstr_of(yytext);
|
||||
@@ -2084,21 +2084,15 @@ BASIS { yy_push_state(basis); return BASIS; }
|
||||
^[ ]*>>{OBLANK}ELSE { return CDF_ELSE; }
|
||||
^[ ]*>>{OBLANK}END-IF { return CDF_END_IF; }
|
||||
|
||||
^[ ]*[$]{OBLANK}IF { if( ! dialect_mf() ) {
|
||||
dialect_error(yylloc, yytext, "mf");
|
||||
}
|
||||
^[ ]*[$]{OBLANK}IF { dialect_ok(yylloc, MfCdfDollar, yytext);
|
||||
yy_push_state(cdf_state); return CDF_IF; }
|
||||
^[ ]*[$]{OBLANK}ELSE { if( ! dialect_mf() ) {
|
||||
dialect_error(yylloc, yytext, "mf");
|
||||
}
|
||||
^[ ]*[$]{OBLANK}ELSE { dialect_ok(yylloc, MfCdfDollar, yytext);
|
||||
return CDF_ELSE; }
|
||||
^[ ]*[$]{OBLANK}END { if( ! dialect_mf() ) {
|
||||
dialect_error(yylloc, yytext, "mf");
|
||||
}
|
||||
^[ ]*[$]{OBLANK}END { dialect_ok(yylloc, MfCdfDollar, yytext);
|
||||
return CDF_END_IF; }
|
||||
|
||||
^[ ]*[$]{OBLANK}SET({SPC}CONSTANT)? {
|
||||
if( ! dialect_mf() ) dialect_error(yylloc, yytext, "mf");
|
||||
dialect_ok(yylloc, MfCdfDollar, yytext);
|
||||
yy_push_state(cdf_state); return CDF_DEFINE; }
|
||||
|
||||
^[ ]*>>{OBLANK}EVALUATE { return CDF_EVALUATE; }
|
||||
@@ -2293,7 +2287,8 @@ BASIS { yy_push_state(basis); return BASIS; }
|
||||
END-SUBTRACT { return END_SUBTRACT; }
|
||||
END-WRITE { return END_WRITE; }
|
||||
ENVIRONMENT { return ENVIRONMENT; }
|
||||
EQUAL { return EQUAL; }
|
||||
EQUAL { ydflval.string = yylval.string = xstrdup(yytext);
|
||||
return EQ; }
|
||||
ERROR { return ERROR; }
|
||||
EVALUATE { return EVALUATE; }
|
||||
EXCEPTION { return EXCEPTION; }
|
||||
|
||||
@@ -295,7 +295,7 @@ static class parsing_status_t : public std::stack<cdf_status_t> {
|
||||
void splat() const {
|
||||
int i=0;
|
||||
for( const auto& status : c ) {
|
||||
yywarn( "%d %s", ++i, status.str() );
|
||||
dbgmsg( "%d %s", ++i, status.str() );
|
||||
}
|
||||
}
|
||||
} parsing;
|
||||
@@ -316,11 +316,9 @@ bool scanner_normal() { return parsing.normal(); }
|
||||
|
||||
void scanner_parsing( int token, bool tf ) {
|
||||
parsing.push( cdf_status_t(token, tf) );
|
||||
if( yydebug ) {
|
||||
yywarn("%s: parsing now %s, depth %zu",
|
||||
keyword_str(token), boolalpha(parsing.on()), parsing.size());
|
||||
parsing.splat();
|
||||
}
|
||||
dbgmsg("%s: parsing now %s, depth %zu",
|
||||
keyword_str(token), boolalpha(parsing.on()), parsing.size());
|
||||
parsing.splat();
|
||||
}
|
||||
void scanner_parsing_toggle() {
|
||||
if( parsing.empty() ) {
|
||||
@@ -328,10 +326,8 @@ void scanner_parsing_toggle() {
|
||||
return;
|
||||
}
|
||||
parsing.top().toggle();
|
||||
if( yydebug ) {
|
||||
yywarn("%s: parsing now %s",
|
||||
keyword_str(CDF_ELSE), boolalpha(parsing.on()));
|
||||
}
|
||||
dbgmsg("%s: parsing now %s",
|
||||
keyword_str(CDF_ELSE), boolalpha(parsing.on()));
|
||||
}
|
||||
void scanner_parsing_pop() {
|
||||
if( parsing.empty() ) {
|
||||
@@ -339,12 +335,10 @@ void scanner_parsing_pop() {
|
||||
return;
|
||||
}
|
||||
parsing.pop();
|
||||
if( yydebug ) {
|
||||
yywarn("%s: parsing now %s, depth %zu",
|
||||
keyword_str(CDF_END_IF), boolalpha(parsing.on()),
|
||||
parsing.size());
|
||||
parsing.splat();
|
||||
}
|
||||
dbgmsg("%s: parsing now %s, depth %zu",
|
||||
keyword_str(CDF_END_IF), boolalpha(parsing.on()),
|
||||
parsing.size());
|
||||
parsing.splat();
|
||||
}
|
||||
|
||||
|
||||
@@ -640,11 +634,9 @@ binary_integer_usage( const char name[]) {
|
||||
}
|
||||
|
||||
static void
|
||||
verify_ws( const YYLTYPE& loc, const char input[], char ch ) {
|
||||
verify_ws( const YYLTYPE& loc, const char [] /* input[] */, char ch ) {
|
||||
if( ! fisspace(ch) ) {
|
||||
if( ! (dialect_mf() || dialect_gnu()) ) {
|
||||
dialect_error(loc, "separator space required in %qs", input);
|
||||
}
|
||||
dialect_ok(loc, LexSeparatorE, "missing separator space");
|
||||
}
|
||||
}
|
||||
#define verify_ws(C) verify_ws(yylloc, yytext, C)
|
||||
@@ -676,7 +668,7 @@ level_of( const char input[] ) {
|
||||
if( input[0] == '0' ) input++;
|
||||
|
||||
if( 1 != sscanf(input, "%u", &output) ) {
|
||||
yywarn( "%s:%d: invalid level '%s'", __func__, __LINE__, input );
|
||||
cbl_internal_error( "%s:%d: invalid level '%s'", __func__, __LINE__, input );
|
||||
}
|
||||
|
||||
return output;
|
||||
@@ -1221,7 +1213,7 @@ typed_name( const char name[] ) {
|
||||
return cbl_field_of(e)->level == 88? NAME88 : CLASS_NAME;
|
||||
break;
|
||||
default:
|
||||
yywarn("%s:%d: invalid symbol type %s for symbol %qs",
|
||||
cbl_internal_error("%s:%d: invalid symbol type %s for symbol %qs",
|
||||
__func__, __LINE__, cbl_field_type_str(type), name);
|
||||
return NAME;
|
||||
}
|
||||
@@ -1253,8 +1245,14 @@ integer_of( const char input[], bool is_hex = false) {
|
||||
if( input[0] == '0' ) input++;
|
||||
|
||||
if( 1 != sscanf(input, fmt, &output) ) {
|
||||
yywarn( "%s:%d: invalid integer '%s'", __func__, __LINE__, input );
|
||||
cbl_internal_error( "%s:%d: invalid integer '%s'", __func__, __LINE__, input );
|
||||
}
|
||||
|
||||
return output;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -120,7 +120,8 @@ datetime_format_of( const char input[] ) {
|
||||
if( 0 != (erc = regcomp(&p->re, p->regex, cflags)) ) {
|
||||
static char msg[80];
|
||||
regerror(erc, &p->re, msg, sizeof(msg));
|
||||
yywarn("%s:%d: %s: %s", __func__, __LINE__, keyword_str(p->token), msg);
|
||||
cbl_internal_error("%s:%d: %s: %s", __func__, __LINE__,
|
||||
keyword_str(p->token), msg);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -293,12 +294,12 @@ prelex() {
|
||||
if( YY_START == field_state && level_needed() ) {
|
||||
switch( token ) {
|
||||
case NUMSTR:
|
||||
if( yy_flex_debug ) yywarn("final token is NUMSTR");
|
||||
dbgmsg("final token is NUMSTR");
|
||||
yylval.number = level_of(yylval.numstr.string);
|
||||
token = LEVEL;
|
||||
break;
|
||||
case YDF_NUMBER:
|
||||
if( yy_flex_debug ) yywarn("final token is %<YDF_NUMBER%>");
|
||||
dbgmsg("final token is YDF_NUMBER");
|
||||
yylval.number = ydflval.number;
|
||||
token = LEVEL;
|
||||
break;
|
||||
|
||||
@@ -449,19 +449,15 @@ extern bool cursor_at_sol;
|
||||
do { \
|
||||
if(!a) \
|
||||
{ \
|
||||
yywarn("%s: parameter %<" #a "%> is NULL", __func__); \
|
||||
gcc_unreachable(); \
|
||||
abort(); \
|
||||
cbl_internal_error("%s: parameter %<" #a "%> is NULL", __func__); \
|
||||
} \
|
||||
if( !a->var_decl_node ) \
|
||||
{ \
|
||||
yywarn("%s: parameter %<" #a "%> is variable " \
|
||||
cbl_internal_error("%s: parameter %<" #a "%> is variable " \
|
||||
"%s<%s> with NULL %<var_decl_node%>", \
|
||||
__func__, \
|
||||
a->name, \
|
||||
cbl_field_type_str(a->type) ); \
|
||||
gcc_unreachable(); \
|
||||
abort(); \
|
||||
} \
|
||||
} while(0);
|
||||
|
||||
@@ -470,19 +466,15 @@ extern bool cursor_at_sol;
|
||||
do { \
|
||||
if(!a) \
|
||||
{ \
|
||||
yywarn("%s: parameter %<" #a "%> is NULL", __func__); \
|
||||
gcc_unreachable(); \
|
||||
abort(); \
|
||||
cbl_internal_error("%s: parameter %<" #a "%> is NULL", __func__); \
|
||||
} \
|
||||
if( !a->var_decl_node && a->type != FldConditional && a->type != FldLiteralA) \
|
||||
{ \
|
||||
yywarn("%s: parameter %<" #a "%> is variable " \
|
||||
cbl_internal_error("%s: parameter %<" #a "%> is variable " \
|
||||
"%s<%s> with NULL %<var_decl_node%>", \
|
||||
__func__, \
|
||||
a->name, \
|
||||
cbl_field_type_str(a->type) ); \
|
||||
gcc_unreachable(); \
|
||||
abort(); \
|
||||
} \
|
||||
} while(0);
|
||||
|
||||
@@ -491,9 +483,7 @@ extern bool cursor_at_sol;
|
||||
do{ \
|
||||
if(!a) \
|
||||
{ \
|
||||
yywarn("%s: parameter %<" #a "%> is NULL", __func__); \
|
||||
gcc_unreachable(); \
|
||||
abort(); \
|
||||
cbl_internal_error("%s: parameter %<" #a "%> is NULL", __func__); \
|
||||
} \
|
||||
}while(0);
|
||||
|
||||
|
||||
@@ -1318,7 +1318,7 @@ static struct symbol_elem_t *
|
||||
|
||||
switch( group->level ) {
|
||||
case 1: case 77:
|
||||
if( dialect_mf() && is_table(group) ) {
|
||||
if( is_table(group) ) {
|
||||
size_t elem_size = std::max(group->data.memsize, group->data.memsize);
|
||||
group->data.memsize = elem_size * group->occurs.ntimes();
|
||||
}
|
||||
@@ -1783,7 +1783,7 @@ symbols_update( size_t first, bool parsed_ok ) {
|
||||
break;
|
||||
case 1:
|
||||
pend = calculate_capacity(p);
|
||||
if( dialect_mf() && is_table(field) ) {
|
||||
if( is_table(field) ) {
|
||||
if( field->data.memsize < field->size() ) {
|
||||
field->data.memsize = field->size();
|
||||
}
|
||||
@@ -3858,7 +3858,9 @@ cbl_field_t::internalize() {
|
||||
iconv_t cd = tocodes[toname];
|
||||
|
||||
if (cd == (iconv_t)-1) {
|
||||
yywarn("failed %<iconv_open%> tocode = %qs fromcode = %qs", tocode, fromcode);
|
||||
cbl_message(ParIconvE,
|
||||
"failed %<iconv_open%> tocode = %qs fromcode = %qs",
|
||||
tocode, fromcode);
|
||||
}
|
||||
|
||||
if( fromcode == tocode || has_attr(hex_encoded_e) ) {
|
||||
|
||||
@@ -51,20 +51,28 @@
|
||||
extern const char *numed_message;
|
||||
|
||||
enum cbl_dialect_t {
|
||||
dialect_gcc_e = 0x00,
|
||||
dialect_ibm_e = 0x01,
|
||||
dialect_mf_e = 0x02,
|
||||
dialect_gnu_e = 0x04,
|
||||
dialect_iso_e = 0x00,
|
||||
dialect_gcc_e = 0x01,
|
||||
dialect_ibm_e = 0x02,
|
||||
dialect_mf_e = 0x04,
|
||||
dialect_gnu_e = 0x08,
|
||||
};
|
||||
|
||||
static inline const char *
|
||||
cbl_dialect_str(cbl_dialect_t dialect) {
|
||||
switch(dialect) {
|
||||
case dialect_iso_e: return "iso";
|
||||
case dialect_gcc_e: return "gcc";
|
||||
case dialect_ibm_e: return "ibm";
|
||||
case dialect_mf_e: return "mf";
|
||||
case dialect_gnu_e: return "gnu";
|
||||
}
|
||||
|
||||
switch(size_t(dialect)) {
|
||||
case dialect_mf_e | dialect_gnu_e: return "mf or gnu";
|
||||
case dialect_ibm_e | dialect_mf_e | dialect_gnu_e: return "ibm or mf or gnu";
|
||||
}
|
||||
|
||||
return "???";
|
||||
};
|
||||
|
||||
@@ -86,6 +94,15 @@ static inline bool dialect_gnu() {
|
||||
return dialect_gnu_e == (cbl_dialects & dialect_gnu_e );
|
||||
}
|
||||
|
||||
static inline bool dialect_has( cbl_dialect_t dialect) {
|
||||
return 0 < (cbl_dialects & dialect);
|
||||
}
|
||||
|
||||
#ifdef GCC_DIAGNOSTIC_H
|
||||
bool cbl_diagnostic_kind( cbl_diag_id_t id, diagnostics::kind kind );
|
||||
bool cbl_dialect_kind( cbl_dialect_t dialect, diagnostics::kind kind );
|
||||
#endif
|
||||
|
||||
enum cbl_gcobol_feature_t {
|
||||
feature_gcc_e = 0x00,
|
||||
feature_internal_ebcdic_e = 0x01,
|
||||
@@ -1715,9 +1732,9 @@ struct cbl_alphabet_t {
|
||||
}
|
||||
|
||||
void dump() const {
|
||||
yywarn("%qs: %s, %<%c%> to %<%c%> (low 0x%x, high 0x%x)",
|
||||
name, encoding_str(encoding),
|
||||
low_index, last_index, low_index, high_index);
|
||||
dbgmsg("%s: '%s', '%c' to '%c' (low 0x%x, high 0x%x)",
|
||||
name, encoding_str(encoding),
|
||||
low_index, last_index, low_index, high_index);
|
||||
if( encoding == custom_encoding_e ) {
|
||||
fprintf(stderr, "\t"
|
||||
" 0 1 2 3 4 5 6 7"
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -100,7 +100,7 @@ get_current_dir_name ()
|
||||
unsigned long
|
||||
gb4( size_t input ) {
|
||||
if( input != static_cast<unsigned long>(input) ) {
|
||||
yywarn("size too large to print: %lx:%lx",
|
||||
dbgmsg("size too large to print: %lx:%lx",
|
||||
(unsigned long)(input >> (4 * sizeof(unsigned long))),
|
||||
static_cast<unsigned long>(input));
|
||||
}
|
||||
@@ -2147,6 +2147,9 @@ static location_t token_location_minus_1 = 0;
|
||||
static location_t token_location = 0;
|
||||
|
||||
location_t current_token_location() { return token_location; }
|
||||
location_t current_token_location(const location_t& loc) {
|
||||
return token_location = loc;
|
||||
}
|
||||
location_t current_location_minus_one() { return token_location_minus_1; }
|
||||
void current_location_minus_one_clear()
|
||||
{
|
||||
@@ -2360,18 +2363,6 @@ yyerror( const char gmsgid[], ... ) {
|
||||
global_dc->end_group();
|
||||
}
|
||||
|
||||
bool
|
||||
yywarn( const char gmsgid[], ... ) {
|
||||
verify_format(gmsgid);
|
||||
auto_diagnostic_group d;
|
||||
va_list ap;
|
||||
va_start (ap, gmsgid);
|
||||
auto ret = emit_diagnostic_valist( diagnostics::kind::warning, token_location,
|
||||
option_zero, gmsgid, &ap );
|
||||
va_end (ap);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/*
|
||||
* Sometimes during parsing an error is noticed late. This message refers back
|
||||
* to an arbitrary file and line number.
|
||||
@@ -2430,9 +2421,11 @@ cobol_fileline_set( const char line[] ) {
|
||||
*filename = xstrndup(line + pmatch[2].rm_so, matched_length(pmatch[2]));
|
||||
int fileline;
|
||||
|
||||
if( 1 != sscanf(line_str, "%d", &fileline) )
|
||||
yywarn("could not parse line number %s from %<#line%> directive", line_str);
|
||||
|
||||
if( 1 != sscanf(line_str, "%d", &fileline) ) {
|
||||
cbl_message(LexLineE,
|
||||
"could not parse line number %s from %<#line%> directive",
|
||||
line_str);
|
||||
}
|
||||
input_file_t input_file( filename, ino_t(0), fileline ); // constructor sets inode
|
||||
|
||||
if( input_filenames.empty() ) {
|
||||
@@ -2525,11 +2518,11 @@ cobol_parse_files (int nfile, const char **files)
|
||||
{
|
||||
const char * opaque = setlocale(LC_CTYPE, "");
|
||||
if( ! opaque ) {
|
||||
yywarn("setlocale: unable to initialize LOCALE");
|
||||
cbl_message(ParLocaleW, "setlocale: unable to initialize LOCALE");
|
||||
} else {
|
||||
char *codeset = nl_langinfo(CODESET);
|
||||
if( ! codeset ) {
|
||||
yywarn("%<nl_langinfo%> failed after %<setlocale()%> succeeded");
|
||||
cbl_message(ParLangInfoW, "%<nl_langinfo%> failed after %<setlocale()%> succeeded");
|
||||
} else {
|
||||
os_locale.codeset = codeset;
|
||||
}
|
||||
@@ -2541,20 +2534,6 @@ cobol_parse_files (int nfile, const char **files)
|
||||
}
|
||||
}
|
||||
|
||||
/* Outputs the formatted string onto the file descriptor */
|
||||
|
||||
void
|
||||
cbl_message(int fd, const char *format_string, ...)
|
||||
{
|
||||
va_list ap;
|
||||
va_start(ap, format_string);
|
||||
char *ostring = xvasprintf(format_string, ap);
|
||||
va_end(ap);
|
||||
write(fd, ostring, strlen(ostring));
|
||||
write(fd, "\n", 1);
|
||||
free(ostring);
|
||||
}
|
||||
|
||||
/* Uses the GCC internal_error () to output the formatted string. Processing
|
||||
ends with a stack trace */
|
||||
|
||||
@@ -2571,15 +2550,30 @@ cbl_internal_error(const char *gmsgid, ...) {
|
||||
// // doesn't cause a warning.
|
||||
}
|
||||
|
||||
diagnostics::kind cbl_diagnostic_kind( cbl_diag_id_t id );
|
||||
const char * cbl_diagnostic_option( cbl_diag_id_t id );
|
||||
|
||||
void
|
||||
cbl_unimplementedw(const char *gmsgid, ...) {
|
||||
cbl_unimplementedw(cbl_diag_id_t id, const char *gmsgid, ...) {
|
||||
verify_format(gmsgid);
|
||||
auto_diagnostic_group d;
|
||||
const char *option;
|
||||
char *msg = nullptr;
|
||||
|
||||
diagnostics::kind kind = cbl_diagnostic_kind(id);
|
||||
if( kind == diagnostics::kind::ignored ) return;
|
||||
|
||||
if( (option = cbl_diagnostic_option(id)) != nullptr ) {
|
||||
msg = xasprintf("%s [%s]", gmsgid, option);
|
||||
gmsgid = msg;
|
||||
}
|
||||
|
||||
va_list ap;
|
||||
|
||||
va_start(ap, gmsgid);
|
||||
emit_diagnostic_valist( diagnostics::kind::warning,
|
||||
token_location, option_zero, gmsgid, &ap );
|
||||
emit_diagnostic_valist( kind, token_location, option_zero, gmsgid, &ap );
|
||||
va_end(ap);
|
||||
free(msg);
|
||||
}
|
||||
|
||||
void
|
||||
@@ -2635,6 +2629,13 @@ cbl_errx(const char *gmsgid, ...) {
|
||||
va_end(ap);
|
||||
}
|
||||
|
||||
/*
|
||||
* For a function that uses host *printf, %zu or %td or %wu are not ok, sadly.
|
||||
* not all supported host arches support those. So, for *printf family one
|
||||
* needs to use macros like HOST_WIDE_INT_PRINT_DEC (for HOST_WIDE_INT
|
||||
* argument), or HOST_SIZE_T_PRINT_UNSIGNED (for size_t, with casts to
|
||||
* (fmt_size_t)).
|
||||
*/
|
||||
void
|
||||
dbgmsg(const char *msg, ...) {
|
||||
if( yy_flex_debug || yydebug ) {
|
||||
@@ -2647,12 +2648,6 @@ dbgmsg(const char *msg, ...) {
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
dialect_error( const YYLTYPE& loc, const char term[], const char dialect[] ) {
|
||||
error_msg(loc, "%s is not ISO syntax, requires %<-dialect %s%>",
|
||||
term, dialect);
|
||||
}
|
||||
|
||||
bool fisdigit(int c)
|
||||
{
|
||||
return ISDIGIT(c);
|
||||
|
||||
@@ -31,8 +31,6 @@
|
||||
#ifndef _UTIL_H_
|
||||
#define _UTIL_H_
|
||||
|
||||
void cbl_message(int fd, const char *format_string, ...)
|
||||
ATTRIBUTE_PRINTF_2;
|
||||
[[noreturn]] void cbl_internal_error(const char *format_string, ...)
|
||||
ATTRIBUTE_GCOBOL_DIAG(1, 2);
|
||||
|
||||
|
||||
Reference in New Issue
Block a user