* fixes ticket 890:

.gitignore

@@ -19,3 +19,4 @@ source/creole
 source/eudoc
 tests/return15
 tests/warnings_issued*.txt
+builds

source/be_execute.c

@@ -4186,9 +4186,21 @@ void do_exec(intptr_t *start_pc)
 
 				// get the routine symtab_ptr:
 				b = get_pos_int("call_proc/call_func", *(object_ptr)pc[2]);
-				if (b >= e_routine_next) {
+
+				// do not count on returned value being positive.
+				if (b < 0 || b >= e_routine_next) {
 					RTFatal("invalid routine id");
 				}
+
+                		sub = e_routine[b];
+                		if (sub->token != PROC) {
+                		    RTFatal("Expected a routine_id of a procedure.  Not that of a function (%s).", sub->name);
+                		}
+
+                		if (sub->u.subp.num_args != 1) {
+                		    RTFatal("Expected a routine_id of a procedure which takes only one argument, not %s which takes %d.", sub->name, sub->u.subp.num_args);
+                		}
+
 				obj_ptr = (object_ptr) DeleteRoutine( b );
 
 				// Only ref if source and target are different, and the source

source/be_machine.c

@@ -231,7 +231,9 @@ object ATOM_TO_ATOM_INT( object X ) {
 }
 
 uintptr_t get_pos_int(char *where, object x)
-/* return a positive integer value if possible */
+/* return a positive integer value if possible.  The value 
+ * returned between -2^30 to 2^64-1. It will fail if x is
+ * a sequence. */
 {
 	if (IS_ATOM_INT(x))
 		return INT_VAL(x);

tests/t_c_890-1.d/control.err

@@ -0,0 +1,6 @@
+tests/t_c_890-1.e:6 in type boolean() 
+Expected a routine_id of a procedure.  Not that of a function (bad_cleanup_routine). 
+    i1 = <no value>
+
+
+Public & Export & Global & Local Variables

tests/t_c_890-1.e

@@ -0,0 +1,32 @@
+include std/unittest.e
+include std/os.e 
+
+enum KEYBOARD = 0, SCREEN 
+
+type enum boolean FALSE = 0, TRUE
+end type
+
+boolean cleaned = FALSE
+
+function bad_cleanup_routine(object x) 
+    cleaned = TRUE
+	return 0
+end function 
+
+function new_object_with_cleanup() 
+	return delete_routine(1, routine_id("bad_cleanup_routine")) 
+end function 
+
+integer x = new_object_with_cleanup() 
+
+-- should clean up x here 
+x = 4 
+
+while x do
+    x = x - 1 
+end while 
+
+test_pass("Able to operate with a destructor assigned to integer\n")
+test_true("cleanup_routine_called", cleaned) 
+
+test_report()

tests/t_c_890-2.d/control.err

@@ -0,0 +1,6 @@
+/home/leprechaun/Source/euphoria/tests/t_c_890-2.e:6 in type boolean() 
+Expected a routine_id of a procedure which takes only one argument, not bad_cleanup_routine which takes 0. 
+    i1 = <no value>
+
+
+Public & Export & Global & Local Variables

tests/t_c_890-2.e

@@ -0,0 +1,31 @@
+include std/unittest.e
+include std/os.e 
+
+enum KEYBOARD = 0, SCREEN 
+
+type enum boolean FALSE = 0, TRUE
+end type
+
+boolean cleaned = FALSE
+
+procedure bad_cleanup_routine() 
+    cleaned = TRUE
+end procedure 
+
+function new_object_with_cleanup() 
+	return delete_routine(1, routine_id("bad_cleanup_routine")) 
+end function 
+
+integer x = new_object_with_cleanup() 
+
+-- should clean up x here 
+x = 4 
+
+while x do
+    x = x - 1 
+end while 
+
+test_pass("Able to operate with a destructor assigned to integer\n")
+test_true("cleanup_routine_called", cleaned) 
+
+test_report()

tests/t_c_890-3.d/control.err

@@ -0,0 +1,7 @@
+euphoria/tests/t_c_890-3.e:6 in type boolean() 
+invalid routine id 
+    i1 = <no value>
+
+
+Public & Export & Global & Local Variables
+

tests/t_c_890-3.e

@@ -0,0 +1,32 @@
+include std/unittest.e
+include std/os.e 
+
+enum KEYBOARD = 0, SCREEN 
+
+type enum boolean FALSE = 0, TRUE
+end type
+
+boolean cleaned = FALSE
+
+function bad_cleanup_routine(object x) 
+    cleaned = TRUE
+	return 0
+end function 
+
+function new_object_with_cleanup() 
+	return delete_routine(1, -5) 
+end function 
+
+integer x = new_object_with_cleanup() 
+
+-- should clean up x here 
+x = 4 
+
+while x do
+    x = x - 1 
+end while 
+
+test_pass("Able to operate with a destructor assigned to integer\n")
+test_true("cleanup_routine_called", cleaned) 
+
+test_report()