diff --git a/src/oberon.c b/src/oberon.c
index 349015dc163318316d7ccbc8c40e964b9c78839f..ece881fc44366290a324ac54b55def84b1c9804b 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
return expr;
}
+static oberon_expr_t *
+oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_object_t * objtype)
+{
+ oberon_type_t * type;
+
+ if(objtype -> class != OBERON_CLASS_TYPE)
+ {
+ oberon_error(ctx, "must be type");
+ }
+ type = objtype -> type;
+
+ /* Охрана типа применима, если */
+ /* 1. v - параметр-переменная типа запись, или v - указатель, и если */
+ /* 2. T - расширение статического типа v */
+
+ if(expr -> is_item
+ && expr -> item.mode == MODE_VAR
+ && expr -> item.var -> class == OBERON_CLASS_VAR_PARAM)
+ {
+ // accept
+ }
+ else if(expr -> result -> class == OBERON_TYPE_POINTER)
+ {
+ // accept
+ }
+ else
+ {
+ oberon_error(ctx, "guard type used only with var-param or pointers");
+ }
+
+ oberon_check_record_compatibility(ctx, type, expr -> result);
+ return oberno_make_record_cast(ctx, expr, objtype -> type);
+}
+
static oberon_expr_t *
oberon_designator(oberon_context_t * ctx)
{
char * name;
oberon_expr_t * expr;
+ oberon_object_t * objtype;
expr = oberon_qualident_expr(ctx);
break;
case LPAREN:
oberon_assert_token(ctx, LPAREN);
- oberon_object_t * objtype = oberon_qualident(ctx, NULL, 1);
- if(objtype -> class != OBERON_CLASS_TYPE)
- {
- oberon_error(ctx, "must be type");
- }
+ objtype = oberon_qualident(ctx, NULL, true);
oberon_assert_token(ctx, RPAREN);
- expr = oberno_make_record_cast(ctx, expr, objtype -> type);
+ expr = oberon_make_type_guard(ctx, expr, objtype);
break;
default:
oberon_error(ctx, "oberon_designator: wat");