-/* $Id: validate.h,v 1.5 2000-04-15 19:30:16 mdj Exp $ */
+/* $Id: validate.h,v 1.25 2001-01-24 00:02:43 dirk Exp $ */
/* Copyright (C) 1999, 2000 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
#define SCM_SYSERROR_MSG(str, args, val) \
do { scm_syserror_msg (FUNC_NAME, (str), (args), (val)); } while (0)
-#define SCM_COERCE_ROSTRING(pos, scm) \
- do { scm = scm_coerce_rostring (scm, FUNC_NAME, pos); } while (0)
-
#define SCM_WTA(pos, scm) \
do { scm_wta (scm, (char *) pos, FUNC_NAME); } while (0)
#define SCM_MISC_ERROR(str, args) \
do { scm_misc_error (FUNC_NAME, str, args); } while (0)
+#define SCM_WRONG_NUM_ARGS() \
+ do { scm_wrong_num_args (scm_makfrom0str (FUNC_NAME)); } while (0)
+
#define SCM_WRONG_TYPE_ARG(pos, obj) \
do { scm_wrong_type_arg (FUNC_NAME, pos, obj); } while (0)
do { scm_out_of_range_pos (FUNC_NAME, arg, SCM_MAKINUM (pos)); } while (0)
#define SCM_ASSERT_RANGE(pos, arg, f) \
- do { SCM_ASSERT (f, arg, SCM_OUTOFRANGE, FUNC_NAME); } while (0)
+ do { if (!(f)) scm_out_of_range (FUNC_NAME, arg); } while (0)
#define SCM_MUST_MALLOC_TYPE(type) \
((type *) scm_must_malloc (sizeof (type), FUNC_NAME))
\f
+#define SCM_VALIDATE_REST_ARGUMENT(x) \
+ do { \
+ if (SCM_DEBUG_REST_ARGUMENT) { \
+ if (scm_ilength (x) < 0) { \
+ SCM_MISC_ERROR ("Rest arguments do not form a proper list.", SCM_EOL); \
+ } \
+ } \
+ } while (0)
+
#define SCM_VALIDATE_NIM(pos, scm) SCM_MAKE_VALIDATE (pos, scm, NIMP)
#define SCM_VALIDATE_BOOL(pos, flag) SCM_MAKE_VALIDATE(pos, flag, BOOLP)
#define SCM_VALIDATE_BOOL_COPY(pos, flag, cvar) \
do { \
SCM_ASSERT (SCM_BOOLP (flag), flag, pos, FUNC_NAME); \
- cvar = SCM_TRUE_P (flag) ? 1 : 0; \
+ cvar = SCM_EQ_P (flag, SCM_BOOL_T) ? 1 : 0; \
} while (0)
-#define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE (pos, scm, ICHRP)
+#define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE (pos, scm, CHARP)
#define SCM_VALIDATE_CHAR_COPY(pos, scm, cvar) \
do { \
cvar = SCM_CHAR (scm); \
} while (0)
-#define SCM_VALIDATE_ROSTRING(pos, str) SCM_MAKE_VALIDATE (pos, str, ROSTRINGP)
+#define SCM_VALIDATE_STRING(pos, str) SCM_MAKE_VALIDATE (pos, str, STRINGP)
-#define SCM_VALIDATE_ROSTRING_COPY(pos, str, cvar) \
+#define SCM_VALIDATE_STRING_COPY(pos, str, cvar) \
do { \
- SCM_ASSERT (SCM_ROSTRINGP (str), str, pos, FUNC_NAME); \
- cvar = SCM_ROCHARS (str); \
+ SCM_ASSERT (SCM_STRINGP (str), str, pos, FUNC_NAME); \
+ cvar = SCM_STRING_CHARS(str); \
} while (0)
-#define SCM_VALIDATE_NULLORROSTRING_COPY(pos, str, cvar) \
- do { \
- SCM_ASSERT (SCM_FALSEP (str) || SCM_ROSTRINGP (str), \
- str, pos, FUNC_NAME); \
- if (SCM_FALSEP(str)) \
- cvar = NULL; \
- else \
- cvar = SCM_ROCHARS(str); \
+/* validate a string and optional start/end arguments which default to
+ 0/string-len. this is unrelated to the old shared substring
+ support, so please do not deprecate it :) */
+#define SCM_VALIDATE_SUBSTRING_SPEC_COPY(pos_str, str, c_str, \
+ pos_start, start, c_start,\
+ pos_end, end, c_end) \
+ do {\
+ SCM_VALIDATE_STRING_COPY (pos_str, str, c_str);\
+ SCM_VALIDATE_INUM_DEF_COPY (pos_start, start, 0, c_start);\
+ SCM_VALIDATE_INUM_DEF_COPY (pos_end, end, SCM_STRING_LENGTH (str), c_end);\
+ SCM_ASSERT_RANGE (pos_start, start,\
+ 0 <= c_start && c_start <= SCM_STRING_LENGTH (str));\
+ SCM_ASSERT_RANGE (pos_end, end,\
+ c_start <= c_end && c_end <= SCM_STRING_LENGTH (str));\
} while (0)
-#define SCM_VALIDATE_STRING(pos, str) SCM_MAKE_VALIDATE (pos, str, STRINGP)
+#define SCM_VALIDATE_REAL(pos, z) SCM_MAKE_VALIDATE (pos, z, REALP)
-#define SCM_VALIDATE_STRINGORSUBSTR(pos, str) \
- do { \
- SCM_ASSERT (SCM_STRINGP (str) || SCM_SUBSTRP (str), \
- str, pos, FUNC_NAME); \
- } while (0)
+#define SCM_VALIDATE_NUMBER(pos, z) SCM_MAKE_VALIDATE (pos, z, NUMBERP)
-#define SCM_VALIDATE_STRING_COPY(pos, str, cvar) \
- do { \
- SCM_ASSERT (SCM_STRINGP (str), str, pos, FUNC_NAME); \
- cvar = SCM_CHARS(str); \
+#define SCM_VALIDATE_NUMBER_COPY(pos, z, cvar) \
+ do { \
+ if (SCM_INUMP (z)) \
+ cvar = (double) SCM_INUM (z); \
+ else if (SCM_REALP (z)) \
+ cvar = SCM_REAL_VALUE (z); \
+ else if (SCM_BIGP (z)) \
+ cvar = scm_big2dbl (z); \
+ else \
+ { \
+ cvar = 0.0; \
+ SCM_WTA (pos, z); \
+ } \
} while (0)
-#define SCM_VALIDATE_RWSTRING(pos, str) \
- do { \
- SCM_ASSERT (SCM_STRINGP (str), str, pos, FUNC_NAME); \
- if (!SCM_RWSTRINGP (str)) \
- scm_misc_error (FUNC_NAME, "argument is a read-only string", str); \
+#define SCM_VALIDATE_NUMBER_DEF_COPY(pos, number, def, cvar) \
+ do { \
+ if (SCM_UNBNDP (number)) \
+ cvar = def; \
+ else \
+ SCM_VALIDATE_NUMBER_COPY(pos, number, cvar); \
} while (0)
-#define SCM_VALIDATE_REAL(pos, z) SCM_MAKE_VALIDATE (pos, z, REALP)
-
#define SCM_VALIDATE_INUM(pos, k) SCM_MAKE_VALIDATE (pos, k, INUMP)
#define SCM_VALIDATE_INUM_COPY(pos, k, cvar) \
#define SCM_VALIDATE_INUM_MIN_COPY(pos, k, min, cvar) \
do { \
SCM_ASSERT (SCM_INUMP (k), k, pos, FUNC_NAME); \
+ SCM_ASSERT_RANGE (pos, k, (SCM_INUM (k) >= min)); \
cvar = SCM_INUM (k); \
- SCM_ASSERT_RANGE (pos, k, (cvar >= min)); \
} while (0)
#define SCM_VALIDATE_INUM_MIN_DEF_COPY(pos, k, min, default, cvar) \
if (SCM_UNBNDP (k)) \
k = SCM_MAKINUM (default); \
SCM_ASSERT (SCM_INUMP (k), k, pos, FUNC_NAME); \
+ SCM_ASSERT_RANGE (pos, k, (SCM_INUM (k) >= min)); \
cvar = SCM_INUM (k); \
- SCM_ASSERT_RANGE (pos, k, (cvar >= min)); \
} while (0)
#define SCM_VALIDATE_INUM_DEF(pos, k, default) \
} while (0)
/* [low,high) */
-#define SCM_VALIDATE_INUM_RANGE(pos, k, low, high) \
+#define SCM_VALIDATE_INUM_RANGE(pos,k,low,high) \
+ do { SCM_ASSERT(SCM_INUMP(k), k, pos, FUNC_NAME); \
+ SCM_ASSERT_RANGE(pos,k, \
+ (SCM_INUM (k) >= low && \
+ SCM_INUM (k) < high)); \
+ } while (0)
+
+#define SCM_VALIDATE_INUM_RANGE_COPY(pos, k, low, high, cvar) \
do { \
SCM_ASSERT (SCM_INUMP (k), k, pos, FUNC_NAME); \
- SCM_ASSERT_RANGE (pos, k, \
- (SCM_INUM (k) >= low \
- && ((unsigned) SCM_INUM (k)) < high)); \
+ SCM_ASSERT_RANGE (pos, k, low <= SCM_INUM (k) && SCM_INUM (k) < high); \
+ cvar = SCM_INUM (k); \
} while (0)
#define SCM_VALIDATE_NULL(pos, scm) SCM_MAKE_VALIDATE (pos, scm, NULLP)
#define SCM_VALIDATE_SMOB(pos, obj, type) \
do { \
- SCM_ASSERT ((SCM_NIMP (obj) && SCM_TYP16 (obj) == scm_tc16_ ## type), \
+ SCM_ASSERT (SCM_TYP16_PREDICATE (scm_tc16_ ## type, obj), \
obj, pos, FUNC_NAME); \
} while (0)
#define SCM_VALIDATE_PROC(pos, proc) \
do { \
- SCM_ASSERT (SCM_TRUE_P (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \
+ SCM_ASSERT (SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T), proc, pos, FUNC_NAME); \
} while (0)
#define SCM_VALIDATE_NULLORCONS(pos, env) \
#define SCM_VALIDATE_RGXP(pos, a) SCM_MAKE_VALIDATE (pos, a, RGXP)
-#define SCM_VALIDATE_OPDIR(pos, port) SCM_MAKE_VALIDATE (pos, port, OPDIRP)
-
#define SCM_VALIDATE_DIR(pos, port) SCM_MAKE_VALIDATE (pos, port, DIRP)
#define SCM_VALIDATE_PORT(pos, port) SCM_MAKE_VALIDATE (pos, port, PORTP)
#define SCM_VALIDATE_VECTOR_LEN(pos, v, len) \
do { \
- SCM_ASSERT (SCM_VECTORP (v) && len == SCM_LENGTH (v), v, pos, FUNC_NAME); \
+ SCM_ASSERT (SCM_VECTORP (v) && len == SCM_VECTOR_LENGTH (v), v, pos, FUNC_NAME); \
} while (0)
+\f
+
+#if (SCM_DEBUG_DEPRECATED == 0)
+
+#define SCM_VALIDATE_STRINGORSUBSTR SCM_VALIDATE_STRING
+
+#define SCM_VALIDATE_ROSTRING(pos, str) SCM_MAKE_VALIDATE (pos, str, ROSTRINGP)
+
+#define SCM_VALIDATE_ROSTRING_COPY(pos, str, cvar) \
+ do { \
+ SCM_ASSERT (SCM_ROSTRINGP (str), str, pos, FUNC_NAME); \
+ cvar = SCM_ROCHARS (str); \
+ } while (0)
+
+#define SCM_VALIDATE_NULLORROSTRING_COPY(pos, str, cvar) \
+ do { \
+ SCM_ASSERT (SCM_FALSEP (str) || SCM_ROSTRINGP (str), \
+ str, pos, FUNC_NAME); \
+ if (SCM_FALSEP(str)) \
+ cvar = NULL; \
+ else \
+ cvar = SCM_ROCHARS(str); \
+ } while (0)
+
+#define SCM_VALIDATE_RWSTRING(pos, str) \
+ do { \
+ SCM_ASSERT (SCM_STRINGP (str), str, pos, FUNC_NAME); \
+ if (!SCM_RWSTRINGP (str)) \
+ scm_misc_error (FUNC_NAME, "argument is a read-only string", str); \
+ } while (0)
+
+#define SCM_VALIDATE_OPDIR(pos, port) SCM_MAKE_VALIDATE (pos, port, OPDIRP)
+
+#endif /* SCM_DEBUG_DEPRECATED == 0 */
+
#endif
/*
HCoop / bpt / guile.git / blobdiff