From a06d4d87617c36040cb3bd583f5b7190599b3ef5 Mon Sep 17 00:00:00 2001 From: Saurabh Kumar Date: Mon, 20 Apr 2026 20:55:07 +0530 Subject: [PATCH 1/5] feat (parser): add parsing support for all class attributes with unimplemented warning Adds support for the following class attributes: * AS literal * IS FINAL * INHERITS FROM {class-name ...} * USING {param-name ...} Also support MF extensions IS STATIC, IS ABSTRACT, IS PARTIAL, IS PUBLIC, IS INTERNAL. Signed-off-by: Saurabh Kumar --- cobc/ChangeLog | 9 +++ cobc/parser.y | 151 +++++++++++++++++++++++++++++++++++++----------- cobc/reserved.c | 14 ++++- cobc/tree.h | 16 ++++- libcob/common.h | 3 +- 5 files changed, 156 insertions(+), 37 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 43776eaf1..aa6222e6a 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,13 @@ +2026-06-11 Saurabh Kumar + + * parser.y, reserved.c: add support for parsing class attributes - AS literal, + IS FINAL, INHERITS FROM {class-name ...}, USING {param-name ...} + with unimplemented warning; also support MF extensions IS STATIC, IS ABSTRACT, + IS PARTIAL, IS PUBLIC, IS INTERNAL + * tree.h, common.h: add COB_MODULE_TYPE_CLASS and bit masks for all + object-oriented class attributes + 2026-06-08 Nicolas Berthier * tree.h, parser.y: change type of cobc_cs_check flags to permit diff --git a/cobc/parser.y b/cobc/parser.y index ee0f4b123..806d2a443 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -123,6 +123,7 @@ #define EVAL_DEPTH 32 #define PROG_DEPTH 16 + /* Global variables */ struct cb_program *current_program = NULL; /* program in parse/syntax check/codegen */ @@ -1287,10 +1288,17 @@ begin_scope_of_program_name (struct cb_program *program) elt_name); return; } else if (strcmp (prog_id, elt_id) == 0) { - cb_error_x (CB_TREE(program), - _("redefinition of program ID '%s'"), - elt_id); - return; + if (program->prog_type == COB_MODULE_TYPE_PROGRAM) { + cb_error_x (CB_TREE(program), + _("redefinition of program ID '%s'"), + elt_id); + return; + } else if (program->prog_type == COB_MODULE_TYPE_CLASS) { + cb_error_x (CB_TREE(program), + _("redefinition of class ID '%s'"), + elt_id); + return; + } } } @@ -1471,7 +1479,7 @@ setup_program (cb_tree id, cb_tree as_literal, const enum cob_module_type type, main_flag_set = 1; current_program->flag_main = !!cobc_flag_main; } - } else { /* COB_MODULE_TYPE_FUNCTION */ + } else if (type == COB_MODULE_TYPE_FUNCTION) { current_program->flag_recursive = 1; } @@ -1515,8 +1523,13 @@ decrement_depth (const char *name, const unsigned char type) } if (depth != d) { - cb_error (_("END PROGRAM '%s' is different from PROGRAM-ID '%s'"), - name, stack_progid[depth]); + if (type == COB_MODULE_TYPE_PROGRAM) { + cb_error (_("END PROGRAM '%s' is different from PROGRAM-ID '%s'"), + name, stack_progid[depth]); + } else if (type == COB_MODULE_TYPE_CLASS) { + cb_error (_("END CLASS '%s' is different from CLASS-ID '%s'"), + name, stack_progid[depth]); + } } } @@ -2548,12 +2561,24 @@ set_record_size (cb_tree min, cb_tree max) } } +/* Object-oriented class */ + +static COB_INLINE void +set_oo_class_attr(enum cb_oo_class_attribute attr, const char* attr_name) +{ + if (current_program->oo_class_attributes & attr) { + emit_duplicate_clause_message (attr_name); + } + current_program->oo_class_attributes |= attr; +} + %} %token TOKEN_EOF 0 "end of file" %token THREEDIMENSIONAL "3D" %token ABSENT +%token ABSTRACT %token ACCEPT %token ACCESS %token ACTIVEX "ACTIVE-X" @@ -2970,6 +2995,7 @@ set_record_size (cb_tree min, cb_tree max) %token INDEX %token INDEXED %token INDICATE +%token INHERITS %token INITIALIZE %token INITIALIZED %token INITIATE @@ -2981,6 +3007,7 @@ set_record_size (cb_tree min, cb_tree max) %token INSPECT %token INSTALLATION /* remark: not used here */ %token INTERMEDIATE +%token INTERNAL %token INTO %token INTRINSIC %token INVALID /* remark: not used here */ @@ -3167,6 +3194,7 @@ set_record_size (cb_tree min, cb_tree max) %token PARAGRAPH %token PARENT %token PARSE +%token PARTIAL %token PASSWORD %token PERFORM %token PERMANENT @@ -3209,6 +3237,7 @@ set_record_size (cb_tree min, cb_tree max) %token PROPERTY %token PROTECTED %token PROTOTYPE +%token PUBLIC %token PURGE %token PUSH_BUTTON "PUSH-BUTTON" %token QUERY_INDEX "QUERY-INDEX" @@ -3793,12 +3822,10 @@ end_class: check_area_a_of ("END CLASS"); } end_class_name _dot - /* - TODO - { - clean_up_program ($3, COB_MODULE_TYPE_CLASS); - } - */ + { + clean_up_program ($3, COB_MODULE_TYPE_CLASS); + } + ; end_function: @@ -3985,38 +4012,94 @@ class_id_header: ; class_id_name: - CLASS_NAME - { - if (CB_REFERENCE_P ($1) && CB_WORD_COUNT ($1) > 0) { - redefinition_error ($1); - } - $$ = $1; - } + CLASS_NAME { $$ = $1; } | LITERAL { cb_trim_program_id ($1); } ; -class_id_paragraph: - class_id_header TOK_DOT +parent_class_name: + WORD { - CB_PENDING ("CLASS-ID"); + current_program->class_inheritance_list = + cb_list_add(current_program->class_inheritance_list, $1); } - class_id_name _as_literal TOK_DOT +; + +parent_class_name_list: + parent_class_name +| parent_class_name_list parent_class_name +; + +/* Parameterized classes not supported for now. */ +class_param_list: + WORD +| class_param_list WORD +; + +_inherits_phrase: + /* empty */ +| INHERITS _from parent_class_name_list +; + +_using_phrase: + /* empty */ +| USING class_param_list +; + +class_attribute: + _is STATIC { set_oo_class_attr(CB_OO_CLASS_ATTR_STATIC, "STATIC"); } +| _is PARTIAL { set_oo_class_attr(CB_OO_CLASS_ATTR_PARTIAL, "PARTIAL"); } +| _is FINAL { set_oo_class_attr(CB_OO_CLASS_ATTR_FINAL, "FINAL"); } +| _is ABSTRACT { set_oo_class_attr(CB_OO_CLASS_ATTR_ABSTRACT, "ABSTRACT"); } +| _is PUBLIC { set_oo_class_attr(CB_OO_CLASS_ATTR_PUBLIC, "PUBLIC"); } +| _is INTERNAL { set_oo_class_attr(CB_OO_CLASS_ATTR_INTERNAL, "INTERNAL"); } +; + +_class_attributes: + /* empty */ { current_program->oo_class_attributes = CB_OO_CLASS_ATTR_NONE; } +| _class_attributes class_attribute +; + +/* + * CLASS-ID paragraph syntax is: + * + * CLASS-ID. object-class-name-1 [ AS literal-1 ] [ IS STATIC ] + * [ IS { PARTIAL, FINAL, ABSTRACT } ... ] [ IS { PUBLIC, INTERNAL } ] + * [ INHERITS FROM { object-class-name-2 } ... ] + * [ USING { parameter-name-1 } ... ] . + * +*/ + +class_id_paragraph: + class_id_header TOK_DOT class_id_name _as_literal { - /* - TODO: The if block below is added for triggering - a class redefinition error. This is not the correct - way to do it since `current_program` is a dummy AST - node here. - Remove it when adding support for AST generation - through `setup_program()`. - */ - if (CB_REFERENCE_P ($4)) { - cb_define ($4, CB_TREE (current_program)); + if (setup_program ($3, $4, COB_MODULE_TYPE_CLASS, 1)) { + YYABORT; } + + __CS_CLEAR_ALL(); cobc_in_id = 0; + + CB_UNSUPPORTED ("object-oriented COBOL"); + } + _inherits_phrase + _class_attributes + _using_phrase + TOK_DOT + { + /* check consistency of current attribues */ + if (current_program->oo_class_attributes & CB_OO_CLASS_ATTR_FINAL + && current_program->oo_class_attributes & CB_OO_CLASS_ATTR_ABSTRACT) { + emit_conflicting_clause_message ("FINAL", "ABSTRACT"); + current_program->oo_class_attributes &= ~CB_OO_CLASS_ATTR_FINAL; + } + if (current_program->oo_class_attributes & CB_OO_CLASS_ATTR_INTERNAL + && current_program->oo_class_attributes & CB_OO_CLASS_ATTR_PUBLIC) { + emit_conflicting_clause_message ("INTERNAL", "PUBLIC"); + current_program->oo_class_attributes &= ~CB_OO_CLASS_ATTR_INTERNAL; + } } ; diff --git a/cobc/reserved.c b/cobc/reserved.c index 2826e9991..4a92aecf0 100644 --- a/cobc/reserved.c +++ b/cobc/reserved.c @@ -253,6 +253,9 @@ static struct cobc_reserved default_reserved_words[] = { { "ABSENT", 0, 0, ABSENT, /* IBM RW */ 0, 0 }, + { "ABSTRACT", 0, 0, ABSTRACT, /* MF extension */ + 0, 0 + }, { "ACCEPT", 1, 0, ACCEPT, /* 2002 */ CB_CS_ACCEPT, 0 }, @@ -1578,7 +1581,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 */ @@ -1623,6 +1626,9 @@ static struct cobc_reserved default_reserved_words[] = { { "INTERMEDIATE", 0, 1, INTERMEDIATE, /* 2014 (C/S) */ 0, CB_CS_OPTIONS }, + { "INTERNAL", 0, 0, INTERNAL, /* MF extension */ + 0, 0 + }, { "INTO", 0, 0, INTO, /* 2002 */ 0, 0 }, @@ -2155,6 +2161,9 @@ static struct cobc_reserved default_reserved_words[] = { { "PARSE", 0, 1, PARSE, /* IBM extension */ 0, 0 }, + { "PARTIAL", 0, 0, PARTIAL, /* MF extension */ + 0, 0 + }, { "PASCAL", 0, 1, PASCAL, /* Extension: implicit defined CALL-CONVENTION */ 0, CB_CS_CALL_CONVENTION | CB_CS_OPTIONS }, @@ -2287,6 +2296,9 @@ static struct cobc_reserved default_reserved_words[] = { { "PROTOTYPE", 0, 0, PROTOTYPE, /* 2002 */ 0, 0 }, + { "PUBLIC", 0, 0, PUBLIC, /* MF extension */ + 0, 0 + }, { "PURGE", 0, 0, PURGE, /* Communication Section */ 0, 0 }, diff --git a/cobc/tree.h b/cobc/tree.h index 816304d8f..1e72b9b76 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -514,6 +514,18 @@ enum cb_index_type { CB_STATIC_INT_VARYING }; +/* Object-oriented class attributes */ +enum cb_oo_class_attribute { + CB_OO_CLASS_ATTR_NONE = 0x00, /* No attribute specified */ + CB_OO_CLASS_ATTR_FINAL = 0x01, /* Cannot be subclassed */ + CB_OO_CLASS_ATTR_ABSTRACT = 0x02, /* Can be subclassed, but not instantiated */ + CB_OO_CLASS_ATTR_PARTIAL = 0x04, + CB_OO_CLASS_ATTR_STATIC = 0x08, /* All methods must be marked STATIC */ + CB_OO_CLASS_ATTR_PUBLIC = 0x10, + CB_OO_CLASS_ATTR_INTERNAL = 0x20 +}; + + /* Reserved word list structure */ struct cobc_reserved { const char *name; /* Word */ @@ -1863,6 +1875,7 @@ struct cb_program { cb_tree user_spec_list; /* User FUNCTION spec */ cb_tree program_spec_list; /* PROGRAM spec */ cb_tree property_spec_list; /* PROPERTY spec */ + cb_tree class_inheritance_list; /* List of Inherited Classes (OOP) */ struct cb_alter_id *alter_gotos; /* ALTER ids */ struct cb_field *working_storage; /* WORKING-STORAGE */ struct cb_field *local_storage; /* LOCAL-STORAGE */ @@ -1913,7 +1926,8 @@ struct cb_program { cob_u8_t high_value; /* High-value for this program */ cob_u16_t low_value_n; /* National Low-value */ cob_u16_t high_value_n; /* National High-value */ - enum cob_module_type prog_type; /* Program type (program = 0, function = 1) */ + enum cob_module_type prog_type; /* Program type (program = 0, function = 1, OO class = 2) */ + cob_u8_t oo_class_attributes; /* OO class attributes */ cb_tree entry_convention; /* ENTRY convention / PROCEDURE convention */ struct literal_list *decimal_constants; diff --git a/libcob/common.h b/libcob/common.h index 7657d624a..b2b3167d2 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -1251,7 +1251,8 @@ typedef struct __cob_screen { /* Module structure */ enum cob_module_type { COB_MODULE_TYPE_PROGRAM = 0, - COB_MODULE_TYPE_FUNCTION = 1 + COB_MODULE_TYPE_FUNCTION = 1, + COB_MODULE_TYPE_CLASS = 2 }; /* From 7b25f560646016b10fac5f3207e2b6f9ac6bdd29 Mon Sep 17 00:00:00 2001 From: Saurabh Kumar Date: Tue, 19 May 2026 23:33:57 +0530 Subject: [PATCH 2/5] tests: add syntax tests for checking class attributes Signed-off-by: Saurabh Kumar --- tests/testsuite.src/run_misc.at | 8 +- tests/testsuite.src/syn_oo.at | 195 +++++++++++++++++++++++++++++--- 2 files changed, 184 insertions(+), 19 deletions(-) diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index af5b9440a..eb1261637 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -7334,10 +7334,10 @@ AT_DATA([callee2.cob], [ . EXIT PROGRAM. ]) - -AT_CHECK([$COMPILE_MODULE -fnot-reserved=double,float,new,volatile,xor callee.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE -fnot-reserved=double,float,new,volatile,xor callee2.cob], [0], [], []) -AT_CHECK([$COMPILE -fnot-reserved=double,float,new,volatile,xor -o prog caller.cob], [0], [], []) + +AT_CHECK([$COMPILE_MODULE -fnot-reserved=double,float,new,volatile,xor,public callee.cob], [0], [], []) +AT_CHECK([$COMPILE_MODULE -fnot-reserved=double,float,new,volatile,xor,public callee2.cob], [0], [], []) +AT_CHECK([$COMPILE -fnot-reserved=double,float,new,volatile,xor,public -o prog caller.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP diff --git a/tests/testsuite.src/syn_oo.at b/tests/testsuite.src/syn_oo.at index a7faa4231..e8f320c26 100644 --- a/tests/testsuite.src/syn_oo.at +++ b/tests/testsuite.src/syn_oo.at @@ -22,34 +22,35 @@ AT_SETUP([CLASS-ID Syntax Check]) -AT_KEYWORDS([CLASS-ID]) +AT_KEYWORDS([OOP]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. CLASS-ID. MyClass. END CLASS MyClass. - CLASS-ID. MySecondClass AS "MyClass". + CLASS-ID. MySecondClass AS "MySecondClass". END CLASS MySecondClass. ]) -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:3: warning: CLASS-ID is not implemented -prog.cob:6: warning: CLASS-ID is not implemented +AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], +[prog.cob:3: error: object-oriented COBOL is not supported +prog.cob:6: error: object-oriented COBOL is not supported ]) AT_CLEANUP + AT_SETUP([CLASS-ID Syntax Error Check]) -AT_KEYWORDS([CLASS-ID]) +AT_KEYWORDS([OOP]) AT_DATA([prog1.cob], [ IDENTIFICATION DIVISION. - CLASS-ID. MyClass. + CLASS-ID. MyFirstClass. END CLASS. ]) AT_CHECK([$COMPILE_ONLY prog1.cob], [1], [], -[prog1.cob:3: warning: CLASS-ID is not implemented +[prog1.cob:3: error: object-oriented COBOL is not supported prog1.cob:4: error: syntax error, unexpected ., expecting class-name or Literal ]) @@ -60,14 +61,26 @@ AT_DATA([prog2.cob], [ ]) AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:3: warning: CLASS-ID is not implemented +[prog2.cob:3: error: object-oriented COBOL is not supported prog2.cob:4: error: syntax error, unexpected END PROGRAM, expecting END CLASS ]) +AT_DATA([prog3.cob], [ + IDENTIFICATION DIVISION. + CLASS-ID. MyFirstClass. + END CLASS MyClass. +]) + +AT_CHECK([$COMPILE_ONLY prog3.cob], [1], [], +[prog3.cob:3: error: object-oriented COBOL is not supported +prog3.cob:4: error: END CLASS 'MyClass' is different from CLASS-ID 'MyFirstClass' +]) + AT_CLEANUP -AT_SETUP([Redefinition of class]) -AT_KEYWORDS([CLASS-ID]) + +AT_SETUP([Redefinition of CLASS-ID]) +AT_KEYWORDS([OOP]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -79,9 +92,161 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:3: warning: CLASS-ID is not implemented -prog.cob:6: warning: CLASS-ID is not implemented -prog.cob:6: error: redefinition of 'MyClass' -prog.cob:3: note: 'MyClass' previously defined here +[prog.cob:3: error: object-oriented COBOL is not supported +prog.cob:6: error: redefinition of class ID 'MyClass' +prog.cob:6: error: object-oriented COBOL is not supported +]) +AT_CLEANUP + + +AT_SETUP([CLASS-ID Attribute Check - INHERITS FROM and USING]) +AT_KEYWORDS([OOP]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + CLASS-ID. Account. + END CLASS Account. + + CLASS-ID. DematAccount. + END CLASS DematAccount. + + CLASS-ID. SavingsAccount INHERITS FROM Account. + END CLASS SavingsAccount. + + *> Skips optional FROM keyword for INHERITS attribute + CLASS-ID. MinorSavingsAccount INHERITS SavingsAccount. + END CLASS MinorSavingsAccount. + + CLASS-ID. MultiPurposeAccount INHERITS + FROM Account DematAccount. + END CLASS MultiPurposeAccount. + + CLASS-ID. MyAccount USING startingBalance. + END CLASS MyAccount. +]) + +AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], +[prog.cob:3: error: object-oriented COBOL is not supported +prog.cob:6: error: object-oriented COBOL is not supported +prog.cob:9: error: object-oriented COBOL is not supported +prog.cob:13: error: object-oriented COBOL is not supported +prog.cob:16: error: object-oriented COBOL is not supported +prog.cob:20: error: object-oriented COBOL is not supported +]) +AT_CLEANUP + + +AT_SETUP([CLASS-ID Attribute Check - Multiple attributes together]) +AT_KEYWORDS([OOP]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + CLASS-ID. MySuperClass. + END CLASS MySuperClass. + + CLASS-ID. MyFirstClass INHERITS + FROM MySuperClass IS FINAL. + END CLASS MyFirstClass. + + CLASS-ID. MySecondClass AS "MySecondClass" + IS FINAL. + END CLASS MySecondClass. + + CLASS-ID. MyThirdClass + INHERITS FROM MySuperClass + USING param-name. + END CLASS MyThirdClass. + + *> Skips optional IS keyword for FINAL attribute + CLASS-ID. MyFourthClass AS "MyFourthClass" + FINAL USING param-name. + END CLASS MyFourthClass. +]) + +AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], +[prog.cob:3: error: object-oriented COBOL is not supported +prog.cob:6: error: object-oriented COBOL is not supported +prog.cob:10: error: object-oriented COBOL is not supported +prog.cob:15: error: object-oriented COBOL is not supported +prog.cob:20: error: object-oriented COBOL is not supported +]) +AT_CLEANUP + + +AT_SETUP([CLASS-ID Attribute Check - FINAL, ABSTRACT, PARTIAL, PUBLIC, INTERNAL]) +AT_KEYWORDS([OOP]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + CLASS-ID. Account IS ABSTRACT. + END CLASS Account. + + CLASS-ID. DematAccount INHERITS Account + ABSTRACT + IS PUBLIC. + END CLASS DematAccount. + + CLASS-ID. SavingsAccount + INHERITS FROM Account + FINAL. + END CLASS SavingsAccount. + + CLASS-ID. MinorSavingsAccount + INHERITS SavingsAccount + IS INTERNAL. + END CLASS MinorSavingsAccount. + + CLASS-ID. MultiPurposeAccount + INHERITS Account DematAccount + PARTIAL. + END CLASS MultiPurposeAccount. +]) + +AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], +[prog.cob:3: error: object-oriented COBOL is not supported +prog.cob:6: error: object-oriented COBOL is not supported +prog.cob:12: error: object-oriented COBOL is not supported +prog.cob:17: error: object-oriented COBOL is not supported +prog.cob:22: error: object-oriented COBOL is not supported +]) +AT_CLEANUP + +AT_SETUP([CLASS-ID Attribute Error Check]) +AT_KEYWORDS([OOP]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + CLASS-ID. Account IS FINAL + FINAL. + END CLASS Account. + + CLASS-ID. DematAccount INHERITS Account + ABSTRACT + IS PUBLIC + INTERNAL. + END CLASS DematAccount. + + CLASS-ID. SavingsAccount + INHERITS FROM Account + FINAL + IS ABSTRACT. + END CLASS SavingsAccount. + + CLASS-ID. MultiPurposeAccount + INHERITS Account DematAccount + PARTIAL + IS PARTIAL. + END CLASS MultiPurposeAccount. +]) + +AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], +[prog.cob:3: error: object-oriented COBOL is not supported +prog.cob:4: error: duplicate FINAL clause +prog.cob:7: error: object-oriented COBOL is not supported +prog.cob:10: error: cannot specify both INTERNAL and PUBLIC +prog.cob:14: error: object-oriented COBOL is not supported +prog.cob:16: error: cannot specify both FINAL and ABSTRACT +prog.cob:20: error: object-oriented COBOL is not supported +prog.cob:22: error: duplicate PARTIAL clause ]) AT_CLEANUP From 4aaf33b0bb883e5c487aac8c13f6c4399299aca8 Mon Sep 17 00:00:00 2001 From: Saurabh Kumar Date: Thu, 11 Jun 2026 13:39:55 +0530 Subject: [PATCH 3/5] [WIP] Signed-off-by: Saurabh Kumar --- cobc/parser.y | 88 ++++++++++++++++++++++++++++++++++++++++++++++++- cobc/reserved.c | 8 ++--- cobc/scanner.l | 15 +++++++++ 3 files changed, 106 insertions(+), 5 deletions(-) diff --git a/cobc/parser.y b/cobc/parser.y index 806d2a443..83f388060 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -2844,11 +2844,14 @@ set_oo_class_attr(enum cb_oo_class_attribute attr, const char* attr_name) %token END_DISPLAY "END-DISPLAY" %token END_DIVIDE "END-DIVIDE" %token END_EVALUATE "END-EVALUATE" +%token END_FACTORY "END FACTORY" %token END_FUNCTION "END FUNCTION" %token END_IF "END-IF" %token END_JSON "END-JSON" +%token END_METHOD "END-METHOD" %token END_MODIFY "END-MODIFY" %token END_MULTIPLY "END-MULTIPLY" +%token END_OBJECT "END OBJECT" %token END_PERFORM "END-PERFORM" %token END_PROGRAM "END PROGRAM" %token END_CLASS "END CLASS" @@ -2954,6 +2957,7 @@ set_oo_class_attr(enum cb_oo_class_attribute attr, const char* attr_name) %token FUNCTION_NAME "intrinsic function name" %token FUNCTION_POINTER "FUNCTION-POINTER" %token GENERATE +%token GET %token GIVING %token GLOBAL %token GO @@ -3089,6 +3093,8 @@ set_oo_class_attr(enum cb_oo_class_attribute attr, const char* attr_name) %token MENU %token MERGE %token MESSAGE +%token METHOD +%token METHOD_ID %token MICROSECOND_TIME "MICROSECOND-TIME" %token MINUS %token MIN_VAL "MIN-VAL" @@ -3184,6 +3190,7 @@ set_oo_class_attr(enum cb_oo_class_attribute attr, const char* attr_name) %token OVERLAP_LEFT "OVERLAP-LEFT" %token OVERLAP_TOP "OVERLAP-TOP" %token OVERLINE +%token OVERRIDE %token PACKED_DECIMAL "PACKED-DECIMAL" %token PADDING %token PASCAL @@ -3777,10 +3784,35 @@ program_definition: class_definition: _identification_header class_id_paragraph - /* TODO: _program_body */ + _class_body + method_definition /* Move to procedure division */ end_class ; +factory_header: | FACTORY TOK_DOT /* _implements_clause */ +object_header: | OBJECT TOK_DOT /* _implements_clause */ + +factory_definition: + factory_header + _program_body + END FACTORY + _dot +; + +object_definition: + object_header + _program_body + END OBJECT + _dot +; + +method_definition: + _identification_header + method_id_paragraph + _program_body + end_method +; + function_definition: _identification_header function_id_paragraph @@ -3825,7 +3857,18 @@ end_class: { clean_up_program ($3, COB_MODULE_TYPE_CLASS); } +; +end_method: + END_METHOD + { + last_source_line = cb_source_line; + check_area_a_of ("END METHOD"); + } + end_program_name _dot + { + clean_up_program ($3, COB_MODULE_TYPE_FUNCTION); + } ; end_function: @@ -4103,6 +4146,27 @@ class_id_paragraph: } ; +method_id_header: + CLASS_ID + { + cobc_in_id = 1; + } +; + +get_or_set: + GET +| SET +; + +method_signature: + program_id_name _as_literal +| get_or_set PROPERTY WORD +; + +method_id_paragraph: + method_id_header TOK_DOT method_signature _override _is_final +; + end_class_name: CLASS_NAME | LITERAL @@ -4130,6 +4194,25 @@ _program_body: _procedure_division ; +/* CLASS body */ + +_factory_or_instance_definition: + _identification_header + factory_or_object_definition +; + + +factory_or_object_definition: + factory_definition + object_definition +; + +_class_body: + _options_paragraph + _environment_division + _factory_or_instance_definition +; + /* IDENTIFICATION DIVISION */ _identification_header: @@ -4698,6 +4781,7 @@ repository_name: { yyerrok; } +| CLASS ; repository_name_list: @@ -20880,6 +20964,7 @@ _is_equal: | IS | TOK_EQUAL; _is_are: | IS | ARE ; _is_are_equal: | IS | ARE | TOK_EQUAL; _is_in: | IS | IN ; +_is_final: | _is FINAL ; _key: | KEY ; _line: | LINE ; _line_or_lines: | LINE | LINES ; @@ -20897,6 +20982,7 @@ _on_for: | ON | FOR ; _onoff_status: | STATUS IS | STATUS | IS ; _other: | OTHER ; _others: | OTHERS ; +_override: | OVERRIDE ; _procedure: | PROCEDURE ; _program: | PROGRAM ; _protected: | PROTECTED ; diff --git a/cobc/reserved.c b/cobc/reserved.c index 4a92aecf0..b6b8eed0f 100644 --- a/cobc/reserved.c +++ b/cobc/reserved.c @@ -1442,8 +1442,8 @@ static struct cobc_reserved default_reserved_words[] = { { "GENERATE", 0, 0, GENERATE, /* 2002 */ 0, 0 }, - { "GET", 0, 0, -1, /* 2002 */ - 0, 0 + { "GET", 0, 0, GET, /* 2002 */ + 0, }, { "GIVING", 0, 0, GIVING, /* 2002 */ 0, 0 @@ -1870,10 +1870,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 */ diff --git a/cobc/scanner.l b/cobc/scanner.l index ae868118a..5eb35e83f 100644 --- a/cobc/scanner.l +++ b/cobc/scanner.l @@ -666,6 +666,21 @@ H#[0-9A-Za-z]+ { RETURN_TOK (END_CLASS); } +"END"[ ,;\n]+"FACTORY"/[ .,;\n] { + count_lines (yytext); + RETURN_TOK (END_FACTORY); +} + +"END"[ ,;\n]+"OBJECT"/[ .,;\n] { + count_lines (yytext); + RETURN_TOK (END_OBJECT); +} + +"END"[ ,;\n]+"METHOD"/[ .,;\n] { + count_lines (yytext); + RETURN_TOK (END_METHOD); +} + "PICTURE"[ ,;\n]+"SYMBOL"/[ .,;\n] { if (lookup_reserved_word ("SYMBOL")) { count_lines (yytext); From dd8db3111e7d0a340a5ddd521c1d99a6f706393d Mon Sep 17 00:00:00 2001 From: Nicolas Berthier Date: Thu, 11 Jun 2026 11:20:57 +0200 Subject: [PATCH 4/5] temporary grammar fixes --- cobc/parser.y | 42 ++++++++++++++++++++---------------------- 1 file changed, 20 insertions(+), 22 deletions(-) diff --git a/cobc/parser.y b/cobc/parser.y index 83f388060..78f6a0661 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -3785,33 +3785,35 @@ class_definition: _identification_header class_id_paragraph _class_body - method_definition /* Move to procedure division */ + /* method_definition /\* Move to procedure division *\/ */ end_class ; -factory_header: | FACTORY TOK_DOT /* _implements_clause */ -object_header: | OBJECT TOK_DOT /* _implements_clause */ +factory_header: FACTORY TOK_DOT /* _implements_clause */; +object_header: OBJECT TOK_DOT /* _implements_clause */; factory_definition: + _identification_header factory_header _program_body - END FACTORY + END_FACTORY _dot ; -object_definition: +instance_definition: + _identification_header object_header _program_body - END OBJECT + END_OBJECT _dot ; -method_definition: - _identification_header - method_id_paragraph - _program_body - end_method -; +/* method_definition: */ +/* _identification_header */ +/* method_id_paragraph */ +/* _program_body */ +/* end_method */ +/* ; */ function_definition: _identification_header @@ -4196,21 +4198,17 @@ _program_body: /* CLASS body */ -_factory_or_instance_definition: - _identification_header - factory_or_object_definition -; - - -factory_or_object_definition: - factory_definition - object_definition +_factory_or_instance_definitions: +| factory_definition +| instance_definition +| factory_definition + instance_definition ; _class_body: _options_paragraph _environment_division - _factory_or_instance_definition + _factory_or_instance_definitions ; /* IDENTIFICATION DIVISION */ From a874bb0f8b409952496fb801eb3432122f5f56c8 Mon Sep 17 00:00:00 2001 From: Saurabh Kumar Date: Mon, 15 Jun 2026 03:23:22 +0530 Subject: [PATCH 5/5] [WIP] More changes Signed-off-by: Saurabh Kumar --- cobc/cobc.h | 4 ++ cobc/parser.y | 163 ++++++++++++++++++++++++++++++++++++++---------- cobc/reserved.c | 10 +-- cobc/scanner.l | 6 +- 4 files changed, 145 insertions(+), 38 deletions(-) diff --git a/cobc/cobc.h b/cobc/cobc.h index 73a3a005f..9573b1a51 100644 --- a/cobc/cobc.h +++ b/cobc/cobc.h @@ -177,6 +177,10 @@ enum cb_current_date { #define CB_CS_REPOSITORY (COB_U64_C(1) << 42) #define CB_CS_CALL_USING (COB_U64_C(1) << 43) /* within USING phrase of CALL statement */ #define CB_CS_READY_OR_RESET (COB_U64_C(1) << 44) +#define CB_CS_CLASS_SPECIFIER (COB_U64_C(1) << 45) +#define CB_CS_INTERFACE_SPECIFIER (COB_U64_C(1) << 46) +#define CB_CS_FACTORY_PARAGRAPH (COB_U64_C(1) << 47) +#define CB_CS_OBJECT_PARAGRAPH (COB_U64_C(1) << 48) /* Support for cobc from stdin */ #define COB_DASH "-" diff --git a/cobc/parser.y b/cobc/parser.y index 78f6a0661..46d87ab08 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -23,7 +23,7 @@ %defines %verbose -%error-verbose +%define parse.error verbose %{ #include "config.h" @@ -2838,23 +2838,24 @@ set_oo_class_attr(enum cb_oo_class_attribute attr, const char* attr_name) %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" %token END_DISPLAY "END-DISPLAY" %token END_DIVIDE "END-DIVIDE" %token END_EVALUATE "END-EVALUATE" -%token END_FACTORY "END FACTORY" +%token END_FACTORY "END-FACTORY" %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_OBJECT "END OBJECT" +%token END_OBJECT "END-OBJECT" %token END_PERFORM "END-PERFORM" %token END_PROGRAM "END PROGRAM" -%token END_CLASS "END CLASS" %token END_READ "END-READ" %token END_RECEIVE "END-RECEIVE" %token END_RETURN "END-RETURN" @@ -2898,6 +2899,7 @@ set_oo_class_attr(enum cb_oo_class_attribute attr, const char* attr_name) %token EXCLUSIVE %token EXHIBIT %token EXIT +%token EXPANDS %token EXPONENTIATION "exponentiation operator" %token EXTEND %token EXTENDED_SEARCH "EXTENDED-SEARCH" @@ -3010,6 +3012,9 @@ set_oo_class_attr(enum cb_oo_class_attribute attr, const char* attr_name) %token INSERT_ROWS "INSERT-ROWS" %token INSPECT %token INSTALLATION /* remark: not used here */ +%token INTERFACE +%token INTERFACE_ID "INTERFACE-ID" +%token INTERFACE_NAME %token INTERMEDIATE %token INTERNAL %token INTO @@ -3093,7 +3098,6 @@ set_oo_class_attr(enum cb_oo_class_attribute attr, const char* attr_name) %token MENU %token MERGE %token MESSAGE -%token METHOD %token METHOD_ID %token MICROSECOND_TIME "MICROSECOND-TIME" %token MINUS @@ -3754,6 +3758,7 @@ source_element: program_definition | class_definition | function_definition +| interface_definition | program_prototype | function_prototype ; @@ -3785,16 +3790,35 @@ class_definition: _identification_header class_id_paragraph _class_body - /* method_definition /\* Move to procedure division *\/ */ end_class ; -factory_header: FACTORY TOK_DOT /* _implements_clause */; -object_header: OBJECT TOK_DOT /* _implements_clause */; +_class_body: + _options_paragraph + _environment_division + _factory_or_instance_definition +; + +interface_definition: + _identification_header + interface_id_paragraph + _options_paragraph + _environment_division + procedure_division + end_interface +; + +_factory_or_instance_definition: + /* empty */ +| factory_definition +| instance_definition +| factory_definition + instance_definition +; factory_definition: _identification_header - factory_header + FACTORY TOK_DOT /* _implements clause */ _program_body END_FACTORY _dot @@ -3802,18 +3826,18 @@ factory_definition: instance_definition: _identification_header - object_header + OBJECT TOK_DOT /* _implements clause */ _program_body END_OBJECT _dot ; -/* method_definition: */ -/* _identification_header */ -/* method_id_paragraph */ -/* _program_body */ -/* end_method */ -/* ; */ +method_definition: + _identification_header + method_id_header TOK_DOT method_signature _override _is_final + _program_body + end_method +; function_definition: _identification_header @@ -3855,19 +3879,28 @@ end_class: last_source_line = cb_source_line; check_area_a_of ("END CLASS"); } - end_class_name _dot + class_id_name _dot { clean_up_program ($3, COB_MODULE_TYPE_CLASS); } ; +end_interface: + END_INTERFACE + { + last_source_line = cb_source_line; + check_area_a_of ("END INTERFACE"); + } + interface_id_name _dot +; + end_method: END_METHOD { last_source_line = cb_source_line; check_area_a_of ("END METHOD"); } - end_program_name _dot + _end_program_name TOK_DOT { clean_up_program ($3, COB_MODULE_TYPE_FUNCTION); } @@ -4056,6 +4089,13 @@ class_id_header: } ; +interface_id_header: + INTERFACE_ID + { + cobc_in_id = 1; + } +; + class_id_name: CLASS_NAME { $$ = $1; } | LITERAL @@ -4064,6 +4104,14 @@ class_id_name: } ; +interface_id_name: + INTERFACE_NAME { $$ = $1; } +| LITERAL + { + cb_trim_program_id ($1); + } +; + parent_class_name: WORD { @@ -4077,6 +4125,21 @@ parent_class_name_list: | parent_class_name_list parent_class_name ; +/* The 2 rules below look same due to usage of WORD, + but they would later require checks that would differentiate + them as the rule name says. +*/ +interface_name_list: + WORD +| interface_name_list WORD +; + +class_or_interface_name_list: + WORD +| class_or_interface_name_list WORD +; + + /* Parameterized classes not supported for now. */ class_param_list: WORD @@ -4086,6 +4149,7 @@ class_param_list: _inherits_phrase: /* empty */ | INHERITS _from parent_class_name_list +| INHERITS _from interface_name_list ; _using_phrase: @@ -4148,8 +4212,21 @@ class_id_paragraph: } ; +interface_id_paragraph: + interface_id_header TOK_DOT interface_id_name _as_literal + { + cobc_cs_check = 0; + cobc_in_id = 0; + + CB_UNSUPPORTED ("interfaces in object-oriented COBOL"); + } + _inherits_phrase + _using_phrase + TOK_DOT +; + method_id_header: - CLASS_ID + METHOD_ID { cobc_in_id = 1; } @@ -4165,18 +4242,6 @@ method_signature: | get_or_set PROPERTY WORD ; -method_id_paragraph: - method_id_header TOK_DOT method_signature _override _is_final -; - -end_class_name: - CLASS_NAME -| LITERAL - { - cb_trim_program_id ($1); - } -; - /* PROGRAM body */ @@ -4309,6 +4374,11 @@ program_id_name: } ; +_end_program_name: + /* empty */ +| end_program_name +; + end_program_name: PROGRAM_NAME | LITERAL @@ -4322,6 +4392,16 @@ _as_literal: | AS LITERAL { $$ = $2; } ; +_override: + /* empty */ +| OVERRIDE +; + +_is_final: + /* empty */ +| _is FINAL +; + _program_type: /* empty */ { $$ = NULL; } | _is program_type_clause _program { $$ = $2; } @@ -4756,6 +4836,17 @@ repository_list: | repository_list repository_name ; +_expands_clause: + /* empty */ +| EXPANDS WORD +{ + /* Check that WORD is a class when used with the CLASS specifier + and interface when used with the INTERFACE specifier. + */ +} +USING class_or_interface_name_list +; + repository_name: FUNCTION ALL INTRINSIC { @@ -4779,7 +4870,8 @@ repository_name: { yyerrok; } -| CLASS +| CLASS WORD _as_literal _expands_clause +| INTERFACE WORD _as_literal _expands_clause ; repository_name_list: @@ -11369,6 +11461,7 @@ procedure_division: emit_statement (cb_build_perform_exit (current_section)); } } +| _method_list | { cb_tree label; @@ -11744,6 +11837,12 @@ procedure: } ; +/* Method list */ + +_method_list: + method_definition +| _method_list method_definition +; /* Section/Paragraph */ diff --git a/cobc/reserved.c b/cobc/reserved.c index b6b8eed0f..2cc95f4ee 100644 --- a/cobc/reserved.c +++ b/cobc/reserved.c @@ -1252,8 +1252,8 @@ static struct cobc_reserved default_reserved_words[] = { { "EXPAND", 0, 1, EXPAND, /* ACU extension */ 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY }, - { "EXPANDS", 0, 1, -1, /* 2002 (C/S) */ - 0, 0 + { "EXPANDS", 0, 1, EXPANDS, /* 2002 (C/S) */ + 0, CB_CS_CLASS_SPECIFIER | CB_CS_INTERFACE_SPECIFIER /* FIXME: 2014 Context-sensitive to class-specifier and interface-specifier of REPOSITORY paragraph */ }, @@ -1562,8 +1562,8 @@ 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) */ - 0, 0 + { "IMPLEMENTS", 0, 1, IMPLEMENTS, /* 2002 (C/S) */ + 0, CB_CS_FACTORY_PARAGRAPH | CB_CS_OBJECT_PARAGRAPH /* FIXME: 2014 Context-sensitive to FACTORY and OBJECT paragraph */ }, { "IN", 0, 0, IN, /* 2002 */ @@ -1620,7 +1620,7 @@ static struct cobc_reserved default_reserved_words[] = { { "INTERFACE", 0, 0, -1, /* 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) */ diff --git a/cobc/scanner.l b/cobc/scanner.l index 5eb35e83f..332107759 100644 --- a/cobc/scanner.l +++ b/cobc/scanner.l @@ -1080,9 +1080,13 @@ H#[0-9A-Za-z]+ { RETURN_TOK (LITERAL); } } else if ((second_last_token == CLASS_ID && last_token == TOK_DOT) - || last_token == END_CLASS) { + || last_token == END_CLASS) { yylval = cb_build_reference (yytext); RETURN_TOK (CLASS_NAME); + } else if ((second_last_token == INTERFACE_ID && last_token == TOK_DOT) + || last_token == END_INTERFACE) { + yylval = cb_build_reference (yytext); + RETURN_TOK (INTERFACE_NAME); } /* Check reserved word */