Поправлены объявления типов наперёд

diff --git a/Test.obn b/Test.obn
index 6fae5299c4ceb508ddf3708622d39e419e562a12..be037a255a86681dfd6dde8cb1ddea47041586bf 100644 (file)
--- a/Test.obn
+++ b/Test.obn
@@ -1,3 +1,11 @@
 MODULE Test;
 
+TYPE
+
+  PC = ARRAY 3 OF PB;
+
+  B = RECORD z : PC; next : PB END;
+
+  PB = POINTER TO B;
+
 END Test.

diff --git a/obn-run-tests.sh b/obn-run-tests.sh
index faaf6eacd92a3c1e2a002f7b5f393b321c1253bf..7cfbb4954b5d1bc145a137171bdfebf0c44a7e7d 100755 (executable)
--- a/obn-run-tests.sh
+++ b/obn-run-tests.sh
@@ -90,3 +90,4 @@ makefail Test18C
 
 maketest Test19
 maketest Test20
+maketest Test21

diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c
index e4ea3833027a6d27cd502cf3be21e98191cfc4b7..be8c9292dd0444f3f50c0ce116baee2ad660f254 100644 (file)
--- a/src/backends/jvm/generator-jvm.c
+++ b/src/backends/jvm/generator-jvm.c
@@ -631,6 +631,13 @@ oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
        struct gen_class * c;
        char * name = var -> name;
        gen_type_t * t = var -> type -> gen_type;
+
+       assert(name);
+       if(t == NULL)
+       {
+               gen_error("uninitialized type class %i", var -> type -> class);
+       }
+
        switch(var -> class)
        {
                case OBERON_CLASS_VAR_PARAM:

diff --git a/src/oberon.c b/src/oberon.c
index e684e655df644a277dbc65955983efcc62d08b27..4afd4c27825aa3eccf0f95c0d62e40c010e3366d 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -1150,6 +1150,8 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_item_t * desig)
        int num_args = desig -> num_args;
        int num_decl = fn -> num_decl;
 
+       printf("oberon_autocast_call: num_args %i num_decl %i\n", num_args, num_decl);
+
        if(num_args < num_decl)
        {
                oberon_error(ctx, "too few arguments");
@@ -2782,7 +2784,14 @@ oberon_prevent_recursive_pointer(oberon_context_t * ctx, oberon_type_t * type)
 
        if(type -> recursive)
        {
-               oberon_error(ctx, "recursive pointer declaration");
+               if(type -> class == OBERON_TYPE_POINTER)
+               {
+                       oberon_error(ctx, "recursive pointer declaration");
+               }
+               else
+               {
+                       oberon_error(ctx, "recursive array declaration (pointer)");
+               }
        }
 
        if(type -> class == OBERON_TYPE_POINTER
@@ -2935,20 +2944,12 @@ static void oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
 static void
 oberon_initialize_record_fields(oberon_context_t * ctx, oberon_type_t * type)
 {
-       if(type -> class != OBERON_TYPE_RECORD)
-       {
-               return;
-       }
+       assert(type -> class == OBERON_TYPE_RECORD);
 
        int num_fields = type -> num_decl;
        oberon_object_t * field = type -> decl;
        for(int i = 0; i < num_fields; i++)
        {
-               if(field -> type -> class == OBERON_TYPE_POINTER)
-               {
-                       oberon_initialize_type(ctx, field -> type);
-               }
-
                oberon_initialize_object(ctx, field);
                field = field -> next;
        }
@@ -2971,39 +2972,50 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
 
        type -> initialized = 1;
 
-       if(type -> class == OBERON_TYPE_POINTER)
-       {
-               oberon_initialize_type(ctx, type -> base);
-               oberon_generator_init_type(ctx, type);
-       }
-       else if(type -> class == OBERON_TYPE_ARRAY)
+       if(type -> class == OBERON_TYPE_POINTER || type -> class == OBERON_TYPE_ARRAY)
        {
-               if(type -> size != 0)
+               if(type -> class == OBERON_TYPE_ARRAY
+                       && type -> size != 0
+                       && type -> base -> class == OBERON_TYPE_ARRAY
+                       && type -> base -> size == 0)
                {
-                       if(type -> base -> class == OBERON_TYPE_ARRAY)
-                       {
-                               if(type -> base -> size == 0)
-                               {
-                                       oberon_error(ctx, "open array not allowed as array element");
-                               }
-                       }
+                       oberon_error(ctx, "open array not allowed as array element");
                }
 
-               oberon_initialize_type(ctx, type -> base);              
-               oberon_generator_init_type(ctx, type);
+               oberon_type_t * rec = type -> base;
+               while(rec -> class == OBERON_TYPE_ARRAY || rec -> class == OBERON_TYPE_POINTER)
+               {
+                       rec = rec -> base;
+               }
+
+               if(rec -> class == OBERON_TYPE_RECORD
+                       && rec -> initialized == 0)
+               {
+                       rec -> initialized = 1;
+                       oberon_generator_init_type(ctx, rec);
+                       oberon_initialize_type(ctx, type -> base);
+                       oberon_generator_init_type(ctx, type);
+                       oberon_initialize_record_fields(ctx, rec);
+               }
+               else
+               {
+                       oberon_initialize_type(ctx, type -> base);
+                       oberon_generator_init_type(ctx, type);
+               }
        }
        else if(type -> class == OBERON_TYPE_RECORD)
        {
+               printf("Init type: RECORD\n");
                oberon_generator_init_type(ctx, type);
                oberon_initialize_record_fields(ctx, type);
        }
        else if(type -> class == OBERON_TYPE_PROCEDURE)
        {
+               printf("Init type: PROCEDURE\n");
                int num_fields = type -> num_decl;
                oberon_object_t * field = type -> decl;
                for(int i = 0; i < num_fields; i++)
                {
-                       //oberon_initialize_object(ctx, field);
                        oberon_initialize_type(ctx, field -> type);
                        field = field -> next;
                }

diff --git a/src/oberon.h b/src/oberon.h
deleted file mode 100644 (file)
index 2f51a77..0000000
--- a/src/oberon.h
+++ /dev/null
@@ -1,24 +0,0 @@
-#ifndef OBERON_H
-#define OBERON_H
-
-typedef struct oberon_type_t oberon_type_t;
-
-typedef struct oberon_module_t oberon_module_t;
-
-typedef struct oberon_context_t oberon_context_t;
-
-typedef const char * (*ModuleImportCallback)(const char * name);
-
-extern oberon_context_t *
-oberon_create_context(ModuleImportCallback import_module);
-
-extern void
-oberon_destroy_context(oberon_context_t * ctx);
-
-extern oberon_module_t *
-oberon_compile_module(oberon_context_t * ctx, const char * code);
-
-extern void
-oberon_set_out_directory(oberon_context_t * ctx, const char * path);
-
-#endif // OBERON_H

diff --git a/tests/Test21.obn b/tests/Test21.obn
new file mode 100644 (file)
index 0000000..88c288d
--- /dev/null
+++ b/tests/Test21.obn
@@ -0,0 +1,23 @@
+MODULE Test21;
+
+TYPE
+  PA = POINTER TO A;
+
+  PC = POINTER TO C;
+
+  A = RECORD nt : PA END;
+  B = RECORD (A) z : PC; next : PB END;
+
+  C = ARRAY 3 OF PB;
+
+  PB = POINTER TO B;
+
+VAR
+  p : PA;
+
+BEGIN
+  NEW(p);
+  p.nt := NIL;
+END Test21.
+
+Тест определений наперёд.