index 6c3b698cbb88e41066ba632d23608ef70145d06a..4291f6c5f402d97b9e5c859056dd107099b31895 100644 (file)
--- a/src/oberon-type-compat.c
+++ b/src/oberon-type-compat.c
return t -> class == OBERON_TYPE_INTEGER;
}
+bool
+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)
+{
+ return oberon_is_integer_type(t) && t -> size == 1;
+}
+
bool
oberon_is_number_type(oberon_type_t * t)
{
return oberon_is_array_type(t) && oberon_is_char_type(t -> base);
}
+bool
+oberon_is_array_of_system_byte_type(oberon_type_t * t)
+{
+ return oberon_is_array_type(t) && oberon_is_system_byte_type(t -> base);
+}
+
bool
oberon_is_nil_type(oberon_type_t * t)
{
@@ -272,22 +296,10 @@ oberon_is_assignment_compatible_expressions(oberon_expr_t * e, oberon_type_t * T
/* совпадают с параметрами Tv. */
/* Доп: Tv - символ, е - строковая константа из одного символа */
- oberon_type_t * Te = e -> result;
+ /* SYSTEM: переменным типа BYTE можно присваивать значения переменных типа CHAR или SHORTINT. */
+ /* SYSTEM: Переменным типа PTR могут быть присвоены значения переменных-указателей любого типа. */
-/*
- 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");
-*/
+ oberon_type_t * Te = e -> result;
return oberon_is_some_types(Te, Tv)
|| (oberon_is_number_type(Te) && oberon_is_number_type(Tv) && oberon_incluses_type(Tv, Te))
@@ -296,7 +308,9 @@ oberon_is_assignment_compatible_expressions(oberon_expr_t * e, oberon_type_t * T
|| ((oberon_is_pointer_type(Tv) || oberon_is_procedure_type(Tv)) && oberon_is_nil_type(Te))
|| (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_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_ptr_type(Tv) && oberon_is_pointer_type(Te));
}
static bool
/* Для параметров-переменных Ta и Tf должны быть одинаковыми типами */
/* или Tf должен быть типом запись, а Ta - расширением Tf. */
+ /* 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_record_type(Tf) && oberon_extension_of(Ta, Tf))
+ || (oberon_is_array_of_system_byte_type(Tf))
+ || (oberon_is_system_ptr_type(Tf));
}
void
@@ -485,14 +506,9 @@ oberon_get_longer_type(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t
{
return a;
}
- else if(oberon_incluses_type(b, a))
- {
- return b;
- }
else
{
- oberon_error(ctx, "oberon_get_longer_type: error");
- return NULL;
+ return b;
}
}
@@ -504,13 +520,8 @@ oberon_get_longer_real_type(oberon_context_t * ctx, oberon_type_t * a, oberon_ty
{
return ctx -> real_type;
}
- else if(oberon_is_real_type(result))
- {
- return result;
- }
else
{
- oberon_error(ctx, "oberon_get_longer_real_type: error");
- return NULL;
+ return result;
}
}