enhanced the compiler to show a proper message for a redundant class name defined with 'class'
Some checks failed
continuous-integration/drone/push Build is failing
Some checks failed
continuous-integration/drone/push Build is failing
This commit is contained in:
parent
c82b56fdf6
commit
309442e307
5
lang.txt
5
lang.txt
@ -20,6 +20,11 @@
|
|||||||
make basic branded types to an object if possible.
|
make basic branded types to an object if possible.
|
||||||
for example (#[10 20]:at 1)
|
for example (#[10 20]:at 1)
|
||||||
|
|
||||||
|
default return value for some class methods.
|
||||||
|
::: method -> return what??
|
||||||
|
::* method -> return the new instance
|
||||||
|
normal method -> return the last evaluated value?
|
||||||
|
|
||||||
|
|
||||||
## dictionary list (DIC)
|
## dictionary list (DIC)
|
||||||
#{ 1 2 3 4 }
|
#{ 1 2 3 4 }
|
||||||
|
31
lib/comp.c
31
lib/comp.c
@ -2336,31 +2336,38 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass)
|
|||||||
class_name = HCL_CNODE_CONS_CAR(obj);
|
class_name = HCL_CNODE_CONS_CAR(obj);
|
||||||
if (!HCL_CNODE_IS_SYMBOL(class_name))
|
if (!HCL_CNODE_IS_SYMBOL(class_name))
|
||||||
{
|
{
|
||||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(class_name), HCL_CNODE_GET_TOK(class_name), "class name not symbol in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
|
hcl_setsynerrbfmt (
|
||||||
|
hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(class_name), HCL_CNODE_GET_TOK(class_name),
|
||||||
|
"class name not symbol in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
|
||||||
return -1;
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (HCL_CNODE_SYMBOL_SYNCODE(class_name)) /*|| HCL_OBJ_GET_FLAGS_KERNEL(class_name) >= 1) */
|
if (HCL_CNODE_SYMBOL_SYNCODE(class_name)) /*|| HCL_OBJ_GET_FLAGS_KERNEL(class_name) >= 1) */
|
||||||
{
|
{
|
||||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(class_name), HCL_CNODE_GET_TOK(class_name), "special symbol not to be used as class name");
|
hcl_setsynerrbfmt (
|
||||||
|
hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(class_name), HCL_CNODE_GET_TOK(class_name),
|
||||||
|
"special symbol not to be used as class name");
|
||||||
return -1;
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
obj = HCL_CNODE_CONS_CDR(obj);
|
obj = HCL_CNODE_CONS_CDR(obj);
|
||||||
/*
|
|
||||||
if (is_in_top_scope(hcl))
|
|
||||||
{
|
|
||||||
HCL_DEBUG2(hcl, "AT TOP SCOPE - %.*js\n", HCL_CNODE_GET_TOKLEN(class_name), HCL_CNODE_GET_TOKPTR(class_name));
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
HCL_DEBUG2(hcl, "NOT NOT NOT NOT NOT AT TOP SCOPE - %.*js\n", HCL_CNODE_GET_TOKLEN(class_name), HCL_CNODE_GET_TOKPTR(class_name));
|
|
||||||
}
|
|
||||||
*/
|
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(cmd, HCL_SYNCODE_CLASS));
|
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(cmd, HCL_SYNCODE_CLASS));
|
||||||
|
|
||||||
|
if (obj && HCL_CNODE_IS_CONS(obj))
|
||||||
|
{
|
||||||
|
class_name = HCL_CNODE_CONS_CAR(obj);
|
||||||
|
if (HCL_CNODE_IS_SYMBOL(class_name))
|
||||||
|
{
|
||||||
|
hcl_setsynerrbfmt (
|
||||||
|
hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(class_name), HCL_CNODE_GET_TOK(class_name),
|
||||||
|
"class name not allowed in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
class_name = HCL_NULL;
|
class_name = HCL_NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1,13 +1,26 @@
|
|||||||
(set t
|
set t (
|
||||||
(defclass X
|
class | x | {
|
||||||
| x |
|
defun ::* make() { set x 1234; return self; };
|
||||||
(defun ::* make() (set x 1234) self)
|
defun get-x() { return x };
|
||||||
(defun get-x() x)
|
}
|
||||||
)
|
);
|
||||||
)
|
|
||||||
(if (nqv? t X) (printf "ERROR: t must point to X\n"))
|
|
||||||
(printf "OK: t points to X\n")
|
|
||||||
|
|
||||||
(set t (:(:t make) get-x))
|
set X t;
|
||||||
(if (nqv? t 1234) (printf "ERROR: t must be 1234\n"))
|
|
||||||
(printf "OK: t is %d\n" t)
|
if (nqv? t X) { printf "ERROR: t must point to X\n" }
|
||||||
|
else { printf "OK: t points to X\n" };
|
||||||
|
|
||||||
|
set t ((t:make):get-x);
|
||||||
|
|
||||||
|
if (nqv? t 1234) { printf "ERROR: t must be 1234\n" }
|
||||||
|
else { printf "OK: t is %d\n" t };
|
||||||
|
|
||||||
|
|
||||||
|
set j #{ ((X:make):get-x): 9999, 4512: ((X: make): get-x) };
|
||||||
|
set v (dic.get j 1234);
|
||||||
|
if (nqv? v 9999) { printf "ERROR: v is not 9999\n" }
|
||||||
|
else { printf "OK: value is %d\n" v };
|
||||||
|
|
||||||
|
set v (dic.get j 4512);
|
||||||
|
if (nqv? v 1234) { printf "ERROR: v is not 1234\n" }
|
||||||
|
else { printf "OK: value is %d\n" v };
|
||||||
|
Loading…
Reference in New Issue
Block a user