X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Foberon.c;h=064cfb10bd0b24955eb0b23655c12ee68d62cf52;hb=879793eaf1d6378593f78a192f2961670f686530;hp=58eb67c3eb72562294074f972fde2e15f68b5fec;hpb=55d9ee92b95dd306ac80fb643ed21d3b733395d7;p=dsw-obn.git

diff --git a/src/oberon.c b/src/oberon.c
index 58eb67c..064cfb1 100644
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -474,6 +474,9 @@ oberon_read_ident(oberon_context_t * ctx)
 	}
 }
 
+#define ISHEXDIGIT(x) \
+	(((x) >= '0' && (x) <= '9') || ((x) >= 'A' && (x) <= 'F'))
+
 static void
 oberon_read_number(oberon_context_t * ctx)
 {
@@ -501,10 +504,10 @@ oberon_read_number(oberon_context_t * ctx)
 
 	end_i = ctx -> code_index;
 
-	if(isxdigit(ctx -> c))
+	if(ISHEXDIGIT(ctx -> c))
 	{
 		mode = 1;
-		while(isxdigit(ctx -> c))
+		while(ISHEXDIGIT(ctx -> c))
 		{
 			oberon_get_char(ctx);
 		}
@@ -1106,6 +1109,7 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
 	// Допускается:
 	//  Если классы типов равны
 	//  Если INTEGER переводится в REAL
+	//  Есди STRING переводится в CHAR
 	//  Есди STRING переводится в ARRAY OF CHAR
 
 	oberon_check_src(ctx, expr);
@@ -1118,7 +1122,21 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
 
 		if(expr -> result -> class == OBERON_TYPE_STRING)
 		{
-			if(pref -> class == OBERON_TYPE_ARRAY)
+			if(pref -> class == OBERON_TYPE_CHAR)
+			{
+				if(expr -> is_item && expr -> item.mode == MODE_STRING)
+				{
+					if(strlen(expr -> item.string) != 1)
+					{
+						error = true;
+					}
+				}
+				else
+				{
+					error = true;
+				}
+			}
+			else if(pref -> class == OBERON_TYPE_ARRAY)
 			{
 				if(pref -> base -> class != OBERON_TYPE_CHAR)
 				{
@@ -1148,7 +1166,16 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
 		oberon_error(ctx, "oberon_autocast_to: incompatible types");
 	}
 
-	if(pref -> class == OBERON_TYPE_INTEGER || pref -> class == OBERON_TYPE_REAL)
+	if(pref -> class == OBERON_TYPE_CHAR)
+	{
+		if(expr -> result -> class == OBERON_TYPE_STRING)
+		{
+			int c = expr -> item.string[0];
+			expr = oberon_new_item(MODE_CHAR, ctx -> char_type, true);
+			expr -> item.integer = c;
+		}
+	}
+	else if(pref -> class == OBERON_TYPE_INTEGER || pref -> class == OBERON_TYPE_REAL)
 	{
 		if(expr -> result -> size > pref -> size)
 		{
@@ -2134,12 +2161,9 @@ oberon_expr(oberon_context_t * ctx)
 	return expr;
 }
 
-static oberon_item_t *
-oberon_const_expr(oberon_context_t * ctx)
+static void
+oberon_check_const(oberon_context_t * ctx, oberon_expr_t * expr)
 {
-	oberon_expr_t * expr;
-	expr = oberon_expr(ctx);
-
 	if(expr -> is_item == 0)
 	{
 		oberon_error(ctx, "const expression are required");
@@ -2160,7 +2184,14 @@ oberon_const_expr(oberon_context_t * ctx)
 			oberon_error(ctx, "const expression are required");
 			break;
 	}
+}
 
+static oberon_item_t *
+oberon_const_expr(oberon_context_t * ctx)
+{
+	oberon_expr_t * expr;
+	expr = oberon_expr(ctx);
+	oberon_check_const(ctx, expr);
 	return (oberon_item_t *) expr;
 }
 
@@ -2469,13 +2500,20 @@ oberon_proc_decl(oberon_context_t * ctx)
 	signature = oberon_new_type_ptr(OBERON_TYPE_VOID);
 	oberon_opt_formal_pars(ctx, &signature);	
 
-	oberon_initialize_decl(ctx);
+	//oberon_initialize_decl(ctx);
 	oberon_generator_init_type(ctx, signature);
 	oberon_close_scope(ctx -> decl);
 
 	oberon_object_t * proc;
 	proc = oberon_find_object(ctx -> decl, name, 0);
-	if(proc != NULL)
+	if(proc == NULL)
+	{
+		proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, export, read_only, false);
+		proc -> type = signature;
+		proc -> scope = proc_scope;
+		oberon_generator_init_proc(ctx, proc);
+	}
+	else
 	{
 		if(proc -> class != OBERON_CLASS_PROC)
 		{
@@ -2497,16 +2535,15 @@ oberon_proc_decl(oberon_context_t * ctx)
 
 		oberon_compare_signatures(ctx, proc -> type, signature);
 	}
-	else
+
+	proc_scope -> parent = proc;
+	oberon_object_t * param = proc_scope -> list -> next;
+	while(param)
 	{
-		proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, export, read_only, false);
-		proc -> type = signature;
-		proc -> scope = proc_scope;
-		oberon_generator_init_proc(ctx, proc);
+		param -> parent = proc;
+		param = param -> next;
 	}
 
-	proc -> scope -> parent = proc;
-
 	if(forward == 0)
 	{
 		proc -> linked = 1;
@@ -3701,7 +3738,7 @@ oberon_parse_module(oberon_context_t * ctx)
 
 	oberon_assert_token(ctx, END);
 	name2 = oberon_assert_ident(ctx);
-	oberon_assert_token(ctx, DOT);
+	oberon_expect_token(ctx, DOT);
 
 	if(strcmp(name1, name2) != 0)
 	{