summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGreg J. Badros <gjb@cs.washington.edu>2000-01-05 18:48:07 +0000
committerGreg J. Badros <gjb@cs.washington.edu>2000-01-05 18:48:07 +0000
commitc751e5e3c31588f8b32c628519efa2c515c1a617 (patch)
tree50ab86fea5acbdf1dc699174ef2d4f122b1b8986
parent5a237c9d5d7cbe592b0ba7f133dadc0cf18bb4e3 (diff)
downloadguile-c751e5e3c31588f8b32c628519efa2c515c1a617.tar.gz
* guile-snarf.awk.in: Do argument/number mismatch checking and
print warnings in an Emacs compile-mode parseable format. * struct.c: Use SCM_ASSERT_RANGE instead of SCM_ASSERT w/ SCM_OUTOFRANGE as 3rd argument. * random.c: Fix argument/number mismatch (that I introduced :-( ). * __scm.h: Do not #define SCM_ARG* when snarfing; lets us distinguish between 1 and SCM_ARG1 when snarfing as only the former (using the number) requires the argument to match the formal in the current argument snarfing check. * ramap.c: Remove extraneous #undef FUNC_NAME.
-rw-r--r--libguile/__scm.h10
-rw-r--r--libguile/guile-snarf.awk.in34
-rw-r--r--libguile/ramap.c1
-rw-r--r--libguile/random.c4
-rw-r--r--libguile/struct.c4
5 files changed, 46 insertions, 7 deletions
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 0494c5286..db0d2a1af 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -449,6 +449,15 @@ extern SCM scm_apply_generic (SCM gf, SCM args);
#define SCM_GASSERTn(cond, gf, args, pos, subr) \
if (!(cond)) SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr))
+#ifndef SCM_MAGIC_SNARFER
+/* Let these macros pass through if
+ we are snarfing; thus we can tell the
+ difference between the use of an actual
+ number vs. the use of one of these macros --
+ actual numbers in SCM_VALIDATE_*/SCM_ASSERT
+ constructs must match the formal argument name,
+ but using SCM_ARG* avoids the test */
+
#define SCM_ARGn 0
#define SCM_ARG1 1
#define SCM_ARG2 2
@@ -472,6 +481,7 @@ extern SCM scm_apply_generic (SCM gf, SCM args);
/* #define SCM_STACK_OVFLOW 12 */
/* #define SCM_EXIT 13 */
+#endif /* SCM_MAGIC_SNARFER */
/* (...still matching scm_errmsgs) These
* are signals. Signals may become errors
diff --git a/libguile/guile-snarf.awk.in b/libguile/guile-snarf.awk.in
index cb3ed40b2..da20af493 100644
--- a/libguile/guile-snarf.awk.in
+++ b/libguile/guile-snarf.awk.in
@@ -25,7 +25,7 @@ BEGIN { FS="|";
gsub(/[ \t]+/," ", copy);
sub(/^[ \t]*/,"(", copy);
gsub(/\"/,"",copy);
- numargs = gsub(/\([ \t]*void[ \t]*\)/,"()", copy);
+ sub(/\([ \t]*void[ \t]*\)/,"()", copy);
sub(/ \(/," ",copy);
numargs = gsub(/SCM /,"", copy);
numcommas = gsub(/,/,"", copy);
@@ -35,8 +35,21 @@ BEGIN { FS="|";
sub(/^[ \t]*/,"",location);
sub(/[ \t]*$/,"",location);
sub(/: /,":",location);
+ # Now whittle copy down to just the $1 field
+ # (but do not use $1, since it hasn't been
+ # altered by the above regexps)
gsub(/[ \t]*\|.*$/,"",copy);
sub(/ \)/,")",copy);
+ # Now `copy' contains the nice scheme proc "prototype", e.g.
+ # (set-car! pair value)
+ # print copy > "/dev/stderr"; # for debugging
+ proc_and_args = copy;
+ curr_function_proto = copy;
+ sub(/[^ \n]* /,"",proc_and_args);
+ sub(/\)[ \t]*/,"",proc_and_args);
+ split(proc_and_args,args," ");
+ # now args is an array of the arguments
+ # args[1] is the formal name of the first argument, etc.
if (numargs != numactuals && !registering)
{ print location ":*** `" copy "' is improperly registered as having " numactuals " arguments" > /dev/stderr; }
print " \n" copy (registering?")":"") > dot_doc_file ; }
@@ -47,6 +60,23 @@ BEGIN { FS="|";
sub(/\"?[ \t]*@!!!.*$/,"", copy);
gsub(/\\\"/,"\"",copy);
gsub(/[ \t]*$/,"", copy);
- if (copy != "") { print copy > dot_doc_file } }
+ if (copy != "") { print copy > dot_doc_file }
+ }
+
/@!!![ \t]/ { print "[" location "]" >> dot_doc_file; }
+/\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION/ { copy = $0;
+ sub(/.*\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION\([ \t]*/,"",copy);
+ if (copy ~ /\"/) { next }
+ gsub(/[ \t]*,[ \t]*/,":",copy);
+ sub(/[ \t]*\).*/,"",copy);
+ split(copy,argpos,":");
+ argname = argpos[1];
+ pos = argpos[2];
+ if (pos ~ /[A-Za-z]/) { next }
+ if (pos ~ /^[ \t]*$/) { next }
+ if (argname ~ / /) { next }
+ line = argpos[3];
+# print pos " " args[pos] " vs. " argname > "/dev/stderr";
+ if (args[pos] != argname) { print filename ":" line ":*** Argument name/number mismatch in `" curr_function_proto "' -- " argname " is not formal #" pos > "/dev/stderr"; }
+ }
diff --git a/libguile/ramap.c b/libguile/ramap.c
index 14c68d480..195d8c684 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -768,7 +768,6 @@ racp (SCM src, SCM dst)
#endif /* SCM_FLOATS */
return 1;
}
-#undef FUNC_NAME
/* This name is obsolete. Will go away in release 1.5. */
diff --git a/libguile/random.c b/libguile/random.c
index 372ff61e0..ddcdccd37 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -380,7 +380,7 @@ GUILE_PROC (scm_copy_random_state, "copy-random-state", 0, 1, 0,
{
if (SCM_UNBNDP (state))
state = SCM_CDR (scm_var_random_state);
- SCM_VALIDATE_RSTATE(2,state);
+ SCM_VALIDATE_RSTATE(1,state);
return make_rstate (scm_the_rng.copy_rstate (SCM_RSTATE (state)));
}
#undef FUNC_NAME
@@ -525,7 +525,7 @@ GUILE_PROC (scm_random_exp, "random:exp", 0, 1, 0,
{
if (SCM_UNBNDP (state))
state = SCM_CDR (scm_var_random_state);
- SCM_VALIDATE_RSTATE(2,state);
+ SCM_VALIDATE_RSTATE(1,state);
return scm_makdbl (scm_c_exp1 (SCM_RSTATE (state)), 0.0);
}
#undef FUNC_NAME
diff --git a/libguile/struct.c b/libguile/struct.c
index 1c039f1d5..e0aeff348 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -552,7 +552,7 @@ integer value small enough to fit in one machine word.")
fields_desc = (unsigned char *) SCM_CHARS (layout);
n_fields = data[scm_struct_i_n_words];
- SCM_ASSERT (p < n_fields, pos, SCM_OUTOFRANGE, FUNC_NAME);
+ SCM_ASSERT_RANGE(1,pos, p < n_fields);
if (p * 2 < SCM_LENGTH (layout))
{
@@ -629,7 +629,7 @@ GUILE_PROC (scm_struct_set_x, "struct-set!", 3, 0, 0,
fields_desc = (unsigned char *)SCM_CHARS (layout);
n_fields = data[scm_struct_i_n_words];
- SCM_ASSERT (p < n_fields, pos, SCM_OUTOFRANGE, FUNC_NAME);
+ SCM_ASSERT_RANGE (1,pos, p < n_fields);
if (p * 2 < SCM_LENGTH (layout))
{