* Martin Atzmueller also fixed ROOM, so that it no longer fails with an
undefined function error.
* gave up on fixing bug 3 (forbidden-by-ANSI warning for type mismatch
- in structure slot initforms) for now, wrote workaround instead:-|
+ in structure slot initforms) for now, documented workaround instead:-|
* fixed bug 4 (no WARNING for DECLAIM FTYPE of slot accessor function)
* fixed bug 5: added stubs for various Gray stream functions called
in the not-a-CL:STREAM case, so that even when Gray streams aren't
consistently in DEFMETHOD forms.
* removed bug 21 from BUGS, since Martin Atzmueller points out that
it doesn't seem to affect SBCL after all
+* The C runtime system now builds with better optimization and many
+ fewer warnings, thanks to lots of cleanups by Martin Atzmueller.
planned incompatible changes in 0.7.x:
* The debugger prompt sequence now goes "5]", "5[2]", "5[3]", etc.
(let (;; FIXME: The first two bindings here seem wrong,
;; violating the principle of least surprise, and making
;; it impossible for the user to do reasonable things
- ;; like using PRINT to send output to the program's
- ;; ordinary (possibly redirected-to-a-file)
- ;; *STANDARD-OUTPUT*, or using PEEK-CHAR or some such
- ;; thing on the program's ordinary (possibly also
- ;; redirected) *STANDARD-INPUT*.
+ ;; like using PRINT at the debugger prompt to send output
+ ;; to the program's ordinary (possibly
+ ;; redirected-to-a-file) *STANDARD-OUTPUT*, or using
+ ;; PEEK-CHAR or some such thing on the program's ordinary
+ ;; (possibly also redirected) *STANDARD-INPUT*.
(*standard-input* *debug-io*)
(*standard-output* *debug-io*)
;; This seems reasonable: e.g. if the user has redirected
(*error-output* *debug-io*))
(unless (typep condition 'step-condition)
(format *debug-io*
- "~%~@<entering the debugger because of ~S~:@_~:@_~
- Within the debugger, you can type HELP for help. At ~
- any command prompt (inside the debugger or not) you can ~
- type (SB-EXT:QUIT) to terminate the SBCL executable.~:@>~2%"
+ "~%~@<Within the debugger, you can type HELP for help. At ~
+ any command prompt (within the debugger or not) you can ~
+ type (SB-EXT:QUIT) to terminate the SBCL executable. ~
+ The condition which caused the debugger to be entered ~
+ is bound to ~S.~:@>~2%"
'*debug-condition*)
(show-restarts *debug-restarts* *debug-io*)
(terpri *debug-io*))
(in-package "SB!C")
-;;; Give the user grief about optimizations that we weren't able to do. It
-;;; is assumed that they want to hear, or there wouldn't be any entries in the
-;;; table. If the node has been deleted or is no longer a known call, then do
-;;; nothing; some other optimization must have gotten to it.
+;;; Give the user grief about optimizations that we weren't able to
+;;; do. It is assumed that the user wants to hear about this, or there
+;;; wouldn't be any entries in the table. If the node has been deleted
+;;; or is no longer a known call, then do nothing; some other
+;;; optimization must have gotten to it.
(defun note-failed-optimization (node failures)
(declare (type combination node) (list failures))
(unless (or (node-deleted node)
(note (transform-note (car failure))))
(cond
((consp what)
+ ;; FIXME: This sometimes gets too long for a single line, e.g.
+ ;; "note: unable to optimize away possible call to FDEFINITION at runtime due to type uncertainty:"
+ ;; It would be nice to pretty-print it somehow, but how?
+ ;; ~@<..~:@> adds ~_ directives to the spaces which are in
+ ;; the format string, but a lot of the spaces where we'd want
+ ;; to break are in the included ~A string instead.
(compiler-note "unable to ~A because:~%~6T~?"
note (first what) (rest what)))
((valid-function-use node what
# from CMU CL. It's presumably to work around some optimizer bug in gcc,
# but the fork was a long time ago, and the optimizer could easily
# have been fixed since then. Try doing without it.
-CFLAGS = -g -Wall -O2 -fno-strength-reduce -DGENCGC
+# CFLAGS = -g -Wall -O2 -fno-strength-reduce -DGENCGC
+CFLAGS = -g -Wall -O3 -DGENCGC
ASFLAGS = -g -DGENCGC
DEPEND_FLAGS =
CPPFLAGS = -I.
gc_assert(generations[i].bytes_allocated
== generation_bytes_allocated(i));
fprintf(stderr,
- " %8d: %5d %5d %5d %5d %8d %5d %8d %4d %3d %7.4lf\n",
+ " %8d: %5d %5d %5d %5d %8d %5d %8d %4d %3d %7.4f\n",
i,
boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt,
generations[i].bytes_allocated,
generations[i].num_gc,
gen_av_mem_age(i));
}
- fprintf(stderr," Total bytes allocated=%d\n", bytes_allocated);
+ fprintf(stderr," Total bytes allocated=%ld\n", bytes_allocated);
fpu_restore(fpu_state);
}
int size;
};
static struct new_area (*new_areas)[];
-static new_areas_index;
+static int new_areas_index;
int max_new_areas;
/* Add a new area to new_areas. */
/* shouldn't happen */
gc_assert(0);
+ return((void *) NIL); /* dummy value: return something ... */
}
/* Allocate space from the boxed_region. If there is not enough free
/* shouldn't happen? */
gc_assert(0);
+ return((void *) NIL); /* dummy value: return something ... */
}
static inline void
{
while (nwords > 0) {
lispobj object;
- int type, words_scavenged;
+#if DIRECT_SCAV
+ int type;
+#endif
+ int words_scavenged;
object = *start;
sniff_code_object(struct code *code, unsigned displacement)
{
int nheader_words, ncode_words, nwords;
- lispobj fheaderl;
- struct function *fheaderp;
void *p;
void *constants_start_addr, *constants_end_addr;
void *code_start_addr, *code_end_addr;
int nheader_words, ncode_words, nwords;
void *constants_start_addr, *constants_end_addr;
void *code_start_addr, *code_end_addr;
- lispobj p;
lispobj fixups = NIL;
unsigned displacement = (unsigned)new_code - (unsigned)old_code;
struct vector *fixups_vector;
{
lispobj new_list_pointer;
struct cons *cons, *new_cons;
- int n = 0;
lispobj cdr;
gc_assert(from_space_p(object));
{
unsigned int kv_length;
lispobj *kv_vector;
- unsigned int length;
+ unsigned int length = 0; /* (0 = dummy to stop GCC warning) */
lispobj *hash_table;
lispobj empty_symbol;
- unsigned int *index_vector, *next_vector, *hash_vector;
+ unsigned int *index_vector = NULL; /* (NULL = dummy to stop GCC warning) */
+ unsigned int *next_vector = NULL; /* (NULL = dummy to stop GCC warning) */
+ unsigned int *hash_vector = NULL; /* (NULL = dummy to stop GCC warning) */
lispobj weak_p_obj;
- unsigned next_vector_length;
+ unsigned next_vector_length = 0;
/* FIXME: A comment explaining this would be nice. It looks as
* though SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based
trans_weak_pointer(lispobj object)
{
lispobj copy;
- struct weak_pointer *wp;
+ /* struct weak_pointer *wp; */
gc_assert(Pointerp(object));
struct weak_pointer *wp;
for (wp = weak_pointers; wp != NULL; wp = wp->next) {
lispobj value = wp->value;
- lispobj first, *first_pointer;
+ lispobj *first_pointer;
first_pointer = (lispobj *)PTR(value);
static void
maybe_adjust_large_object(lispobj *where)
{
- int tag;
- lispobj *new;
- lispobj *source, *dest;
int first_page;
int nwords;
/* the new_areas array currently being written to by gc_alloc */
struct new_area (*current_new_areas)[] = &new_areas_1;
int current_new_areas_index;
- int current_new_areas_allocated;
/* the new_areas created but the previous scavenge cycle */
struct new_area (*previous_new_areas)[] = NULL;
int previous_new_areas_index;
- int previous_new_areas_allocated;
#define SC_NS_GEN_CK 0
#if SC_NS_GEN_CK
static void
unprotect_oldspace(void)
{
- int bytes_freed = 0;
int i;
for (i = 0; i < last_free_page; i++) {
if ((page_table[i].allocated != FREE_PAGE)
&& (page_table[i].bytes_used != 0)
&& (page_table[i].gen == from_space)) {
- void *page_start, *addr;
+ void *page_start;
page_start = (void *)page_address(i);
if (pi1 != -1)
fprintf(stderr," %x: page %d alloc %d gen %d bytes_used %d offset %d dont_move %d\n",
- addr,
+ (unsigned int) addr,
pi1,
page_table[pi1].allocated,
page_table[pi1].gen,
static void
garbage_collect_generation(int generation, int raise)
{
- unsigned long allocated = bytes_allocated;
unsigned long bytes_freed;
unsigned long i;
unsigned long read_only_space_size, static_space_size;
}
/* Scavenge the binding stack. */
- scavenge(BINDING_STACK_START,
+ scavenge( (lispobj *) BINDING_STACK_START,
(lispobj *)SymbolValue(BINDING_STACK_POINTER) -
(lispobj *)BINDING_STACK_START);
FSHOW((stderr,
"/scavenge read only space: %d bytes\n",
read_only_space_size * sizeof(lispobj)));
- scavenge(READ_ONLY_SPACE_START, read_only_space_size);
+ scavenge( (lispobj *) READ_ONLY_SPACE_START, read_only_space_size);
}
static_space_size =
FSHOW((stderr,
"/scavenge static space: %d bytes\n",
static_space_size * sizeof(lispobj)));
- scavenge(STATIC_SPACE_START, static_space_size);
+ scavenge( (lispobj *) STATIC_SPACE_START, static_space_size);
/* All generations but the generation being GCed need to be
* scavenged. The new_space generation needs special handling as
SetSymbolValue(ALLOCATION_POINTER,
(lispobj)(((char *)heap_base) + last_free_page*4096));
+ return 0; /* dummy value: return something ... */
}
/* GC all generations below last_gen, raising their objects to the
addr);
}
} else if (gencgc_zero_check_during_free_heap) {
- int *page_start, i;
-
/* Double-check that the page is zero filled. */
+ int *page_start, i;
gc_assert(page_table[page].allocated == FREE_PAGE);
gc_assert(page_table[page].bytes_used == 0);
-
- page_start = (int *)page_address(i);
-
+ page_start = (int *)page_address(page);
for (i=0; i<1024; i++) {
if (page_start[i] != 0) {
lose("free region not zero at %x", page_start + i);
{
lispobj *object = NULL;
- if (object = search_read_only_space(pc))
+ if ( (object = search_read_only_space(pc)) )
;
- else if (object = search_static_space(pc))
+ else if ( (object = search_static_space(pc)) )
;
else
object = search_dynamic_space(pc);
interrupt_internal_error(int signal, siginfo_t *info, os_context_t *context,
boolean continuable)
{
- lispobj context_sap;
+ lispobj context_sap = 0;
fake_foreign_function_call(context);
void
interrupt_handle_pending(os_context_t *context)
{
+#ifndef __i386__
boolean were_in_lisp = !foreign_function_call_active;
+#endif
SetSymbolValue(INTERRUPT_PENDING, NIL);
interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
{
os_context_t *context = (os_context_t*)void_context;
- int were_in_lisp;
+#ifndef __i386__
+ boolean were_in_lisp;
+#endif
union interrupt_handler handler;
#ifdef __linux__
return;
}
- were_in_lisp = !foreign_function_call_active;
#ifndef __i386__
+ were_in_lisp = !foreign_function_call_active;
if (were_in_lisp)
#endif
{
static void call_cmd(char **ptr)
{
- lispobj thing = parse_lispobj(ptr), function, result, cons, args[3];
+ lispobj thing = parse_lispobj(ptr), function, result = 0, cons, args[3];
int numargs;
if (LowtagOf(thing) == type_OtherPointer) {
static int max_depth = 5, brief_depth = 2, cur_depth = 0;
static int max_length = 5;
static boolean dont_descend = 0, skip_newline = 0;
-static cur_clock = 0;
+static int cur_clock = 0;
static void print_obj(char *prefix, lispobj obj);
break;
default:
- printf(": data=%ld", (obj>>8)&0xffffff);
+ printf(": data=%ld", (long) (obj>>8)&0xffffff);
break;
}
}
static void brief_struct(lispobj obj)
{
printf("#<ptr to 0x%08lx instance>",
- ((struct instance *)PTR(obj))->slots[0]);
+ (unsigned long) ((struct instance *)PTR(obj))->slots[0]);
}
static void print_struct(lispobj obj)
NEWLINE;
printf("0x");
while (count-- > 0)
- printf("%08lx", *--ptr);
+ printf("%08lx", (unsigned long) *--ptr);
break;
case type_Ratio:
case type_Sap:
NEWLINE;
#ifndef alpha
- printf("0x%08lx", *ptr);
+ printf("0x%08lx", (unsigned long) *ptr);
#else
- printf("0x%016lx", *(long*)(ptr+1));
+ printf("0x%016lx", *(lispobj*)(ptr+1));
#endif
break;
}
else
newline(NULL);
- printf("%s0x%08lx: ", prefix, obj);
+ printf("%s0x%08lx: ", prefix, (unsigned long) obj);
if (cur_depth < brief_depth) {
fputs(lowtag_Names[type], stdout);
(*verbose_fns[type])(obj);
case type_ByteCodeClosure:
if ((int)pointer != ((int)start_addr+type_FunctionPointer)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wf2: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wf2: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
}
break;
default:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wf3: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wf3: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
}
case type_ListPointer:
if ((int)pointer != ((int)start_addr+type_ListPointer)) {
if (pointer_filter_verbose)
- fprintf(stderr,"*Wl1: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
return 0;
}
/* Is it plausible cons? */
break;
} else {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wl2: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wl2: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
}
case type_InstancePointer:
if ((int)pointer != ((int)start_addr+type_InstancePointer)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wi1: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
}
if (TypeOf(start_addr[0]) != type_InstanceHeader) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wi2: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wi2: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
}
case type_OtherPointer:
if ((int)pointer != ((int)start_addr+type_OtherPointer)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo1: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
}
/* Is it plausible? Not a cons. X should check the headers. */
if(Pointerp(start_addr[0]) || ((start_addr[0] & 3) == 0)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo2: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
}
case type_UnboundMarker:
case type_BaseChar:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo3: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
case type_ByteCodeFunction:
case type_ByteCodeClosure:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo4: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
case type_InstanceHeader:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo5: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
default:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo6: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*Wo6: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
}
break;
default:
if (pointer_filter_verbose) {
- fprintf(stderr,"*W?: %x %x %x\n", pointer, start_addr, *start_addr);
+ fprintf(stderr,"*W?: %x %x %x\n", (unsigned int) pointer,
+ (unsigned int) start_addr, *start_addr);
}
return 0;
}
*valid_stack_ra_locations[i],
(int)(*valid_stack_ra_locations[i])
- ((int)valid_stack_ra_code_objects[i] - (int)code_obj),
- valid_stack_ra_code_objects[i], code_obj);
+ (unsigned int) valid_stack_ra_code_objects[i], code_obj);
}
*valid_stack_ra_locations[i] =
((int)(*valid_stack_ra_locations[i])
}
default:
gc_abort();
+ return NIL; /* dummy value: return something ... */
}
}
int nheader_words, ncode_words, nwords;
void *constants_start_addr, *constants_end_addr;
void *code_start_addr, *code_end_addr;
- lispobj p;
lispobj fixups = NIL;
unsigned displacement = (unsigned)new_code - (unsigned)old_code;
struct vector *fixups_vector;
static lispobj *pscav(lispobj *addr, int nwords, boolean constant)
{
lispobj thing, *thingp, header;
- int count;
+ int count = 0; /* (0 = dummy init value to stop GCC warning) */
struct vector *vector;
while (nwords > 0) {
fflush(stdout);
#endif
#if !defined(ibmrt) && !defined(__i386__)
- pscav(BINDING_STACK_START,
- current_binding_stack_pointer - (lispobj *)BINDING_STACK_START,
+ pscav( (lispobj *)BINDING_STACK_START,
+ (lispobj *)current_binding_stack_pointer - (lispobj *)BINDING_STACK_START,
0);
#else
- pscav(BINDING_STACK_START,
+ pscav( (lispobj *)BINDING_STACK_START,
(lispobj *)SymbolValue(BINDING_STACK_POINTER) -
(lispobj *)BINDING_STACK_START,
0);
fprintf(stderr,
"scavenging read only space: %d bytes\n",
read_only_space_size * sizeof(lispobj));
- pscav(READ_ONLY_SPACE_START, read_only_space_size, 0);
+ pscav( (lispobj *)READ_ONLY_SPACE_START, read_only_space_size, 0);
}
#endif
#include <sys/file.h>
#include <sys/fcntl.h>
#include <sys/ioctl.h>
-#ifdef SVR4
+#if defined(SVR4) || defined(__linux__)
#include <unistd.h>
#endif
/* Put us in our own process group. */
#if defined(hpux)
setsid();
-#elif defined(SVR4)
+#elif defined(SVR4) || defined(__linux__)
setpgrp();
#else
setpgrp(0, getpid());
static void sigint_handler(int signal, siginfo_t *info, void *void_context)
{
- printf("\nSIGINT hit at 0x%08lX\n", *os_context_pc_addr(void_context));
+ printf("\nSIGINT hit at 0x%08lX\n",
+ (unsigned long) *os_context_pc_addr(void_context));
ldb_monitor();
}
} else {
return result;
}
+ return (void *) NULL; /* dummy value: return something ... */
}
char *
char *sbcl_home = getenv("SBCL_HOME");
if (sbcl_home) {
char *lookhere;
- asprintf(&lookhere, "%s/sbcl.core", sbcl_home);
+ lookhere = (char *) calloc(strlen("/sbcl.core") + strlen(sbcl_home) + 1,
+ sizeof(char));
+ sprintf(lookhere, "%s/sbcl.core", sbcl_home);
core = copied_existing_filename_or_null(lookhere);
free(lookhere);
} else {
/* initial_function() is not supposed to return. */
lose("Lisp initial_function gave up control.");
+ return 0; /* dummy value: return something */
}
+
gc_alloc_update_page_tables(1,&unboxed_region);
update_x86_dynamic_space_free_pointer();
#endif
- output_space(file, DYNAMIC_SPACE_ID, DYNAMIC_SPACE_START,
+ output_space(file, DYNAMIC_SPACE_ID, (lispobj *)DYNAMIC_SPACE_START,
(lispobj *)SymbolValue(ALLOCATION_POINTER));
#endif
{
if (os_validate((os_vm_address_t)start,(os_vm_size_t)size)==NULL) {
fprintf(stderr,
- "ensure_space: failed to validate %ld bytes at 0x%08X\n",
+ "ensure_space: failed to validate %ld bytes at 0x%08lx\n",
size,
(unsigned long)start);
exit(1);
fflush(stdout);
#endif
- ensure_space(READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE);
- ensure_space(STATIC_SPACE_START , STATIC_SPACE_SIZE);
- ensure_space(DYNAMIC_SPACE_START , DYNAMIC_SPACE_SIZE);
- ensure_space(CONTROL_STACK_START , CONTROL_STACK_SIZE);
- ensure_space(BINDING_STACK_START , BINDING_STACK_SIZE);
+ ensure_space( (lispobj *)READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE);
+ ensure_space( (lispobj *)STATIC_SPACE_START , STATIC_SPACE_SIZE);
+ ensure_space( (lispobj *)DYNAMIC_SPACE_START , DYNAMIC_SPACE_SIZE);
+ ensure_space( (lispobj *)CONTROL_STACK_START , CONTROL_STACK_SIZE);
+ ensure_space( (lispobj *)BINDING_STACK_START , BINDING_STACK_SIZE);
#ifdef HOLES
make_holes();
vlen = *(char*)(*os_context_pc_addr(context))++;
/* Skip Lisp error arg data bytes. */
while (vlen-- > 0) {
- (char*)(*os_context_pc_addr(context))++;
+ ( (char*)(*os_context_pc_addr(context)) )++;
}
break;
if (*os_context_pc_addr(context) == (int)single_stepping + 1) {
fprintf(stderr, "warning: couldn't reinstall breakpoint\n");
} else {
- char *ptr = (char*)single_stepping;
*((char *)single_stepping) = BREAKPOINT_INST; /* x86 INT3 */
*((char *)single_stepping+1) = trap_Breakpoint;
}
--- /dev/null
+;;;; To test the IGNORE/IGNORABLE behavior in CLOS, run COMPILE-FILE on
+;;;; this file and look at the output (warnings, etc.).
+;;;;
+;;;; (In sbcl-0.6.8.25, the handling of IGNORE and IGNORABLE in
+;;;; DEFMETHOD forms was rewritten to systematize the old PCL behavior.
+;;;; Now all required variables are IGNORABLE by default.)
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(in-package :cl-user)
+
+(defgeneric foo ((x t) (y t) &key &allow-other-keys))
+
+;;; should have no STYLE-WARNINGs (e.g. about unused vars)
+(defmethod foo ((x t) (y t))
+ nil)
+
+;;; should have no STYLE-WARNINGs
+(defmethod foo ((x t) (y t) &key &allow-other-keys)
+ (declare (ignore x)))
+
+;;; should have no STYLE-WARNINGs
+(defmethod foo ((x t) (y t) &key &allow-other-keys)
+ (declare (ignorable x y))
+ (declare (ignore y)))
+
+;;; should have no STYLE-WARNINGs
+(defmethod foo ((x t) (y t) &key &allow-other-keys)
+ x)
+
+;;; should have a STYLE-WARNING: using an IGNOREd variable
+(defmethod foo ((x t) (y t) &key &allow-other-keys)
+ (declare (ignore x y))
+ x)
+
+;;; should have no STYLE-WARNINGs
+(defmethod foo (x y &key &allow-other-keys)
+ (declare (ignore x y))
+ (call-next-method))
+
+;;; should have no STYLE-WARNINGs
+(defmethod foo ((x integer) (y t) &key &allow-other-keys)
+ (declare (ignore x y))
+ (call-next-method))
+
+;;; should have no STYLE-WARNINGs
+(defmethod foo ((x integer) (y t) &key &allow-other-keys)
+ (declare (ignore x))
+ (call-next-method))
+
+;;; should have a STYLE-WARNING: Z is unused.
+(defmethod foo ((x t) (y integer) &key z)
+ nil)
;;; versions, and a string like "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.8.25"
+"0.6.8.26"
projects / sbcl.git / commitdiff