Исправлена проверка VAR-параметров-записей

diff --git a/Test.obn b/Test.obn
index e4eeec3fd93e1dc48ac82f3e67accc672fd2131c..b9b14ae66be8abf069ff9c19ca678ff3e117694d 100644 (file)
--- a/Test.obn
+++ b/Test.obn
@@ -1,15 +1,23 @@
 MODULE Test;
 
 TYPE
-  Rider = RECORD i : INTEGER END;
+  Stream* = POINTER TO Handle;
+  Handle = RECORD END;
 
-PROCEDURE X;
-  VAR
-    r : Rider;
+  Writer* = RECORD END;
+
+  Printer* = RECORD (Writer) END;
+
+VAR
+  s : Stream;
+  o : Writer;
+  out : Printer;
+
+PROCEDURE SetStream(VAR w : Writer; stream : Stream);
 BEGIN
-  r.i := 666;
-END X;
+END SetStream;
 
 BEGIN
-  X;
+  SetStream(o, s);
+  SetStream(out, s);
 END Test.

diff --git a/obn-run-tests.sh b/obn-run-tests.sh
index b9116ff673c445e6081b5c256fa7e928bdae4a3f..57756c3e9669ed1f9fb5a9a1355b419d3f7b3056 100755 (executable)
--- a/obn-run-tests.sh
+++ b/obn-run-tests.sh
@@ -92,3 +92,6 @@ maketest Test19
 maketest Test20
 maketest Test21
 maketest Test22
+
+makecomp Test23A
+makefail Test23B

diff --git a/src/main.c b/src/main.c
index 9d471e6baa33ed44cddced222fba5c25d81869c8..05ea89235061fc67b83013bfd2386ebeb2e3cbc4 100644 (file)
--- a/src/main.c
+++ b/src/main.c
@@ -49,7 +49,7 @@ open_file(struct string_stack * path, const char * ext, const char * name, const
 
        size_t len = strlen(fname);
        res -> source = malloc(len + 1);
-       memcpy(res -> source, fname, len);
+       memcpy(res -> source, fname, len + 1);
 
        return fp;
 }

diff --git a/src/oberon-type-compat.c b/src/oberon-type-compat.c
index 964f0a0e4797875c123aae905c700bab23f17a9f..ab5419d7d444c39fc645df0c04704756cb0678fd 100644 (file)
--- a/src/oberon-type-compat.c
+++ b/src/oberon-type-compat.c
@@ -474,7 +474,7 @@ oberon_is_compatible_var_param(oberon_type_t * Tf, oberon_type_t * Ta)
        /* фактический параметр может быть указателем любого типа. */
 
        return oberon_is_some_types(Tf, Ta)
-               || (oberon_is_record_type(Tf) && oberon_extension_of(Ta, Tf))
+               || (oberon_is_record_type(Tf) && oberon_extension_of(Tf, Ta))
                || (oberon_is_system_byte_type(Tf) && (oberon_is_char_type(Ta) || oberon_is_byte_type(Ta)))
                || (oberon_is_array_of_system_byte_type(Tf))
                || (oberon_is_system_ptr_type(Tf));

diff --git a/src/oberon.c b/src/oberon.c
index 437e7694205489c681c5da3757bdc7e58a42ad39..4a740d8130db2be573d6c197eadc2ee767244d3c 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -4535,7 +4535,7 @@ oberon_make_ord_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
        }
        else
        {
-               expr = oberon_cast_expr(ctx, arg, ctx -> int_type);
+               expr = oberon_cast_expr(ctx, arg, ctx -> shortint_type);
        }
        return expr;
 }

diff --git a/tests/Test23A.obn b/tests/Test23A.obn
new file mode 100644 (file)
index 0000000..e8cf446
--- /dev/null
+++ b/tests/Test23A.obn
@@ -0,0 +1,25 @@
+MODULE Test23A;
+
+TYPE
+  Stream* = POINTER TO Handle;
+  Handle = RECORD END;
+
+  Writer* = RECORD END;
+
+  Printer* = RECORD (Writer) END;
+
+VAR
+  s : Stream;
+  o : Writer;
+  out : Printer;
+
+PROCEDURE SetStream(VAR w : Writer; stream : Stream);
+BEGIN
+END SetStream;
+
+BEGIN
+  SetStream(o, s);
+  SetStream(out, s);
+END Test23A.
+
+Проверка VAR-параметров-записи. Должно компилироваться.

diff --git a/tests/Test23B.obn b/tests/Test23B.obn
new file mode 100644 (file)
index 0000000..518fb03
--- /dev/null
+++ b/tests/Test23B.obn
@@ -0,0 +1,24 @@
+MODULE Test23B;
+
+TYPE
+  Stream* = POINTER TO Handle;
+  Handle = RECORD END;
+
+  Writer* = RECORD END;
+
+  Printer* = RECORD (Writer) END;
+
+VAR
+  s : Stream;
+  o : Writer;
+  out : Printer;
+
+PROCEDURE SetStream(VAR w : Writer; stream : Stream);
+BEGIN
+END SetStream;
+
+BEGIN
+  SetStream(s, s);
+END Test23B.
+
+Проверка VAR-параметров-записи. Должно проваливаться.