Исправлено присваивание NIL

diff --git a/Test.obn b/Test.obn
index f4deaccac3d5c739ec23505c314e13b8d333e776..98ac0e23e370819a8b9e96db5387e7f64d97eb65 100644 (file)
--- a/Test.obn
+++ b/Test.obn
@@ -1,17 +1,12 @@
 MODULE Test;
 
-IMPORT
-  Out,
-  System;
-
-TYPE
-  RBase = RECORD END;
-  R = RECORD (RBase) END;
+VAR
+  a : POINTER TO RECORD END;
+  b : POINTER TO ARRAY OF INTEGER;
+  c : PROCEDURE;
 
 BEGIN
-  Out.Open;
-  IF FALSE THEN
-    Out.String("Hello World!"); Out.Ln;
-  END;
-  System.Halt(1);
+  a := NIL;
+  b := NIL;
+  c := NIL;
 END Test.

diff --git a/Test4.obn b/Test4.obn
new file mode 100644 (file)
index 0000000..132f864
--- /dev/null
+++ b/Test4.obn
@@ -0,0 +1,12 @@
+MODULE Test4;
+
+VAR
+  a : POINTER TO RECORD END;
+  b : POINTER TO ARRAY OF INTEGER;
+  c : PROCEDURE;
+
+BEGIN
+  a := NIL;
+  b := NIL;
+  c := NIL;
+END Test4.

diff --git a/obn-run-tests.sh b/obn-run-tests.sh
index 6017f7e2865044cbe86f7cb78999cbaf82ee43f0..c665472c81c9a1bdb6767438573dea2b890a1562 100755 (executable)
--- a/obn-run-tests.sh
+++ b/obn-run-tests.sh
@@ -30,3 +30,4 @@ compile_false_positive()
 maketest Test1
 maketest Test2
 maketest Test3
+maketest Test4

diff --git a/src/backends/jvm/generator-jvm-basic.c b/src/backends/jvm/generator-jvm-basic.c
index fac9e0bc0def269786de76b60734d24cceb2fc6e..9c8b78c598e73aaacc9644309c4e5a654146ad44 100644 (file)
--- a/src/backends/jvm/generator-jvm-basic.c
+++ b/src/backends/jvm/generator-jvm-basic.c
@@ -53,7 +53,7 @@ jvm_get_descriptor(oberon_type_t * type)
 
        switch(type -> class)
        {
-               case OBERON_TYPE_VOID:
+               case OBERON_TYPE_NOTYPE:
                        return new_string("V");
                        break;
                case OBERON_TYPE_INTEGER:
@@ -194,6 +194,7 @@ jvm_get_prefix(oberon_type_t * type)
                case OBERON_TYPE_RECORD:
                case OBERON_TYPE_POINTER:
                case OBERON_TYPE_STRING:
+               case OBERON_TYPE_NIL:
                        return 'a';
                        break;
                case OBERON_TYPE_REAL:
@@ -261,6 +262,7 @@ jvm_get_postfix(oberon_type_t * type)
                case OBERON_TYPE_RECORD:
                case OBERON_TYPE_POINTER:
                case OBERON_TYPE_STRING:
+               case OBERON_TYPE_NIL:
                        return 'a';
                        break;
                case OBERON_TYPE_REAL:
@@ -397,7 +399,7 @@ jvm_cell_size_for_type(oberon_type_t * type)
                        return 2;
                }
        }
-       else if(type -> class == OBERON_TYPE_VOID)
+       else if(type -> class == OBERON_TYPE_NOTYPE)
        {
                return 0;
        }

diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c
index 9d5e1f4af7d58e970c49a0ad2665e0488ff36488..90b0e88f777caa2c3731b55241603b971d126af6 100644 (file)
--- a/src/backends/jvm/generator-jvm.c
+++ b/src/backends/jvm/generator-jvm.c
@@ -424,7 +424,7 @@ oberon_generate_procedure_pointer_class(oberon_object_t * proc)
        int cell_size = jvm_cell_size_for_type(proc -> type -> base);
        jvm_generate(p, use_size, cell_size, "invokestatic %s%s", full_name, signature);
 
