Исправлен экспорт полей и экспорт для "только чтения"

diff --git a/generator.c b/generator.c
index 991b6dd83c416be4d19a81a0722c30f29d6e12d5..ff4896d3880de3b018213680a62c216a192e05da 100644 (file)
--- a/generator.c
+++ b/generator.c
@@ -161,25 +161,31 @@ oberon_generator_get_full_name(char * name, int max_len, oberon_object_t * x)
                return;
        }
 
-       char parent[256];
-       parent[0] = 0;
-
+       int add_module_prefix;
        switch(x -> class)
        {
                case OBERON_CLASS_FIELD:
                case OBERON_CLASS_PARAM:
                case OBERON_CLASS_VAR_PARAM:
                        /* В локальных областях префиксы излишни */
+                       add_module_prefix = 0;
                        break;
                default:
-                       oberon_generator_get_full_name(parent, 256, x -> parent);
+                       add_module_prefix = 1;
                        break;
        }
 
+       char parent[256];
+       oberon_generator_get_full_name(parent, 256, x -> parent);
+
        if(strlen(parent) > 0)
        {
                snprintf(name, max_len, "%s_%s", parent, x -> name);
        }
+       else if(add_module_prefix)
+       {
+               snprintf(name, max_len, "%s_%s", x -> module -> name, x -> name);
+       }
        else
        {
                snprintf(name, max_len, "%s", x -> name);

diff --git a/notes b/notes
index 148c0b4607839a11b72ca610804dd7e425fdf2ad..c1a8b0b5dfc95559b85b6c5fdbf0dbad7a58e315 100644 (file)
--- a/notes
+++ b/notes
@@ -1,5 +1,3 @@
-- поля структур всегда доступны
-- нету проверки экспорта для чтения
 - нету комментариев
 
 - нету тестовых процедур для ввода-вывода

diff --git a/oberon.c b/oberon.c
index 5b4c4ea84efada1e388a0c775f4d363e16df49d8..b56a458a6c1e979a743c9d4139b5df3044f1cdc3 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -155,42 +155,13 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class, int export,
        newvar -> read_only = read_only;
        newvar -> local = scope -> local;
        newvar -> parent = scope -> parent;
+       newvar -> module = scope -> ctx -> mod;
 
        x -> next = newvar;
 
        return newvar;
 }
 
-/*
-static void
-oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char *  name, oberon_type_t * type)
-{
-       // TODO check base fields
-
-       oberon_object_t * x = rec -> decl;
-       while(x -> next && strcmp(x -> next -> name, name) != 0)
-       {
-               x = x -> next;
-       }
-
-       if(x -> next)
-       {
-               oberon_error(ctx, "multiple definition");
-       }
-
-       oberon_object_t * field = malloc(sizeof *field);
-       memset(field, 0, sizeof *field);
-       field -> name = name;
-       field -> class = OBERON_CLASS_FIELD;
-       field -> type = type;
-       field -> local = 1;
-       field -> parent = NULL;
-
-       rec -> num_decl += 1;
-       x -> next = field;
-}
-*/
-
 static oberon_object_t *
 oberon_find_object_in_list(oberon_object_t * list, char * name)
 {
@@ -554,6 +525,7 @@ oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon
 
        operator -> is_item = 0;
        operator -> result = result;
+       operator -> read_only = 1;
        operator -> op = op;
        operator -> left = left;
        operator -> right = right;
@@ -562,7 +534,7 @@ oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon
 }
 
 static oberon_expr_t *
-oberon_new_item(int mode, oberon_type_t * result)
+oberon_new_item(int mode, oberon_type_t * result, int read_only)
 {
        oberon_item_t * item;
         item = malloc(sizeof *item);
@@ -570,6 +542,7 @@ oberon_new_item(int mode, oberon_type_t * result)
 
        item -> is_item = 1;
        item -> result = result;
+       item -> read_only = read_only;
        item -> mode = mode;
 
        return (oberon_expr_t *)item;
@@ -776,7 +749,7 @@ oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_ar
                        oberon_error(ctx, "attempt to call procedure in expression");
                }
 
