Добавлен тип SYSTEM.PTR

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

diff --git a/src/oberon-type-compat.c b/src/oberon-type-compat.c
index a99a04d37c70652f3add5a483b0ca5b0bf1edbfd..4291f6c5f402d97b9e5c859056dd107099b31895 100644 (file)
--- a/src/oberon-type-compat.c
+++ b/src/oberon-type-compat.c
@@ -45,6 +45,12 @@ oberon_is_system_byte_type(oberon_type_t * t)
        return t -> class == OBERON_TYPE_SYSTEM_BYTE;
 }
 
+bool
+oberon_is_system_ptr_type(oberon_type_t * t)
+{
+       return t -> class == OBERON_TYPE_SYSTEM_PTR;
+}
+
 bool
 oberon_is_byte_type(oberon_type_t * t)
 {
@@ -291,24 +297,10 @@ oberon_is_assignment_compatible_expressions(oberon_expr_t * e, oberon_type_t * T
        /* Доп: Tv - символ, е - строковая константа из одного символа */
 
        /* SYSTEM: переменным типа BYTE можно присваивать значения переменных типа CHAR или SHORTINT. */
+       /* SYSTEM: Переменным типа PTR могут быть присвоены значения переменных-указателей любого типа. */
 
        oberon_type_t * Te = e -> result;
 
-/*
-       printf("<<< oberon_is_assignment_compatible_expressions ===\n");
-       printf(": Te -> class == %i\n", Te -> class);
-       printf(": Tv -> class == %i\n", Tv -> class);
-       printf(":: oberon_is_some_types(Te, Tv) == %i\n", oberon_is_some_types(Te, Tv));
-       printf("::: oberon_is_number_type(Te) == %i\n", oberon_is_number_type(Te));
-       printf("::: oberon_is_number_type(Tv) == %i\n", oberon_is_number_type(Tv));
-       printf("::: oberon_incluses_type(Tv, Te) == %i\n", oberon_incluses_type(Tv, Te));
-       printf(":::: oberon_is_record_type(Te) == %i\n", oberon_is_record_type(Te));
-       printf(":::: oberon_is_record_type(Tv) == %i\n", oberon_is_record_type(Tv));
-//     printf(":::: oberon_extension_of(Te, Tv) == %i\n", oberon_extension_of(Te, Tv));
-       printf(":::: oberon_extension_of(Tv, Te) == %i\n", oberon_extension_of(Tv, Te));
-       printf("=== oberon_is_assignment_compatible_expressions >>>\n");
-*/
-
        return oberon_is_some_types(Te, Tv)
                || (oberon_is_number_type(Te) && oberon_is_number_type(Tv) && oberon_incluses_type(Tv, Te))
                || (oberon_is_record_type(Te) && oberon_is_record_type(Tv) && oberon_extension_of(Tv, Te))
@@ -317,7 +309,8 @@ oberon_is_assignment_compatible_expressions(oberon_expr_t * e, oberon_type_t * T
                || (oberon_is_array_of_char_type(Tv) && !oberon_is_open_array(Tv) && oberon_is_const_string(e) && (strlen(e -> item.string) < Tv -> size))
                || (oberon_is_procedure_type(Tv) && e -> is_item && e -> item.var -> class == OBERON_CLASS_PROC && oberon_is_some_procedure_signatures(Tv, e -> result))
                || (oberon_is_char_type(Tv) && oberon_is_const_string(e) && strlen(e -> item.string) == 1)
-               || (oberon_is_system_byte_type(Tv) && (oberon_is_char_type(Te) || oberon_is_byte_type(Te)));
+               || (oberon_is_system_byte_type(Tv) && (oberon_is_char_type(Te) || oberon_is_byte_type(Te)))
+               || (oberon_is_system_ptr_type(Tv) && oberon_is_pointer_type(Te));
 }
 
 static bool
@@ -452,10 +445,13 @@ oberon_is_compatible_var_param(oberon_type_t * Tf, oberon_type_t * Ta)
 
        /* SYSTEM: Если формальный параметр-переменная имеет тип ARRAY OF BYTE, */
        /* то соответствующий фактический параметр может иметь любой тип. */
+       /* SYSTEM: Если формальный параметр-переменная имеет тип PTR, */
+       /* фактический параметр может быть указателем любого типа. */
 
        return oberon_is_some_types(Tf, Ta)
                || (oberon_is_record_type(Tf) && oberon_extension_of(Ta, Tf))
-               || (oberon_is_array_of_system_byte_type(Tf));
+               || (oberon_is_array_of_system_byte_type(Tf))
+               || (oberon_is_system_ptr_type(Tf));
 }
 
 void