void ambiguous_error (cb_tree x) { struct cb_word *w; struct cb_field *p; struct cb_label *l2; cb_tree l; cb_tree y; w = CB_REFERENCE (x)->word; if (w->error == 0) { if (!errnamebuff) { errnamebuff = cobc_malloc (COB_NORMAL_BUFF); } /* display error on the first time */ snprintf (errnamebuff, COB_NORMAL_MAX, "'%s'", CB_NAME (x)); for (l = CB_REFERENCE (x)->chain; l; l = CB_REFERENCE (l)->chain) { strcat (errnamebuff, " in '"); strcat (errnamebuff, CB_NAME (l)); strcat (errnamebuff, "'"); } cb_error_x (x, _("%s ambiguous; need qualification"), errnamebuff); w->error = 1; /* display all fields with the same name */ for (l = w->items; l; l = CB_CHAIN (l)) { y = CB_VALUE (l); snprintf (errnamebuff, COB_NORMAL_MAX, "'%s' ", w->name); switch (CB_TREE_TAG (y)) { case CB_TAG_FIELD: for (p = CB_FIELD (y)->parent; p; p = p->parent) { strcat (errnamebuff, "in '"); strcat (errnamebuff, p->name); strcat (errnamebuff, "' "); } break; case CB_TAG_LABEL: l2 = CB_LABEL (y); if (l2->section) { strcat (errnamebuff, "in '"); strcat (errnamebuff, (const char *)(l2->section->name)); strcat (errnamebuff, "' "); } break; default: break; } strcat (errnamebuff, _("defined here")); cb_error_x (y, errnamebuff); } } }
cb_tree cb_build_field_tree (cb_tree level, cb_tree name, struct cb_field *last_field, enum cb_storage storage, struct cb_file *fn) { struct cb_reference *r; struct cb_field *f; struct cb_field *p; struct cb_field *field_fill; cb_tree dummy_fill; cb_tree l; cb_tree x; int lv; if (level == cb_error_node || name == cb_error_node) { return cb_error_node; } /* check the level number */ lv = cb_get_level (level); if (!lv) { return cb_error_node; } /* build the field */ r = CB_REFERENCE (name); f = CB_FIELD (cb_build_field (name)); f->storage = storage; last_real_field = last_field; if (lv == 78) { f->level = 01; f->flag_item_78 = 1; return CB_TREE (f); } else { f->level = lv; } if (f->level == 01 && storage == CB_STORAGE_FILE) { if (fn->external) { f->flag_external = 1; has_external = 1; } else if (fn->global) { f->flag_is_global = 1; } } if (last_field) { if (last_field->level == 77 && f->level != 01 && f->level != 77 && f->level != 66 && f->level != 88) { cb_error_x (name, _("Level number must begin with 01 or 77")); return cb_error_node; } } /* checks for redefinition */ if (cb_warn_redefinition) { if (r->word->count > 1) { if (f->level == 01 || f->level == 77) { redefinition_warning (name, NULL); } else { for (l = r->word->items; l; l = CB_CHAIN (l)) { x = CB_VALUE (l); if (!CB_FIELD_P (x) || CB_FIELD (x)->level == 01 || CB_FIELD (x)->level == 77 || (f->level == last_field->level && CB_FIELD (x)->parent == last_field->parent)) { redefinition_warning (name, x); break; } } } } } if (last_field && last_field->level == 88) { last_field = last_field->parent; } /* link the field into the tree */ if (f->level == 01 || f->level == 77) { /* top level */ cb_needs_01 = 0; if (last_field) { /* cb_field_add (cb_field_founder (last_field), f); */ cb_field_founder (last_field)->sister = f; } } else if (!last_field || cb_needs_01) { /* invalid top level */ cb_error_x (name, _("Level number must begin with 01 or 77")); return cb_error_node; } else if (f->level == 66) { /* level 66 */ f->parent = cb_field_founder (last_field); for (p = f->parent->children; p && p->sister; p = p->sister) ; if (p) { p->sister = f; } } else if (f->level == 88) { /* level 88 */ f->parent = last_field; } else if (f->level > last_field->level) { /* lower level */ last_field->children = f; f->parent = last_field; } else if (f->level == last_field->level) { /* same level */ same_level: last_field->sister = f; f->parent = last_field->parent; } else { /* upper level */ for (p = last_field->parent; p; p = p->parent) { if (p->level == f->level) { last_field = p; goto same_level; } if (cb_relax_level_hierarchy && p->level < f->level) { break; } } if (cb_relax_level_hierarchy) { dummy_fill = cb_build_filler (); field_fill = CB_FIELD (cb_build_field (dummy_fill)); cb_warning_x (name, _("No previous data item of level %02d"), f->level); field_fill->level = f->level; field_fill->storage = storage; field_fill->children = p->children; field_fill->parent = p; for (p = p->children; p != NULL; p = p->sister) { p->parent = field_fill; } field_fill->parent->children = field_fill; field_fill->sister = f; f->parent = field_fill->parent; last_field = field_fill; } else { cb_error_x (name, _("No previous data item of level %02d"), f->level); return cb_error_node; } } /* inherit parent's properties */ if (f->parent) { f->usage = f->parent->usage; f->indexes = f->parent->indexes; f->flag_sign_leading = f->parent->flag_sign_leading; f->flag_sign_separate = f->parent->flag_sign_separate; f->flag_is_global = f->parent->flag_is_global; } return CB_TREE (f); }
static int validate_field_1 (struct cb_field *f) { cb_tree x; cb_tree l; char *name; struct cb_field *p; char *pp; unsigned char *pstr; int vorint; int need_picture; char pic[16]; x = CB_TREE (f); name = cb_name (x); if (f->flag_any_length) { if (f->storage != CB_STORAGE_LINKAGE) { cb_error_x (x, _("'%s' ANY LENGTH only allowed in LINKAGE"), name); return -1; } if (f->level != 01) { cb_error_x (x, _("'%s' ANY LENGTH must be 01 level"), name); return -1; } if (f->flag_item_based || f->flag_external) { cb_error_x (x, _("'%s' ANY LENGTH can not be BASED/EXTERNAL"), name); return -1; } if (f->flag_occurs || f->occurs_depending || f->children || f->values || f->flag_blank_zero) { cb_error_x (x, _("'%s' ANY LENGTH has invalid definition"), name); return -1; } if (!f->pic) { cb_error_x (x, _("'%s' ANY LENGTH must have a PICTURE"), name); return -1; } if (f->pic->size != 1 || f->usage != CB_USAGE_DISPLAY) { cb_error_x (x, _("'%s' ANY LENGTH has invalid definition"), name); return -1; } f->count++; return 0; } if (f->level == 77) { if (f->storage != CB_STORAGE_WORKING && f->storage != CB_STORAGE_LOCAL && f->storage != CB_STORAGE_LINKAGE) { cb_error_x (x, _("'%s' 77 level not allowed here"), name); } } if (f->flag_external) { if (f->level != 01 && f->level != 77) { cb_error_x (x, _("'%s' EXTERNAL must be specified at 01/77 level"), name); } if (f->storage != CB_STORAGE_WORKING && f->storage != CB_STORAGE_FILE) { cb_error_x (x, _("'%s' EXTERNAL can only be specified in WORKING-STORAGE section"), name); } if (f->flag_item_based) { cb_error_x (x, _("'%s' EXTERNAL and BASED are mutually exclusive"), name); } if (f->redefines) { cb_error_x (x, _("'%s' EXTERNAL not allowed with REDEFINES"), name); } } if (f->flag_item_based) { if (f->storage != CB_STORAGE_WORKING && f->storage != CB_STORAGE_LOCAL && f->storage != CB_STORAGE_LINKAGE) { cb_error_x (x, _("'%s' BASED not allowed here"), name); } if (f->redefines) { cb_error_x (x, _("'%s' BASED not allowed with REDEFINES"), name); } if (f->level != 01 && f->level != 77) { cb_error_x (x, _("'%s' BASED only allowed at the 01 and 77 levels"), name); } } if (f->level == 66) { if (!f->redefines) { level_require_error (x, "RENAMES"); return -1; } if (f->flag_occurs) { level_except_error (x, "RENAMES"); } return 0; } /* validate OCCURS */ if (f->flag_occurs) { if ((!cb_verify (cb_top_level_occurs_clause, "01/77 OCCURS") && (f->level == 01 || f->level == 77)) || (f->level == 66 || f->level == 88)) { level_redundant_error (x, "OCCURS"); } for (l = f->index_list; l; l = CB_CHAIN (l)) { cb_field (CB_VALUE (l))->flag_is_global = f->flag_is_global; } } /* validate OCCURS DEPENDING */ if (f->occurs_depending) { /* the data item that contains a OCCURS DEPENDING clause shall not be subordinate to a data item that has the OCCURS clause */ for (p = f->parent; p; p = p->parent) { if (p->flag_occurs) { cb_error_x (CB_TREE (p), _("'%s' cannot have the OCCURS clause due to '%s'"), check_filler_name ((char *)p->name), check_filler_name (name)); break; } } /* the data item that contains a OCCURS DEPENDING clause must be the last data item in the group */ for (p = f; p->parent; p = p->parent) { for (; p->sister; p = p->sister) { if (p->sister == cb_field (f->occurs_depending)) { cb_error_x (x, _("'%s' ODO field item invalid here"), p->sister->name); } if (!p->sister->redefines) { if (!cb_complex_odo) { cb_error_x (x, _("'%s' cannot have OCCURS DEPENDING"), check_filler_name (name)); break; } } } } /* If the field is GLOBAL, then the ODO must also be GLOBAL */ if (f->flag_is_global) { if (!cb_field (f->occurs_depending)->flag_is_global) { cb_error_x (x, _("'%s' ODO item must have GLOBAL attribute"), cb_field (f->occurs_depending)->name); } if (f->storage != cb_field (f->occurs_depending)->storage) { cb_error_x (x, _("GLOBAL '%s' ODO item is not in the same section as OCCURS"), cb_field (f->occurs_depending)->name); } } } /* validate REDEFINES */ if (f->redefines) { /* check OCCURS */ if (f->redefines->flag_occurs) { cb_warning_x (x, _("The original definition '%s' should not have OCCURS"), f->redefines->name); } /* check definition */ for (p = f->redefines->sister; p && p != f; p = p->sister) { if (!p->redefines) { cb_error_x (x, _("REDEFINES must follow the original definition")); break; } } /* check variable occurrence */ if (f->occurs_depending || cb_field_variable_size (f)) { cb_error_x (x, _("'%s' cannot be variable length"), f->name); } if (cb_field_variable_size (f->redefines)) { cb_error_x (x, _("The original definition '%s' cannot be variable length"), f->redefines->name); } } if (f->children) { /* group item */ if (f->pic) { group_error (x, "PICTURE"); } if (f->flag_justified) { group_error (x, "JUSTIFIED RIGHT"); } if (f->flag_blank_zero) { group_error (x, "BLANK WHEN ZERO"); } for (f = f->children; f; f = f->sister) { if (validate_field_1 (f) != 0) { return -1; } } } else { /* elementary item */ /* validate PICTURE */ need_picture = 1; if (f->usage == CB_USAGE_INDEX || f->usage == CB_USAGE_LENGTH || f->usage == CB_USAGE_OBJECT || f->usage == CB_USAGE_POINTER || f->usage == CB_USAGE_PROGRAM_POINTER || f->usage == CB_USAGE_FLOAT || f->usage == CB_USAGE_DOUBLE || f->usage == CB_USAGE_SIGNED_CHAR || f->usage == CB_USAGE_SIGNED_SHORT || f->usage == CB_USAGE_SIGNED_INT || f->usage == CB_USAGE_SIGNED_LONG || f->usage == CB_USAGE_UNSIGNED_CHAR || f->usage == CB_USAGE_UNSIGNED_SHORT || f->usage == CB_USAGE_UNSIGNED_INT || f->usage == CB_USAGE_UNSIGNED_LONG || f->usage == CB_USAGE_PROGRAM) { need_picture = 0; } if (f->pic == NULL && need_picture != 0) { if (f->storage == CB_STORAGE_SCREEN) { /* RXW if (f->values && CB_LITERAL(CB_VALUE(f->values))->size) { */ if (f->values) { sprintf (pic, "X(%d)", (int)CB_LITERAL(CB_VALUE(f->values))->size); } else { sprintf (pic, "X(1)"); } f->pic = CB_PICTURE (cb_build_picture (pic)); } else if (f->flag_item_78 && f->values && CB_VALUE(f->values) != cb_error_node) { f->count++; if (CB_NUMERIC_LITERAL_P(CB_VALUE(f->values))) { memset (pic, 0, sizeof (pic)); pp = pic; if (CB_LITERAL(CB_VALUE(f->values))->sign) { *pp++ = 'S'; } vorint = CB_LITERAL(CB_VALUE(f->values))->size - CB_LITERAL(CB_VALUE(f->values))->scale; if (vorint) { pp += sprintf (pp, "9(%d)", vorint); } if (CB_LITERAL(CB_VALUE(f->values))->scale) { sprintf (pp, "V9(%d)", CB_LITERAL(CB_VALUE(f->values))->scale); } if (CB_LITERAL(CB_VALUE(f->values))->size < 10) { f->usage = CB_USAGE_COMP_5; } else { f->usage = CB_USAGE_DISPLAY; } f->pic = CB_PICTURE (cb_build_picture (pic)); f->pic->category = CB_CATEGORY_NUMERIC; } else { sprintf (pic, "X(%d)", (int)CB_LITERAL(CB_VALUE(f->values))->size); f->pic = CB_PICTURE (cb_build_picture (pic)); f->pic->category = CB_CATEGORY_ALPHANUMERIC; f->usage = CB_USAGE_DISPLAY; } } else { if (f->flag_item_78) { cb_error_x (x, _("Value required for constant item '%s'"), name); } else { cb_error_x (x, _("PICTURE clause required for '%s'"), check_filler_name (name)); } return -1; } } if (f->pic != NULL && need_picture == 0) { cb_error_x (x, _("'%s' cannot have PICTURE clause"), check_filler_name (name)); } /* validate USAGE */ switch (f->usage) { case CB_USAGE_SIGNED_CHAR: f->usage = CB_USAGE_COMP_5; f->pic = CB_PICTURE (cb_build_picture ("S99")); f->flag_real_binary = 1; break; case CB_USAGE_SIGNED_SHORT: f->usage = CB_USAGE_COMP_5; f->pic = CB_PICTURE (cb_build_picture ("S9(4)")); f->flag_real_binary = 1; break; case CB_USAGE_SIGNED_INT: f->usage = CB_USAGE_COMP_5; f->pic = CB_PICTURE (cb_build_picture ("S9(9)")); f->flag_real_binary = 1; break; case CB_USAGE_SIGNED_LONG: f->usage = CB_USAGE_COMP_5; f->pic = CB_PICTURE (cb_build_picture ("S9(18)")); f->flag_real_binary = 1; break; case CB_USAGE_UNSIGNED_CHAR: f->usage = CB_USAGE_COMP_5; f->pic = CB_PICTURE (cb_build_picture ("99")); f->flag_real_binary = 1; break; case CB_USAGE_UNSIGNED_SHORT: f->usage = CB_USAGE_COMP_5; f->pic = CB_PICTURE (cb_build_picture ("9(4)")); f->flag_real_binary = 1; break; case CB_USAGE_UNSIGNED_INT: f->usage = CB_USAGE_COMP_5; f->pic = CB_PICTURE (cb_build_picture ("9(9)")); f->flag_real_binary = 1; break; case CB_USAGE_UNSIGNED_LONG: f->usage = CB_USAGE_COMP_5; f->pic = CB_PICTURE (cb_build_picture ("9(18)")); f->flag_real_binary = 1; break; case CB_USAGE_BINARY: case CB_USAGE_PACKED: if (f->pic->category != CB_CATEGORY_NUMERIC) { cb_error_x (x, _("'%s' PICTURE clause not compatible with USAGE"), name); } break; case CB_USAGE_COMP_5: case CB_USAGE_COMP_X: if (f->pic) { if (f->pic->category != CB_CATEGORY_NUMERIC && f->pic->category != CB_CATEGORY_ALPHANUMERIC) { cb_error_x (x, _("'%s' PICTURE clause not compatible with USAGE"), name); } } break; default: break; } /* validate SIGN */ /* validate JUSTIFIED RIGHT */ if (f->flag_justified) { switch (f->pic->category) { case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: break; default: cb_error_x (x, _("'%s' cannot have JUSTIFIED RIGHT"), name); break; } } /* validate SYNCHRONIZED */ /* validate BLANK ZERO */ if (f->flag_blank_zero) { switch (f->pic->category) { case CB_CATEGORY_NUMERIC: /* reconstruct the picture string */ if (f->pic->scale > 0) { f->pic->str = cobc_malloc (20); pstr = (unsigned char *)(f->pic->str); *pstr++ = '9'; vorint = f->pic->digits - f->pic->scale; memcpy (pstr, (unsigned char *)&vorint, sizeof(int)); pstr += sizeof(int); *pstr++ = 'V'; vorint = 1; memcpy (pstr, (unsigned char *)&vorint, sizeof(int)); pstr += sizeof(int); *pstr++ = '9'; vorint = f->pic->scale; memcpy (pstr, (unsigned char *)&vorint, sizeof(int)); f->pic->size++; } else { f->pic->str = cobc_malloc (8); pstr = (unsigned char *)(f->pic->str); *pstr++ = '9'; vorint = f->pic->digits; memcpy (pstr, (unsigned char *)&vorint, sizeof(int)); } f->pic->category = CB_CATEGORY_NUMERIC_EDITED; break; case CB_CATEGORY_NUMERIC_EDITED: break; default: cb_error_x (x, _("'%s' cannot have BLANK WHEN ZERO"), name); break; } } /* validate VALUE */ if (f->values) { if (CB_PAIR_P (CB_VALUE (f->values)) || CB_CHAIN (f->values)) { cb_error_x (x, _("Only level 88 item may have multiple values")); } /* ISO+IEC+1989-2002: 13.16.42.2-10 */ for (p = f; p; p = p->parent) { if (p->redefines) { cb_error_x (x, _("Entries under REDEFINES cannot have VALUE clause")); } if (p->flag_external) { cb_warning_x (x, _("VALUE clause ignored for EXTERNAL items")); } } } } return 0; }