-               call = oberon_new_item(MODE_CALL, proc -> type -> base);
+               call = oberon_new_item(MODE_CALL, proc -> type -> base, 1);
                call -> item.var = proc;
                call -> item.num_args = num_args;
                call -> item.args = list_args;
@@ -827,7 +800,7 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_ar
                }
 
                oberon_expr_t * call;
-               call = oberon_new_item(MODE_CALL, proc -> type -> base);
+               call = oberon_new_item(MODE_CALL, proc -> type -> base, 1);
                call -> item.var = proc;
                call -> item.num_args = num_args;
                call -> item.args = list_args;
@@ -857,7 +830,7 @@ oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
        assert(expr -> is_item);
 
        oberon_expr_t * selector;
-       selector = oberon_new_item(MODE_DEREF, expr -> result -> base);
+       selector = oberon_new_item(MODE_DEREF, expr -> result -> base, expr -> read_only);
        selector -> item.parent = (oberon_item_t *) expr;
 
        return selector;
@@ -901,7 +874,7 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon
        }
 
        oberon_expr_t * selector;
-       selector = oberon_new_item(MODE_INDEX, base);
+       selector = oberon_new_item(MODE_INDEX, base, desig -> read_only);
        selector -> item.parent = (oberon_item_t *) desig;
        selector -> item.num_args = 1;
        selector -> item.args = index;
@@ -929,8 +902,25 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
        oberon_object_t * field;
        field = oberon_find_field(ctx, rec, name);
 
+       if(field -> export == 0)
+       {
+               if(field -> module != ctx -> mod)
+               {
+                       oberon_error(ctx, "field not exported");
+               }
+       }
+
+       int read_only = 0;
+       if(field -> read_only)
+       {
+               if(field -> module != ctx -> mod)
+               {
+                       read_only = 1;
+               }
+       }
+
        oberon_expr_t * selector;
-       selector = oberon_new_item(MODE_FIELD, field -> type);
+       selector = oberon_new_item(MODE_FIELD, field -> type, read_only);
        selector -> item.var = field;
        selector -> item.parent = (oberon_item_t *) expr;
 
@@ -984,6 +974,15 @@ oberon_designator(oberon_context_t * ctx)
 
        var = oberon_qualident(ctx, NULL, 1);
 
+       int read_only = 0;
+       if(var -> read_only)
+       {
+               if(var -> module != ctx -> mod)
+               {
+                       read_only = 1;
+               }
+       }
+
        switch(var -> class)
        {
                case OBERON_CLASS_CONST:
@@ -993,8 +992,10 @@ oberon_designator(oberon_context_t * ctx)
                case OBERON_CLASS_VAR:
                case OBERON_CLASS_VAR_PARAM:
                case OBERON_CLASS_PARAM:
+                       expr = oberon_new_item(MODE_VAR, var -> type, read_only);
+                       break;
                case OBERON_CLASS_PROC:
-                       expr = oberon_new_item(MODE_VAR, var -> type);
+                       expr = oberon_new_item(MODE_VAR, var -> type, 1);
                        break;
                default:
                        oberon_error(ctx, "invalid designator");
@@ -1098,17 +1099,17 @@ oberon_factor(oberon_context_t * ctx)
                        expr = oberon_opt_func_parens(ctx, expr);
                        break;
                case INTEGER:
-                       expr = oberon_new_item(MODE_INTEGER, ctx -> int_type);
+                       expr = oberon_new_item(MODE_INTEGER, ctx -> int_type, 1);
                        expr -> item.integer = ctx -> integer;
                        oberon_assert_token(ctx, INTEGER);
                        break;
                case TRUE:
-                       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type);
+                       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, 1);
                        expr -> item.boolean = 1;
                        oberon_assert_token(ctx, TRUE);
                        break;
                case FALSE:
