~ chicken-core (chicken-5) 72be4d4334280a8bcd83a91253295fb8e32debd7

commit 72be4d4334280a8bcd83a91253295fb8e32debd7
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Dec 10 09:59:05 2009 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Dec 10 09:59:05 2009 +0100

    handling of negative offsets in move-memory\!

diff --git a/lolevel.scm b/lolevel.scm
index 32628bfa..925448ad 100644
--- a/lolevel.scm
+++ b/lolevel.scm
@@ -1,7 +1,7 @@
 ;;;; lolevel.scm - Low-level routines for CHICKEN
 ;
-; Copyright (c) 2000-2007, Felix L. Winkelmann
 ; Copyright (c) 2008, The Chicken Team
+; Copyright (c) 2000-2007, Felix L. Winkelmann
 ; All rights reserved.
 ;
 ; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
@@ -196,6 +196,12 @@ EOF
       ;
       (##sys#check-block from 'move-memory!)
       (##sys#check-block to 'move-memory!)
+      #+(not unsafe)
+      (when (fx< foffset 0)
+	(##sys#error 'move-memory! "negative source offset" foffset))
+      #+(not unsafe)
+      (when (fx< toffset 0)
+	(##sys#error 'move-memory! "negative destination offset" toffset))
       (let move ([from from] [to to])
 	(cond [(##sys#generic-structure? from)
 	       (if (memq (##sys#slot from 0) slot1structs)
diff --git a/tests/lolevel-tests.scm b/tests/lolevel-tests.scm
index 94040a5c..2258554d 100644
--- a/tests/lolevel-tests.scm
+++ b/tests/lolevel-tests.scm
@@ -2,8 +2,16 @@
 
 (require-extension lolevel)
 
+(define-syntax assert-error
+  (syntax-rules ()
+    ((_ expr) 
+     (assert (handle-exceptions _ #t expr #f)))))
+
 ; move-memory!
 
+(let ((s "..."))
+  (assert-error (move-memory! "abc" s 3 -1)))
+
 ; object-copy
 
 ; allocate