mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

* Make sure that parameter errors are reported correctly.

Browse source 
Thanks to Martin Grabmueller for sending this patch.
This commit is contained in:
Dirk Herrmann 2001-01-24 18:07:29 +00:00
parent ed6a2db9d7
commit 3ba5a6c2f2
2 changed files with 79 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

20
libguile/ChangeLog
View file

@ -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

82
libguile/strorder.c
View file

@ -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