X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=src%2Foberon-type-compat.c;h=ab5419d7d444c39fc645df0c04704756cb0678fd;hp=a99a04d37c70652f3add5a483b0ca5b0bf1edbfd;hb=HEAD;hpb=1233fb1d5d8f67a8f5e970386c1c4cbb6691ec04

diff --git a/src/oberon-type-compat.c b/src/oberon-type-compat.c
index a99a04d..ab5419d 100644
--- a/src/oberon-type-compat.c
+++ b/src/oberon-type-compat.c
@@ -7,11 +7,9 @@
 #include <stdbool.h>
 #include <math.h>
 
-#include "../include/oberon.h"
-
-#include "oberon-common.h"
 #include "oberon-internals.h"
 #include "oberon-type-compat.h"
+#include "oberon-common.h"
 
 bool
 oberon_is_array_type(oberon_type_t * t)
@@ -45,6 +43,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)
 {
@@ -275,6 +279,12 @@ oberon_is_const_string(oberon_expr_t * e)
 	return e -> result -> class == OBERON_TYPE_STRING && e -> is_item && e -> item.mode == MODE_STRING;
 }
 
+bool
+oberon_is_string_of_one(oberon_expr_t * e)
+{
+	return oberon_is_const_string(e) && strlen(e -> item.string) == 1;
+}
+
 bool
 oberon_is_assignment_compatible_expressions(oberon_expr_t * e, oberon_type_t * Tv)
 {
@@ -290,25 +300,11 @@ oberon_is_assignment_compatible_expressions(oberon_expr_t * e, oberon_type_t * T
 	/*      совпадают с параметрами Tv. */
 	/* Доп: Tv - символ, е - строковая константа из одного символа */
 
-	/* SYSTEM: переменным типа BYTE можно присваивать значения переменных типа CHAR или SHORTINT. */
+	/* 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))
@@ -316,8 +312,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_system_byte_type(Tv) && (oberon_is_char_type(Te) || oberon_is_byte_type(Te)));
+		|| (oberon_is_char_type(Tv) && oberon_is_string_of_one(e))
+		|| (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
@@ -351,6 +348,27 @@ oberon_check_compatible_arrays(oberon_context_t * ctx, oberon_object_t * f, ober
 	}
 }
 
+bool
+oberon_is_compatible_bin_expr(int token, oberon_expr_t * a, oberon_expr_t * b)
+{
+	if(token == EQUAL || token == NEQ || token == LESS || token == LEQ || token == GREAT || token == GEQ)
+	{
+		if((oberon_is_char_type(a -> result) || oberon_is_string_of_one(a))
+			&& (oberon_is_char_type(b -> result) || oberon_is_string_of_one(b)))
+		{
+			return true;
+		}
+		else
+		{
+			return oberon_is_compatible_bin_expr_types(token, a -> result, b -> result);
+		}
+	}
+	else
+	{
+		return oberon_is_compatible_bin_expr_types(token, a -> result, b -> result);
+	}
+}
+
 bool
 oberon_is_compatible_bin_expr_types(int token, oberon_type_t * a, oberon_type_t * b)
 {
@@ -402,8 +420,8 @@ oberon_is_compatible_bin_expr_types(int token, oberon_type_t * a, oberon_type_t
 		{
 			return true;
 		}
-		else if((oberon_is_nil_type(a) || oberon_is_pointer_to_record(a) || oberon_is_procedure_type(a))
-			&& (oberon_is_nil_type(b) || oberon_is_pointer_to_record(b) || oberon_is_procedure_type(b)))
+		else if((oberon_is_nil_type(a) || oberon_is_pointer_type(a) || oberon_is_procedure_type(a))
+			&& (oberon_is_nil_type(b) || oberon_is_pointer_type(b) || oberon_is_procedure_type(b)))
 		{
 			return true;
 		}
@@ -452,10 +470,14 @@ 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_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));
 }
 
 void
@@ -477,9 +499,9 @@ oberon_check_type_expr(oberon_context_t * ctx, oberon_expr_t * e)
 }
 
 void
-oberon_check_compatible_bin_expr_types(oberon_context_t * ctx, int token, oberon_type_t * a, oberon_type_t * b)
+oberon_check_compatible_bin_expr(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
 {
-	if(!oberon_is_compatible_bin_expr_types(token, a, b))
+	if(!oberon_is_compatible_bin_expr(token, a, b))
 	{
 		oberon_error(ctx, "incompatibe expression types");
 	}