Фиксы проверки типов

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

diff --git a/src/oberon.c b/src/oberon.c
index c1e86d229c340de3f475029119b6335ea08f4aba..29c40cb974b5a822bb89c18cfe567a2d464aa966 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -171,6 +171,17 @@ oberon_make_char(oberon_context_t * ctx, int64_t i)
        return expr;
 }
 
+static oberon_expr_t *
+oberon_make_string(oberon_context_t * ctx, char * str)
+{
+       oberon_expr_t * expr;
+       expr = oberon_new_item(MODE_STRING, ctx -> string_type, true);
+       expr -> item.integer = str[0];
+       expr -> item.real = str[0];
+       expr -> item.string = str;
+       return expr;
+}
+
 static oberon_expr_t *
 oberon_make_real_typed(oberon_context_t * ctx, double r, oberon_type_t * result)
 {
@@ -1666,9 +1677,7 @@ oberon_factor(oberon_context_t * ctx)
                        oberon_assert_token(ctx, CHAR);
                        break;
                case STRING:
-                       result = ctx -> string_type;
-                       expr = oberon_new_item(MODE_STRING, result, true);
-                       expr -> item.string = ctx -> string;
+                       expr = oberon_make_string(ctx, ctx -> string);
                        oberon_assert_token(ctx, STRING);
                        break;
                case REAL:
@@ -1705,7 +1714,7 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
        oberon_expr_t * expr;
        oberon_type_t * result;
 
-       oberon_check_compatible_bin_expr_types(ctx, token, a -> result, b -> result);
+       oberon_check_compatible_bin_expr(ctx, token, a, b);
        oberon_check_src(ctx, a);
        if(token != IS)
        {
@@ -1730,7 +1739,22 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
        }
        else if((token >= EQUAL && token <= GEQ) || token == OR || token == AND)
        {
-               result = oberon_get_longer_type(ctx, a -> result, b -> result);
+               if(oberon_is_string_of_one(a) && oberon_is_char_type(b -> result))
+               {
+                       result = b -> result;
+               }
+               else if(oberon_is_string_of_one(b) && oberon_is_char_type(a -> result))
+               {
+                       result = a -> result;
+               }
+               else if(oberon_is_string_of_one(a) && oberon_is_string_of_one(b))
+               {
+                       result = ctx -> char_type;
+               }
+               else
+               {
+                       result = oberon_get_longer_type(ctx, a -> result, b -> result);
+               }
 
                if(oberon_is_const(a) && oberon_is_const(b)
                        && (oberon_is_real_type(result) || oberon_is_integer_type(result)))
@@ -3132,7 +3156,7 @@ oberon_case_labels(oberon_context_t * ctx, oberon_expr_t * val)
        oberon_expr_t * cond2;
 
        e1 = (oberon_expr_t *) oberon_const_expr(ctx);
-       
+
        e2 = NULL;
        if(ctx -> token == DOTDOT)
        {
@@ -4398,7 +4422,7 @@ oberon_make_ord_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
        arg = list_args;
        oberon_check_src(ctx, arg);
 
-       if(!oberon_is_char_type(arg -> result))
+       if(!oberon_is_char_type(arg -> result) && !oberon_is_string_of_one(arg))
        {
                oberon_error(ctx, "expected char");
        }