Добавлен автокаст типов-записей

diff --git a/notes b/notes
index 22d31b00a218c48a188e3cab11cd8c120c475545..2f6fc268841c8c8fb378f328265f345dbe99753f 100644 (file)
--- a/notes
+++ b/notes
@@ -1,5 +1,4 @@
 - Нет оператора IS
-- Нет автокаста записей
 - Нужно изменить передачу информации о вызываемой процедуре в MODE_CALL
    На данный момент конкретная процедура передаётся в поле var, вместо parent
    Что не позволяет делать процедуры-переменные в полях записей, массивах и т.д.

diff --git a/src/oberon.c b/src/oberon.c
index 6aa94d602fd9da13bb67174ecf2dc6632f9c2d4a..cefd46928194b60c17099c25211692000f067ff4 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -767,6 +767,18 @@ oberon_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * p
        return cast;
 }
 
+static oberon_expr_t *
+oberno_make_record_cast(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * rec)
+{
+       if(expr -> result -> class != OBERON_TYPE_RECORD
+               || rec -> class != OBERON_TYPE_RECORD)
+       {
+               oberon_error(ctx, "must be record type");
+       }
+
+       return oberon_cast_expr(ctx, expr, rec);
+}
+
 static oberon_type_t *
 oberon_get_equal_expr_type(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b)
 {
@@ -841,11 +853,20 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
        }
        else if(pref -> class == OBERON_TYPE_RECORD)
        {
-               if(expr -> result != pref)
+               oberon_type_t * t = expr -> result;
+               while(t != NULL && t != pref)
+               {
+                       t = t -> base;
+               }
+               if(t == NULL)
                {
                        printf("oberon_autocast_to: rec %p != %p\n", expr -> result, pref);
                        oberon_error(ctx, "incompatible record types");
                }
+               if(expr -> result != pref)
+               {
+                       expr = oberno_make_record_cast(ctx, expr, pref);
+               }
        }
        else if(pref -> class == OBERON_TYPE_POINTER)
        {
@@ -1195,18 +1216,6 @@ oberon_qualident(oberon_context_t * ctx, char ** xname, int check)
        return x;
 }
 
-static oberon_expr_t *
-oberno_make_record_cast(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * rec)
-{
-       if(expr -> result -> class != OBERON_TYPE_RECORD
-               || rec -> class != OBERON_TYPE_RECORD)
-       {
-               oberon_error(ctx, "must be record type");
-       }
-
-       return oberon_cast_expr(ctx, expr, rec);
-}
-
 static oberon_expr_t *
 oberon_designator(oberon_context_t * ctx)
 {

diff --git a/src/test.c b/src/test.c
index 7a449d63c16f129c4fd450d3b537d2d5240bd7fc..c6d49e48cb3b54951d1ce87cb7ce6f3b255f7789 100644 (file)
--- a/src/test.c
+++ b/src/test.c
@@ -20,12 +20,13 @@ static char source_test[] =
        ""
        "VAR"
        "  baser : Baser;"
-       "  r : R1;"
-       "  inv : R2;"
+       "  r     : R1;"
+       "  inv   : R2;"
        ""
        "BEGIN"
        "  r.a := 1;"
-       "  baser := r(Baser);"
+       "  baser := baser;"
+       "  baser := r;"
        "END Test."
 ;