Ejemplo n.º 1
0
void
level_except_error (cb_tree x, const char *clause)
{
	cb_error_x (x, _("Level %02d item '%s' cannot have other than %s clause"),
		    cb_field (x)->level, check_filler_name (cb_name (x)), clause);
}
Ejemplo n.º 2
0
void
group_error (cb_tree x, const char *clause)
{
	cb_error_x (x, _("Group item '%s' cannot have %s clause"), check_filler_name (cb_name (x)), clause);
}
Ejemplo n.º 3
0
void
level_require_error (cb_tree x, const char *clause)
{
	cb_error_x (x, _("Level %02d item '%s' requires %s clause"),
		    cb_field (x)->level, check_filler_name (cb_name (x)), clause);
}
Ejemplo n.º 4
0
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;
}