diff --git a/cobc/ChangeLog b/cobc/ChangeLog index f4c5ee4ef..7c3581274 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -212,6 +212,23 @@ * parser.y (examine_format_variant): fix compiler warning +2022-09-15 Nicolas Berthier + + FR #360 AREACHECK + FR #309 raise warnings/errors when some periods are missing + * config.def: add dialect options areacheck and missing-period + * pplex.l, scanner.l, parser.y: check for empty Area A, and use a + dedicated *_IN_AREA_A tokens to detect missing periods and incorrect + use of Area A + * pplex.l, scanner.l, parser.y: support AREACHECK and NOAREACHECK + directives + * pplex.l (cobc_has_areacheck_directive): new helper function + * pplex.l (count_newlines): new helper function + * parser.y (check_area_a, check_non_area_a): new functions for Area A + checks + * parser.y (begin_statement): check statement does not start in Area A + * parser.y: support some missing periods + 2022-09-01 Nicolas Berthier FR #18 support EXAMINE statement diff --git a/cobc/config.def b/cobc/config.def index f641f9eae..187378668 100644 --- a/cobc/config.def +++ b/cobc/config.def @@ -198,6 +198,10 @@ CB_CONFIG_BOOLEAN (cb_device_mnemonics, "device-mnemonics", CB_CONFIG_BOOLEAN (cb_xml_parse_xmlss, "xml-parse-xmlss", "XML PARSE XMLSS") +CB_CONFIG_BOOLEAN (cb_areacheck, "areacheck", + _("check contents of Area A in PROCEDURE DIVISION " + "(when reference format supports Area A enforcement)")) + /* Support flags */ CB_CONFIG_SUPPORT (cb_comment_paragraphs, "comment-paragraphs", @@ -411,6 +415,9 @@ CB_CONFIG_SUPPORT (cb_sequential_advancing, "record-sequential-advancing", CB_CONFIG_SUPPORT (cb_missing_statement, "missing-statement", _("missing statement (e.g. empty IF / PERFORM)")) +CB_CONFIG_SUPPORT (cb_missing_period, "missing-period", + _("missing period in PROCEDURE DIVISION (when reference format supports Area A enforcement)")) + CB_CONFIG_SUPPORT (cb_zero_length_lit, "zero-length-literals", _("zero-length literals, e.g. '' and \"\"")) diff --git a/cobc/parser.y b/cobc/parser.y index 28656f6fa..763a93b24 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -156,6 +156,8 @@ unsigned int cobc_cs_check = 0; unsigned int cobc_allow_program_name = 0; unsigned int cobc_in_xml_generate_body = 0; unsigned int cobc_in_json_generate_body = 0; +unsigned int cobc_areacheck = 0; +unsigned int cobc_in_area_a = 0; /* Local variables */ @@ -311,6 +313,35 @@ static int backup_source_line = 0; /* Static functions */ +/* Area A enforcement */ + +static COB_INLINE void +check_area_a (cb_tree stmt) { + if (!cobc_in_area_a && cobc_areacheck) { + if (stmt) + cb_warning_x (COBC_WARN_FILLER, stmt, + _("'%s' should start in Area A"), + CB_NAME (stmt)); + else + cb_warning (COBC_WARN_FILLER, + _("statement should start in Area A")); + } +} + +static COB_INLINE void +check_non_area_a (cb_tree stmt) { + if (cobc_in_area_a && cobc_areacheck) { + if (stmt) + cb_warning_x (COBC_WARN_FILLER, stmt, + _("start of statement in Area A")); + else + cb_warning (COBC_WARN_FILLER, + _("start of statement in Area A")); + } +} + +/* Statements */ + static void begin_statement (enum cob_statement statement, const unsigned int term) { @@ -324,6 +355,7 @@ begin_statement (enum cob_statement statement, const unsigned int term) CB_TREE (current_statement)->source_file = cb_source_file; CB_TREE (current_statement)->source_line = cb_source_line; current_statement->flag_in_debug = in_debugging; + check_non_area_a (CB_TREE (current_statement)); emit_statement (CB_TREE (current_statement)); if (term) { term_array[term]++; @@ -3230,6 +3262,9 @@ set_record_size (cb_tree min, cb_tree max) %token YYYYMMDD %token ZERO +%token LEVEL_NUMBER_IN_AREA_A "level-number (Area A)" +%token WORD_IN_AREA_A "Identifier (Area A)" + /* Set up precedence operators to force shift */ %nonassoc SHIFT_PREFER @@ -3342,6 +3377,7 @@ set_record_size (cb_tree min, cb_tree max) %nonassoc IN %nonassoc WORD +%nonassoc WORD_IN_AREA_A %nonassoc LITERAL %nonassoc TOK_OPEN_PAREN @@ -3462,9 +3498,10 @@ end_program_list: end_program: END_PROGRAM { + check_area_a ($1); backup_current_pos (); } - end_program_name TOK_DOT + end_program_name _dot { first_nested_program = 0; clean_up_program ($3, COB_MODULE_TYPE_PROGRAM); @@ -3476,7 +3513,7 @@ end_function: { backup_current_pos (); } - end_program_name TOK_DOT + end_program_name _dot { clean_up_program ($3, COB_MODULE_TYPE_FUNCTION); } @@ -3486,7 +3523,7 @@ end_function: program_prototype: _identification_header - program_id_header TOK_DOT program_id_name _as_literal _is PROTOTYPE TOK_DOT + program_id_header TOK_DOT program_id_name _as_literal _is PROTOTYPE _dot { /* Error if program_id_name is a literal */ @@ -3536,7 +3573,7 @@ program_prototype: function_prototype: _identification_header - function_id_header TOK_DOT program_id_name _as_literal _is PROTOTYPE TOK_DOT + function_id_header TOK_DOT program_id_name _as_literal _is PROTOTYPE _dot { /* Error if program_id_name is a literal */ @@ -3578,20 +3615,22 @@ function_prototype: _prototype_procedure_division_header: /* empty */ -| PROCEDURE DIVISION _procedure_using_chaining _procedure_returning TOK_DOT +| PROCEDURE { check_area_a ($1); } + DIVISION _procedure_using_chaining _procedure_returning _dot { - cb_validate_parameters_and_returning (current_program, $3); - current_program->num_proc_params = cb_list_length ($3); + cb_validate_parameters_and_returning (current_program, $4); + current_program->num_proc_params = cb_list_length ($4); /* add pseudo-entry as it contains the actual USING parameters */ - emit_main_entry (current_program, $3); + emit_main_entry (current_program, $4); } ; /* CONTROL DIVISION (GCOS extension) */ +control: CONTROL { check_area_a ($1); }; _control_division: /* empty */ -| CONTROL DIVISION TOK_DOT +| control DIVISION _dot { cb_verify (cb_control_division, "CONTROL DIVISION"); } @@ -3600,7 +3639,8 @@ _control_division: _default_section: /* empty */ -| DEFAULT SECTION TOK_DOT +| DEFAULT { check_area_a ($1); } + SECTION TOK_DOT _default_clauses { cobc_cs_check = 0; @@ -3658,7 +3698,8 @@ _identification_header: ; identification_header: - identification_or_id DIVISION TOK_DOT + identification_or_id { check_area_a ($1); } + DIVISION _dot { setup_program_start (); setup_from_identification = 1; @@ -3679,7 +3720,7 @@ program_id_header: ; program_id_paragraph: - program_id_header TOK_DOT program_id_name _as_literal _program_type TOK_DOT + program_id_header TOK_DOT program_id_name _as_literal _program_type TOK_DOT /* optional, yet impacts errors on recovery */ { if (setup_program ($3, $4, COB_MODULE_TYPE_PROGRAM, 0)) { YYABORT; @@ -3718,7 +3759,7 @@ function_id_header: ; function_id_paragraph: - function_id_header TOK_DOT program_id_name _as_literal TOK_DOT +function_id_header TOK_DOT program_id_name _as_literal TOK_DOT /* optional, yet impacts errors on recovery */ { if (setup_program ($3, $4, COB_MODULE_TYPE_FUNCTION, 0)) { YYABORT; @@ -3815,7 +3856,7 @@ _options_clauses: _default_rounded_clause _entry_convention_clause _intermediate_rounding_clause - TOK_DOT + _dot ; _arithmetic_clause: @@ -3930,8 +3971,9 @@ _environment_header: | environment_header ; +environment: ENVIRONMENT { check_area_a ($1); }; environment_header: - ENVIRONMENT DIVISION TOK_DOT + environment DIVISION _dot { header_check |= COBC_HD_ENVIRONMENT_DIVISION; } @@ -3948,8 +3990,9 @@ _configuration_header: | configuration_header ; +configuration: CONFIGURATION { check_area_a ($1); }; configuration_header: - CONFIGURATION SECTION TOK_DOT + configuration SECTION _dot { check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, 0, 0, 0); header_check |= COBC_HD_CONFIGURATION_SECTION; @@ -3984,7 +4027,7 @@ _source_computer_paragraph: ; source_computer_paragraph: - SOURCE_COMPUTER TOK_DOT + SOURCE_COMPUTER _dot { check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, COBC_HD_CONFIGURATION_SECTION, 0, 0); @@ -4012,7 +4055,7 @@ _with_debugging_mode: /* OBJECT-COMPUTER paragraph */ object_computer_paragraph: - OBJECT_COMPUTER TOK_DOT + OBJECT_COMPUTER _dot { check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, COBC_HD_CONFIGURATION_SECTION, 0, 0); @@ -4159,7 +4202,7 @@ _repository_paragraph: ; repository_paragraph: - REPOSITORY TOK_DOT + REPOSITORY _dot { check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, COBC_HD_CONFIGURATION_SECTION, 0, 0); @@ -4228,7 +4271,7 @@ repository_name_list: /* SPECIAL-NAMES paragraph */ special_names_header: - SPECIAL_NAMES TOK_DOT + SPECIAL_NAMES _dot { check_duplicate = 0; check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, @@ -5081,8 +5124,9 @@ _input_output_section: _i_o_control ; +input_output: INPUT_OUTPUT { check_area_a ($1); }; _input_output_header: -| INPUT_OUTPUT SECTION TOK_DOT +| input_output SECTION _dot { check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, 0, 0, 0); header_check |= COBC_HD_INPUT_OUTPUT_SECTION; @@ -5092,7 +5136,7 @@ _input_output_header: /* FILE-CONTROL paragraph */ _file_control_header: -| FILE_CONTROL TOK_DOT +| FILE_CONTROL _dot { check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, COBC_HD_INPUT_OUTPUT_SECTION, 0, 0); @@ -5996,7 +6040,7 @@ _i_o_control: ; i_o_control_header: - I_O_CONTROL TOK_DOT + I_O_CONTROL _dot { check_headers_present(COBC_HD_ENVIRONMENT_DIVISION, COBC_HD_INPUT_OUTPUT_SECTION, 0, 0); @@ -6198,8 +6242,9 @@ _data_division_header: | data_division_header ; +data: DATA { check_area_a ($1); }; data_division_header: - DATA DIVISION TOK_DOT + data DIVISION _dot { header_check |= COBC_HD_DATA_DIVISION; cobc_in_data_division = 1; @@ -6208,8 +6253,9 @@ data_division_header: /* FILE SECTION */ +tok_file: TOK_FILE { check_area_a ($1); }; _file_section_header: -| TOK_FILE SECTION TOK_DOT +| tok_file SECTION _dot { current_storage = CB_STORAGE_FILE; check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); @@ -6274,10 +6320,12 @@ file_description_entry: file_type: FD { + check_area_a ($1); $$ = cb_int0; } | SD { + check_area_a ($1); $$ = cb_int1; } ; @@ -6626,8 +6674,9 @@ rep_name_list: /* COMMUNICATION SECTION */ +communication: COMMUNICATION { check_area_a ($1); }; _communication_section: -| COMMUNICATION SECTION TOK_DOT +| communication SECTION _dot { current_storage = CB_STORAGE_COMMUNICATION; check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); @@ -6773,8 +6822,9 @@ unnamed_i_o_cd_clauses: /* WORKING-STORAGE SECTION */ +working_storage: WORKING_STORAGE { check_area_a ($1); }; _working_storage_section: -| WORKING_STORAGE SECTION TOK_DOT +| working_storage SECTION _dot { check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); header_check |= COBC_HD_WORKING_STORAGE_SECTION; @@ -6807,8 +6857,8 @@ _record_description_list: ; record_description_list: - data_description TOK_DOT -| record_description_list data_description TOK_DOT + data_description _dot_or_else_area_a_in_data_division +| record_description_list data_description _dot_or_else_area_a_in_data_division ; data_description: @@ -6853,6 +6903,20 @@ data_description: level_number: not_const_word LEVEL_NUMBER + { + int level = cb_get_level ($2); + switch (level) { + case 1: + case 77: + case 78: + check_area_a ($2); + break; + default: + break; + } + $$ = $2; + } +| not_const_word LEVEL_NUMBER_IN_AREA_A { $$ = $2; } @@ -8486,8 +8550,9 @@ identified_by_clause: /* LOCAL-STORAGE SECTION */ +local_storage: LOCAL_STORAGE { check_area_a ($1); }; _local_storage_section: -| LOCAL_STORAGE SECTION TOK_DOT +| local_storage SECTION _dot { check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); header_check |= COBC_HD_LOCAL_STORAGE_SECTION; @@ -8509,8 +8574,9 @@ _local_storage_section: /* LINKAGE SECTION */ +linkage: LINKAGE { check_area_a ($1); }; _linkage_section: -| LINKAGE SECTION TOK_DOT +| linkage SECTION _dot { check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); header_check |= COBC_HD_LINKAGE_SECTION; @@ -8527,7 +8593,8 @@ _linkage_section: /* REPORT SECTION */ _report_section: -| REPORT SECTION TOK_DOT +| REPORT { check_area_a ($1); } + SECTION _dot { header_check |= COBC_HD_REPORT_SECTION; current_storage = CB_STORAGE_REPORT; @@ -8545,15 +8612,16 @@ _report_description_sequence: /* RD report description */ report_description: - RD report_name + RD { check_area_a ($1); } + report_name { - if (CB_INVALID_TREE ($2)) { + if (CB_INVALID_TREE ($3)) { YYERROR; } else { current_field = NULL; control_field = NULL; description_field = NULL; - current_report = CB_REPORT_PTR ($2); + current_report = CB_REPORT_PTR ($3); } check_duplicate = 0; } @@ -9299,7 +9367,8 @@ group_indicate_clause: /* SCREEN SECTION */ _screen_section: -| SCREEN SECTION TOK_DOT +| SCREEN { check_area_a ($1); } + SECTION _dot { cobc_cs_check = CB_CS_SCREEN; current_storage = CB_STORAGE_SCREEN; @@ -10421,7 +10490,8 @@ _procedure_division: ; procedure_division: - PROCEDURE DIVISION + PROCEDURE { check_area_a ($1); } + DIVISION { current_section = NULL; current_paragraph = NULL; @@ -10432,14 +10502,14 @@ procedure_division: cb_set_system_names (); backup_current_pos (); } - _mnemonic_conv _conv_linkage _procedure_using_chaining _procedure_returning TOK_DOT + _mnemonic_conv _conv_linkage _procedure_using_chaining _procedure_returning { - cb_tree call_conv = $4; - if ($5) { - call_conv = $5; - if ($4) { + cb_tree call_conv = $5; + if ($6) { + call_conv = $6; + if ($5) { /* note: $4 is likely to be a reference to SPECIAL-NAMES */ - cb_error_x ($5, _("%s and %s are mutually exclusive"), + cb_error_x ($6, _("%s and %s are mutually exclusive"), "CALL-CONVENTION", "WITH LINKAGE"); } } @@ -10456,10 +10526,10 @@ procedure_division: cb_check_definition_matches_prototype (current_program); } + _dot_or_else_area_a _procedure_declaratives { - - emit_main_entry (current_program, $6); + emit_main_entry (current_program, $7); } _procedure_list { @@ -10507,7 +10577,9 @@ procedure_division: emit_statement (CB_TREE (current_paragraph)); cb_set_system_names (); } - statements TOK_DOT _procedure_list + statements + _dot_or_else_area_a + _procedure_list ; _procedure_using_chaining: @@ -10748,13 +10820,19 @@ _procedure_returning: ; _procedure_declaratives: -| DECLARATIVES TOK_DOT +| DECLARATIVES { + check_area_a ($1); /* "DECLARATIVES" should be in Area A */ in_declaratives = 1; emit_statement (cb_build_comment ("DECLARATIVES")); } + _dot_or_else_area_a _procedure_list - END DECLARATIVES TOK_DOT + END + { + check_area_a ($5); /* "END" should be in Area A */ + } + DECLARATIVES { if (needs_field_debug) { start_debug = 1; @@ -10780,6 +10858,7 @@ _procedure_declaratives: emit_statement (cb_build_comment ("END DECLARATIVES")); check_unreached = 0; } + _dot_or_else_area_a ; @@ -10810,7 +10889,7 @@ procedure: /* check_unreached = 0; */ cb_end_statement(); } - TOK_DOT + _dot_or_else_area_a | invalid_statement %prec SHIFT_PREFER | TOK_DOT { @@ -10822,8 +10901,20 @@ procedure: /* Section/Paragraph */ +proc_name: + WORD_IN_AREA_A + { + $$ = $1; + } +| WORD + { + check_area_a ($1); + $$ = $1; + } +; + section_header: - WORD SECTION + proc_name SECTION { non_const_word = 0; check_unreached = 0; @@ -10874,7 +10965,7 @@ _use_statement: ; paragraph_header: - WORD TOK_DOT + proc_name TOK_DOT { cb_tree label; @@ -10919,18 +11010,21 @@ paragraph_header: ; invalid_statement: - WORD + WORD error /* error is required here to avoid a reduce/reduce conflict */ { non_const_word = 0; check_unreached = 0; if (cb_build_section_name ($1, 0) != cb_error_node) { if (is_reserved_word (CB_NAME ($1))) { - cb_error_x ($1, _("'%s' is not a statement"), CB_NAME ($1)); + cb_note_x (COB_WARNOPT_NONE, $1, + _("'%s' is not a statement"), CB_NAME ($1)); } else if (is_default_reserved_word (CB_NAME ($1))) { - cb_error_x ($1, _("unknown statement '%s'; it may exist in another dialect"), - CB_NAME ($1)); + cb_note_x (COB_WARNOPT_NONE, $1, + _("unknown statement '%s'; it may exist in another dialect"), + CB_NAME ($1)); } else { - cb_error_x ($1, _("unknown statement '%s'"), CB_NAME ($1)); + cb_note_x (COB_WARNOPT_NONE, $1, + _("unknown statement '%s'"), CB_NAME ($1)); } } YYERROR; @@ -11109,7 +11203,8 @@ statement: | xml_generate_statement | xml_parse_statement | %prec SHIFT_PREFER - NEXT SENTENCE + NEXT { check_non_area_a ($1); } + SENTENCE { if (cb_verify (cb_next_sentence_phrase, "NEXT SENTENCE")) { cb_tree label; @@ -13303,15 +13398,16 @@ enable_statement: /* ENTRY statement */ +entry: ENTRY { check_non_area_a ($1); }; entry_statement: - ENTRY + entry { check_unreached = 0; begin_statement (STMT_ENTRY, 0); backup_current_pos (); } entry_body -| ENTRY FOR GO TO +| entry FOR GO TO { check_unreached = 0; begin_statement (STMT_ENTRY_FOR_GO_TO, 0); @@ -14529,8 +14625,9 @@ inspect_after: /* JSON GENERATE statement */ +json: JSON { check_non_area_a ($1); }; json_generate_statement: - JSON GENERATE + json GENERATE { begin_statement (STMT_JSON_GENERATE, TERM_JSON); cobc_in_json_generate_body = 1; @@ -14591,7 +14688,7 @@ _end_json: /* JSON PARSE statement */ json_parse_statement: - JSON PARSE + json PARSE { begin_statement (STMT_JSON_PARSE, TERM_JSON); CB_PENDING ("JSON PARSE"); @@ -15465,14 +15562,15 @@ rollback_statement: /* SEARCH statement */ +search: SEARCH { check_non_area_a ($1); }; search_statement: - SEARCH + search { begin_statement (STMT_SEARCH, TERM_SEARCH); } search_body _end_search -| SEARCH ALL +| search ALL { begin_statement (STMT_SEARCH_ALL, TERM_SEARCH); } @@ -16118,8 +16216,9 @@ transaction: /* STOP statement */ +stop: STOP { check_non_area_a ($1); }; stop_statement: - STOP RUN + stop RUN { begin_statement (STMT_STOP_RUN, 0); cobc_cs_check = CB_CS_STOP; @@ -16130,14 +16229,14 @@ stop_statement: check_unreached = 1; cobc_cs_check = 0; } -| STOP ERROR /* GCOS */ +| stop ERROR /* GCOS */ { begin_statement (STMT_STOP_ERROR, 0); cb_verify (cb_stop_error_statement, cb_statement_name[STMT_STOP_ERROR]); cb_emit_stop_error (); check_unreached = 1; } -| STOP stop_argument +| stop stop_argument { begin_statement (STMT_STOP, 0); cb_emit_display (CB_LIST_INIT ($2), cb_int0, cb_int1, NULL, @@ -16145,7 +16244,7 @@ stop_statement: cb_emit_accept (cb_null, NULL, NULL); cobc_cs_check = 0; } -| STOP thread_reference_optional +| stop thread_reference_optional { begin_statement (STMT_STOP_THREAD, 0); cb_emit_stop_thread ($2); @@ -16336,7 +16435,8 @@ _end_subtract: /* SUPPRESS statement */ suppress_statement: - SUPPRESS _printing + SUPPRESS { check_non_area_a ($1); } + _printing { begin_statement (STMT_SUPPRESS, 0); if (!in_declaratives) { @@ -16927,8 +17027,9 @@ _end_write: /* XML GENERATE statement */ +xml: XML { check_non_area_a ($1); }; xml_generate_statement: - XML GENERATE + xml GENERATE { begin_statement (STMT_XML_GENERATE, TERM_XML); cobc_in_xml_generate_body = 1; @@ -17216,7 +17317,7 @@ _end_xml: /* XML PARSE statement */ xml_parse_statement: - XML PARSE + xml PARSE { begin_statement (STMT_XML_PARSE, TERM_XML); CB_PENDING ("XML PARSE"); @@ -19560,6 +19661,39 @@ scope_terminator: | END_XML ; +_dot: + TOK_DOT +| { + if (! cb_verify (cb_missing_period, _("optional period"))) + YYERROR; + } +; + +_dot_or_else_area_a: + TOK_DOT +| TOKEN_EOF + { + if (! cb_verify (cb_missing_period, _("optional period"))) + YYERROR; + } +| WORD_IN_AREA_A + { + /* No need to raise the error for *_IN_AREA_A tokens */ + (void) cb_verify (cb_missing_period, _("optional period")); + cobc_repeat_last_token = 1; + } +; + +_dot_or_else_area_a_in_data_division: + TOK_DOT +| LEVEL_NUMBER_IN_AREA_A + { + /* No need to raise the error for *_IN_AREA_A tokens */ + (void) cb_verify (cb_missing_period, _("optional period")); + cobc_repeat_last_token = 1; + } +; + /* Mandatory/Optional keyword selection without actions */ /* Optional selection */ diff --git a/cobc/pplex.l b/cobc/pplex.l index af0ee2f82..04fc6b607 100644 --- a/cobc/pplex.l +++ b/cobc/pplex.l @@ -156,6 +156,7 @@ static int floating_area_b = 0; /* whether indicator is optional */ static int fill_continued_alnums = 1; /* whether continued alphanumeric literals should be filled with spaces up to text column */ +static int emit_area_a_tokens = 0; static char display_msg[PPLEX_BUFF_LEN]; @@ -178,6 +179,7 @@ static void switch_to_buffer (const int, const char *, const YY_BUFFER_STATE); static void check_listing (const char *, const unsigned int); static void skip_to_eol (void); +static void count_newlines (const char *); static void display_finish (void); static void set_print_replace_list (struct cb_replace_list *list); static void get_new_listing_file (void); @@ -190,6 +192,9 @@ ALNUM_LITERAL "\""[^""\n]*"\""|"\'"[^''\n]*"\'" SET_PAREN_LIT \([^()\n]*\) DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ +AREA_A [ ]?# +MAYBE_AREA_A [ ]?#? + %x CALL_DIRECTIVE_STATE %x COBOL_WORDS_DIRECTIVE_STATE %x COPY_STATE @@ -222,33 +227,33 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ #endif } -^[ ]*">>"[ ]?"COBOL-WORDS" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"COBOL-WORDS" { /* 202x+: directive for setting source format */ BEGIN COBOL_WORDS_DIRECTIVE_STATE; return COBOL_WORDS_DIRECTIVE; } -^[ ]*">>"[ ]?"DEFINE" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"DEFINE" { /* 2002+: definition of compiler constants display message during compilation */ /* Define here to preempt next debug rule below */ BEGIN DEFINE_DIRECTIVE_STATE; return DEFINE_DIRECTIVE; } -^[ ]*">>"[ ]?"DISPLAY"[ ]+ { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"DISPLAY"[ ]+ { /* previous OpenCOBOL/GnuCOBOL 2.x extension, added in COBOL 202x with slightly different syntax: display message during compilation --> needs a dialect option to switch to the appropriate state */ display_msg[0] = 0; BEGIN DISPLAY_DIRECTIVE_STATE; } -^[ ]*">>"[ ]?"REF-MOD-ZERO-LENGTH" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"REF-MOD-ZERO-LENGTH" { /* 202x: directive to allow zero ref-mod */ BEGIN ON_OFF_DIRECTIVE_STATE; return REFMOD_DIRECTIVE; } -^[ ]*">>D" { +^{MAYBE_AREA_A}[ ]*">>D" { /* 2002 (only) floating debug line */ /* Remove line if debugging lines not activated */ /* Otherwise ignore the directive part of the line */ @@ -258,13 +263,13 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ } } -^[ ]*">>"[ ]?"PAGE" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"PAGE" { /* 2002+: listing directive for page eject with optional comment Note: processed in cobc.c */ skip_to_eol (); } -^[ ]*">>"[ ]?"LISTING" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"LISTING" { /* 2002+: listing directive for (de-)activating the listing, ON implied for empty value Note: further checks in ppparse.y, processed in cobc.c */ @@ -272,68 +277,85 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ return LISTING_DIRECTIVE; } -^[ ]*">>"[ ]?"SOURCE" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"SOURCE" { /* 2002+: directive for setting source format */ BEGIN SOURCE_DIRECTIVE_STATE; return SOURCE_DIRECTIVE; } -^[ ]*">>"[ ]?"SET" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"SET" { /* OpenCOBOL/GnuCOBOL 2.0 extension: MF SET directive in 2002+ style format */ BEGIN SET_DIRECTIVE_STATE; return SET_DIRECTIVE; } -^[ ]*">>"[ ]?"TURN" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"TURN" { /* 2002+: directive for (de-)activating exception checks */ BEGIN TURN_DIRECTIVE_STATE; return TURN_DIRECTIVE; } -^[ ]*">>"[ ]?"IF" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"IF" { /* 2002+: conditional compilation */ BEGIN IF_DIRECTIVE_STATE; return IF_DIRECTIVE; } -^[ ]*">>"[ ]?"ELIF" | -^[ ]*">>"[ ]?"ELSE-IF" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"ELIF" | +^{MAYBE_AREA_A}[ ]*">>"[ ]?"ELSE-IF" { /* OpenCOBOL extension: conditional compilation combined ELSE IF, 2002+ style format */ BEGIN IF_DIRECTIVE_STATE; return ELIF_DIRECTIVE; } -^[ ]*">>"[ ]?"ELSE" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"ELSE" { /* 2002+: conditional compilation */ BEGIN ELSE_DIRECTIVE_STATE; return ELSE_DIRECTIVE; } -^[ ]*">>"[ ]?"END-IF" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"END-IF" { /* 2002+: conditional compilation */ BEGIN ENDIF_DIRECTIVE_STATE; return ENDIF_DIRECTIVE; } -^[ ]*">>"[ ]?"LEAP-SECOND" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"LEAP-SECOND" { /* 2002+: more then 60 seconds per minute (currently always set to off), OFF implied for empty value */ BEGIN ON_OFF_DIRECTIVE_STATE; return LEAP_SECOND_DIRECTIVE; } -^[ ]*">>"[ ]?"CALL-CONVENTION" { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"CALL-CONVENTION" { /* 2002+: convention for CALL/CANCEL */ BEGIN CALL_DIRECTIVE_STATE; return CALL_DIRECTIVE; } -^[ ]*">>"[ ]*\n { +^{MAYBE_AREA_A}[ ]*">>"[ ]?"AREACHECK" | +^{MAYBE_AREA_A}[ ]*">>"[ ]?"AREA-CHECK" { + if (cobc_has_areacheck_directive ("AREACHECK")) { + fprintf (ppout, "#AREACHECK\n"); + } + skip_to_eol (); +} + +^{MAYBE_AREA_A}[ ]*">>"[ ]?"NOAREACHECK" | +^{MAYBE_AREA_A}[ ]*">>"[ ]?"NO-AREACHECK" | +^{MAYBE_AREA_A}[ ]*">>"[ ]?"NO-AREA-CHECK" { + if (cobc_has_areacheck_directive ("NOAREACHECK")) { + fprintf (ppout, "#NOAREACHECK\n"); + } + skip_to_eol (); +} + +^{MAYBE_AREA_A}[ ]*">>"[ ]*\n { /* empty 2002+ style directive */ cb_plex_warning (COBC_WARN_FILLER, newline_count, _("ignoring empty directive")); unput ('\n'); } -^[ ]*">>"[ ]*[_0-9A-Z-]+ { +^{MAYBE_AREA_A}[ ]*">>"[ ]*[_0-9A-Z-]+ { /* unknown 2002+ style directive */ char *s; @@ -343,64 +365,64 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ skip_to_eol (); } -^[ ]*">>" { +^{MAYBE_AREA_A}[ ]*">>" { /* unknown 2002+ style directive */ cb_plex_warning (COBC_WARN_FILLER, newline_count, _("ignoring invalid directive")); skip_to_eol (); } -^[ ]*"$DISPLAY"[ ]+"VCS"[ ]+"="[ ]+ { +^{MAYBE_AREA_A}[ ]*"$DISPLAY"[ ]+"VCS"[ ]+"="[ ]+ { /* MF extension: include @(#)text\0 in the object file */ /* we just add a warning for now, maybe implement it later */ CB_PENDING (_("VCS directive")); skip_to_eol (); } -^[ ]*"$DISPLAY"[ ]+ { +^{MAYBE_AREA_A}[ ]*"$DISPLAY"[ ]+ { /* MF extension: display message during compilation */ display_msg[0] = 0; BEGIN DISPLAY_DIRECTIVE_STATE; } -^[ ]*"$SET" { +^{MAYBE_AREA_A}[ ]*"$SET" { /* MF extension: SET directive */ /* TODO: check position of the $SET directive */ BEGIN SET_DIRECTIVE_STATE; return SET_DIRECTIVE; } -^[ ]*"$IF" { +^{MAYBE_AREA_A}[ ]*"$IF" { /* MF extension: conditional compilation */ BEGIN IF_DIRECTIVE_STATE; return IF_DIRECTIVE; } -^[ ]*"$ELIF" | -^[ ]*"$ELSE-IF" { +^{MAYBE_AREA_A}[ ]*"$ELIF" | +^{MAYBE_AREA_A}[ ]*"$ELSE-IF" { /* OpenCOBOL/GnuCOBOL 2.0 extension: conditional compilation combined ELSE IF, MF style format */ BEGIN IF_DIRECTIVE_STATE; return ELIF_DIRECTIVE; } -^[ ]*"$ELSE" { +^{MAYBE_AREA_A}[ ]*"$ELSE" { /* MF extension: conditional compilation */ BEGIN ELSE_DIRECTIVE_STATE; return ELSE_DIRECTIVE; } -^[ ]*"$END" | -^[ ]*"$END-IF" { +^{MAYBE_AREA_A}[ ]*"$END" | +^{MAYBE_AREA_A}[ ]*"$END-IF" { /* MF extension: conditional compilation, second undocumented */ BEGIN ENDIF_DIRECTIVE_STATE; return ENDIF_DIRECTIVE; } -^[ ]*"$REGION" | -^[ ]*"$END-$REGION" { +^{MAYBE_AREA_A}[ ]*"$REGION" | +^{MAYBE_AREA_A}[ ]*"$END-$REGION" { /* MF extension for logical marking of a block in the editor */ /* _possibly_ check: MF rule "$REGION and $IF statements must not overlap." */ skip_to_eol (); } -^[ ]*"$"[_0-9A-Z-]+ { +^{MAYBE_AREA_A}[ ]*"$"[_0-9A-Z-]+ { /* unknown MF style directive */ char *s; @@ -410,7 +432,7 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ skip_to_eol (); } -^......."@OPTIONS"[ ][A-Z0-9() ,;'"=]* { +^{MAYBE_AREA_A}.{7}"@OPTIONS"[ ][A-Z0-9() ,;'"=]* { /* Fujitsu COBOL extension for specifying command line options */ /* TODO: check position of the @OPTIONS directive */ char *s = strchr (yytext, '@'); @@ -419,7 +441,7 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ skip_to_eol (); } -^[ ]*("PROCESS"|"CBL")[ ,;]*[\n] { +^{MAYBE_AREA_A}[ ]*("PROCESS"|"CBL")[ ,;]*[\n] { /* IBM COBOL extension for specifying compiler options */ /* TODO: The CBL (PROCESS) statement must be placed before any comment lines, IDENTIFICATIO DIVISION, or other @@ -428,7 +450,7 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ skip_to_eol (); } -^[ ]*("PROCESS"|"CBL")[ ][A-Z0-9() ,;'"=]* { +^{MAYBE_AREA_A}[ ]*("PROCESS"|"CBL")[ ][A-Z0-9() ,;'"=]* { /* IBM COBOL extension for specifying compiler options */ /* TODO: The CBL (PROCESS) statement must be placed before any comment lines, IDENTIFICATIO DIVISION, or other @@ -440,12 +462,20 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ skip_to_eol (); } -^[ ]*"$" { +^{MAYBE_AREA_A}[ ]*"$" { cb_plex_warning (COBC_WARN_FILLER, newline_count, _("spurious '$' detected - ignored")); skip_to_eol (); } +%{/* Strip any Area A marker leading to COPY, INCLUDE, and REPLACE right now as + at this stage they may not be seen on the line that directly follows the + marker. However, we still need to count the lines we are skipping this + way. */%} +^{AREA_A}[ \n]*/"COPY"[ ,;\n] { count_newlines (yytext); } +^{AREA_A}[ \n]*/"INCLUDE"[ ,;\n] { count_newlines (yytext); } +^{AREA_A}[ \n]*/"REPLACE"[ ,;\n] { count_newlines (yytext); } + "COPY"/[ ,;\n] { yy_push_state (COPY_STATE); if (cb_src_list_file) { @@ -469,12 +499,26 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ return REPLACE; } -^......[ ]*"*CONTROL" | -^......[ ]*"*CBL" { +^{MAYBE_AREA_A}.{6}[ ]*"*CONTROL" | +^{MAYBE_AREA_A}.{6}[ ]*"*CBL" { BEGIN CONTROL_STATEMENT_STATE; return CONTROL_STATEMENT; } +^{AREA_A} { + /* Output a special marker that precedes lines starting in area A. This + is required to detect missing periods. + + See "(*area-a*)" in `ppinput' function below for the code that emits + the `#'. + + The optional space before '#' in the rule above is only needed to + properly handle the first line in each buffer, that for some reason + always starts with a space. + */ + fprintf (ppout, "\n#area_a\n"); +} + "CONTROL"[ ,;\n]+"DIVISION" { /* Syntax extension for GCOS: such a division may include a SUBSTITUTION SECTION that records source text replacement statements, along with a @@ -524,6 +568,7 @@ SUBSTITUTION_SECTION_STATE>{ cb_source_line++; } [,;]?[ ]+ { /* ignore */ } + ^{AREA_A} {} } ppecho (yytext, 0, (int)yyleng); } -^[ ]*"EJECT"([ ]*\.)? | -^[ ]*"SKIP1"([ ]*\.)? | -^[ ]*"SKIP2"([ ]*\.)? | -^[ ]*"SKIP3"([ ]*\.)? { +^{MAYBE_AREA_A}[ ]*"EJECT"([ ]*\.)? | +^{MAYBE_AREA_A}[ ]*"SKIP1"([ ]*\.)? | +^{MAYBE_AREA_A}[ ]*"SKIP2"([ ]*\.)? | +^{MAYBE_AREA_A}[ ]*"SKIP3"([ ]*\.)? { /* These words can either be a listing-directive statement, a reserved word, or a user-defined word... some implementations (dis-)allow the (optional) "." @@ -579,7 +624,7 @@ SUBSTITUTION_SECTION_STATE> } } -^[ ]*"TITLE"[ ,;\n] { +^{MAYBE_AREA_A}[ ]*"TITLE"[ ,;\n] { /* This word can either be a listing-directive statement, a reserved word, or a user-defined word... some implementations (dis-)allow the (optional) "." @@ -765,6 +810,10 @@ COBOL_WORDS_DIRECTIVE_STATE>{ "ADD-SYN" { return ADDSYN; } + "AREACHECK" | + "AREA-CHECK" { + return AREACHECK; + } "ASSIGN" { return ASSIGN; } @@ -807,6 +856,11 @@ COBOL_WORDS_DIRECTIVE_STATE>{ "NO-BOUND" { return NOBOUND; } + "NOAREACHECK" | + "NO-AREACHECK" | + "NO-AREA-CHECK" { + return NOAREACHECK; + } "NOCHECKNUM" | "NO-CHECKNUM" | "NO-CHECK-NUM" { @@ -963,6 +1017,7 @@ ENDIF_DIRECTIVE_STATE>{ cb_source_line++; } [,;]?[ ]+ { /* ignore */ } + ^{AREA_A} {} [_0-9A-Z\x80-\xFF-]+(\.[_0-9A-Z\x80-\xFF-]+)+ { /* special case to allow copybook names with periods without a literal @@ -1005,6 +1060,12 @@ ENDIF_DIRECTIVE_STATE>{ cb_source_line++; } + ^{AREA_A} { + /* Pseudo-text words that start in area-a retain that property, and + should thus be preceded with the marker. */ + pplval.s = cobc_plex_strdup ("\n#area_a\n"); + } + [,;]?[ ]+ { pplval.s = cobc_plex_strdup (" "); return TOKEN; @@ -1426,8 +1487,21 @@ ppparse_error (const char *err_msg) cb_plex_error (newline_count-1, "%s", err_msg); } -/* Sets `source_format`, `indicator_column`, `text_column`, - `floating_area_b`, and `fill_continued_alnums`, based on the given source +int +cobc_has_areacheck_directive (const char * directive) { + if (source_format != CB_FORMAT_FIXED && + source_format != CB_FORMAT_FREE) { + return 1; + } else { + cb_plex_warning (COBC_WARN_FILLER, newline_count, + _("ignoring %s directive because of %s"), + directive, "-fformat=fixed/free"); + return 0; + } +} + +/* Sets `source_format`, `indicator_column`, `text_column`, `floating_area_b`, + `fill_continued_alnums`, and `cobc_areacheck`, based on the given source format. */ void cobc_set_source_format (const enum cb_format sf) { @@ -1477,6 +1551,17 @@ cobc_set_source_format (const enum cb_format sf) { text_column = -1; break; } + + switch (source_format) { + case CB_FORMAT_FIXED: + case CB_FORMAT_FREE: + emit_area_a_tokens = 0; + cobc_areacheck = 0; + break; + default: + emit_area_a_tokens = 1; + cobc_areacheck = cb_areacheck; + } } COB_A_PURE enum cb_format cobc_get_source_format (void) { return source_format; } @@ -1832,6 +1917,7 @@ ppinput (char *buff, const size_t max_size) int i,k; int n; int coln; + int in_area_a; struct list_skip *skip; /* check that we actually have input to process @@ -2265,13 +2351,20 @@ start: goto start; } - /* Substitute spaces for indicator */ + /* Substitute spaces for indicator, and check whether area A is blank */ { const int margin_a = cobc_get_margin_a (indicator_width); + const int margin_b = cobc_get_margin_b (indicator_width); for (i = indicator_column - 1; i < margin_a; i++) { buff[i] = ' '; } bp = buff + margin_a; + + in_area_a = 0; + if (emit_area_a_tokens) { + for (i = margin_a; i < margin_b; i++) + in_area_a |= buff[i] != ' '; + } } if (continuation) { @@ -2389,6 +2482,17 @@ start: memset (buff, '\n', newline_count); gotcr += newline_count; } + if (in_area_a) { + /* (*area-a*): prepend special marker `#', indicating + the current non-continuation line starts in area A + (see "AREA_A" and "MAYBE_AREA_A"... in lexer rules + above). + + Assumes `buff' is large enough for one extra char. */ + memmove (buff + 1, buff, gotcr + 1); + buff[1] = '#'; + gotcr += 1; + } newline_count = 1; } return (int)gotcr; @@ -2584,6 +2688,14 @@ skip_to_eol (void) } } +static void +count_newlines (const char *p) +{ + for (; *p; p++) + if (*p == '\n') + newline_count++; +} + static void display_finish (void) { diff --git a/cobc/ppparse.y b/cobc/ppparse.y index 1c02b7765..4828021af 100644 --- a/cobc/ppparse.y +++ b/cobc/ppparse.y @@ -643,6 +643,8 @@ ppparse_clear_vars (const struct cb_define_struct *p) %token SET_DIRECTIVE %token ADDRSV %token ADDSYN +%token AREACHECK +%token NOAREACHECK %token ASSIGN %token BOUND %token CALLFH @@ -878,6 +880,12 @@ set_choice: fprintf (ppout, "#ADDSYN %s %s\n", l->text, l->next->text); } } +| AREACHECK + { + if (cobc_has_areacheck_directive ("AREACHECK")) { + fprintf (ppout, "#AREACHECK\n"); + } + } | ASSIGN unquoted_literal { char *p = $2; @@ -971,6 +979,12 @@ set_choice: { fprintf (ppout, "#MAKESYN %s %s\n", $2->text, $2->next->text); } +| NOAREACHECK + { + if (cobc_has_areacheck_directive ("NOAREACHECK")) { + fprintf (ppout, "#NOAREACHECK\n"); + } + } | NOBOUND { /* Disable EC-BOUND-SUBSCRIPT checking */ diff --git a/cobc/scanner.l b/cobc/scanner.l index 8ae70549f..c8627b756 100644 --- a/cobc/scanner.l +++ b/cobc/scanner.l @@ -178,6 +178,8 @@ static void make_synonym (void); %} +AREA_A \n"#AREA_A"\n + %s DECIMAL_IS_PERIOD DECIMAL_IS_COMMA %x PICTURE_STATE FUNCTION_STATE @@ -206,6 +208,7 @@ static void make_synonym (void); } else { integer_is_label = 0; } + cobc_in_area_a = 0; %} <*>^[ ]?"#CALLFH".*\n { @@ -337,6 +340,25 @@ static void make_synonym (void); } } +<*>^[ ]?"#AREACHECK"\n { + cobc_areacheck = 1; +} + +<*>^[ ]?"#NOAREACHECK"\n { + cobc_areacheck = 0; +} + +<*>^{AREA_A}[ ]*/"." { + count_lines (yytext + 9); /* skip "\n#area_a\n" */ + if (cobc_in_procedure && cobc_areacheck) { + cb_warning (COBC_WARN_FILLER, _("separator period in Area A")); + } +} + +<*>^{AREA_A}[ ]* { + cobc_in_area_a = 1; +} + <*>\n { cb_source_line++; } @@ -496,7 +518,7 @@ H#[0-9A-Za-z]+ { int value; cobc_force_literal = 0; - if (integer_is_label) { + if (integer_is_label || cobc_in_area_a) { yylval = cb_build_reference (yytext); if (!cobc_in_procedure) { @@ -512,12 +534,20 @@ H#[0-9A-Za-z]+ { RETURN_TOK (EIGHTY_EIGHT); } else if ((value >= 1 && value <= 49) || value == 77) { /* level number (1 through 49, 77) */ - RETURN_TOK (LEVEL_NUMBER); + if (cobc_in_area_a) { + RETURN_TOK (LEVEL_NUMBER_IN_AREA_A); + } else { + RETURN_TOK (LEVEL_NUMBER); + } } } /* Integer label */ - RETURN_TOK (WORD); + if (cobc_in_area_a) { + RETURN_TOK (WORD_IN_AREA_A); + } else { + RETURN_TOK (WORD); + } } /* Numeric literal or referenced integer label remark: all transformations/checks are postponed: @@ -531,10 +561,14 @@ H#[0-9A-Za-z]+ { [0-9]+ { cobc_force_literal = 0; - if (integer_is_label) { + if (integer_is_label || cobc_in_area_a) { /* Integer label */ yylval = cb_build_reference (yytext); - RETURN_TOK (WORD); + if (cobc_in_area_a) { + RETURN_TOK (WORD_IN_AREA_A); + } else { + RETURN_TOK (WORD); + } } /* Numeric literal or referenced integer label remark: all transformations/checks are postponed: @@ -1123,7 +1157,11 @@ H#[0-9A-Za-z]+ { } } - RETURN_TOK (WORD); + if (cobc_in_area_a) { + RETURN_TOK (WORD_IN_AREA_A); + } else { + RETURN_TOK (WORD); + } } "<=" { @@ -1277,6 +1315,7 @@ H#[0-9A-Za-z]+ { } top_78_ptr = NULL; last_token_is_dot = 0; + cobc_in_area_a = 0; integer_is_label = 0; inside_bracket = 0; lev_78_ptr = NULL; diff --git a/cobc/tree.h b/cobc/tree.h index 6e64159fe..9c01f78a8 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -2176,6 +2176,9 @@ extern unsigned int cobc_cs_check; extern unsigned int cobc_allow_program_name; extern unsigned int cobc_in_xml_generate_body; extern unsigned int cobc_in_json_generate_body; +extern unsigned int cobc_areacheck; +extern unsigned int cobc_in_area_a; /* set by scanner only */ +extern unsigned int cobc_still_in_area_a; /* raised by parser only */ /* reserved.c */ extern int is_reserved_word (const char *); @@ -2537,6 +2540,9 @@ extern void cobc_xref_call (const char *, const int, const int, const int); extern void cobc_xref_set_receiving (const cb_tree); extern unsigned int cb_correct_program_order; +/* pplex.l */ +extern int cobc_has_areacheck_directive (const char *directive); + /* Function defines */ #define CB_BUILD_FUNCALL_0(f) \ diff --git a/config/ChangeLog b/config/ChangeLog index a2cf8698e..e5175dec3 100644 --- a/config/ChangeLog +++ b/config/ChangeLog @@ -21,6 +21,10 @@ * runtime.cfg: extend docs for LINE SEQUENTIAL settings +2022-09-15 Nicolas Berthier + + * general: add options areacheck and missing-period + 2022-08-17 Simon Sobisch * general: add xml-parse-xmlss, note: explicit NOT enabled diff --git a/config/acu-strict.conf b/config/acu-strict.conf index 69739e725..bb30c82e9 100644 --- a/config/acu-strict.conf +++ b/config/acu-strict.conf @@ -38,6 +38,9 @@ numeric-literal-length: 31 # default in ACUCOBOL is 18 with the possibility to pic-length: 100 occurs-max-length-without-subscript: yes +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: no #not verified yet + # Default assign type # Value: 'dynamic', 'external' assign-clause: dynamic @@ -271,6 +274,7 @@ sequential-delimiters: unconformable record-delim-with-fixed-recs: ok record-sequential-advancing: ok missing-statement: ok # gets a warning in some places but not in PERFORM +missing-period: warning #when format not in {fixed,free} zero-length-literals: unconformable # not verified yet xml-generate-extra-phrases: unconformable continue-after: unconformable diff --git a/config/bs2000-strict.conf b/config/bs2000-strict.conf index 06b890a89..c57f5ad0b 100644 --- a/config/bs2000-strict.conf +++ b/config/bs2000-strict.conf @@ -39,6 +39,9 @@ literal-length: 180 # TO-DO: Check max hex string length is 360. numeric-literal-length: 31 # TO-DO: Different rules for exponent-format floating-point literals. pic-length: 50 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: yes + # Default assign type # Value: 'dynamic', 'external' assign-clause: external @@ -268,6 +271,7 @@ sequential-delimiters: unconformable record-delim-with-fixed-recs: unconformable record-sequential-advancing: error missing-statement: warning # not verified yet +missing-period: error #when format not in {fixed,free}, not verified yet zero-length-literals: unconformable xml-generate-extra-phrases: unconformable continue-after: unconformable diff --git a/config/cobol2002.conf b/config/cobol2002.conf index b188c1ca7..230dce9d5 100644 --- a/config/cobol2002.conf +++ b/config/cobol2002.conf @@ -37,6 +37,9 @@ literal-length: 160 numeric-literal-length: 31 pic-length: 50 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: no + # Default assign type # Value: 'dynamic', 'external' # Note: standard COBOL supports neither of them but has USING data-name for DYNAMIC @@ -266,6 +269,7 @@ sequential-delimiters: ok record-delim-with-fixed-recs: unconformable record-sequential-advancing: ignore missing-statement: error +missing-period: error #when format not in {fixed,free} zero-length-literals: unconformable xml-generate-extra-phrases: unconformable continue-after: unconformable diff --git a/config/cobol2014.conf b/config/cobol2014.conf index 769e2dcb1..7b851d79a 100644 --- a/config/cobol2014.conf +++ b/config/cobol2014.conf @@ -37,6 +37,9 @@ literal-length: 8191 numeric-literal-length: 31 pic-length: 63 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: no + # Default assign type # Value: 'dynamic', 'external' # Note: standard COBOL supports neither of them but has USING data-name for DYNAMIC @@ -266,6 +269,7 @@ sequential-delimiters: ok record-delim-with-fixed-recs: unconformable record-sequential-advancing: error missing-statement: error +missing-period: error #when format not in {fixed,free} zero-length-literals: ok xml-generate-extra-phrases: unconformable continue-after: unconformable diff --git a/config/cobol85.conf b/config/cobol85.conf index dad73dde7..976ccdf61 100644 --- a/config/cobol85.conf +++ b/config/cobol85.conf @@ -37,6 +37,9 @@ literal-length: 160 numeric-literal-length: 18 pic-length: 30 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: yes + # Default assign type # Value: 'dynamic', 'external' # Note: standard COBOL supports neither of them, later have USING data-name for DYNAMIC @@ -266,6 +269,7 @@ sequential-delimiters: ok record-sequential-advancing: ok record-delim-with-fixed-recs: unconformable missing-statement: error +missing-period: error #when format not in {fixed,free} zero-length-literals: unconformable xml-generate-extra-phrases: unconformable continue-after: unconformable diff --git a/config/default.conf b/config/default.conf index b5c29779f..3810df779 100644 --- a/config/default.conf +++ b/config/default.conf @@ -58,6 +58,9 @@ numeric-literal-length: 38 # Maximum number of characters allowed in the character-string (max. 255) pic-length: 255 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: no + # Default assign type # Value: 'dynamic', 'external' assign-clause: dynamic @@ -289,6 +292,7 @@ sequential-delimiters: ok record-delim-with-fixed-recs: ok record-sequential-advancing: warning missing-statement: warning +missing-period: warning #when format not in {fixed,free} zero-length-literals: ok xml-generate-extra-phrases: ok continue-after: ok diff --git a/config/gcos-strict.conf b/config/gcos-strict.conf index a956e4aac..e31c6921c 100644 --- a/config/gcos-strict.conf +++ b/config/gcos-strict.conf @@ -34,6 +34,9 @@ literal-length: 256 numeric-literal-length: 30 pic-length: 30 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: yes + assign-clause: external # If yes, file names are resolved at run time using @@ -268,6 +271,7 @@ sequential-delimiters: ok record-sequential-advancing: ok # TODO: verify record-delim-with-fixed-recs: unconformable missing-statement: error +missing-period: error #when format not in {fixed,free} zero-length-literals: unconformable xml-generate-extra-phrases: unconformable continue-after: unconformable diff --git a/config/ibm-strict.conf b/config/ibm-strict.conf index be876090d..f263f2777 100644 --- a/config/ibm-strict.conf +++ b/config/ibm-strict.conf @@ -37,6 +37,9 @@ literal-length: 160 numeric-literal-length: 31 # for ARITH(EXTENDED), otherwise 18 pic-length: 50 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: yes + # Default assign type # Value: 'dynamic', 'external' assign-clause: external @@ -265,6 +268,7 @@ sequential-delimiters: unconformable record-delim-with-fixed-recs: unconformable record-sequential-advancing: warning missing-statement: warning # not verified yet +missing-period: warning #when format not in {fixed,free}, not verified yet zero-length-literals: unconformable xml-generate-extra-phrases: ok continue-after: unconformable diff --git a/config/lax.conf-inc b/config/lax.conf-inc index 7ebc333f1..a6f2fcbe0 100644 --- a/config/lax.conf-inc +++ b/config/lax.conf-inc @@ -126,6 +126,7 @@ record-delimiter: ok sequential-delimiters: ok record-delim-with-fixed-recs: ok missing-statement: +warning +missing-period: +warning zero-length-literals: ok xml-generate-extra-phrases: ok continue-after: warning diff --git a/config/mf-strict.conf b/config/mf-strict.conf index fcf73d9b8..a0d81bcb8 100644 --- a/config/mf-strict.conf +++ b/config/mf-strict.conf @@ -40,6 +40,9 @@ literal-length: 8192 numeric-literal-length: 18 pic-length: 50 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: no #not verified yet + # Default assign type # Value: 'dynamic', 'external' assign-clause: dynamic @@ -269,6 +272,7 @@ sequential-delimiters: ok record-delim-with-fixed-recs: ok record-sequential-advancing: ok missing-statement: error # according to documentation +missing-period: warning #when format not in {fixed,free} zero-length-literals: unconformable xml-generate-extra-phrases: ok continue-after: unconformable diff --git a/config/mvs-strict.conf b/config/mvs-strict.conf index aa2a28e5a..2f15d8522 100644 --- a/config/mvs-strict.conf +++ b/config/mvs-strict.conf @@ -37,6 +37,9 @@ literal-length: 160 # not verified yet numeric-literal-length: 18 # not verified yet pic-length: 50 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: yes + # Default assign type # Value: 'dynamic', 'external' assign-clause: external @@ -265,6 +268,7 @@ sequential-delimiters: unconformable record-delim-with-fixed-recs: unconformable record-sequential-advancing: warning missing-statement: warning # not verified yet +missing-period: warning #when format not in {fixed,free}, not verified yet zero-length-literals: unconformable xml-generate-extra-phrases: unconformable continue-after: unconformable diff --git a/config/realia-strict.conf b/config/realia-strict.conf index a8d8b4adb..c2f16dbac 100644 --- a/config/realia-strict.conf +++ b/config/realia-strict.conf @@ -38,6 +38,9 @@ numeric-literal-length: 18 # to check pic-length: 100 # to check occurs-max-length-without-subscript: yes # to check +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: yes + # Default assign type # Value: 'dynamic', 'external' assign-clause: dynamic # to check @@ -271,6 +274,7 @@ sequential-delimiters: unconformable record-delim-with-fixed-recs: error record-sequential-advancing: warning missing-statement: warning +missing-period: warning #when format not in {fixed,free}, not verified yet zero-length-literals: unconformable # not verified yet xml-generate-extra-phrases: unconformable continue-after: unconformable diff --git a/config/rm-strict.conf b/config/rm-strict.conf index 4b7edbb59..17485724d 100644 --- a/config/rm-strict.conf +++ b/config/rm-strict.conf @@ -43,6 +43,9 @@ literal-length: 65535 numeric-literal-length: 30 pic-length: 30 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: yes + # Default assign type # Value: 'dynamic', 'external' assign-clause: dynamic # TO-DO: Verify @@ -272,6 +275,7 @@ sequential-delimiters: ok record-delim-with-fixed-recs: ok record-sequential-advancing: ok missing-statement: warning # not verified yet +missing-period: warning #when format not in {fixed,free}, not verified yet zero-length-literals: unconformable xml-generate-extra-phrases: unconformable continue-after: unconformable diff --git a/config/xopen.conf b/config/xopen.conf index effe7d520..d10f349a4 100644 --- a/config/xopen.conf +++ b/config/xopen.conf @@ -40,6 +40,9 @@ literal-length: 160 numeric-literal-length: 18 pic-length: 30 +# Enable AREACHECK by default, for reference formats other than {fixed,free} +areacheck: yes + # Default assign type # Value: 'dynamic', 'external' # Note: standard COBOL supports neither of them, later have USING data-name for DYNAMIC @@ -276,6 +279,7 @@ sequential-delimiters: ok record-delim-with-fixed-recs: unconformable record-sequential-advancing: ok missing-statement: error +missing-period: error #when format not in {fixed,free} zero-length-literals: unconformable xml-generate-extra-phrases: unconformable continue-after: unconformable diff --git a/doc/ChangeLog b/doc/ChangeLog index 7af9d81a6..5f4a4efe0 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,8 @@ +2022-09-23 Nicolas Berthier + + * gnucobol.texi: mention Area A enforcement + 2022-07-29 Nicolas Berthier * gnucobol.texi: document newly supported source formats diff --git a/doc/gnucobol.texi b/doc/gnucobol.texi index b85272526..b54ee6e5b 100644 --- a/doc/gnucobol.texi +++ b/doc/gnucobol.texi @@ -422,8 +422,8 @@ GnuCOBOL supports fixed, free, Micro Focus' Variable, X/Open Free-form, ICOBOL xCard and Free-form, ACUCOBOL-GT Terminal, and COBOLX source formats. The default format is the fixed format. This can be overridden either by the @code{>>SOURCE [FORMAT] [IS] -@{FIXED|FREE|VARIABLE|XOPEN|XCARD|CRT|TERMINAL|COBOLX@}} directive, or -by one of the following options: +@{FIXED|FREE|COBOL85|VARIABLE|XOPEN|XCARD|CRT|TERMINAL|COBOLX@}} +directive, or by one of the following options: @table @code @item -free, -F, -fformat=free @@ -437,10 +437,8 @@ number area; column 7, the indicator area; columns 8-72, the program-text area; and columns 72-80 as the reference area.@footnote{Historically, fixed format was based on 80-character punch cards.} -@ignore (pending) @item -fformat=cobol85 Fixed format with enforcements on the use of Area A. -@end ignore @item -fformat=variable Micro Focus' Variable format. Identical to the fixed format above @@ -480,6 +478,22 @@ Note that with source formats @code{XOPEN}, @code{CRT}, @code{TERMINAL}, and @code{COBOLX}, missing spaces are not inserted within continued alphanumeric literals that are truncated before the right margin. +@emph{Area A} denotes the source code that spans between margin A and +margin B, and Area B spans from the latter to the end of the record. +@emph{Area A enforcement} checks the contents of Area A, and reports any +item that does not belong to the correct Area: this feature helps in +developping COBOL programs that are portable to actual mainframe +environments. + +In general, division, section, and paragraph names must start in Area A. +In the @code{DATA DIVISION}, level numbers @code{01}, @code{77}, and (as +an extension) @code{78}, must also start in Area A. In the +@code{PROCEDURE DIVISION}s, statements and separator periods must fit +within Area B. Every source format listed above may be subject to Area +A enforcement, except @code{FIXED} and @code{FREE}. + +Note that Area A enforcement enables recovery from missing periods +between paragraphs and sections. @node Warning options diff --git a/tests/ChangeLog b/tests/ChangeLog index f72052466..847b8bc5e 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -35,6 +35,16 @@ * atlocal_valgrind, atlocal_win: updated to match atlocal.in +2022-07-19 Nicolas Berthier + + * general: fix area A in testsuite + +2022-03-29 Nicolas Berthier + + * testsuite.src/configuration.at, testsuite.at/syn_misc.at: new + tests for sections and paragraphs that do not end with a period + * testsuite.src/run_misc.at: fix lines in trace test + 2022-07-28 Simon Sobisch * atlocal.in: option to run part of the testsuite via perf -stat diff --git a/tests/testsuite.src/configuration.at b/tests/testsuite.src/configuration.at index 9064fb523..051209aa7 100644 --- a/tests/testsuite.src/configuration.at +++ b/tests/testsuite.src/configuration.at @@ -409,7 +409,7 @@ name: "Empty Conf" ]) # check if incomplete configuration result in error -AT_CHECK([$COMPILE_ONLY -fmax-errors=132 -conf=test.conf prog.cob], [1], [], +AT_CHECK([$COMPILE_ONLY -fmax-errors=134 -conf=test.conf prog.cob], [1], [], [configuration error: test.conf: missing definitions: no definition of 'reserved-words' @@ -460,6 +460,7 @@ test.conf: missing definitions: no definition of 'implicit-assign-dynamic-var' no definition of 'device-mnemonics' no definition of 'xml-parse-xmlss' + no definition of 'areacheck' no definition of 'comment-paragraphs' no definition of 'control-division' no definition of 'partial-replacing-with-literal' @@ -528,6 +529,7 @@ test.conf: missing definitions: no definition of 'record-delim-with-fixed-recs' no definition of 'record-sequential-advancing' no definition of 'missing-statement' + no definition of 'missing-period' no definition of 'zero-length-literals' no definition of 'xml-generate-extra-phrases' no definition of 'continue-after' @@ -874,13 +876,13 @@ AT_CHECK([$COMPILE_ONLY -fformat=fixed wide.cob], [1], [], [wide.cob:10: error: continuation character expected wide.cob:9: error: invalid literal: ' ...' wide.cob:9: error: missing terminating ' character -wide.cob:9: error: syntax error, unexpected end of file +wide.cob:9: warning: optional period used ]) AT_CHECK([$COMPILE_ONLY -fformat=cobol85 wide.cob], [1], [], [wide.cob:10: error: continuation character expected wide.cob:9: error: invalid literal: ' ...' wide.cob:9: error: missing terminating ' character -wide.cob:9: error: syntax error, unexpected end of file +wide.cob:9: warning: optional period used ]) AT_CHECK([$COMPILE_ONLY -ftext-column=80 wide.cob], [0], [], []) diff --git a/tests/testsuite.src/run_extensions.at b/tests/testsuite.src/run_extensions.at index 795a46921..8379006df 100644 --- a/tests/testsuite.src/run_extensions.at +++ b/tests/testsuite.src/run_extensions.at @@ -1554,7 +1554,7 @@ AT_DATA([prog.cob], [ L1-3-S L1-3-2-S. STOP RUN. - END PROGRAM prog. + END PROGRAM prog. IDENTIFICATION DIVISION. PROGRAM-ID. IBM-ODO-TEST. @@ -5516,9 +5516,9 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], ]) # Check that manually setting -ftext-column in combination with -# variable source format isstill allowed: -ftext-column now impacts -# fixed format only; 250 is the default right margin for variable -# format. +# variable source format is still allowed: -ftext-column now impacts +# fixed and cobol85 format only; 250 is the default right margin for +# variable format. AT_DATA([fit.cob], [ 000010 IDENTIFICATION DIVISION. 000020 PROGRAM-ID. fit. @@ -5592,9 +5592,9 @@ D DISPLAY "KO" NO ADVANCING STOP RUN. ]) -AT_CHECK([$COMPILE -fformat=xopen prog.cob], [0], [], []) +AT_CHECK([$COMPILE -fformat=xopen -fno-areacheck prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) -AT_CHECK([$COMPILE -fformat=xopen -fdebugging-line -o prog prog.cob], [0], [], []) +AT_CHECK([$COMPILE -fformat=xopen -fno-areacheck -fdebugging-line -o prog prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OKKO], []) AT_DATA([fit.cob], [ @@ -5610,11 +5610,11 @@ D DISPLAY ' 20 30 40 50 60 70 79' STOP RUN. ]) -AT_CHECK([$COMPILE -fformat=xopen fit.cob], [0], [], []) +AT_CHECK([$COMPILE -fformat=xopen -fno-areacheck fit.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./fit], [0], [ 20 30 40 50 60 70 79 ], []) -AT_CHECK([$COMPILE -fformat=xopen -fdebugging-line -o fit fit.cob], [0], [], []) +AT_CHECK([$COMPILE -fformat=xopen -fno-areacheck -fdebugging-line -o fit fit.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./fit], [0], [ 20 30 40 50 60 70 79 20 30 40 50 60 70 79 @@ -5669,11 +5669,11 @@ PROCEDURE DIVISION. ]) AT_CHECK([$COMPILE -fformat=terminal -fcomment-paragraphs=ok -fdebugging-line marginberr.cob], [1], [], -[marginberr.cob:7: error: ENVIRONMENT DIVISION header missing -marginberr.cob:7: error: CONFIGURATION SECTION header missing -marginberr.cob:7: error: SPECIAL-NAMES header missing -marginberr.cob:7: error: invalid system-name 'Somebody' -marginberr.cob:7: error: syntax error, unexpected ELSE, expecting CRT or Identifier +[marginberr.cob:7: error: PROCEDURE DIVISION header missing +marginberr.cob:7: error: syntax error, unexpected Identifier (Area A) +marginberr.cob:8: error: syntax error, unexpected DATA +marginberr.cob:9: error: syntax error, unexpected WORKING-STORAGE +marginberr.cob:10: error: syntax error, unexpected PROCEDURE ]) AT_DATA([fit.cob], [ diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 8a9f572cf..bbc56de7a 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -12432,7 +12432,17 @@ AT_DATA([prog.cob], [ STOP RUN RETURNING 0. ]) -AT_CHECK([$COMPILE -std=ibm prog.cob], [0], [], []) +AT_CHECK([$COMPILE -std=ibm prog.cob], [0], [], +[prog.cob:12: warning: start of statement in Area A +prog.cob:13: warning: start of statement in Area A +prog.cob:14: warning: start of statement in Area A +prog.cob:15: warning: start of statement in Area A +prog.cob:16: warning: start of statement in Area A +prog.cob:17: warning: start of statement in Area A +prog.cob:18: warning: start of statement in Area A +prog.cob:20: warning: start of statement in Area A +prog.cob:22: warning: start of statement in Area A +]) AT_CHECK([$COBCRUN_DIRECT ./prog PLAIN], [0], [This is sent to CONSOLE PLAIN @@ -13622,7 +13632,7 @@ COBCSUB(int y, unsigned char x[15]) ]]) -AT_CHECK([$COMPILE -std=ibm -debug -Wall prog.cob cmod.c], [0], [], []) +AT_CHECK([$COMPILE -fno-areacheck -std=ibm -debug -Wall prog.cob cmod.c], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [00000001 'Fun and games for you' 00000002 'More Fun and games for all' @@ -13752,7 +13762,7 @@ void one_parameter(void *dummy) } ]]) -AT_CHECK([$COMPILE -std=ibm -o prog cmod.c prog.cob], [0], [], []) +AT_CHECK([$COMPILE -fno-areacheck -std=ibm -o prog cmod.c prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [Now in routine1 with 2 params Expect '1' and got 1 diff --git a/tests/testsuite.src/syn_misc.at b/tests/testsuite.src/syn_misc.at index 3e586ff13..821d154b1 100644 --- a/tests/testsuite.src/syn_misc.at +++ b/tests/testsuite.src/syn_misc.at @@ -1840,20 +1840,23 @@ prog.cob:11: warning: source text after program-text area (column 72) [[-Wdangli AT_CHECK([$COBC -fsyntax-only -free -Wextra prog.cob], [1], [], [prog.cob:7: warning: source text exceeds 512 bytes, will be truncated [[-Wothers]] prog.cob:8: warning: source text exceeds 512 bytes, will be truncated [[-Wothers]] -prog.cob:8: error: unknown statement 'This' +prog.cob:8: error: syntax error, unexpected IS, expecting SECTION or . +prog.cob:8: note: unknown statement 'This' ]) AT_CHECK([$COBC -fsyntax-only -F -Wextra prog.cob], [1], [], [prog.cob:7: warning: source text exceeds 512 bytes, will be truncated [[-Wothers]] prog.cob:8: warning: source text exceeds 512 bytes, will be truncated [[-Wothers]] -prog.cob:8: error: unknown statement 'This' +prog.cob:8: error: syntax error, unexpected IS, expecting SECTION or . +prog.cob:8: note: unknown statement 'This' ]) # Check dialect option `format` (fixed for default) does not erase flags like `-F`, `--free`: AT_CHECK([$COBC -fsyntax-only -F -std=default -Wextra prog.cob], [1], [], [prog.cob:7: warning: source text exceeds 512 bytes, will be truncated [[-Wothers]] prog.cob:8: warning: source text exceeds 512 bytes, will be truncated [[-Wothers]] -prog.cob:8: error: unknown statement 'This' +prog.cob:8: error: syntax error, unexpected IS, expecting SECTION or . +prog.cob:8: note: unknown statement 'This' ]) AT_CLEANUP @@ -1871,8 +1874,8 @@ AT_DATA([prog.cob], [ CONTINUE ]) -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: syntax error, unexpected end of file +AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], +[prog.cob:8: warning: optional period used ]) # fixing the initial setup but now producing a missing newline: @@ -4220,7 +4223,8 @@ AT_DATA([prog2.cob], [ ]) AT_CHECK([$COMPILE_ONLY -fnot-reserved=DISPLAY -freserved=COMP-1=DISPLAY prog2.cob], [1], [], -[prog2.cob:7: error: unknown statement 'DISPLAY'; it may exist in another dialect +[prog2.cob:7: error: syntax error, unexpected Literal, expecting SECTION or . +prog2.cob:7: note: unknown statement 'DISPLAY'; it may exist in another dialect ]) AT_CLEANUP @@ -4532,13 +4536,14 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], [prog.cob:10: error: 'CONVERSION' is not defined, but is a reserved word in another dialect -prog.cob:11: error: unknown statement 'TRANSFORM'; it may exist in another dialect +prog.cob:11: error: syntax error, unexpected Identifier, expecting SECTION or . +prog.cob:11: note: unknown statement 'TRANSFORM'; it may exist in another dialect ]) AT_CLEANUP AT_SETUP([redundant periods]) -AT_KEYWORDS([misc]) +AT_KEYWORDS([misc redundant-periods]) AT_DATA([a.cpy], [ 01 var PIC X @@ -4567,6 +4572,245 @@ prog.cob:12: warning: ignoring redundant . AT_CLEANUP +AT_SETUP([missing periods]) +AT_KEYWORDS([misc cobol85 area-a missing-periods]) + +# Check whether the first line is correcly handled: +AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 DONE COMP-1 VALUE ZERO. + + PROCEDURE DIVISION. + MAIN SECTION. + PERFORM SEC-1. + IF NOT DONE = 1 + DISPLAY "SEC-1 NOT EXECUTED" + END-IF + STOP RUN + SEC-1 SECTION. + MOVE 1 TO DONE + GOBACK. +]) + +AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], +[prog.cob: in section 'MAIN': +prog.cob:15: error: 'SEC-1' is not defined +prog.cob:15: error: syntax error, unexpected SECTION +]) +AT_CHECK([$COMPILE_ONLY -fformat=cobol85 -fmissing-period=error prog.cob], [1], [], +[prog.cob: in section 'MAIN': +prog.cob:15: error: optional period used +]) +AT_CHECK([$COMPILE -fformat=cobol85 prog.cob], [0], [], +[prog.cob: in section 'MAIN': +prog.cob:15: warning: optional period used +]) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([missing periods with COPYs]) +AT_KEYWORDS([misc cobol85 area-a missing-periods copy]) + +AT_DATA([ok.inc], [ + 01 FLG PIC XX VALUE "KO". +]) + +AT_DATA([sec-1.inc], [ + SEC-1 SECTION. + MOVE "OK" TO FLG +]) + +AT_DATA([sec-2.inc], [ + SEC-2 SECTION. + IF FLG NOT EQUAL "OK" + DISPLAY "DEC-1 NOT EXECUTED" + END-IF. +]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + DATA DIVISION. + WORKING-STORAGE SECTION. + COPY "ok.inc". + + PROCEDURE DIVISION. + MAIN SECTION. + PERFORM SEC-1. + PERFORM SEC-2. + * Directive purposefully in Area A + REPLACE ==RUNNN== BY ==RUN==. + STOP RUNNN + COPY "sec-1.inc". + * Also purposefully in Area A + COPY "sec-2.inc". +]) + +AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], +[sec-1.inc: in section 'MAIN': +sec-1.inc:2: error: 'SEC-1' is not defined +sec-1.inc:2: error: syntax error, unexpected SECTION +sec-2.inc: in section 'MAIN': +sec-2.inc:2: error: 'SEC-2' is not defined +sec-2.inc:2: error: syntax error, unexpected SECTION +]) +AT_CHECK([$COMPILE -fformat=cobol85 prog.cob], [0], [], +[sec-1.inc: in section 'MAIN': +sec-1.inc:2: warning: optional period used +sec-2.inc: in section 'SEC-1': +sec-2.inc:2: warning: optional period used +]) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_DATA([prog_err.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + DATA DIVISION. + WORKING-STORAGE SECTION. + COPY "ok.inc". + + PROCEDURE DIVISION. + MAIN SECTION. + PERFORM SEC-1. + PERFORM SEC-2. + * Directive purposefully in Area A + REPLACE ==RUNNN== BY ==RUN==. + PERFORM SEC-3. + STOP RUN + COPY "sec-1.inc". + COPY "sec-2.inc". + SEC-3 SECTION. + DISPLAY KO NO ADVANCING. +]) + +AT_CHECK([$COMPILE_ONLY -fformat=cobol85 prog_err.cob], [1], [], +[sec-1.inc: in section 'MAIN': +sec-1.inc:2: warning: optional period used +sec-2.inc: in section 'SEC-1': +sec-2.inc:2: warning: optional period used +prog_err.cob: in section 'SEC-3': +prog_err.cob:20: error: 'KO' is not defined +]) + +AT_CLEANUP + + +AT_SETUP([statement in Area A]) +AT_KEYWORDS([misc cobol85 areacheck]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 FLAG PIC 9 VALUE ZERO. + PROCEDURE DIVISION. + MAIN + . + PERFORM SEC-1 + IF NOT FLAG = 1 + DISPLAY "SEC-1 NOT EXECUTED" + END-IF + STOP RUN + . + SEC-1 SECTION. + MOVE 1 TO FLAG + . +]) + +AT_CHECK([$COMPILE_ONLY prog.cob], [0], []) +AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [0], [], +[prog.cob:9: warning: separator period in Area A +prog.cob: in paragraph 'MAIN': +prog.cob:10: warning: start of statement in Area A +prog.cob:11: warning: start of statement in Area A +prog.cob:14: warning: start of statement in Area A +prog.cob:15: warning: separator period in Area A +prog.cob: in section 'SEC-1': +prog.cob:17: warning: start of statement in Area A +prog.cob:18: warning: separator period in Area A +]) + +AT_CHECK([$COMPILE_ONLY -std=cobol85 -fno-areacheck prog.cob], [0], []) +AT_CHECK([$COMPILE_ONLY -std=cobol85 -fformat=fixed prog.cob], [0], []) + +AT_CLEANUP + + +AT_SETUP([pseudotext replacement with text in area A]) +AT_KEYWORDS([misc cobol85 gcos copy missing-periods]) + +# Check whether the first line is correcly handled: +AT_DATA([ok.inc], [ 01 REPLACE-ME + 01 KO PIC XX VALUE "KO". + PROCEDURE DIVISION. + MAIN SECTION. + PERFORM SEC-1 +]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + DATA DIVISION. + WORKING-STORAGE SECTION. + COPY "ok.inc" REPLACING == 01 REPLACE-ME == BY == + 01 OK PIC XX VALUE "OK". == + . + + PERFORM SEC-2 + STOP RUN + CONTINUE + SEC-1 SECTION. + IF OK NOT EQUAL "OK" DISPLAY OK + SEC-2 SECTION. + IF OK NOT EQUAL "OK" DISPLAY OK. +]) + +AT_CHECK([$COMPILE -std=cobol85 -fmissing-period=warning prog.cob], [0], [], +[prog.cob: in section 'MAIN': +prog.cob:14: warning: optional period used +prog.cob: in section 'SEC-1': +prog.cob:16: warning: optional period used +]) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_DATA([prog_err.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + DATA DIVISION. + WORKING-STORAGE SECTION. + COPY "ok.inc" REPLACING == 01 REPLACE-ME == BY == + 01 OK PIC XX VALUE "OK". == + . + + PERFORM SEC-2. + STOP RUN + SEC-1 SECTION. + IF OK NOT EQUAL "OK" DISPLAY OK + SEC-2 SECTION. + DISPLAY NOT-FOUND. +]) +AT_CHECK([$COMPILE -std=gcos prog_err.cob], [1], [], +[prog_err.cob: in section 'MAIN': +prog_err.cob:13: warning: optional period used +prog_err.cob: in section 'SEC-1': +prog_err.cob:15: warning: optional period used +prog_err.cob: in section 'SEC-2': +prog_err.cob:16: error: 'NOT-FOUND' is not defined +]) + +AT_CLEANUP + + AT_SETUP([IF-ELSE statement list with invalid syntax]) AT_KEYWORDS([misc]) @@ -5388,12 +5632,15 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], [prog.cob:10: error: CALL-CONVENTION and WITH LINKAGE are mutually exclusive ]) +# GOBACK does not belong to COBOL85 reserved words; the last line is +# therefore an empty paragraph that does not start in Area A AT_CHECK([$COMPILE_ONLY -std=cobol85 -freserved=EXTERN,C prog.cob], [1], [], [prog.cob:5: error: CALL-/ENTRY-CONVENTION does not conform to COBOL 85 prog.cob:6: error: WITH ... LINKAGE does not conform to COBOL 85 prog.cob:8: error: CALL-/ENTRY-CONVENTION does not conform to COBOL 85 prog.cob:10: error: WITH ... LINKAGE does not conform to COBOL 85 prog.cob:10: error: CALL-CONVENTION and WITH LINKAGE are mutually exclusive +prog.cob:12: warning: 'GOBACK' should start in Area A ]) AT_CLEANUP @@ -6031,7 +6278,7 @@ prog.cob:10: error: syntax error, unexpected Identifier AT_CHECK([$COMPILE_ONLY -std=mf-strict -freserved=CONSTANT prog.cob], [1], [], [prog.cob:6: error: 01 CONSTANT does not conform to Micro Focus COBOL prog.cob:7: error: 01 CONSTANT does not conform to Micro Focus COBOL -prog.cob:7: error: syntax error, unexpected Identifier, expecting . +prog.cob:7: error: syntax error, unexpected Identifier, expecting . or level-number (Area A) ]) AT_CHECK([$COMPILE_ONLY -std=mf prog.cob], [1], [], @@ -6878,6 +7125,7 @@ prog.cob:8: error: PROCEDURE DIVISION header missing prog.cob:8: error: syntax error, unexpected Literal ]) AT_CLEANUP +# " (close unclosed quotation above) # normal register extension, @@ -7608,8 +7856,10 @@ AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], [prog.cob:8: error: BASED only allowed at 01/77 level prog.cob:16: error: PROCEDURE DIVISION header missing prog.cob:16: error: syntax error, unexpected Identifier -prog.cob:17: error: unknown statement '01' -prog.cob:18: error: unknown statement '03' +prog.cob:17: error: syntax error, unexpected Identifier, expecting SECTION or . +prog.cob:17: note: unknown statement '01' +prog.cob:18: error: syntax error, unexpected Identifier, expecting SECTION or . +prog.cob:18: note: unknown statement '03' prog.cob:20: error: syntax error, unexpected PROCEDURE prog.cob:23: error: ALLOCATE CHARACTERS requires RETURNING clause prog.cob:26: error: 'one' is not a numeric value @@ -7974,7 +8224,6 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE_ONLY -w prog.cob], [1], [], [prog.cob:5: error: invalid literal: ' 1 c d e f g h i j k l m n 0 q. 2 ...' prog.cob:5: error: missing terminating ' character -prog.cob:5: error: syntax error, unexpected end of file ]) AT_CLEANUP @@ -9098,3 +9347,147 @@ AT_CHECK([$COMPILE_ONLY -fpicture-l=warning prog.cob], [0], [], ]) AT_CLEANUP + +AT_SETUP([AREACHECK / NOAREACHECK directives]) +AT_KEYWORDS([directive]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + >> NOAREACHECK + MAIN-1 SECTION. + DISPLAY "SOMETHING". + >> AREACHECK + MAIN-2 SECTION. + DISPLAY "SOMETHING ELSE" + STOP RUN. +]) + +AT_DATA([prog2.cob], [ + $SET NO-AREA-CHECK + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + DATA DIVISION. + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + MAIN-1 SECTION. + DISPLAY "SOMETHING". + $SET AREA-CHECK + MAIN-2 SECTION. + DISPLAY "SOMETHING ELSE" + STOP RUN. +]) + +AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [0], [], +[prog.cob: in section 'MAIN-2': +prog.cob:12: warning: start of statement in Area A +prog.cob:13: warning: start of statement in Area A +]) + +AT_CHECK([$COMPILE_ONLY -std=cobol85 prog2.cob], [0], [], +[prog2.cob: in section 'MAIN-2': +prog2.cob:12: warning: start of statement in Area A +prog2.cob:13: warning: start of statement in Area A +]) + +AT_CLEANUP + +AT_SETUP([AREACHECK / NOAREACHECK directives (2)]) +AT_KEYWORDS([directive missing-periods]) + +AT_DATA([prog.cob], [ + >> NOAREACHECK + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + >> AREACHECK + WORKING-STORAGE SECTION. + 01 X. + 02 Y PIC X. + 01 Z PIC X + 01 T PIC 9. + >> NOAREACHECK + PROCEDURE DIVISION. + MAIN-1 SECTION. + DISPLAY "SOMETHING" + >> AREACHECK + MAIN-2 SECTION. + DISPLAY "SOMETHING ELSE" + STOP RUN. +]) + +AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], +[prog.cob:10: warning: '01' should start in Area A +prog.cob:11: error: optional period used +prog.cob: in section 'MAIN-1': +prog.cob:17: error: optional period used +prog.cob: in section 'MAIN-2': +prog.cob:18: warning: start of statement in Area A +prog.cob:19: warning: start of statement in Area A +]) +AT_CHECK([$COMPILE_ONLY -std=cobol85 -fmissing-period=ok prog.cob], [0], [], +[prog.cob:10: warning: '01' should start in Area A +prog.cob: in section 'MAIN-2': +prog.cob:18: warning: start of statement in Area A +prog.cob:19: warning: start of statement in Area A +]) + +AT_CLEANUP + + +AT_SETUP([Optional dots]) +AT_KEYWORDS([missing-periods]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION + PROGRAM-ID. prog. + DATA DIVISION + WORKING-STORAGE SECTION. + 01 X PIC X. + 01 Y PIC X. + PROCEDURE DIVISION. + MAIN SECTION. + PERFORM P + STOP RUN. + P. + GOBACK +]) + +AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], +[prog.cob:3: warning: optional period used +prog.cob:5: warning: optional period used +prog.cob: in section 'MAIN': +prog.cob: in paragraph 'P': +prog.cob:14: warning: optional period used +]) + +AT_DATA([cobol85.cob], [ + IDENTIFICATION DIVISION + PROGRAM-ID. cobol85. + DATA DIVISION + WORKING-STORAGE SECTION + 01 X PIC X *> dot optional here because of cobol85 format + 01 Y PIC X. + PROCEDURE DIVISION. + MAIN SECTION. + PERFORM P + STOP RUN *> dot optional here because of cobol85 format + P. + GOBACK +]) + +AT_CHECK([$COMPILE_ONLY -fformat=cobol85 cobol85.cob], [0], [], +[cobol85.cob:3: warning: optional period used +cobol85.cob:5: warning: optional period used +cobol85.cob:6: warning: optional period used +cobol85.cob:7: warning: optional period used +cobol85.cob: in section 'MAIN': +cobol85.cob:12: warning: optional period used +cobol85.cob: in paragraph 'P': +cobol85.cob:14: warning: optional period used +]) + +AT_CLEANUP diff --git a/tests/testsuite.src/syn_occurs.at b/tests/testsuite.src/syn_occurs.at index c27aebc52..ceeb4e6b4 100644 --- a/tests/testsuite.src/syn_occurs.at +++ b/tests/testsuite.src/syn_occurs.at @@ -94,7 +94,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: syntax error, unexpected OCCURS, expecting . +[prog.cob:7: error: syntax error, unexpected OCCURS, expecting . or level-number (Area A) ]) AT_CLEANUP @@ -112,7 +112,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: error: syntax error, unexpected OCCURS, expecting . +[prog.cob:6: error: syntax error, unexpected OCCURS, expecting . or level-number (Area A) ]) AT_CLEANUP @@ -133,9 +133,10 @@ AT_DATA([prog.cob], [ # note: the message is from level-88 content-validation entry format, # which is mixed in the parser (as it may be used as) condition format AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: syntax error, unexpected OCCURS, expecting INVALID or VALID +[prog.cob:7: error: syntax error, unexpected OCCURS, expecting . or level-number (Area A) ]) + AT_CLEANUP # 1b) with ODO below (allowed with IBM extension)