-                       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type);
+                       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, 1);
                        expr -> item.boolean = 0;
                        oberon_assert_token(ctx, FALSE);
                        break;
@@ -1124,7 +1125,7 @@ oberon_factor(oberon_context_t * ctx)
                        break;
                case NIL:
                        oberon_assert_token(ctx, NIL);
-                       expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type);
+                       expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type, 1);
                        break;
                default:
                        oberon_error(ctx, "invalid expression");
@@ -2294,6 +2295,11 @@ oberon_decl_seq(oberon_context_t * ctx)
 static void
 oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 {
+       if(dst -> read_only)
+       {
+               oberon_error(ctx, "read-only destination");
+       }
+
        oberon_autocast_to(ctx, src, dst -> result);
        oberon_generate_assign(ctx, src, dst);
 }
@@ -2420,17 +2426,11 @@ oberon_parse_module(oberon_context_t * ctx)
        oberon_assert_token(ctx, SEMICOLON);
        ctx -> mod -> name = name1;
 
-       oberon_object_t * this_module;
-       this_module = oberon_define_object(ctx -> decl, name1, OBERON_CLASS_MODULE, 0, 0);
-       this_module -> module = ctx -> mod;
-
        if(ctx -> token == IMPORT)
        {
                oberon_import_list(ctx);
        }
 
-       ctx -> decl -> parent = this_module;
-
        oberon_decl_seq(ctx);
 
        oberon_generate_begin_module(ctx);

diff --git a/oberon.h b/oberon.h
index 86f95def78e74ccd07b87b82e8bdeefde13601eb..ef9ad7f1c891223eb2241ef8d4020e3855a50645 100644 (file)
--- a/oberon.h
+++ b/oberon.h
@@ -114,6 +114,8 @@ struct oberon_type_s
        oberon_type_t * base;
        oberon_object_t * decl;
 
+       oberon_module_t * module;
+
        int recursive;
        int initialized;
        gen_type_t * gen_type;
@@ -289,6 +291,7 @@ struct oberon_item_s
        int is_item; // == 1
        oberon_type_t * result;
        oberon_expr_t * next;
+       int read_only;
 
        int mode;
        int integer;
@@ -306,6 +309,7 @@ struct oberon_oper_s
        int is_item; // == 0
        oberon_type_t * result;
        oberon_expr_t * next;
+       int read_only;
 
        int op;
        oberon_expr_t * left;
@@ -318,6 +322,7 @@ union oberon_expr_u
                int is_item;
                oberon_type_t * result;
                oberon_expr_t * next;
+               int read_only;
        };
 
        oberon_item_t item;

diff --git a/test.c b/test.c
index 4bef02c8bd7bc3c33d0788d4243d49e875f575ad..541b3a57f55dae71a8936e0c696f6ad506084340 100644 (file)
--- a/test.c
+++ b/test.c
@@ -10,25 +10,29 @@ static char source_test[] =
        "VAR"
        "  x, y : I.Rider;"
        "PROCEDURE Proc(x, y, z : INTEGER);"
-       "END Proc;"
        "BEGIN"
-       "  x.i := 1;"
-       "  I.Ln;"
-       "  I.i := 666;"
+       "  x := 1;"
+       "END Proc;"
+       "BEGIN;"
+       "  y.i := 1;"
+       "  I.a[0] := 1;"
        "END Test."
 ;
 
 static char source_imported[] =
        "MODULE Imported;"
        "TYPE"
-       "       Rider* = RECORD i, j, k : INTEGER; END;"
+       "       Rider* = RECORD i*, j-, k : INTEGER; END;"
        "VAR"
        "       i- : INTEGER;"
+       "       a* : ARRAY 3 OF INTEGER;"
        ""
        "PROCEDURE Ln*;"
        "END Ln;"
        ""
        "BEGIN;"
+       "       i := 1;"
+       "       a[0] := 555;"
        "END Imported."
 ;