From 3ba5a6c2f2be7ee559f336d96f923e490b4d145b Mon Sep 17 00:00:00 2001
From: Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
Date: Wed, 24 Jan 2001 18:07:29 +0000
Subject: [PATCH] * Make sure that parameter errors are reported correctly.  
 Thanks to Martin Grabmueller for sending this patch.

---
 libguile/ChangeLog  | 20 +++++++++++
 libguile/strorder.c | 82 ++++++++++++++++++++++++++++++++-------------
 2 files changed, 79 insertions(+), 23 deletions(-)

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 3fa5ceda2..66e913e43 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,23 @@
+2001-01-24  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	This patch was sent by Martin Grabmueller and makes sure that
+	parameter errors are reported correctly by the lexicographic
+	ordering predicates.
+
+	* strorder.c (string_less_p, string_ci_less_p):  New functions.
+
+	(scm_string_less_p, scm_string_ci_less_p):  Extracted the core
+	functionality into string_less_p, string_ci_less_p respectively.
+	The remaining code is just a wrapper to do the parameter
+	checking.
+
+	(scm_string_leq_p, scm_string_gr_p, scm_string_geq_p):  Check the
+	parameters and call string_less_p instead of scm_string_less_p.
+
+	(scm_string_ci_leq_p, scm_string_ci_gr_p, scm_string_ci_geq_p):
+	Check the parameters and call string_less_ci_p instead of
+	scm_string_ci_less_p.
+
 2001-01-24  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
 	This patch modifies scm_display_error to perform parameter
diff --git a/libguile/strorder.c b/libguile/strorder.c
index 815488a92..adea5de92 100644
--- a/libguile/strorder.c
+++ b/libguile/strorder.c
@@ -124,18 +124,14 @@ SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
 #undef FUNC_NAME
 
 
-SCM_DEFINE1 (scm_string_less_p, "string<?", scm_tc7_rpsubr,
-             (SCM s1, SCM s2),
-	     "Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n"
-	     "is lexicographically less than @var{s2}.  (r5rs)")
-#define FUNC_NAME s_scm_string_less_p
+/* Helper function for the lexicographic ordering predicates.
+ * No argument checking is performed.  */
+static SCM
+string_less_p (SCM s1, SCM s2)
 {
   scm_sizet i, length1, length2, lengthm;
   unsigned char *c1, *c2;
 
-  SCM_VALIDATE_STRING (1, s1);
-  SCM_VALIDATE_STRING (2, s2);
-
   length1 = SCM_STRING_LENGTH (s1);
   length2 = SCM_STRING_LENGTH (s2);
   lengthm = min (length1, length2);
@@ -150,6 +146,19 @@ SCM_DEFINE1 (scm_string_less_p, "string<?", scm_tc7_rpsubr,
 
   return SCM_BOOL (length1 < length2);
 }
+
+
+SCM_DEFINE1 (scm_string_less_p, "string<?", scm_tc7_rpsubr,
+             (SCM s1, SCM s2),
+	     "Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n"
+	     "is lexicographically less than @var{s2}.  (r5rs)")
+#define FUNC_NAME s_scm_string_less_p
+{
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  return string_less_p (s1, s2);
+}
 #undef FUNC_NAME
 
 
@@ -159,7 +168,10 @@ SCM_DEFINE1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr,
 	     "is lexicographically less than or equal to @var{s2}.  (r5rs)")
 #define FUNC_NAME s_scm_string_leq_p
 {
-  return SCM_BOOL_NOT (scm_string_less_p (s2, s1));
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  return SCM_BOOL_NOT (string_less_p (s2, s1));
 }
 #undef FUNC_NAME
 
@@ -170,7 +182,10 @@ SCM_DEFINE1 (scm_string_gr_p, "string>?", scm_tc7_rpsubr,
 	     "is lexicographically greater than @var{s2}.  (r5rs)")
 #define FUNC_NAME s_scm_string_gr_p
 {
-  return scm_string_less_p (s2, s1);
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  return string_less_p (s2, s1);
 }
 #undef FUNC_NAME
 
@@ -181,24 +196,22 @@ SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr,
 	     "is lexicographically greater than or equal to @var{s2}.  (r5rs)")
 #define FUNC_NAME s_scm_string_geq_p
 {
-  return SCM_BOOL_NOT (scm_string_less_p (s1, s2));
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  return SCM_BOOL_NOT (string_less_p (s1, s2));
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr,
-             (SCM s1, SCM s2),
-	     "Case insensitive lexicographic ordering predicate; \n"
-	     "returns @t{#t} if @var{s1} is lexicographically less than\n"
-	     "@var{s2} regardless of case.  (r5rs)")
-#define FUNC_NAME s_scm_string_ci_less_p
+/* Helper function for the case insensitive lexicographic ordering
+ * predicates.  No argument checking is performed.  */
+static SCM
+string_ci_less_p (SCM s1, SCM s2)
 {
   scm_sizet i, length1, length2, lengthm;
   unsigned char *c1, *c2;
 
-  SCM_VALIDATE_STRING (1, s1);
-  SCM_VALIDATE_STRING (2, s2);
-
   length1 = SCM_STRING_LENGTH (s1);
   length2 = SCM_STRING_LENGTH (s2);
   lengthm = min (length1, length2);
@@ -213,6 +226,20 @@ SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr,
 
   return SCM_BOOL (length1 < length2);
 }
+
+
+SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr,
+             (SCM s1, SCM s2),
+	     "Case insensitive lexicographic ordering predicate; \n"
+	     "returns @t{#t} if @var{s1} is lexicographically less than\n"
+	     "@var{s2} regardless of case.  (r5rs)")
+#define FUNC_NAME s_scm_string_ci_less_p
+{
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  return string_ci_less_p (s1, s2);
+}
 #undef FUNC_NAME
 
 
@@ -223,7 +250,10 @@ SCM_DEFINE1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr,
 	     "or equal to @var{s2} regardless of case.  (r5rs)")
 #define FUNC_NAME s_scm_string_ci_leq_p
 {
-  return SCM_BOOL_NOT (scm_string_ci_less_p (s2, s1));
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  return SCM_BOOL_NOT (string_ci_less_p (s2, s1));
 }
 #undef FUNC_NAME
 
@@ -235,7 +265,10 @@ SCM_DEFINE1 (scm_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr,
 	     "@var{s2} regardless of case.  (r5rs)")
 #define FUNC_NAME s_scm_string_ci_gr_p
 {
-  return scm_string_ci_less_p (s2, s1);
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  return string_ci_less_p (s2, s1);
 }
 #undef FUNC_NAME
 
@@ -247,7 +280,10 @@ SCM_DEFINE1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr,
 	     "or equal to @var{s2} regardless of case.  (r5rs)")
 #define FUNC_NAME s_scm_string_ci_geq_p
 {
-  return SCM_BOOL_NOT (scm_string_ci_less_p (s1, s2));
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  return SCM_BOOL_NOT (string_ci_less_p (s1, s2));
 }
 #undef FUNC_NAME