X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=src%2Foberon.c;h=e755b6cf625c2984edd3ef2dd8655810426fd44e;hp=570db39df1417efe4ffde397dc3f600ab2cc9e22;hb=e6a70a3b694efa5600cfcd0d8110f8d9e8866342;hpb=c055d16f1d6ca38c5c2171dbafd1a25305fb909c

diff --git a/src/oberon.c b/src/oberon.c
index 570db39..e755b6c 100644
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -673,6 +673,7 @@ static void oberon_assert_token(oberon_context_t * ctx, int token);
 static char * oberon_assert_ident(oberon_context_t * ctx);
 static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type);
 static oberon_item_t * oberon_const_expr(oberon_context_t * ctx);
+static oberon_expr_t * oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr);
 
 static oberon_expr_t *
 oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right)
@@ -776,8 +777,19 @@ oberon_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * p
 static oberon_expr_t *
 oberno_make_record_cast(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * rec)
 {
-	if(expr -> result -> class != OBERON_TYPE_RECORD
-		|| rec -> class != OBERON_TYPE_RECORD)
+	oberon_type_t * from = expr -> result;
+	oberon_type_t * to = rec;
+
+	printf("oberno_make_record_cast: from class %i to class %i\n", from -> class, to -> class);
+
+	if(from -> class == OBERON_TYPE_POINTER && to -> class == OBERON_TYPE_POINTER)
+	{
+		printf("oberno_make_record_cast: pointers\n");
+		from = from -> base;
+		to = to -> base;
+	}
+
+	if(from -> class != OBERON_TYPE_RECORD || to -> class != OBERON_TYPE_RECORD)
 	{
 		oberon_error(ctx, "must be record type");
 	}
@@ -813,39 +825,60 @@ oberon_get_equal_expr_type(oberon_context_t * ctx, oberon_type_t * a, oberon_typ
 	return result;
 }
 
+static void
+oberon_check_record_compatibility(oberon_context_t * ctx, oberon_type_t * from, oberon_type_t * to)
+{
+	if(from -> class == OBERON_TYPE_POINTER && to -> class == OBERON_TYPE_POINTER)
+	{
+		from = from -> base;
+		to = to -> base;
+	}
+
+	if(from -> class != OBERON_TYPE_RECORD || to -> class != OBERON_TYPE_RECORD)
+	{
+		oberon_error(ctx, "not a record");
+	}
+
+	oberon_type_t * t = from;
+	while(t != NULL && t != to)
+	{
+		t = t -> base;
+	}
+
+	if(t == NULL)
+	{
+		oberon_error(ctx, "incompatible record types");
+	}
+}
+
 static oberon_expr_t *
 oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
 {
+	// Допускается:
+	//  Если классы типов равны
+	//  Если INTEGER переводится в REAL
+
+	bool error = false;
 	if(pref -> class != expr -> result -> class)
 	{
-		if(pref -> class == OBERON_TYPE_POINTER)
-		{
-			if(expr -> result -> class == OBERON_TYPE_POINTER)
-			{
-				// accept
-			}
-			else
-			{
-				oberon_error(ctx, "incompatible types");
-			}
-		}
-		else if(pref -> class == OBERON_TYPE_REAL)
+		if(expr -> result -> class == OBERON_TYPE_INTEGER)
 		{
-			if(expr -> result -> class == OBERON_TYPE_INTEGER)
-			{
-				// accept
-			}
-			else
+			if(pref -> class != OBERON_TYPE_REAL)
 			{
-				oberon_error(ctx, "incompatible types");
+				error = true;
 			}
 		}
 		else
 		{
-			oberon_error(ctx, "incompatible types");
+			error = true;
 		}
 	}
 
+	if(error)
+	{
+		oberon_error(ctx, "incompatible types");
+	}
+
 	if(pref -> class == OBERON_TYPE_INTEGER || pref -> class == OBERON_TYPE_REAL)
 	{
 		if(expr -> result -> size > pref -> size)
@@ -859,24 +892,17 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
 	}
 	else if(pref -> class == OBERON_TYPE_RECORD)
 	{
-		oberon_type_t * t = expr -> result;
-		while(t != NULL && t != pref)
-		{
-			t = t -> base;
-		}
-		if(t == NULL)
-		{
-			printf("oberon_autocast_to: rec %p != %p\n", expr -> result, pref);
-			oberon_error(ctx, "incompatible record types");
-		}
-		if(expr -> result != pref)
-		{
-			expr = oberno_make_record_cast(ctx, expr, pref);
-		}
+		oberon_check_record_compatibility(ctx, expr -> result, pref);
 	}
 	else if(pref -> class == OBERON_TYPE_POINTER)
 	{
-		if(expr -> result -> base != pref -> base)
+		assert(pref -> base);
+		if(expr -> result -> base -> class == OBERON_TYPE_RECORD)
+		{
+			oberon_check_record_compatibility(ctx, expr -> result, pref);
+			expr = oberno_make_record_cast(ctx, expr, pref);
+		}
+		else if(expr -> result -> base != pref -> base)
 		{
 			if(expr -> result -> base -> class != OBERON_TYPE_VOID)
 			{
@@ -1088,6 +1114,7 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_ar
 static oberon_expr_t *
 oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
 {
+	printf("oberno_make_dereferencing\n");
 	if(expr -> result -> class != OBERON_TYPE_POINTER)
 	{
 		oberon_error(ctx, "not a pointer");
@@ -1273,8 +1300,7 @@ oberon_designator(oberon_context_t * ctx)
 	}
 	expr -> item.var = var;
 
-	bool brk = false;
-	while(brk == false && ISSELECTOR(ctx -> token))
+	while(expr -> result -> class != OBERON_TYPE_PROCEDURE && ISSELECTOR(ctx -> token))
 	{
 		switch(ctx -> token)
 		{
@@ -1301,11 +1327,6 @@ oberon_designator(oberon_context_t * ctx)
 				expr = oberno_make_dereferencing(ctx, expr);
 				break;
 			case LPAREN:
-				if(expr -> result -> class == OBERON_TYPE_PROCEDURE)
-				{
-					brk = true;
-					break;
-				}
 				oberon_assert_token(ctx, LPAREN);
 				oberon_object_t * objtype = oberon_qualident(ctx, NULL, 1);
 				if(objtype -> class != OBERON_CLASS_TYPE)
@@ -1320,14 +1341,13 @@ oberon_designator(oberon_context_t * ctx)
 				break;
 		}
 	}
+
 	return expr;
 }
 
 static oberon_expr_t *
 oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 {
-	assert(expr -> is_item == 1);
-
 	/* Если есть скобки - значит вызов. Если нет, то передаём указатель. */
 	if(ctx -> token == LPAREN)
 	{
@@ -1341,6 +1361,7 @@ oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 			oberon_expr_list(ctx, &num_args, &arguments, 0);
 		}
 
+		assert(expr -> is_item == 1);
 		expr = oberon_make_call_func(ctx, (oberon_item_t *) expr, num_args, arguments);
 
 		oberon_assert_token(ctx, RPAREN);
@@ -2176,13 +2197,19 @@ oberon_type_record_body(oberon_context_t * ctx, oberon_type_t * rec)
 			oberon_error(ctx, "base must be type");
 		}
 
-		if(typeobj -> type -> class != OBERON_TYPE_RECORD)
+		oberon_type_t * base = typeobj -> type;
+		if(base -> class == OBERON_TYPE_POINTER)
+		{
+			base = base -> base;
+		}
+
+		if(base -> class != OBERON_TYPE_RECORD)
 		{
 			oberon_error(ctx, "base must be record type");
 		}
 
-		rec -> base = typeobj -> type;
-		ctx -> decl = rec -> base -> scope;
+		rec -> base = base;
+		ctx -> decl = base -> scope;
 
 		oberon_assert_token(ctx, RPAREN);
 	}