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

[dsw-obn.git] / src / oberon.c

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);