fixed the tv.wcount and tv.s.len restoration logic upon compiliation failure
All checks were successful
continuous-integration/drone/push Build is passing

This commit is contained in:
2024-04-21 02:24:27 +09:00
parent 759c7a029b
commit 803f9b2817
7 changed files with 166 additions and 126 deletions

View File

@ -8,7 +8,9 @@ check_SCRIPTS = \
ret-01.hcl \
retvar-01.hcl \
va-01.hcl \
var-02.hcl
var-01.hcl \
var-02.hcl \
var-03.hcl
check_ERRORS = \
call-5001.err \

View File

@ -480,7 +480,9 @@ check_SCRIPTS = \
ret-01.hcl \
retvar-01.hcl \
va-01.hcl \
var-02.hcl
var-01.hcl \
var-02.hcl \
var-03.hcl
check_ERRORS = \
call-5001.err \

View File

@ -1,111 +1,97 @@
(defun x (a b :: r)
defun x (a b :: r) {
| x y |
(set x a)
(set y b)
set x a
set y b
(if (> a b)
(do
| a b |
(set a (mod x y))
(set b (+ x y))
(set r (* a b))
)
else
(do
if (> a b) {
| a b |
set a (mod x y)
set b (+ x y)
set r (* a b)
} else {
| a b |
set a (* x y)
set b (- x y)
set r (* a b)
}
| a b |
(set a (* x y))
(set b (- x y))
(set r (* a b))
)
)
(if (/= x a) (printf "ERROR: x is not equal to a\n"))
(if (/= y b) (printf "ERROR: y is not equal to b\n"))
if (/= x a) (printf "ERROR: x is not equal to a\n")
if (/= y b) (printf "ERROR: y is not equal to b\n")
}
t := (x 10 20)
if (/= t -2000) (printf "ERROR: t is not equal to -2000\n") \
else (printf "OK: %d\n" t)
set t (x 30 20)
if (/= t 500) (printf "ERROR: t is not equal to 500\n") \
else (printf "OK: %d\n" t)
defun x () {
| x y |
set x 99
try {
| x |
set x 88
if (/= x 88) (printf "ERROR: x is not 88\n") \
else (printf "OK: %d\n" x)
throw 1000
} catch (x) {
if (/= x 1000) (printf "ERROR: x is not 1000\n") \
else (printf "OK: %d\n" x)
set y x
}
if (/= x 99) (printf "ERROR: x is not 99\n") \
else (printf "OK: %d\n" x)
if (/= y 1000) (print "ERROR: y is not 1000\n") \
else (printf "OK: %d\n" y)
}
x
class T | j | {
defun :* new() {
set j 99
return self
}
defun x() {
set R {
| x |
set x 1
while (< x j) {
defun Q() x
set x (+ x 1)
}
}
}
}
set t (T:new)
t:x
set t (Q)
if (/= t 99) (print "ERROR: t is not 99\n") \
else (printf "OK: %d\n" t)
if (nqv? R false) (print "ERROR: R is not false\n") \
else (printf "OK: %O\n" R)
set v #(
(do |a b| (set a 10) (set b 20) (+ a b) )
(do |a b| (set a 11) (set b 21) (+ a b) )
999
)
(set t (x 10 20))
(if (/= t -2000) (printf "ERROR: t is not equal to -2000\n")
else (printf "OK: %d\n" t))
(set t (x 30 20))
(if (/= t 500) (printf "ERROR: t is not equal to 500\n")
else (printf "OK: %d\n" t))
set v2 #(30 32 999)
(defun x ()
(do
| x y |
(set x 99)
(try
(do
| x |
(set x 88)
(if (/= x 88) (printf "ERROR: x is not 88\n")
else (printf "OK: %d\n" x))
(throw 1000)
)
catch (x)
(if (/= x 1000) (printf "ERROR: x is not 1000\n")
else (printf "OK: %d\n" x))
(set y x)
)
(if (/= x 99) (printf "ERROR: x is not 99\n")
else (printf "OK: %d\n" x))
(if (/= y 1000) (print "ERROR: y is not 1000\n")
else (printf "OK: %d\n" y))
)
)
(x)
(defclass T
| j |
(defun :* new()
(set j 99)
(return self)
)
(defun x()
(set R
(do
| x |
(set x 1)
(while (< x j)
(defun Q() x)
(set x (+ x 1))
)
)
)
)
)
(set t (:T new))
(:t x)
(set t (Q))
(if (/= t 99) (print "ERROR: t is not 99\n")
else (printf "OK: %d\n" t))
(if (nqv? R false) (print "ERROR: R is not false\n")
else (printf "OK: %O\n" R))
(set v
#(
(do |a b| (set a 10) (set b 20) (+ a b) )
(do |a b| (set a 11) (set b 21) (+ a b) )
999
)
)
(set v2 #(30 32 999))
(if (nql? v v2) (print "ERROR: v1 and v2 are not equal\n")
else (printf "OK: v and v2 equal\n"))
if (nql? v v2) (print "ERROR: v1 and v2 are not equal\n")\
else (printf "OK: v and v2 equal\n")

31
t/var-03.hcl Normal file
View File

@ -0,0 +1,31 @@
## there are 8 local temporaries variables in the top-level context
## the 8 temporaries defined inside the block expression are parked
## at the top-level context. 'a' assigned before the block expression
## is a global variable.
a := 1234
{
| a b c d |
| e f g h |
a := 10
b := 20
c := 30
d := 40
e := 50
f := 60
g := 70
h := 80
if (/= a 10) { print "ERROR: a inside the block expression is not 10\n" } \
else { printf "OK: %d\n" a };
}
a := (a + 1)
c := (sprintf "%d" a)
if (/= a 1235) { printf "ERROR: a is not 1235\n" } \
else { printf "OK: %d\n" a };
if (nql? c "1235") { printf "ERROR: c is not \"1235\"\n" } \
else { printf "OK: %s\n" c };