X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=4bd3959f5147ac5bdcab4f1d46760f5cbc60fcec;hp=fd753ce5e0b0d43484fb6959e19cb30c7ee04aab;hb=cb8d9032314bbb51b505a5100b0bc484056771e0;hpb=5a438bb96ff5bd82e67312b79f593ecfcbf32529

diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc
index fd753ce..4bd3959 100644
--- a/csrc/oceani.mdc
+++ b/csrc/oceani.mdc
@@ -166,6 +166,12 @@ structures can be used.
 		{NULL,        0, NULL, 0},
 	};
 	const char *options = "tpnbs";
+
+	static void pr_err(char *msg)			// NOTEST
+	{
+		fprintf(stderr, "%s\n", msg);		// NOTEST
+	}						// NOTEST
+
 	int main(int argc, char *argv[])
 	{
 		int fd;
@@ -207,7 +213,7 @@ structures can be used.
 		context.file_name = argv[optind];
 		len = lseek(fd, 0, 2);
 		file = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, 0);
-		s = code_extract(file, file+len, NULL);
+		s = code_extract(file, file+len, pr_err);
 		if (!s) {
 			fprintf(stderr, "oceani: could not find any code in %s\n",
 			        argv[optind]);
@@ -258,6 +264,7 @@ structures can be used.
 		}
 		## free context vars
 		## free context types
+		## free context storage
 		exit(context.parse_error ? 1 : 0);
 	}
 
@@ -524,8 +531,8 @@ Named type are stored in a simple linked list.  Objects of each type are
 	{
 		if (tl && tl->cmp_order)
 			return tl->cmp_order(tl, tr, left, right);
-		if (tl && tl->cmp_eq)
-			return tl->cmp_eq(tl, tr, left, right);
+		if (tl && tl->cmp_eq)			// NOTEST
+			return tl->cmp_eq(tl, tr, left, right);	// NOTEST
 		return -1;				// NOTEST
 	}
 
@@ -612,9 +619,9 @@ A separate function encoding these cases will simplify some code later.
 	static int type_compat(struct type *require, struct type *have, int rules)
 	{
 		if ((rules & Rboolok) && have == Tbool)
-			return 1;
+			return 1;	// NOTEST
 		if ((rules & Rnolabel) && have == Tlabel)
-			return 0;
+			return 0;	// NOTEST
 		if (!require || !have)
 			return 1;
 
@@ -766,7 +773,7 @@ A separate function encoding these cases will simplify some code later.
 		t->size = size;
 		t->align = size > sizeof(void*) ? sizeof(void*) : size;
 		if (t->size & (t->align - 1))
-			t->size = (t->size | (t->align - 1)) + 1;
+			t->size = (t->size | (t->align - 1)) + 1;	// NOTEST
 		return t;
 	}
 
