void
run_tests()
{
TRACE(fprintf(stderr, "---- tart unit tests ----\n"));
TRACE(fprintf(stderr, "NIL = %p\n", NIL));
TRACE(fprintf(stderr, "NOTHING = %p\n", NOTHING));
TRACE(fprintf(stderr, "a_halt = %p\n", a_halt));
TRACE(fprintf(stderr, "a_ignore = %p\n", a_ignore));
TRACE(fprintf(stderr, "e_nomem = %p\n", e_nomem));
TRACE(fprintf(stderr, "e_inval = %p\n", e_inval));
test_number();
test_string();
test_expr();
test_universe();
}
int
main (int argc, char *argv[])
{
int fd;
struct stat st;
int result;
char *inmem;
char *outmem;
size_t inlen;
size_t outlen;
#ifdef HAVE_MCHECK_H
mtrace ();
#endif
if (!argv[1])
exit (1);
/* Make the content of the file available in memory. */
fd = open (argv[1], O_RDONLY);
if (fd == -1)
error (EXIT_FAILURE, errno, "cannot open %s", basename (argv[1]));
if (fstat (fd, &st) != 0)
error (EXIT_FAILURE, errno, "cannot stat %s", basename (argv[1]));
memlen = st.st_size;
mem = (char *) malloc (memlen + 1);
if (mem == NULL)
error (EXIT_FAILURE, errno, "while allocating buffer");
if ((size_t) read (fd, mem, memlen) != memlen)
error (EXIT_FAILURE, 0, "cannot read entire file");
mem[memlen] = '\0';
close (fd);
/* We have to convert a few things from Latin-1 to UTF-8. */
cd = iconv_open ("UTF-8", "ISO-8859-1");
if (cd == (iconv_t) -1)
error (EXIT_FAILURE, errno, "cannot get conversion descriptor");
/* For the second test we have to convert the file content to UTF-8.
Since the text is mostly ASCII it should be enough to allocate
twice as much memory for the UTF-8 text than for the Latin-1
text. */
umem = (char *) calloc (2, memlen);
if (umem == NULL)
error (EXIT_FAILURE, errno, "while allocating buffer");
inmem = mem;
inlen = memlen;
outmem = umem;
outlen = 2 * memlen - 1;
iconv (cd, &inmem, &inlen, &outmem, &outlen);
umemlen = outmem - umem;
if (inlen != 0)
error (EXIT_FAILURE, errno, "cannot convert buffer");
#ifdef DEBUG
re_set_syntax (RE_DEBUG);
#endif
/* Run the actual tests. All tests are run in a single-byte and a
multi-byte locale. */
result = test_expr ("[הבאגיטךםלמסצףעפ�תש�]", 2, 2);
result |= test_expr ("G.ran", 2, 3);
result |= test_expr ("G.\\{1\\}ran", 2, 3);
result |= test_expr ("G.*ran", 3, 44);
result |= test_expr ("[הבאג]", 0, 0);
result |= test_expr ("Uddeborg", 2, 2);
result |= test_expr (".Uddeborg", 2, 2);
/* Free the resources. */
free (umem);
iconv_close (cd);
free (mem);
return result;
}
int
main (void)
{
const char *file;
int fd;
struct stat st;
int result;
char *inmem;
char *outmem;
size_t inlen;
size_t outlen;
mtrace ();
/* Make the content of the file available in memory. */
file = "../ChangeLog.8";
fd = open (file, O_RDONLY);
if (fd == -1)
error (EXIT_FAILURE, errno, "cannot open %s", basename (file));
if (fstat (fd, &st) != 0)
error (EXIT_FAILURE, errno, "cannot stat %s", basename (file));
memlen = st.st_size;
mem = (char *) malloc (memlen + 1);
if (mem == NULL)
error (EXIT_FAILURE, errno, "while allocating buffer");
if (read (fd, mem, memlen) != memlen)
error (EXIT_FAILURE, 0, "cannot read entire file");
mem[memlen] = '\0';
close (fd);
/* We have to convert a few things from Latin-1 to UTF-8. */
cd = iconv_open ("UTF-8", "ISO-8859-1");
if (cd == (iconv_t) -1)
error (EXIT_FAILURE, errno, "cannot get conversion descriptor");
/* For the second test we have to convert the file content to UTF-8.
Since the text is mostly ASCII it should be enough to allocate
twice as much memory for the UTF-8 text than for the Latin-1
text. */
umem = (char *) calloc (2, memlen);
if (umem == NULL)
error (EXIT_FAILURE, errno, "while allocating buffer");
inmem = mem;
inlen = memlen;
outmem = umem;
outlen = 2 * memlen - 1;
iconv (cd, &inmem, &inlen, &outmem, &outlen);
if (inlen != 0)
error (EXIT_FAILURE, errno, "cannot convert buffer");
#ifdef _POSIX_CPUTIME
/* See whether we can use the CPU clock. */
use_clock = clock_getcpuclockid (0, &cl) == 0;
#endif
#ifdef DEBUG
re_set_syntax (RE_DEBUG);
#endif
/* Run the actual tests. All tests are run in a single-byte and a
multi-byte locale. */
result = test_expr ("[הבאגיטךםלמסצףעפ�תש�]", 2);
result |= test_expr ("G.ran", 2);
result |= test_expr ("G.\\{1\\}ran", 2);
result |= test_expr ("G.*ran", 3);
result |= test_expr ("[הבאג]", 0);
/* Free the resources. */
free (umem);
iconv_close (cd);
free (mem);
return result;
}
static Const const_fold(Node node) /*;const_fold*/
{
/* This recursive procedure evaluates expressions, when static.
* If node is static, its actual value is returned, and the node is
* modified to be an ivalue. Otherwise const_fold returns om, and node
* is untouched. If the static evaluation shows that the expression
* would raise an exception, a ['raise' exception] value is produced
* and placed on the tree.
*/
Fortup ft1;
Node expn, index_list, index, discr_range;
Const result;
Node opn;
Node n2, op_range;
Symbol sym, op_type;
/* */
#define is_simple_value(t) ((t)->const_kind == CONST_INT \
|| (t)->const_kind == CONST_UINT || (t)->const_kind == CONST_REAL)
if (cdebug2 > 3) { }
switch (N_KIND(node)) {
case(as_simple_name):
result = const_val(N_UNQ(node));
break;
case(as_ivalue):
result = (Const) N_VAL(node);
break;
case(as_int_literal):
/* TBSL: assuming int literal already converted check this Const*/
result = (Const) N_VAL(node);
break;
case(as_real_literal):
/*TBSL: assuming real literal already converted */
result = (Const) N_VAL(node);
break;
case(as_string_ivalue):
/* Will be static if required type has static low bound.*/
/* indx := index_type(N_TYPE(node));
* [-, lo_exp, -] := signature(indx);
* * Move this test to the expander, once format of aggregates is known.
* if is_static_expr(lo_exp) then
* lob := N_VAL(lo_exp);
* av := [v : [-, v] in comp_list];
* result := check_null_aggregate(av, lob, indices, node);
* result := ['array_ivalue', [v: [-, v] in comp_list],
* lob, lob + #comp_list - 1];
* else
*/
result = const_new(CONST_OM);
/* end if; */
break;
case(as_character_literal):
result = const_new(CONST_STR);
break;
case(as_un_op):
result = fold_unop(node);
break;
case(as_in):
opn = N_AST1(node);
op_range = N_AST2(node);
result = eval_qual_range(opn, N_TYPE(op_range));
if (is_const_constraint_error(result))
result = test_expr(FALSE);
else if (!is_const_om(result))
result = test_expr(TRUE);
break;
case(as_notin):
opn = N_AST1(node);
n2 = N_AST2(node);
result = eval_qual_range(opn, N_TYPE(n2));
if (is_const_constraint_error(result))
result = test_expr(TRUE);
else if (!is_const_constraint_error(result))
result = test_expr(FALSE);
break;
case(as_op):
result = fold_op(node);
break;
case(as_call):
{
int i;
Tuple arg_list;
Const arg;
opn = N_AST1(node);
result = const_new(CONST_OM); /* in general not static */
arg_list = N_LIST(N_AST2(node)); /* but can fold actuals. */
for (i = 1; i <= tup_size(arg_list); i++)
arg = const_fold((Node)arg_list[i]);
if (N_KIND(opn) == as_simple_name) {
sym = ALIAS(N_UNQ(opn));
if (sym != (Symbol)0 && is_literal(sym))
/* replace call by actual value of literal */
result = eval_lit_map(sym);
}
}
break;
case(as_parenthesis):
/* If the parenthesised expression is evaluable, return
* its value. Otherwise leave it parenthesised.
*/
opn = N_AST1(node);
result = const_fold(opn);
break;
case(as_qual_range):
opn = N_AST1(node);
op_type = N_TYPE(node);
result = eval_qual_range(opn, op_type);
if (is_const_constraint_error(result)) {
create_raise(node, symbol_constraint_error);
result = const_new(CONST_OM);
}
break;
case(as_qual_index):
eval_static(N_AST1(node));
result = const_new(CONST_OM);
break;
case(as_attribute):
case(as_range_attribute):
/* use separate procedure for C */
result = fold_attr(node);
break;
case(as_qualify):
if (fold_context)
result = const_fold(N_AST2(node));
else
/* in the context of a conformance check, keep qualification.*/
result = const_new(CONST_OM);
break;
/* Type conversion:
* /TBSL/ These conversions are not properly checked!
*/
case(as_convert):
/* use separate procedure for C */
result = fold_convert(node);
break;
case(as_array_aggregate):
/* This is treated in the expander.*/
result = const_new(CONST_OM);
break;
case(as_record_aggregate):
result = const_new(CONST_OM);
break;
case(as_selector): /*TBSL Case for discriminants needed */
expn = N_AST1(node);
eval_static(expn);
return const_new(CONST_OM);
case(as_slice):
expn = N_AST1(node);
discr_range = N_AST2(node);
eval_static(expn);
eval_static(discr_range);
return const_new(CONST_OM);
case(as_row): /* Not folded for now.*/
/* p1 := check_const_val(op1);
* if is_value(op1) then
* result := ['array_ivalue', [op1(2)], 1, 1];
* else
*/
return const_new(CONST_OM);
case(as_index):
expn = N_AST1(node);
index_list = N_AST2(node);
eval_static(expn);
FORTUP(index = (Node), N_LIST(index_list), ft1)
eval_static(index);
ENDFORTUP(ft1);
return const_new(CONST_OM);
default:
result = const_new(CONST_OM);
}
if (result->const_kind != CONST_OM)
insert_and_prune(node, result);
return result;
}
