Добавлен автокаст строки единичного размера в символ

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

diff --git a/src/oberon.c b/src/oberon.c
index 66a3c7025056b195a204386c126024933c4ebca3..064cfb10bd0b24955eb0b23655c12ee68d62cf52 100644 (file)
--- 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;
 }
 
@@ -3707,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)
        {