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

diff --git a/System.obn b/System.obn
new file mode 100644 (file)
index 0000000..54db52e
--- /dev/null
+++ b/System.obn
@@ -0,0 +1,6 @@
+MODULE System;
+
+PROCEDURE Halt*(n : INTEGER);
+END Halt;
+
+END System.

diff --git a/Test.obn b/Test.obn
index 8249fb77223116fd24082f63a7dba78821d98fe1..0b020f71a79862e5a3510e07528b982ea6a21749 100644 (file)
--- a/Test.obn
+++ b/Test.obn
@@ -1,8 +1,11 @@
 MODULE Test;
 
-IMPORT Out;
+IMPORT
+  Out,
+  System;
 
 BEGIN
   Out.Open;
   Out.String("Hello World!"); Out.Ln;
+  System.Halt(1);
 END Test.

diff --git a/Test1.obn b/Test1.obn
new file mode 100644 (file)
index 0000000..290f35d
--- /dev/null
+++ b/Test1.obn
@@ -0,0 +1,6 @@
+MODULE Test1;
+
+END Test1.
+
+Пустой модуль.
+Сий текст не должен иметь значения.

diff --git a/Test2.obn b/Test2.obn
new file mode 100644 (file)
index 0000000..ea902da
--- /dev/null
+++ b/Test2.obn
@@ -0,0 +1,48 @@
+MODULE Test2;
+
+IMPORT Out;
+
+CONST
+  dec1 = 1991;
+  hex1 = 0DH; (* = 13 *)
+  hex2 = 0123H; (* = 291 *)
+  real1 = 12.3;
+  real2 = 4.567E8;
+  real3 = 4.567E+8;
+  real4 = 4.567E-8;
+  long1 = 0.57712566;
+  long2 = 0.57712566D6;
+  long3 = 0.57712566D+6;
+  long4 = 0.57712566D-6;
+  char1 = 042X; (* = "B" *)
+  char2 = 03FX; (* = "?" *)
+  str1 = 'Oberon-2';
+  str2 = "Don't worry!";
+  charvsstr1 = 'A';
+  charvsstr2 = "Z";
+
+BEGIN
+  Out.Open;
+  Out.String("dec1 = "); Out.Int(dec1, 0); Out.Ln;
+  Out.String("hex1 = "); Out.Int(hex1, 0); Out.Ln;
+  Out.String("hex2 = "); Out.Int(hex2, 0); Out.Ln;
+  Out.String("real1 = "); Out.Real(real1, 0); Out.Ln;
+  Out.String("real2 = "); Out.Real(real2, 0); Out.Ln;
+  Out.String("real3 = "); Out.Real(real3, 0); Out.Ln;
+  Out.String("real4 = "); Out.Real(real4, 0); Out.Ln;
+  Out.String("long1 = "); Out.LongReal(long1, 0); Out.Ln;
+  Out.String("long2 = "); Out.LongReal(long2, 0); Out.Ln;
+  Out.String("long3 = "); Out.LongReal(long3, 0); Out.Ln;
+  Out.String("long4 = "); Out.LongReal(long4, 0); Out.Ln;
+  Out.String("char1 = "); Out.Char(char1); Out.Ln;
+  Out.String("char2 = "); Out.Char(char2); Out.Ln;
+  Out.String("str1 = "); Out.String(str1); Out.Ln;
+  Out.String("str2 = "); Out.String(str2); Out.Ln;
+  Out.String("charvsstr1 (string) = "); Out.String(charvsstr1); Out.Ln;
+  Out.String("charvsstr2 (string) = "); Out.String(charvsstr2); Out.Ln;
+  Out.String("charvsstr1 (char) = "); Out.Char(charvsstr1); Out.Ln;
+  Out.String("charvsstr2 (char) = "); Out.Char(charvsstr2); Out.Ln;
+END Test2.
+
+Проверка констант.
+Всё должно компилироваться и работать.

diff --git a/gdb_run.sh b/gdb_run.sh
deleted file mode 100755 (executable)
index b6e0bbd..0000000
--- a/gdb_run.sh
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/bin/sh
-
-set -e
-
-export PATH="/usr/lib/gcc/x86_64-pc-linux-gnu/7.1.1:${PATH}"
-export LIBRARY_PATH="/usr/lib/gcc/x86_64-pc-linux-gnu/7.1.1:${LIBRARY_PATH}"
-
-exec gdb ./a.out

