~ chicken-core (chicken-5) c9ece0acc497d3247c83fb3ab5feeb3d55f744ec
commit c9ece0acc497d3247c83fb3ab5feeb3d55f744ec 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: Fri Dec 11 09:17:13 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 ; allocateTrap