@@ -1140,7 +1147,7 @@ all pending-scope variables become conditionally scoped.
 
 		scope_pop(c);
 		for (vp = &c->in_scope;
-		     v = *vp, v && v->depth > c->scope_depth && v->min_depth > c->scope_depth;
+		     v = *vp, v && v->min_depth > c->scope_depth;
 		     ) {
 			if (v->name->var == v) switch (ct) {
 			case CloseElse:
@@ -1153,10 +1160,10 @@ all pending-scope variables become conditionally scoped.
 					else if (v->previous &&
 					         v->previous->scope == PendingScope)
 						v->scope = PendingScope;
-					else if (v->type == Tlabel)
-						v->scope = PendingScope;
-					else if (v->name->var == v)
-						v->scope = OutScope;
+					else if (v->type == Tlabel)	// UNTESTED
+						v->scope = PendingScope;	// UNTESTED
+					else if (v->name->var == v)	// UNTESTED
+						v->scope = OutScope;	// UNTESTED
 					if (ct == CloseElse) {
 						/* All Pending variables with this name
 						 * are now Conditional */
@@ -1173,7 +1180,7 @@ all pending-scope variables become conditionally scoped.
 						if (v2->type != Tlabel)
 							v2->scope = OutScope;
 					break;
-				case OutScope: break;
+				case OutScope: break;	// UNTESTED
 				}
 				break;
 			case CloseSequential:
@@ -1262,10 +1269,10 @@ is started, so there is no need to allocate until the size is known.
 		struct variable scratch;
 
 		if (t->prepare_type)
-			t->prepare_type(c, t, 1);
+			t->prepare_type(c, t, 1);	// NOTEST
 
 		if (c->global_size & (t->align - 1))
-			c->global_size = (c->global_size + t->align) & ~(t->align-1);
+			c->global_size = (c->global_size + t->align) & ~(t->align-1);	// UNTESTED
 		if (!v) {
 			v = &scratch;
 			v->type = t;
@@ -1312,7 +1319,7 @@ For this we have `scope_finalize()`.
 		c->local = calloc(1, c->local_size);
 	}
 
-###### free context vars
+###### free context storage
 	free(context.global);
 	free(context.local);
 
@@ -1369,7 +1376,7 @@ from the `exec_types` enum.
 	static int __fput_loc(struct exec *loc, FILE *f)
 	{
 		if (!loc)
-			return 0;		// NOTEST
+			return 0;
 		if (loc->line >= 0) {
 			fprintf(f, "%d:%d: ", loc->line, loc->column);
 			return 1;
@@ -1579,9 +1586,9 @@ in `rval`.
 
 		rvtype = ret.type = Tnone;
 		if (!e) {
-			ret.lval = lrv;
-			ret.rval = rv;
-			return ret;
+			ret.lval = lrv;	// UNTESTED
+			ret.rval = rv;	// UNTESTED
+			return ret;	// UNTESTED
 		}
 
 		switch(e->type) {
@@ -1688,9 +1695,9 @@ with a const size by whether they are prepared at parse time or not.
 		void *ptr = val->ptr;
 
 		if (!val)
-			return;
+			return;				// NOTEST
 		if (!type->array.static_size) {
-			val->array = calloc(type->array.size, 
+			val->array = calloc(type->array.size,
 					    type->array.member->size);
 			ptr = val->array;
 		}
@@ -1720,23 +1727,23 @@ with a const size by whether they are prepared at parse time or not.
 	static int array_compat(struct type *require, struct type *have)
 	{
 		if (have->compat != require->compat)
-			return 0;
+			return 0;	// UNTESTED
 		/* Both are arrays, so we can look at details */
 		if (!type_compat(require->array.member, have->array.member, 0))
 			return 0;
 		if (have->array.unspec && require->array.unspec) {
 			if (have->array.vsize && require->array.vsize &&
-			    have->array.vsize != require->array.vsize)
+			    have->array.vsize != require->array.vsize)	// UNTESTED
 				/* sizes might not be the same */
-				return 0;
+				return 0;	// UNTESTED
 			return 1;
 		}
 		if (have->array.unspec || require->array.unspec)
-			return 1;
+			return 1;	// UNTESTED
 		if (require->array.vsize == NULL && have->array.vsize == NULL)
 			return require->array.size == have->array.size;
 
-		return require->array.vsize == have->array.vsize;
+		return require->array.vsize == have->array.vsize;	// UNTESTED
 	}
 
 	static void array_print_type(struct type *type, FILE *f)
@@ -2058,7 +2065,7 @@ function will be needed.
 		struct type *st = propagate_types(f->left, c, ok, NULL, 0);
 
 		if (!st)
-			type_err(c, "error: unknown type for field access", f->left,
+			type_err(c, "error: unknown type for field access", f->left,	// UNTESTED
 			         NULL, 0, NULL);
 		else if (st->init != structure_init)
 			type_err(c, "error: field reference attempted on %1, not a struct",
@@ -2103,8 +2110,8 @@ function will be needed.
 			return;
 		free_fieldlist(f->prev);
 		if (f->f.init) {
-			free_value(f->f.type, f->f.init);
-			free(f->f.init);
+			free_value(f->f.type, f->f.init);	// UNTESTED
+			free(f->f.init);	// UNTESTED
 		}
 		free(f);
 	}
@@ -2160,7 +2167,7 @@ function will be needed.
 		| ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$
 
 	Field -> IDENTIFIER : Type = Expression ${ {
-			int ok;
+			int ok;	// UNTESTED
 
 			$0 = calloc(1, sizeof(struct fieldlist));
 			$0->f.name = $1.txt;
@@ -2171,7 +2178,7 @@ function will be needed.
 				propagate_types($<5, c, &ok, $3, 0);
 			} while (ok == 2);
 			if (!ok)
-				c->parse_error = 1;
+				c->parse_error = 1;	// UNTESTED
 			else {
 				struct value vl = interp_exec(c, $5, NULL);
 				$0->f.init = global_alloc(c, $0->f.type, NULL, &vl);
@@ -2189,9 +2196,9 @@ function will be needed.
 	static void structure_print_type(struct type *t, FILE *f);
 
 ###### value functions
-	static void structure_print_type(struct type *t, FILE *f)
-	{
-		int i;
+	static void structure_print_type(struct type *t, FILE *f)	// UNTESTED
+	{	// UNTESTED
+		int i;	// UNTESTED
 
 		fprintf(f, "struct %.*s\n", t->name.len, t->name.txt);
 
@@ -2202,18 +2209,18 @@ function will be needed.
 			if (fl->type->print && fl->init) {
 				fprintf(f, " = ");
 				if (fl->type == Tstr)
-					fprintf(f, "\"");
+					fprintf(f, "\"");	// UNTESTED
 				print_value(fl->type, fl->init);
 				if (fl->type == Tstr)
-					fprintf(f, "\"");
+					fprintf(f, "\"");	// UNTESTED
 			}
 			printf("\n");
 		}
 	}
 
 ###### print type decls
-	{
-		struct type *t;
+	{	// UNTESTED
+		struct type *t;	// UNTESTED
 		int target = -1;
 
 		while (target != 0) {
@@ -2299,7 +2306,7 @@ or as an indented list of one parameter per line
 		| Varlist ; ${ $0 = $<1; }$
 		| Varlist NEWLINE ${ $0 = $<1; }$
 
-	Varlist -> Varlist ; ArgDecl ${
+	Varlist -> Varlist ; ArgDecl ${	// UNTESTED
 			$0 = new(binode);
 			$0->op = List;
 			$0->left = $<Vl;
@@ -2369,7 +2376,7 @@ an executable.
 			{
 			char tail[3];
 			if (number_parse($0->val.num, tail, $1.txt) == 0)
-				mpq_init($0->val.num);
+				mpq_init($0->val.num);	// UNTESTED
 				if (tail[0])
 					tok_err(c, "error: unsupported number suffix",
 					        &$1);
@@ -2635,7 +2642,7 @@ link to find the primary instance.
 		struct variable *v = var->var;
 
 		if (v->merged)
-			v = v->merged;
+			v = v->merged;	// UNTESTED
 		lrv = var_value(c, v);
 		rvtype = v->type;
 		break;
@@ -2720,7 +2727,7 @@ there.
 		struct binode *b2 = cast(binode, b->right);
 		left = interp_exec(c, b->left, &ltype);
 		if (left.bool)
-			rv = interp_exec(c, b2->left, &rvtype);
+			rv = interp_exec(c, b2->left, &rvtype);	// UNTESTED
 		else
 			rv = interp_exec(c, b2->right, &rvtype);
 		}
@@ -2945,9 +2952,9 @@ expression operator, and the `CMPop` non-terminal will match one of them.
 		if (t)
 			propagate_types(b->right, c, ok, t, 0);
 		else {
-			t = propagate_types(b->right, c, ok, NULL, Rnolabel);
-			if (t)
-				t = propagate_types(b->left, c, ok, t, 0);
+			t = propagate_types(b->right, c, ok, NULL, Rnolabel);	// UNTESTED
+			if (t)	// UNTESTED
+				t = propagate_types(b->left, c, ok, t, 0);	// UNTESTED
 		}
 		if (!type_compat(type, Tbool, 0))
 			type_err(c, "error: Comparison returns %1 but %2 expected", prog,
@@ -3127,7 +3134,7 @@ should only insert brackets were needed for precedence.
 		/* op must be string, result is number */
 		propagate_types(b->left, c, ok, Tstr, 0);
 		if (!type_compat(type, Tnum, 0))
-			type_err(c,
+			type_err(c,	// UNTESTED
 			  "error: Can only convert string to number, not %1",
 				prog, type, 0, NULL);
 		return Tnum;
@@ -3198,16 +3205,16 @@ should only insert brackets were needed for precedence.
 		char tail[3];
 		int neg = 0;
 		if (tx.txt[0] == '-') {
-			neg = 1;
-			tx.txt++;
-			tx.len--;
+			neg = 1;	// UNTESTED
+			tx.txt++;	// UNTESTED
+			tx.len--;	// UNTESTED
 		}
 		if (number_parse(rv.num, tail, tx) == 0)
-			mpq_init(rv.num);
+			mpq_init(rv.num);	// UNTESTED
 		else if (neg)
-			mpq_neg(rv.num, rv.num);
+			mpq_neg(rv.num, rv.num);	// UNTESTED
 		if (tail[0])
-			printf("Unsupported suffix: %.*s\n", tx.len, tx.txt);
+			printf("Unsupported suffix: %.*s\n", tx.len, tx.txt);	// UNTESTED
 
 		break;
 
@@ -3361,13 +3368,13 @@ is in-place.
 	case Block:
 		if (indent < 0) {
 			// simple statement
-			if (b->left == NULL)
-				printf("pass");
+			if (b->left == NULL)	// UNTESTED
+				printf("pass");	// UNTESTED
 			else
-				print_exec(b->left, indent, bracket);
-			if (b->right) {
-				printf("; ");
-				print_exec(b->right, indent, bracket);
+				print_exec(b->left, indent, bracket);	// UNTESTED
+			if (b->right) {	// UNTESTED
+				printf("; ");	// UNTESTED
+				print_exec(b->right, indent, bracket);	// UNTESTED
 			}
 		} else {
 			// block, one per line
@@ -4019,16 +4026,16 @@ defined.
 				do_indent(indent, "if");
 			if (cs->condpart && cs->condpart->type == Xbinode &&
 			    cast(binode, cs->condpart)->op == Block) {
-				if (bracket)
-					printf(" {\n");
+				if (bracket)	// UNTESTED
+					printf(" {\n");	// UNTESTED
 				else
-					printf(":\n");
-				print_exec(cs->condpart, indent+1, bracket);
-				if (bracket)
-					do_indent(indent, "}\n");
-				if (cs->thenpart) {
-					do_indent(indent, "then:\n");
-					print_exec(cs->thenpart, indent+1, bracket);
+					printf(":\n");	// UNTESTED
+				print_exec(cs->condpart, indent+1, bracket);	// UNTESTED
+				if (bracket)	// UNTESTED
+					do_indent(indent, "}\n");	// UNTESTED
+				if (cs->thenpart) {	// UNTESTED
+					do_indent(indent, "then:\n");	// UNTESTED
+					print_exec(cs->thenpart, indent+1, bracket);	// UNTESTED
 				}
 			} else {
 				printf(" ");
@@ -4087,14 +4094,14 @@ defined.
 
 		t = propagate_types(cs->forpart, c, ok, Tnone, 0);
 		if (!type_compat(Tnone, t, 0))
-			*ok = 0;
+			*ok = 0;	// UNTESTED
 		t = propagate_types(cs->dopart, c, ok, Tnone, 0);
 		if (!type_compat(Tnone, t, 0))
-			*ok = 0;
+			*ok = 0;	// UNTESTED
 		if (cs->dopart) {
 			t = propagate_types(cs->thenpart, c, ok, Tnone, 0);
 			if (!type_compat(Tnone, t, 0))
-				*ok = 0;
+				*ok = 0;	// UNTESTED
 		}
 		if (cs->casepart == NULL)
 			propagate_types(cs->condpart, c, ok, Tbool, 0);
@@ -4105,7 +4112,7 @@ defined.
 			     cp && !t; cp = cp->next)
 				t = propagate_types(cp->value, c, ok, NULL, 0);
 			if (!t && cs->condpart)
-				t = propagate_types(cs->condpart, c, ok, NULL, Rboolok);
+				t = propagate_types(cs->condpart, c, ok, NULL, Rboolok);	// UNTESTED
 			// Now we have a type (I hope) push it down
 			if (t) {
 				for (cp = cs->casepart; cp; cp = cp->next)
@@ -4120,8 +4127,8 @@ defined.
 			type = propagate_types(cs->elsepart, c, ok, NULL, rules);
 		for (cp = cs->casepart;
 		     cp && !type;
-		     cp = cp->next)
-			type = propagate_types(cp->action, c, ok, NULL, rules);
+		     cp = cp->next)	// UNTESTED
+			type = propagate_types(cp->action, c, ok, NULL, rules);	// UNTESTED
 		if (type) {
 			if (!cs->dopart)
 				propagate_types(cs->thenpart, c, ok, type, rules);
@@ -4147,7 +4154,7 @@ defined.
 			if (cs->condpart)
 				cnd = interp_exec(c, cs->condpart, &cndtype);
 			else
-				cndtype = Tnone;
+				cndtype = Tnone;	// UNTESTED
 			if (!(cndtype == Tnone ||
 			      (cndtype == Tbool && cnd.bool != 0)))
 				break;
@@ -4215,7 +4222,7 @@ various declarations in the parse context.
 		| DeclarationList Declaration
 
 	Declaration -> ERROR Newlines ${
-			tok_err(c,
+			tok_err(c,	// UNTESTED
 			        "error: unhandled parse error", &$1);
 		}$
 		| DeclareConstant
@@ -4418,7 +4425,7 @@ analysis is a bit more interesting at this level.
 		/* Make sure everything is still consistent */
 		propagate_types(bp->right, c, &ok, Tnone, 0);
 		if (!ok)
-			return 0;
+			return 0;	// UNTESTED
 		scope_finalize(c);
 		return 1;
 	}