Merge branch 'master' into new_cfun

src/CHANGELOG

@@ -85,6 +85,13 @@ ECL 9.1.0:
 
  - DEFSTRUCT :INCLUDE did not work with read only slots.
 
+ - EXT:SETENV now ensures that strings are null terminated.
+
+ - For high safety settings, ECL produces a CHECK-TYPE for each declaration
+   at the beginning of a function. If the declaration has a function type,
+   these checks were wrong, for TYPEP cannot take an arbitrary function type
+   as argument.
+
 * Visible changes:
 
  - New function (EXT:HEAP-SIZE &optional NEW-MAX-HEAP-SIZE) can change the      

src/c/main.d

@@ -703,7 +703,8 @@ si_setenv(cl_object var, cl_object value)
 	const cl_env_ptr the_env = ecl_process_env();
 	cl_fixnum ret_val;
 
-	var = ecl_check_cl_type(@'ext::setenv', var, t_base_string);
+	/* Strings have to be null terminated base strings */
+	var = si_copy_to_simple_base_string(var);
 	if (value == Cnil) {
 #ifdef HAVE_SETENV
 		/* Remove the variable when setting to nil, so that
@@ -720,22 +721,20 @@ si_setenv(cl_object var, cl_object value)
 		ret_val = 0;
 	} else {
 #ifdef HAVE_SETENV
-		value = ecl_check_cl_type(@'intern', value, t_base_string);
+		value = si_copy_to_simple_base_string(value);
 		ret_val = setenv((char*)var->base_string.self,
 				 (char*)value->base_string.self, 1);
 #else
-		cl_object temp =
-		  cl_format(4, Cnil, make_constant_base_string("~A=~A"), var,
-			    value);
-		if (temp->base_string.hasfillp && temp->base_string.fillp < temp->base_string.dim)
-		  temp->base_string.self[temp->base_string.fillp] = '\0';
+		value = cl_format(4, Cnil, make_constant_base_string("~A=~A"), var,
+				  value);
+		value = si_copy_to_simple_base_string(value);
 		putenv((char*)temp->base_string.self);
 #endif
 	}
 	if (ret_val == -1)
 		CEerror(Ct, "SI:SETENV failed: insufficient space in environment.",
 			1, Cnil);
-	@(return (value))
+	@(return value)
 }
 #endif
 

src/cmp/cmplam.lsp

@@ -232,7 +232,10 @@ The function thus belongs to the type of functions that cl_make_cfun accepts."
 	    do (push `(type ,type ,var) declarations))
       ;; We generate automatic type checks for function arguments that
       ;; are declared These checks can be deactivated by appropriate
-      ;; safety settings which are checked by OPTIONAL-CHECK-TYPE
+      ;; safety settings which are checked by OPTIONAL-CHECK-TYPE. Note
+      ;; that not all type declarations can be checked (take for instance
+      ;; (type (function (t t) t) foo)) We let OPTIONAL-CHECK-TYPE do the
+      ;; job.
       ;;
       (let* ((pairs (loop for var in type-checks
 		       nconc (let* ((name (var-name var))

src/cmp/cmptype.lsp

@@ -441,13 +441,25 @@
 ;;
 
 (defun remove-function-types (type)
-  (if (atom type)
-      type
-      (case (first type)
-	((OR AND NOT)
-	 (cons (first type) (loop for i in (rest type) collect (remove-function-types i))))
-	(FUNCTION 'FUNCTION)
-	(otherwise type))))
+  ;; We replace this type by an approximate one that contains no function
+  ;; types. This function may not produce the best approximation. Hence,
+  ;; it is only used for optional type checks where we do not want to pass
+  ;; TYPEP a complex type.
+  (flet ((simplify-type (type)
+           (cond ((subtypep type '(NOT FUNCTION))
+                  type)
+                 ((subtypep type 'FUNCTION)
+                  'FUNCTION)
+                 (t
+                  T))))
+    (if (atom type)
+        (simplify-type type)
+        (case (first type)
+          ((OR AND NOT)
+           (cons (first type)
+                 (loop for i in (rest type) collect (remove-function-types i))))
+          (FUNCTION 'FUNCTION)
+          (otherwise (simplify-type type))))))
 
 (defmacro optional-check-type (&whole whole var-name type &environment env)
   "Generates a type check that is only activated for the appropriate