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.
--- /dev/null
+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.
+
+Тест конверсии строки единичного размера в символ.
-- Перепроверить конверсию строк единичного размера в символ.
-- Не полная реализация модуля 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)
- Запретить доступ к битам 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: Не достаточно средств для реализации рефлексии на уровне локальных процедур.
Как минимум нужно каждой функции добавлять фрейм к параметрам (динамическая связь?)
makefail Test18C
maketest Test19
+maketest Test20
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)
{
|| ((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));
}
}
}
+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)
{
}
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");
}
bool
oberon_is_type_expr(oberon_expr_t * e);
+bool
+oberon_is_string_of_one(oberon_expr_t * e);
+
bool
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);
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);
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)
{
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:
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)
{
}
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)))
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");
}
