From ba1a55241f3841d1254317d76d45322c85fb687b Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Fri, 18 Aug 2017 18:30:30 +0300 Subject: [PATCH] =?utf8?q?=D0=98=D1=81=D0=BF=D1=80=D0=B0=D0=B2=D0=BB=D0=B5?= =?utf8?q?=D0=BD=D0=B0=20=D0=BA=D0=BE=D0=BD=D0=B2=D0=B5=D1=80=D1=81=D0=B8?= =?utf8?q?=D1=8F=20=D1=81=D1=82=D1=80=D0=BE=D0=BA=D0=B8=20=D0=B5=D0=B4?= =?utf8?q?=D0=B8=D0=BD=D0=B8=D1=87=D0=BD=D0=BE=D0=B3=D0=BE=20=D1=80=D0=B0?= =?utf8?q?=D0=B7=D0=BC=D0=B5=D1=80=D0=B0=20=D0=B2=20=D1=81=D0=B8=D0=BC?= =?utf8?q?=D0=B2=D0=BE=D0=BB=20=D0=B2=20=D1=81=D1=80=D0=B0=D0=B2=D0=BD?= =?utf8?q?=D0=B5=D0=BD=D0=B8=D1=8F=D1=85?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- Test.obn | 18 +++++++++--------- Test20.obn | 20 ++++++++++++++++++++ notes | 24 +++++++++++++----------- obn-run-tests.sh | 1 + src/oberon-type-compat.c | 33 ++++++++++++++++++++++++++++++--- src/oberon-type-compat.h | 8 +++++++- src/oberon.c | 36 ++++++++++++++++++++++++++++++------ 7 files changed, 110 insertions(+), 30 deletions(-) create mode 100644 Test20.obn diff --git a/Test.obn b/Test.obn index d232953..67a35e4 100644 --- a/Test.obn +++ b/Test.obn @@ -1,14 +1,14 @@ MODULE Test; -IMPORT SYSTEM, Out; - -TYPE - R = RECORD END; - -VAR - i : INTEGER; - l : LONGINT; +IMPORT Out; BEGIN - i := SYSTEM.VAL(INTEGER, l); + Out.String("A"); + Out.Char("A"); + Out.Ln; + ASSERT("A" = 041X); + ASSERT(041X = "A"); + ASSERT(ORD("A") = 041H); + ASSERT(041H = ORD("A")); + ASSERT("A" = "A"); END Test. diff --git a/Test20.obn b/Test20.obn new file mode 100644 index 0000000..0eea39b --- /dev/null +++ b/Test20.obn @@ -0,0 +1,20 @@ +MODULE Test20; + +IMPORT Out; + +VAR + ch : CHAR; + +BEGIN + ch := "A"; + Out.String("A"); + Out.Char("A"); + Out.Ln; + ASSERT("A" = 041X); + ASSERT(041X = "A"); + ASSERT(ORD("A") = 041H); + ASSERT(041H = ORD("A")); + ASSERT("A" = "A"); +END Test20. + +Тест конверсии строки единичного размера в символ. diff --git a/notes b/notes index ad35ef7..6c6cf6f 100644 --- a/notes +++ b/notes @@ -1,16 +1,21 @@ -- Перепроверить конверсию строк единичного размера в символ. -- Не полная реализация модуля SYSTEM - * Процедуры GETREG PUTREG впринципе вписываются в jvm - и могут быть полезны при реализции рефлекции - Нет процедур привязанных к типм (10.2) - Не полная реализация модуля Files * Не реализована запись в файл +- Нужна опция для задания списка директорий для поиска модулей. + - Не полная реализация модуля Strings * Реализованы только процедуры Length и Cap - Сделать проверку повторов в CASE. - Сделать нормальную проверку наличия RETURN. +- Нет счёта строк / столбцов (хрен с ними - у меня есть утилита tail!) +- Нужны средства создания биндингов. (oakwood 3.5) +- Любая ошибка фатальна + +- Примеры -5 DIV 3 и -5 MOD 3 работают не так как в (8.2.2) + Нужен другой тип округления? + - Неплохо бы иметь оператор ** (oakwood 3.7) - Неплохо бы иметь параметры только для чтения (oakwood 5.13) - Надо что-то делать с ситуацией описанной в (okawood 2.4) @@ -20,16 +25,13 @@ - Запретить доступ к битам SET которые не входят в пределы 0..MAX(SET) (oakwood 2.3.5) - Запретить каст через SHORT если значение не в пределах результата (в рантайме чтоли?) (oakwood 2.3.6) - Нет проверки переполнений (oakwood 2.3.8) - -- Примеры -5 DIV 3 и -5 MOD 3 работают не так как в (8.2.2) - Нужен другой тип округления? - -- Нет счёта строк / столбцов (хрен с ними - у меня есть утилита tail!) -- Нужны средства создания биндингов. (oakwood 3.5) -- Любая ошибка фатальна - Нет проверок переполнения в компилтайме. Возможно можно заюзать это: https://gcc.gnu.org/onlinedocs/gcc/Integer-Overflow-Builtins.html +- Не полная реализация модуля SYSTEM + * Процедуры GETREG PUTREG впринципе вписываются в jvm + и могут быть полезны при реализции рефлекции + * Остальное не имеет смысла в jvm - JVM: Не достаточно средств для реализации рефлексии на уровне локальных процедур. Как минимум нужно каждой функции добавлять фрейм к параметрам (динамическая связь?) diff --git a/obn-run-tests.sh b/obn-run-tests.sh index 7011dc5..fa1d728 100755 --- a/obn-run-tests.sh +++ b/obn-run-tests.sh @@ -92,3 +92,4 @@ makefail Test18B makefail Test18C maketest Test19 +maketest Test20 diff --git a/src/oberon-type-compat.c b/src/oberon-type-compat.c index 4291f6c..3da62ed 100644 --- a/src/oberon-type-compat.c +++ b/src/oberon-type-compat.c @@ -281,6 +281,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) { @@ -308,7 +314,7 @@ 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_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)); } @@ -344,6 +350,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) { @@ -473,9 +500,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"); } diff --git a/src/oberon-type-compat.h b/src/oberon-type-compat.h index 92b6750..ccb1e24 100644 --- a/src/oberon-type-compat.h +++ b/src/oberon-type-compat.h @@ -46,6 +46,9 @@ oberon_is_array_of_char_type(oberon_type_t * t); bool oberon_is_type_expr(oberon_expr_t * e); +bool +oberon_is_string_of_one(oberon_expr_t * e); + bool @@ -72,6 +75,9 @@ oberon_is_assignment_compatible_expressions(oberon_expr_t * e, oberon_type_t * T bool oberon_is_compatible_arrays(oberon_object_t * f, oberon_expr_t * a); +bool +oberon_is_comatible_bin_expr(int token, oberon_expr_t * a, oberon_expr_t * b); + bool oberon_is_compatible_bin_expr_types(int token, oberon_type_t * a, oberon_type_t * b); @@ -81,7 +87,7 @@ void 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); void oberon_check_compatible_arrays(oberon_context_t * ctx, oberon_object_t * f, oberon_expr_t * a); diff --git a/src/oberon.c b/src/oberon.c index c1e86d2..04d4c6d 100644 --- 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))) @@ -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"); } -- 2.29.2