-       if(proc -> type -> base -> class == OBERON_TYPE_VOID)
+       if(proc -> type -> base -> class == OBERON_TYPE_NOTYPE)
        {
                jvm_generate(p, 0, 0, "return");
        }
@@ -475,18 +475,23 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
        memset(t, 0, sizeof *t);
        type -> gen_type = t;
 
-       if(type -> class != OBERON_TYPE_VOID)
+       if(type -> class != OBERON_TYPE_NOTYPE)
        {
                t -> wide = jvm_is_wide_type(type);
                t -> prefix = jvm_get_prefix(type);
                t -> postfix = jvm_get_postfix(type);
        }
+
        t -> cell_size = jvm_cell_size_for_type(type);
-       t -> desc = jvm_get_descriptor(type);
+
+       if(type -> class != OBERON_TYPE_NIL)
+       {
+               t -> desc = jvm_get_descriptor(type);
+       }
 
        switch(type -> class)
        {
-               case OBERON_TYPE_VOID:
+               case OBERON_TYPE_NOTYPE:
                case OBERON_TYPE_INTEGER:
                case OBERON_TYPE_BOOLEAN:
                case OBERON_TYPE_ARRAY:
@@ -495,6 +500,7 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
                case OBERON_TYPE_CHAR:
                case OBERON_TYPE_STRING:
                case OBERON_TYPE_SET:
+               case OBERON_TYPE_NIL:
                        break;
                case OBERON_TYPE_RECORD:
                        ;

diff --git a/src/oberon-internals.h b/src/oberon-internals.h
index fa9b5d5280903bf0ea16496170cb3e81fcb69045..3c6fb853f1a824330eb773fa55a95b7ac0ffd16d 100644 (file)
--- a/src/oberon-internals.h
+++ b/src/oberon-internals.h
@@ -36,7 +36,7 @@ struct oberon_scope_t
 
 enum oberon_type_kind
 {
-       OBERON_TYPE_VOID,
+       OBERON_TYPE_NOTYPE,
        OBERON_TYPE_INTEGER,
        OBERON_TYPE_BOOLEAN,
        OBERON_TYPE_PROCEDURE,
@@ -46,7 +46,8 @@ enum oberon_type_kind
        OBERON_TYPE_REAL,
        OBERON_TYPE_CHAR,
        OBERON_TYPE_STRING,
-       OBERON_TYPE_SET
+       OBERON_TYPE_SET,
+       OBERON_TYPE_NIL
 };
 
 typedef oberon_expr_t * (*GenerateFuncCallback)(oberon_context_t *, int, oberon_expr_t *);
@@ -145,8 +146,8 @@ struct oberon_context_t
        oberon_module_t * mod;
        /*** END PARSER DATA ***/
 
-       oberon_type_t * void_type;
-       oberon_type_t * void_ptr_type;
+       oberon_type_t * notype_type;
+       oberon_type_t * nil_type;
        oberon_type_t * bool_type;
        oberon_type_t * byte_type;
        oberon_type_t * shortint_type;

diff --git a/src/oberon.c b/src/oberon.c
index bf5dad872cbdc3c420dec670d8c5de40c463f5d3..5a93489b35ed197ee2ac10b262a95c042583d146 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -1094,15 +1094,25 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
        // Допускается:
        //  Если классы типов равны
        //  Если INTEGER переводится в REAL
-       //  Есди STRING переводится в CHAR
-       //  Есди STRING переводится в ARRAY OF CHAR
+       //  Если STRING переводится в CHAR
+       //  Если STRING переводится в ARRAY OF CHAR
+       //  Если NIL переводится в POINTER
+       //  Если NIL переводится в PROCEDURE
 
        oberon_check_src(ctx, expr);
 
        bool error = false;
        if(pref -> class != expr -> result -> class)
        {
-               if(expr -> result -> class == OBERON_TYPE_STRING)
+               if(expr -> result -> class == OBERON_TYPE_NIL)
+               {
+                       if(pref -> class != OBERON_TYPE_POINTER
+                               && pref -> class != OBERON_TYPE_PROCEDURE)
+                       {
+                               error = true;
+                       }
+               }
+               else if(expr -> result -> class == OBERON_TYPE_STRING)
                {
                        if(pref -> class == OBERON_TYPE_CHAR)
                        {
@@ -1176,17 +1186,18 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
        else if(pref -> class == OBERON_TYPE_POINTER)
        {
                assert(pref -> base);
-               if(expr -> result -> base -> class == OBERON_TYPE_RECORD)
+               if(expr -> result -> class == OBERON_TYPE_NIL)
+               {
+                       // do nothing
+               }
+               else if(expr -> result -> base -> class == OBERON_TYPE_RECORD)
                {
                        oberon_check_record_compatibility(ctx, expr -> result, pref);
                        expr = oberno_make_record_cast(ctx, expr, pref);
                }
                else if(expr -> result -> base != pref -> base)
                {
-                       if(expr -> result -> base -> class != OBERON_TYPE_VOID)
-                       {
-                               oberon_error(ctx, "incompatible pointer types");
-                       }
+                       oberon_error(ctx, "incompatible pointer types");
                }
        }
 
@@ -1285,7 +1296,7 @@ oberon_make_call_func(oberon_context_t * ctx, oberon_item_t * item, int num_args
        }
        else
        {
-               if(signature -> base -> class == OBERON_TYPE_VOID)
+               if(signature -> base -> class == OBERON_TYPE_NOTYPE)
                {
                        oberon_error(ctx, "attempt to call procedure in expression");
                }
@@ -1322,7 +1333,7 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args
        }
        else
        {
-               if(signature -> base -> class != OBERON_TYPE_VOID)
+               if(signature -> base -> class != OBERON_TYPE_NOTYPE)
                {
                        oberon_error(ctx, "attempt to call function as non-typed procedure");
                }
@@ -1807,7 +1818,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, true);
+                       expr = oberon_new_item(MODE_NIL, ctx -> nil_type, true);
                        break;
                default:
                        oberon_error(ctx, "invalid expression");
@@ -2262,7 +2273,7 @@ oberon_var_decl(oberon_context_t * ctx)
        int num;
        oberon_object_t * list;
        oberon_type_t * type;
-       type = oberon_new_type_ptr(OBERON_TYPE_VOID);
+       type = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
 
        oberon_ident_list(ctx, OBERON_CLASS_VAR, false, &num, &list);
        oberon_assert_token(ctx, COLON);
@@ -2293,7 +2304,7 @@ oberon_fp_section(oberon_context_t * ctx, int * num_decl)
        oberon_assert_token(ctx, COLON);
 
        oberon_type_t * type;
-       type = oberon_new_type_ptr(OBERON_TYPE_VOID);
+       type = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
        oberon_type(ctx, &type);
 
        oberon_object_t * param = list;
@@ -2348,7 +2359,7 @@ oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type)
        signature = *type;
        signature -> class = OBERON_TYPE_PROCEDURE;
        signature -> num_decl = 0;
-       signature -> base = ctx -> void_type;
+       signature -> base = ctx -> notype_type;
        signature -> decl = NULL;
 
        if(ctx -> token == LPAREN)
@@ -2391,7 +2402,7 @@ oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
        oberon_object_t * proc = ctx -> decl -> parent;
        oberon_type_t * result_type = proc -> type -> base;
 
-       if(result_type -> class == OBERON_TYPE_VOID)
+       if(result_type -> class == OBERON_TYPE_NOTYPE)
        {
                if(expr != NULL)
                {
@@ -2437,7 +2448,7 @@ oberon_proc_decl_body(oberon_context_t * ctx, oberon_object_t * proc)
                oberon_error(ctx, "procedure name not matched");
        }
 
-       if(proc -> type -> base -> class == OBERON_TYPE_VOID
+       if(proc -> type -> base -> class == OBERON_TYPE_NOTYPE
                && proc -> has_return == 0)
        {
                oberon_make_return(ctx, NULL);
@@ -2475,7 +2486,7 @@ oberon_proc_decl(oberon_context_t * ctx)
        ctx -> decl -> local = 1;
 
        oberon_type_t * signature;
-       signature = oberon_new_type_ptr(OBERON_TYPE_VOID);
+       signature = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
        oberon_opt_formal_pars(ctx, &signature);        
 
        //oberon_initialize_decl(ctx);
@@ -2582,7 +2593,7 @@ oberon_qualident_type(oberon_context_t * ctx, oberon_type_t ** type)
        else
        {
                to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, false, false, false);
-               to -> type = oberon_new_type_ptr(OBERON_TYPE_VOID);
+               to -> type = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
        }
 
        *type = to -> type;
@@ -2604,7 +2615,7 @@ oberon_make_multiarray(oberon_context_t * ctx, oberon_expr_t * sizes, oberon_typ
        }
 
        oberon_type_t * dim;
-       dim = oberon_new_type_ptr(OBERON_TYPE_VOID);
+       dim = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
 
        oberon_make_multiarray(ctx, sizes -> next, base, &dim);
 
@@ -2627,7 +2638,7 @@ oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec, oberon_scope_t *
                int num;
                oberon_object_t * list;
                oberon_type_t * type;
-               type = oberon_new_type_ptr(OBERON_TYPE_VOID);
+               type = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
 
                oberon_ident_list(ctx, OBERON_CLASS_FIELD, true, &num, &list);
                oberon_assert_token(ctx, COLON);
@@ -2728,7 +2739,7 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
                oberon_assert_token(ctx, OF);
 
                oberon_type_t * base;
-               base = oberon_new_type_ptr(OBERON_TYPE_VOID);
+               base = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
                oberon_type(ctx, &base);
 
                if(num_sizes == 0)
@@ -2759,7 +2770,7 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
                oberon_assert_token(ctx, TO);
 
                oberon_type_t * base;
-               base = oberon_new_type_ptr(OBERON_TYPE_VOID);
+               base = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
                oberon_type(ctx, &base);
 
                oberon_type_t * ptr;
@@ -2796,7 +2807,7 @@ oberon_type_decl(oberon_context_t * ctx)
        if(newtype == NULL)
        {
                newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, export, read_only, false);
-               newtype -> type = oberon_new_type_ptr(OBERON_TYPE_VOID);
+               newtype -> type = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
                assert(newtype -> type);
        }
        else
@@ -2820,7 +2831,7 @@ oberon_type_decl(oberon_context_t * ctx)
        type = newtype -> type;
        oberon_type(ctx, &type);
 
-       if(type -> class == OBERON_TYPE_VOID)
+       if(type -> class == OBERON_TYPE_NOTYPE)
        {
                oberon_error(ctx, "recursive alias declaration");
        }
@@ -3020,7 +3031,7 @@ oberon_initialize_record_fields(oberon_context_t * ctx, oberon_type_t * type)
 static void
 oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
 {
-       if(type -> class == OBERON_TYPE_VOID)
+       if(type -> class == OBERON_TYPE_NOTYPE)
        {
                oberon_error(ctx, "undeclarated type");
        }
@@ -3738,12 +3749,11 @@ oberon_parse_module(oberon_context_t * ctx)
 static void
 register_default_types(oberon_context_t * ctx)
 {
-       ctx -> void_type = oberon_new_type_ptr(OBERON_TYPE_VOID);
-       oberon_generator_init_type(ctx, ctx -> void_type);
+       ctx -> notype_type = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
+       oberon_generator_init_type(ctx, ctx -> notype_type);
 
-       ctx -> void_ptr_type = oberon_new_type_ptr(OBERON_TYPE_POINTER);
-       ctx -> void_ptr_type -> base = ctx -> void_type;
-       oberon_generator_init_type(ctx, ctx -> void_ptr_type);
+       ctx -> nil_type = oberon_new_type_ptr(OBERON_TYPE_NIL);
+       oberon_generator_init_type(ctx, ctx -> nil_type);
 
        ctx -> string_type = oberon_new_type_string(1);
        oberon_generator_init_type(ctx, ctx -> string_type);