diff --git a/jvm_test.sh b/jvm_test.sh
deleted file mode 100755 (executable)
index 4944b91..0000000
--- a/jvm_test.sh
+++ /dev/null
@@ -1,28 +0,0 @@
-#!/bin/sh
-
-set -e
-
-./make.sh jvm
-
-rm -rf classes
-rm -f *.j *.jad
-mkdir -p classes
-
-./run.sh $*
-
-javac -d classes Launcher.java
-jasmin -d classes *.j
-
-javac -d classes rtl/*.java
-
-# -a -- for asm as comments
-jad -o -b -noinner classes/*
-
-proguard -injars classes \
-       -libraryjars /usr/lib/jvm/java-8-openjdk/jre/lib/rt.jar \
-       -dontshrink -dontobfuscate -keep class Test -keep class Launcher
-
-java -cp classes Launcher Test
-
-echo Everythin ok! Wheee...
-

diff --git a/obn-compile.sh b/obn-compile.sh
new file mode 100755 (executable)
index 0000000..f89bf03
--- /dev/null
+++ b/obn-compile.sh
@@ -0,0 +1,17 @@
+#!/bin/sh
+
+set -e
+
+rm -rf classes
+rm -f *.j *.jad
+mkdir -p classes
+
+./a.out $1
+
+jasmin -d classes *.j
+
+javac -d classes rtl/*.java
+
+proguard -injars classes \
+       -libraryjars /usr/lib/jvm/java-8-openjdk/jre/lib/rt.jar \
+       -dontshrink -dontobfuscate -keep class $1 -keep class Launcher

diff --git a/obn-dev-test.sh b/obn-dev-test.sh
new file mode 100755 (executable)
index 0000000..89592da
--- /dev/null
+++ b/obn-dev-test.sh
@@ -0,0 +1,14 @@
+#!/bin/sh
+
+set -e
+
+./make.sh jvm
+./obn-compile.sh Test
+
+# -a -- for asm as comments
+jad -o -b -noinner classes/*
+
+./obn-run.sh Test
+
+echo Everythin ok! Wheee...
+

diff --git a/obn-gdb-compile.sh b/obn-gdb-compile.sh
new file mode 100755 (executable)
index 0000000..dbb00a5
--- /dev/null
+++ b/obn-gdb-compile.sh
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+set -e
+
+exec gdb ./a.out $*

diff --git a/obn-run-tests.sh b/obn-run-tests.sh
new file mode 100755 (executable)
index 0000000..b68d4b2
--- /dev/null
+++ b/obn-run-tests.sh
@@ -0,0 +1,31 @@
+#!/bin/sh
+
+set -e
+
+maketest()
+{
+       local OK=1
+       if ! ./obn-compile.sh $1; then
+               OK=0; echo "Test fail: $1 compile-time $?"
+       fi
+       if ! ./obn-run.sh $1; then
+               OK=0; echo "Test fail: $1 run-time $?"
+       fi
+       if [ $OK ]; then
+               echo "Test ok: $1"
+       fi
+}
+
+compile_false_positive()
+{
+       if ./obn-compile.sh $1; then
+               echo "Test fail: $1 compile-time $?"
+       else
+               echo "Test ok: $1"
+       fi
+}
+
+./make.sh jvm
+
+maketest Test1
+maketest Test2

diff --git a/obn-run.sh b/obn-run.sh
new file mode 100755 (executable)
index 0000000..ef0185c
--- /dev/null
+++ b/obn-run.sh
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+set -e
+
+java -cp classes Launcher $1

diff --git a/Launcher.java b/rtl/Launcher.java
similarity index 100%
rename from Launcher.java
rename to rtl/Launcher.java

diff --git a/rtl/System.java b/rtl/System.java
new file mode 100644 (file)
index 0000000..08411e7
--- /dev/null
+++ b/rtl/System.java
@@ -0,0 +1,7 @@
+public class System
+{
+       public static void Halt(int n)
+       {
+               java.lang.System.exit(n);
+       }
+}

diff --git a/run.sh b/run.sh
deleted file mode 100755 (executable)
index f53eb55..0000000
--- a/run.sh
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/bin/sh
-
-set -e
-
-export PATH="/usr/lib/gcc/x86_64-pc-linux-gnu/7.1.1:${PATH}"
-export LIBRARY_PATH="/usr/lib/gcc/x86_64-pc-linux-gnu/7.1.1:${LIBRARY_PATH}"
-
-exec ./a.out $*

diff --git a/src/test.c b/src/main.c
similarity index 100%
rename from src/test.c
rename to src/main.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)
        {