diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 4974c990f..1e336ac53 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -49,6 +49,13 @@ * typeck.c (cb_emit_call): fixed skipping memory-fence generation for EXTERNAL/BASED sub-fields +2023-07-20 Simon Sobisch + + * field.c (copy_validation): new function + * field.c (copy_validation, copy_into_field): handling validation + * cobc.c (print_fields): leave a hint to field being TYPEDEF + * cobc.c (xref_fields): dont output references for TYPEDEF sub items + 2023-07-19 Simon Sobisch * typeck.c (refmod_checks): extracted from (cb_build_identifier) @@ -257,6 +264,8 @@ 2023-05-30 Simon Sobisch * typeck.y (is_subordinate_to): start with parent, not field + * field.c (copy_into_field_recursive, copy_into_field): handling more + field attributes, don't re-build picture 2023-05-28 Simon Sobisch diff --git a/cobc/cobc.c b/cobc/cobc.c index 8b623a930..4238418cd 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -622,7 +622,7 @@ static void print_program_header (void); static void print_program_data (const char *); static void print_program_trailer (void); static void print_program_listing (void); -static void print_with_overflow (char *, char *); +static void print_with_overflow (const char *, char *); static int process (const char *); /* cobc functions */ @@ -5793,6 +5793,7 @@ print_88_values (struct cb_field *field) " %-14.14s %02d %s", "CONDITIONAL", f->level, f->name); print_program_data (print_data); + /* CHECKME: Would it be useful or noise to print 88er values here? */ } } @@ -5852,7 +5853,14 @@ print_fields (struct cb_field *top, int *found) pd_off = sprintf (print_data, "%05d ", top->size); } - pd_off += sprintf (print_data + pd_off, "%-14.14s %02d ", type, top->level); + if (top->flag_is_typedef) { + /* at least leave a hint on the TYPEDEF in symbol listing, + note: for "ALPHANUMERIC" we have only 2 positions left, so "T " */ + pd_off += sprintf (print_data + pd_off, "T %-12.12s ", type); + } else { + pd_off += sprintf (print_data + pd_off, "%-14.14s ", type); + } + pd_off += sprintf (print_data + pd_off, "%02d ", top->level); name_or_filler = check_filler_name (top); if (got_picture) { @@ -6172,6 +6180,12 @@ xref_fields (struct cb_field *top) xref_print (&top->xref, XREF_FIELD, NULL); } + /* enough, if we are a typedef, as its contents are only + referenced through fields using this type */ + if (top->flag_is_typedef) { + continue; + } + /* print xref for all assigned 88 validation entries */ if (top->validation) { xref_88_values (top); @@ -6416,7 +6430,7 @@ print_program_trailer (void) cmd_line[pd_off - 1] = 0; force_new_page_for_next_line (); print_program_data (_("command line:")); - print_with_overflow ((char *)" ", cmd_line); + print_with_overflow (" ", cmd_line); print_break = 0; } else { print_program_data (""); @@ -6857,7 +6871,7 @@ print_free_line (const int line_num, char pch, char *line) } static void -print_with_overflow (char *prefix, char *content) +print_with_overflow (const char *prefix, char *content) { const unsigned int max_chars_on_line = cb_listing_wide ? 120 : 80; int offset; diff --git a/cobc/field.c b/cobc/field.c index 0957f2eef..54ca3c1da 100644 --- a/cobc/field.c +++ b/cobc/field.c @@ -714,6 +714,33 @@ copy_duplicated_field_into_field (struct cb_field *field, struct cb_field *targe copy_into_field_recursive (field, CB_FIELD (x), outer_indexes); } +static void +copy_validation (struct cb_field *source, struct cb_field *target) +{ + struct cb_field *val, *last_val; +#if 0 /* in case we want to allow combining condition-names of typedef and field */ + for (last_val = target->validation; last_val; last_val = last_val->sister) { + /* get to the last validation entry*/ + if (!last_val->sister) { + break; + } + } +#else + if (target->validation) { + (void) cb_syntax_check_x (CB_TREE (target->validation), _("duplicate %s"), "level 88"); + } +#endif + for (val = source->validation; val; val = val->sister) { + /* create content-name and link into the reference list */ + cb_tree x = cb_build_field_tree (88, cb_build_reference (val->name), + target, target->storage, target->file, 0); + last_val = CB_FIELD (x); + /* directly assign the typef's value + false (no need for copy) */ + last_val->values = val->values; + last_val->false_88 = val->false_88; + } +} + static void copy_children (struct cb_field *child, struct cb_field *target, const int level, const int outer_indexes, const enum cb_storage storage) @@ -813,10 +840,12 @@ copy_into_field_recursive (struct cb_field *source, struct cb_field *target, field_attribute_override (flag_sign_leading); field_attribute_override (flag_sign_separate); field_attribute_override (flag_synchronized); - field_attribute_override (flag_item_based); + field_attribute_override (flag_sync_right); + field_attribute_override (flag_sync_left); field_attribute_override (flag_any_length); field_attribute_override (flag_any_numeric); field_attribute_override (flag_invalid); + field_attribute_override (flag_item_based); field_attribute_override (flag_is_pointer); /* Note: attributes must be handled both here and in copy_into_field */ @@ -827,10 +856,18 @@ copy_into_field_recursive (struct cb_field *source, struct cb_field *target, target->redefines = cb_resolve_redefines (target, ref); } + /* copy all level 88 */ + if (source->validation) { + copy_validation (source, target); + } + if (source->children) { copy_children (source->children, target, target->level, outer_indexes, target->storage); } else if (source->pic){ - target->pic = cb_build_picture (source->pic->orig); + /* take over internal PICTURE representation as-is, no use in re-building + that from scratch and handle calculated ->pic special */ + target->pic = cobc_parse_malloc (sizeof (struct cb_picture)); + memcpy (target->pic, source->pic, sizeof (struct cb_picture)); } if (source->sister) { @@ -859,7 +896,8 @@ copy_into_field (struct cb_field *source, struct cb_field *target) #endif /* note: EXTERNAL is always applied from the typedef (if level 1/77), - but may be specified on the field */ + but may be specified on the field; + note: MF has different syntax rules and _only_ allows it on the field */ if (target->level == 1 || target->level == 77) { field_attribute_copy (flag_external); if (target->flag_external @@ -872,10 +910,15 @@ copy_into_field (struct cb_field *source, struct cb_field *target) } } target->usage = source->usage; + target->common.category = source->common.category; if (target->flag_external && target->ename == NULL) { /* External Name is required */ target->ename = target->name; - } + } + + /* Note: The attributes GLOBAL and SELECT WHEN are never included; + SAME AS does not include EXTERNAL, but the TYPEDEF */ + if (source->values) { if (target->values) { duplicate_clause_message (target->values, "VALUE"); @@ -888,19 +931,32 @@ copy_into_field (struct cb_field *source, struct cb_field *target) field_attribute_copy (flag_sign_clause); field_attribute_copy (flag_sign_leading); field_attribute_copy (flag_sign_separate); - field_attribute_copy (flag_synchronized); - field_attribute_copy (flag_item_based); + if (source->flag_synchronized + && !target->flag_synchronized) { + target->flag_synchronized = source->flag_synchronized; + target->flag_sync_right = source->flag_sync_right; + target->flag_sync_left = source->flag_sync_left; + } field_attribute_override (flag_any_length); field_attribute_override (flag_any_numeric); field_attribute_override (flag_invalid); + field_attribute_copy (flag_item_based); field_attribute_override (flag_is_pointer); /* Note: attributes must be handled both here and in copy_into_field_recursive */ + /* copy all level 88 */ + if (source->validation) { + copy_validation (source, target); + } + if (!target->like_modifier) { if (source->children) { copy_children (source->children, target, target->level, target->indexes, target->storage); } else if (source->pic) { - target->pic = cb_build_picture (source->pic->orig); + /* take over internal PICTURE representation as-is, no use in re-building + that from scratch and in handling calculated ->pic special */ + target->pic = cobc_parse_malloc (sizeof (struct cb_picture)); + memcpy (target->pic, source->pic, sizeof (struct cb_picture)); } } else { struct cb_picture *new_pic = NULL; @@ -971,6 +1027,7 @@ copy_into_field (struct cb_field *source, struct cb_field *target) if (new_pic) { target->pic = new_pic; } else if (target->pic) { + /* CHECKME: is there any use in re-building the PIC? */ target->pic = cb_build_picture (target->pic->orig); } } diff --git a/tests/testsuite.src/syn_definition.at b/tests/testsuite.src/syn_definition.at index 2cb6db9f0..dcf4286d8 100644 --- a/tests/testsuite.src/syn_definition.at +++ b/tests/testsuite.src/syn_definition.at @@ -2216,7 +2216,7 @@ AT_CLEANUP AT_SETUP([TYPEDEF clause]) -AT_KEYWORDS([definition EXTERNAL GLOBAL TYPE USAGE listing symbols]) +AT_KEYWORDS([definition EXTERNAL GLOBAL TYPE USAGE listing symbols xref]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -2245,7 +2245,9 @@ AT_DATA([prog.cob], [ 49 MT3 USAGE MESSAGE-TEXT-2T. 49 MT3-REN REDEFINES MT3 USAGE MESSAGE-TEXT-2T. - 77 CALCULUS PIC S9(15)V9(03) IS TYPEDEF. + 01 CALCULUS PIC S9(15)V9(03) IS TYPEDEF. + 88 NO-DETAIL VALUE ZERO. + 88 MIN-DETAIL VALUE 0.001. 01 USER-TYPE IS TYPEDEF. 02 AMOUNT USAGE CALCULUS. 02 FILLER OCCURS 100. @@ -2253,6 +2255,7 @@ AT_DATA([prog.cob], [ 01 USER-VAR USAGE USER-TYPE. 01 PROC USAGE PROGRAM-POINTER IS TYPEDEF. + 88 PROC-UNSET VALUE NULL. 77 MY-PROC USAGE PROC VALUE NULL. PROCEDURE DIVISION. @@ -2361,10 +2364,10 @@ prog.cob:21: error: USAGE type-name does not conform to COBOL 2002 prog.cob:23: error: USAGE type-name does not conform to COBOL 2002 prog.cob:25: error: USAGE type-name does not conform to COBOL 2002 prog.cob:26: error: USAGE type-name does not conform to COBOL 2002 -prog.cob:30: error: USAGE type-name does not conform to COBOL 2002 prog.cob:32: error: USAGE type-name does not conform to COBOL 2002 -prog.cob:33: error: USAGE type-name does not conform to COBOL 2002 -prog.cob:36: error: USAGE type-name does not conform to COBOL 2002 +prog.cob:34: error: USAGE type-name does not conform to COBOL 2002 +prog.cob:35: error: USAGE type-name does not conform to COBOL 2002 +prog.cob:39: error: USAGE type-name does not conform to COBOL 2002 ]) AT_CHECK([$COMPILE_ONLY -std=mf-strict prog.cob], [0], [], []) AT_CHECK([$COMPILE_ONLY progstd.cob], [0], [], []) @@ -2394,9 +2397,55 @@ badprog.cob:11: error: illegal combination of TYPE TO with other clauses badprog.cob:12: error: elementary item expected ]) +# FIXME: mises NO-DETAIL above MIN-DETAIL (likely bug in copying in field.c) + +AT_CHECK([$COMPILE_LISTING0 -t - -Xref -fno-tsource -fno-tmessages prog.cob], +[0], +[GnuCOBOL V.R.P prog.cob + +NAME DEFINED REFERENCES + +AUSGABE-FILE-NAME-T 6 13 17 x2 +SOME-VERY-LONG-TYPEDEF-NAME 7 10 21 x2 +AUSGABE-FILE-NAME-2T 8 16 23 x2 +MESSAGE-TEXT-2T 12 19 25 26 x3 +MESSAGE-TEXT-2 19 42 x1 +AUSGABE-FILE-NAME 21 42 x1 +AUSGABE-FILE-NAME-2 21 referenced by parent +DETAIL-NO 21 referenced by parent +OUTPUT-NAME 21 45 x1 +Z-MESSAGE-T2 23 43 x1 +DETAIL-NO 24 43 x1 +Z-MESSAGE-T3 24 referenced by child +MT3 25 44 x1 +AUSGABE-FILE-NAME 26 44 x1 +AUSGABE-FILE-NAME-2 26 referenced by parent +DETAIL-NO 26 referenced by parent +MT3-REN 26 not referenced +AUSGABE-FILE-NAME 28 not referenced +AUSGABE-FILE-NAME-2 28 not referenced +DETAIL-NO 28 not referenced +CALCULUS 28 32 34 x2 +USER-TYPE 31 35 x1 +USER-VAR 35 referenced by child +AMOUNT 37 *46 47 x2 +MIN-DETAIL 37 not referenced +GRP-AMOUNT 37 *47 x1 +MIN-DETAIL 37 not referenced +PROC 37 39 x1 +MY-PROC 39 48 *49 x2 +PROC-UNSET 41 not referenced + + +LABEL DEFINED REFERENCES + +E prog 42 + +], []) + AT_CAPTURE_FILE([symbols.lst]) -AT_CHECK([$COMPILE_ONLY -std=mf-strict -t symbols.lst -ftsymbols -fno-tsource -fno-tmessages -tlines=0 prog.cob], +AT_CHECK([$COMPILE_LISTING0 -t symbols.lst -ftsymbols -fno-tsource -fno-tmessages prog.cob], [0], [], []) AT_CHECK([test "$COB_HAS_64_BIT_POINTER" = "yes"], [0], [], [], [ @@ -2404,21 +2453,21 @@ AT_CHECK([test "$COB_HAS_64_BIT_POINTER" = "yes"], [0], [], [], [ # Previous test "failed" --> 32 bit AT_DATA([prog-32.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY +[GnuCOBOL V.R.P prog.cob SIZE TYPE LVL NAME PICTURE WORKING-STORAGE SECTION -00050 ALPHANUMERIC 01 AUSGABE-FILE-NAME-T X(50) +00050 T ALPHANUMERIC 01 AUSGABE-FILE-NAME-T X(50) -00004 NUMERIC 01 SOME-VERY-LONG-TYPEDEF-NAME 9999 +00004 T NUMERIC 01 SOME-VERY-LONG-TYPEDEF-NAME 9999 -00008 GROUP 01 AUSGABE-FILE-NAME-2T +00008 T GROUP 01 AUSGABE-FILE-NAME-2T 00004 NUMERIC 05 FILLER 9999 00004 NUMERIC 05 DETAIL-NO SOME-VERY-LONG-TYPEDE... -00108 GROUP 01 MESSAGE-TEXT-2T +00108 T GROUP 01 MESSAGE-TEXT-2T 00050 ALPHANUMERIC 02 AUSGABE-FILE-NAME AUSGABE-FILE-NAME-T 00004 GROUP 02 FILLER, REDEFINES AUSGABE-FILE-NAME 00004 NUMERIC 05 FILLER 9999 @@ -2435,44 +2484,47 @@ SIZE TYPE LVL NAME PICTURE 00108 GROUP 49 MT3 MESSAGE-TEXT-2T 00108 GROUP 49 MT3-REN MESSAGE-TEXT-2T, REDEFINES MT3 -00018 NUMERIC 77 CALCULUS S9(15)V9(03) +00018 T NUMERIC 01 CALCULUS S9(15)V9(03) + CONDITIONAL 88 NO-DETAIL + CONDITIONAL 88 MIN-DETAIL -01818 GROUP 01 USER-TYPE +01818 T GROUP 01 USER-TYPE 00018 NUMERIC 02 AMOUNT CALCULUS 01800 GROUP 02 FILLER OCCURS 100 00018 NUMERIC 05 GRP-AMOUNT CALCULUS 01818 GROUP 01 USER-VAR USER-TYPE -00004 POINTER 01 PROC PROGRAM-POINTER +00004 T POINTER 01 PROC PROGRAM-POINTER + CONDITIONAL 88 PROC-UNSET 00004 POINTER 77 MY-PROC PROC ]) -AT_CHECK([gcdiff prog-32.lst symbols.lst], [0], [], []) +AT_CHECK([diff prog-32.lst symbols.lst], [0], [], []) ] , [ # Previous test "passed" --> 64 bit AT_DATA([prog-64.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY +[GnuCOBOL V.R.P prog.cob SIZE TYPE LVL NAME PICTURE WORKING-STORAGE SECTION -00050 ALPHANUMERIC 01 AUSGABE-FILE-NAME-T X(50) +00050 T ALPHANUMERIC 01 AUSGABE-FILE-NAME-T X(50) -00004 NUMERIC 01 SOME-VERY-LONG-TYPEDEF-NAME 9999 +00004 T NUMERIC 01 SOME-VERY-LONG-TYPEDEF-NAME 9999 -00008 GROUP 01 AUSGABE-FILE-NAME-2T +00008 T GROUP 01 AUSGABE-FILE-NAME-2T 00004 NUMERIC 05 FILLER 9999 00004 NUMERIC 05 DETAIL-NO SOME-VERY-LONG-TYPEDE... -00108 GROUP 01 MESSAGE-TEXT-2T +00108 T GROUP 01 MESSAGE-TEXT-2T 00050 ALPHANUMERIC 02 AUSGABE-FILE-NAME AUSGABE-FILE-NAME-T 00004 GROUP 02 FILLER, REDEFINES AUSGABE-FILE-NAME 00004 NUMERIC 05 FILLER 9999 @@ -2489,23 +2541,26 @@ SIZE TYPE LVL NAME PICTURE 00108 GROUP 49 MT3 MESSAGE-TEXT-2T 00108 GROUP 49 MT3-REN MESSAGE-TEXT-2T, REDEFINES MT3 -00018 NUMERIC 77 CALCULUS S9(15)V9(03) +00018 T NUMERIC 01 CALCULUS S9(15)V9(03) + CONDITIONAL 88 NO-DETAIL + CONDITIONAL 88 MIN-DETAIL -01818 GROUP 01 USER-TYPE +01818 T GROUP 01 USER-TYPE 00018 NUMERIC 02 AMOUNT CALCULUS 01800 GROUP 02 FILLER OCCURS 100 00018 NUMERIC 05 GRP-AMOUNT CALCULUS 01818 GROUP 01 USER-VAR USER-TYPE -00008 POINTER 01 PROC PROGRAM-POINTER +00008 T POINTER 01 PROC PROGRAM-POINTER + CONDITIONAL 88 PROC-UNSET 00008 POINTER 77 MY-PROC PROC ]) -AT_CHECK([gcdiff prog-64.lst symbols.lst], [0], [], []) +AT_CHECK([diff prog-64.lst symbols.lst], [0], [], []) ])