diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 84aa483e6..c29ecf90e 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,9 @@ +2024-08-08 Remi Bertrand-Hardy + + * parser.y : added syntax rules for object-oriented COBOL + * reserved.c : added token for object-oriented COBOL + 2024-07-29 Chuck Haatvedt * tree.c (cb_build_picture): added logic to find the valid floating @@ -21,6 +26,8 @@ * reserved.c: make MENU context-sensitive * reserved.c, parser.y: added MODAL + MODELESS to acu extension windows + + 2024-07-10 Chuck Haatvedt * tree.c (cb_build_picture): fixed currency scale counting logic diff --git a/cobc/parser.y b/cobc/parser.y old mode 100644 new mode 100755 index 5f4eebe45..9479fe2b7 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -2601,6 +2601,7 @@ set_record_size (cb_tree min, cb_tree max) %token CHARACTERS %token CHECK_BOX "CHECK-BOX" %token CLASS +%token CLASS_ID %token CLASSIFICATION %token CLASS_NAME "class-name" %token CLEAR_SELECTION "CLEAR-SELECTION" @@ -2737,6 +2738,7 @@ set_record_size (cb_tree min, cb_tree max) %token END_ACCEPT "END-ACCEPT" %token END_ADD "END-ADD" %token END_CALL "END-CALL" +%token END_CLASS "END CLASS" %token END_COMPUTE "END-COMPUTE" %token END_COLOR "END-COLOR" %token END_DELETE "END-DELETE" @@ -2745,7 +2747,9 @@ set_record_size (cb_tree min, cb_tree max) %token END_EVALUATE "END-EVALUATE" %token END_FUNCTION "END FUNCTION" %token END_IF "END-IF" +%token END_INTERFACE "END INTERFACE" %token END_JSON "END-JSON" +%token END_METHOD "END METHOD" %token END_MODIFY "END-MODIFY" %token END_MULTIPLY "END-MULTIPLY" %token END_PERFORM "END-PERFORM" @@ -2852,6 +2856,7 @@ set_record_size (cb_tree min, cb_tree max) %token FUNCTION_NAME "intrinsic function name" %token FUNCTION_POINTER "FUNCTION-POINTER" %token GENERATE +%token GET %token GIVING %token GLOBAL %token GO @@ -2893,9 +2898,13 @@ set_record_size (cb_tree min, cb_tree max) %token INDEX %token INDEXED %token INDICATE +%token INHERITS %token INITIALIZE %token INITIALIZED %token INITIATE +%token INTERFACE +%token INTERFACE_ID +%token IMPLEMENTS %token INPUT %token INPUT_OUTPUT "INPUT-OUTPUT" %token INQUIRE @@ -2908,7 +2917,9 @@ set_record_size (cb_tree min, cb_tree max) %token INTRINSIC %token INVALID /* remark: not used here */ %token INVALID_KEY "INVALID KEY" +%token INVOKE %token IS +%token IS_FINAL "IS FINAL" %token ITEM %token ITEM_TEXT "ITEM-TEXT" %token ITEM_TO_ADD "ITEM-TO_ADD" @@ -2985,6 +2996,8 @@ set_record_size (cb_tree min, cb_tree max) %token MENU %token MERGE %token MESSAGE +%token METHOD +%token METHOD_ID %token MICROSECOND_TIME "MICROSECOND-TIME" %token MINUS %token MIN_VAL "MIN-VAL" @@ -3080,6 +3093,7 @@ set_record_size (cb_tree min, cb_tree max) %token OVERLAP_LEFT "OVERLAP-LEFT" %token OVERLAP_TOP "OVERLAP-TOP" %token OVERLINE +%token OVERRIDE %token PACKED_DECIMAL "PACKED-DECIMAL" %token PADDING %token PASCAL @@ -3403,6 +3417,7 @@ set_record_size (cb_tree min, cb_tree max) %token V %token VALID %token VALIDATE +%token VAL_STATUS "VAL-STATUS" %token VALIDATE_STATUS "VALIDATE-STATUS" %token VALIDATING %token VALUE @@ -3641,6 +3656,8 @@ source_element: | function_definition | program_prototype | function_prototype +| class_definition +| interface_definition ; simple_prog: @@ -3666,6 +3683,47 @@ program_definition: */ ; +interface_definition: + _identification_header + interface_id_paragraph + { + CB_PENDING("INTERFACE-ID") + } + _interface_body + end_interface +; + +class_definition: + _identification_header + class_id_paragraph + { + CB_PENDING("CLASS-ID") + } + _class_body + end_class + +; + +method_definition: + _identification_header + method_id_paragraph + { + CB_PENDING("METHOD-ID") + } + _program_body + end_method +; + +method_definition_list : + method_definition +| method_definition_list method_definition +; + +_method_definition_list : + /*empty*/ +| method_definition_list +; + function_definition: _identification_header function_id_paragraph @@ -3673,6 +3731,27 @@ function_definition: end_function ; + +_object_definition: +/*empty*/ +| object_paragraph +{ + CB_PENDING("OBJECT") +} + _factory_object_body + END OBJECT TOK_DOT +; + +factory_definition: + factory_paragraph + { + CB_PENDING("FACTORY") + } + _factory_object_body + END FACTORY TOK_DOT +; + + _end_program_list: /* empty (still do cleanup) */ { @@ -3712,6 +3791,20 @@ end_function: } ; +end_class: + END_CLASS + end_program_name _dot +; + +end_method: + END_METHOD + end_program_name _dot + +end_interface: + END_INTERFACE + end_program_name _dot + + /* Program prototype */ program_prototype: @@ -3877,6 +3970,55 @@ _default_display_clause: } ; + +/*CLASS body*/ + +_class_body: + _options_paragraph + _environment_division + factory_definition + _object_definition +|_options_paragraph + _environment_division + _object_definition +; + + + +_implements: +/*empty*/ +| IMPLEMENTS + identifier +; + + +_factory_object_body: + _options_paragraph + _environment_division + { + cb_validate_program_environment (current_program); + } + _data_division + { + /* note: + we also validate all references we found so far here */ + cb_validate_program_data (current_program); + within_typedef_definition = 0; + } + _OO_procedure_division +; + + +/*INTERFACE body*/ + +_interface_body: + _options_paragraph + _environment_division + _OO_procedure_division +; + + + /* PROGRAM body */ _program_body: @@ -3916,6 +4058,47 @@ identification_or_id: IDENTIFICATION | ID ; + +class_id_header: + CLASS_ID +; + +class_id_paragraph: +class_id_header TOK_DOT program_id_name _as_literal _is_final _inherits TOK_DOT /*_using_class*/ +; + + +factory_paragraph: + _identification_header + FACTORY TOK_DOT + _implements +; + +object_paragraph: + _identification_header + OBJECT TOK_DOT + _implements +; + + +method_id_paragraph: + METHOD_ID + method_name_or_get_set + _override + _is_final +; + +method_name_or_get_set: + /*TO DO*/ +; + + +interface_id_paragraph: + INTERFACE_ID program_id_name _as_literal _inherits /*_using_class*/ TOK_DOT + + +; + program_id_header: PROGRAM_ID { @@ -4006,6 +4189,27 @@ _as_literal: | AS LITERAL { $$ = $2; } ; +_is_final: + /*empty*/ +| _is FINAL +; + + + +_override: + /*empty*/ +| OVERRIDE +; + + +_inherits: + /*empty*/ + | INHERITS _from + PROGRAM_NAME + +; + + _program_type: /* empty */ { $$ = NULL; } | _is program_type_clause _program { $$ = $2; } @@ -5337,8 +5541,8 @@ input_output_section: ; input_output: INPUT_OUTPUT { check_area_a_of ("INPUT-OUTPUT SECTION"); }; -input_output_header: - input_output SECTION _dot + _input_output_header: +| input_output SECTION _dot { check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, 0, 0, 0); header_check |= COBC_HD_INPUT_OUTPUT_SECTION; @@ -7538,9 +7742,35 @@ data_description_clause: { CB_PENDING ("VALIDATE"); } +| property_clause +| is_final_property_subclause /* Not clean, here to prevent conflict with other + subclause starting by IS such as typedef*/ ; +/*PROPERTY clause*/ + +property_clause: + PROPERTY + _with_no_get_set +; + +is_final_property_subclause: + _is FINAL +; + +_with_no_get_set: +/*empty*/ +| _with + NO + get_or_set +; + +get_or_set: + GET +| SET +; + /* REDEFINES clause */ redefines_clause: @@ -11020,6 +11250,13 @@ procedure_division: } ; + +_OO_procedure_division: + /*empty*/ +| PROCEDURE DIVISION + _method_definition_list +; + _procedure_using_chaining: /* empty */ { @@ -11636,7 +11873,7 @@ statement: | initiate_statement | inquire_statement | inspect_statement -/* | TODO: invoke_statement */ +/*TODO invoke_statement*/ | json_generate_statement | json_parse_statement | merge_statement diff --git a/cobc/reserved.c b/cobc/reserved.c old mode 100644 new mode 100755 index 344ee8cf4..c929fc5ae --- a/cobc/reserved.c +++ b/cobc/reserved.c @@ -636,7 +636,7 @@ static struct cobc_reserved default_reserved_words[] = { { "CLASS", 0, 0, CLASS, /* 2002 */ 0, 0 }, - { "CLASS-ID", 0, 0, -1, /* 2002 */ + { "CLASS-ID", 0, 0, CLASS_ID, /* 2002 */ 0, 0 }, { "CLASSIFICATION", 0, 1, CLASSIFICATION, /* 2002 (C/S) */ @@ -1558,7 +1558,7 @@ static struct cobc_reserved default_reserved_words[] = { { "IGNORING", 0, 1, IGNORING, /* 2002 (C/S) */ 0, CB_CS_READ }, - { "IMPLEMENTS", 0, 1, -1, /* 2002 (C/S) */ + { "IMPLEMENTS", 0, 1, IMPLEMENTS, /* 2002 (C/S) */ 0, 0 /* FIXME: 2014 Context-sensitive to FACTORY and OBJECT paragraph */ }, @@ -1577,7 +1577,7 @@ static struct cobc_reserved default_reserved_words[] = { { "INDICATE", 0, 0, INDICATE, /* 2002 */ 0, 0 }, - { "INHERITS", 0, 0, -1, /* 2002 */ + { "INHERITS", 0, 0, INHERITS, /* 2002 */ 0, 0 }, { "INITIAL", 0, 0, TOK_INITIAL, /* 2002 */ @@ -1613,10 +1613,10 @@ static struct cobc_reserved default_reserved_words[] = { { "INSTALLATION", 0, 1, INSTALLATION, /* 85 (later: C/S) */ 0, CB_CS_DAY /* HACK, we only want it to normally be not usable */ }, - { "INTERFACE", 0, 0, -1, /* 2002 */ + { "INTERFACE", 0, 0, INTERFACE, /* 2002 */ 0, 0 }, - { "INTERFACE-ID", 0, 0, -1, /* 2002 */ + { "INTERFACE-ID", 0, 0, INTERFACE_ID, /* 2002 */ 0, 0 }, { "INTERMEDIATE", 0, 1, INTERMEDIATE, /* 2014 (C/S) */ @@ -1632,7 +1632,7 @@ static struct cobc_reserved default_reserved_words[] = { { "INVALID", 0, 0, INVALID, /* 2002 */ 0, 0 }, - { "INVOKE", 0, 0, -1, /* 2002 */ + { "INVOKE", 0, 0, INVOKE, /* 2002 */ 0, 0 }, { "IS", 0, 0, IS, /* 2002 */ @@ -1864,10 +1864,10 @@ static struct cobc_reserved default_reserved_words[] = { { "MESSAGE-TAG", 0, 0, -1, /* COBOL 2023 MCS */ 0, 0 }, - { "METHOD", 0, 0, -1, /* 2002 */ + { "METHOD", 0, 0, METHOD, /* 2002 */ 0, 0 }, - { "METHOD-ID", 0, 0, -1, /* 2002 */ + { "METHOD-ID", 0, 0, METHOD_ID, /* 2002 */ 0, 0 }, { "MICROSECOND-TIME", 0, 1, MICROSECOND_TIME, /* ACU extension */ @@ -2125,7 +2125,7 @@ static struct cobc_reserved default_reserved_words[] = { { "OVERLINE", 0, 0, OVERLINE, /* Extension */ 0, 0 }, - { "OVERRIDE", 0, 0, -1, /* 2002 */ + { "OVERRIDE", 0, 0, OVERRIDE, /* 2002 */ 0, 0 }, { "PACKED-DECIMAL", 0, 0, PACKED_DECIMAL, /* 2002 */