diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index ed14b2298..2ad13f5a5 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -5924,7 +5924,8 @@ that modifying the elements of the new list also modifies the elements of the old list. On the other hand, applying procedures like @code{set-cdr!} or @code{delv!} to the new list will not alter the old list. If you also need to copy the list elements (making a deep copy), -use the procedure @code{copy-tree} (@pxref{Copying}). +use the procedure @code{copy-tree} from @code{(ice-9 copy-tree)} +(@pxref{Copying}). @node List Selection @subsubsection List Selection diff --git a/doc/ref/api-utility.texi b/doc/ref/api-utility.texi index d82d31a48..5c0142940 100644 --- a/doc/ref/api-utility.texi +++ b/doc/ref/api-utility.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011, 2012, 2013, 2014 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011, 2012, 2013, 2014, 2020 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -378,13 +378,16 @@ is not specified. @node Copying @subsection Copying Deep Structures -@c FIXME::martin: Review me! - The procedures for copying lists (@pxref{Lists}) only produce a flat copy of the input list, and currently Guile does not even contain -procedures for copying vectors. @code{copy-tree} can be used for these -application, as it does not only copy the spine of a list, but also -copies any pairs in the cars of the input lists. +procedures for copying vectors. The @code{(ice-9 copy-tree)} module +contains a @code{copy-tree} function that can be used for this purpose, +as it does not only copy the spine of a list, but also copies any pairs +in the cars of the input lists. + +@example +(use-modules (ice-9 copy-tree)) +@end example @deffn {Scheme Procedure} copy-tree obj @deffnx {C Function} scm_copy_tree (obj) diff --git a/libguile.h b/libguile.h index 2ffa3d5e6..553b0ec35 100644 --- a/libguile.h +++ b/libguile.h @@ -1,7 +1,7 @@ #ifndef SCM_LIBGUILE_H #define SCM_LIBGUILE_H -/* Copyright 1995-1998,2000-2004,2006,2008-2014,2018 +/* Copyright 1995-1998,2000-2004,2006,2008-2014,2018,2020 Free Software Foundation, Inc. This file is part of Guile. @@ -112,7 +112,6 @@ extern "C" { #include "libguile/struct.h" #include "libguile/symbols.h" #include "libguile/throw.h" -#include "libguile/trees.h" #include "libguile/uniform.h" #include "libguile/values.h" #include "libguile/variable.h" diff --git a/libguile/Makefile.am b/libguile/Makefile.am index d4cfec7a3..7bc949222 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -225,7 +225,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \ syntax.c \ threads.c \ throw.c \ - trees.c \ unicode.c \ uniform.c \ values.c \ @@ -336,7 +335,6 @@ DOT_X_FILES = \ syntax.x \ threads.x \ throw.x \ - trees.x \ unicode.x \ uniform.x \ values.x \ @@ -440,7 +438,6 @@ DOT_DOC_FILES = \ syntax.doc \ threads.doc \ throw.doc \ - trees.doc \ unicode.doc \ uniform.doc \ values.doc \ @@ -702,7 +699,6 @@ modinclude_HEADERS = \ tags.h \ threads.h \ throw.h \ - trees.h \ validate.h \ unicode.h \ uniform.h \ diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 0b9ce3558..fcc4e8343 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -31,8 +31,10 @@ #include "boolean.h" #include "bitvectors.h" #include "deprecation.h" +#include "eval.h" #include "gc.h" #include "gsubr.h" +#include "modules.h" #include "procprop.h" #include "srcprop.h" #include "srfi-4.h" @@ -586,6 +588,16 @@ scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist) filename, alist); } +SCM +scm_copy_tree (SCM obj) +{ + scm_c_issue_deprecation_warning + ("scm_copy_tree is deprecated; use copy-tree from (ice-9 copy-tree) " + "instead."); + + return scm_call_1 (scm_c_public_ref ("ice-9 copy-tree", "copy-tree"), obj); +} + diff --git a/libguile/deprecated.h b/libguile/deprecated.h index c78e2b1a4..c95f919e5 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -138,6 +138,8 @@ SCM_DEPRECATED SCM scm_sym_copy; SCM_DEPRECATED SCM scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist); +SCM_DEPRECATED SCM scm_copy_tree (SCM obj); + void scm_i_init_deprecated (void); #endif diff --git a/libguile/init.c b/libguile/init.c index 2a9f963ac..2429b2c1a 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -1,4 +1,4 @@ -/* Copyright 1995-2004,2006,2009-2014,2016-2019 +/* Copyright 1995-2004,2006,2009-2014,2016-2020 Free Software Foundation, Inc. This file is part of Guile. @@ -137,7 +137,6 @@ #include "symbols.h" #include "syntax.h" #include "throw.h" -#include "trees.h" #include "unicode.h" #include "uniform.h" #include "values.h" @@ -462,7 +461,6 @@ scm_i_init_guile (void *base) scm_init_srfi_14 (); /* Requires smob_prehistory */ scm_init_exceptions (); scm_init_throw (); /* Requires smob_prehistory */ - scm_init_trees (); scm_init_version (); scm_init_weak_set (); scm_init_weak_table (); diff --git a/libguile/trees.c b/libguile/trees.c deleted file mode 100644 index 32ff984fa..000000000 --- a/libguile/trees.c +++ /dev/null @@ -1,210 +0,0 @@ -/* Copyright 1995-2010,2018 - Free Software Foundation, Inc. - - This file is part of Guile. - - Guile is free software: you can redistribute it and/or modify it - under the terms of the GNU Lesser General Public License as published - by the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Guile is distributed in the hope that it will be useful, but WITHOUT - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public - License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with Guile. If not, see - . */ - - - -#ifdef HAVE_CONFIG_H -# include -#endif - -#include - -#include "eq.h" -#include "gsubr.h" -#include "list.h" -#include "pairs.h" -#include "srcprop.h" -#include "vectors.h" - -#include "trees.h" - - -/* scm_copy_tree creates deep copies of pairs and vectors, but not of any other - * data types. - * - * To avoid infinite recursion due to cyclic structures, the hare-and-tortoise - * pattern is used to detect cycles. In fact, the pattern is used in two - * dimensions, vertical (indicated in the code by the variable names 'hare' - * and 'tortoise') and horizontal ('rabbit' and 'turtle'). In both - * dimensions, the hare/rabbit will take two steps when the tortoise/turtle - * takes one. - * - * The vertical dimension corresponds to recursive calls to function - * copy_tree: This happens when descending into vector elements, into cars of - * lists and into the cdr of an improper list. In this dimension, the - * tortoise follows the hare by using the processor stack: Every stack frame - * will hold an instance of struct t_trace. These instances are connected in - * a way that represents the trace of the hare, which thus can be followed by - * the tortoise. The tortoise will always point to struct t_trace instances - * relating to SCM objects that have already been copied. Thus, a cycle is - * detected if the tortoise and the hare point to the same object, - * - * The horizontal dimension is within one execution of copy_tree, when the - * function cdr's along the pairs of a list. This is the standard - * hare-and-tortoise implementation, found several times in guile. */ - -struct t_trace { - struct t_trace *trace; /* These pointers form a trace along the stack. */ - SCM obj; /* The object handled at the respective stack frame.*/ -}; - -static SCM -copy_tree (struct t_trace *const hare, - struct t_trace *tortoise, - unsigned int tortoise_delay); - -SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0, - (SCM obj), - "Recursively copy the data tree that is bound to @var{obj}, and return a\n" - "the new data structure. @code{copy-tree} recurses down the\n" - "contents of both pairs and vectors (since both cons cells and vector\n" - "cells may point to arbitrary objects), and stops recursing when it hits\n" - "any other object.") -#define FUNC_NAME s_scm_copy_tree -{ - /* Prepare the trace along the stack. */ - struct t_trace trace; - trace.obj = obj; - - /* In function copy_tree, if the tortoise makes its step, it will do this - * before the hare has the chance to move. Thus, we have to make sure that - * the very first step of the tortoise will not happen after the hare has - * really made two steps. This is achieved by passing '2' as the initial - * delay for the tortoise. NOTE: Since cycles are unlikely, giving the hare - * a bigger advantage may improve performance slightly. */ - return copy_tree (&trace, &trace, 2); -} -#undef FUNC_NAME - - -static SCM -copy_tree (struct t_trace *const hare, - struct t_trace *tortoise, - unsigned int tortoise_delay) -#define FUNC_NAME s_scm_copy_tree -{ - if (!scm_is_pair (hare->obj) && !scm_is_vector (hare->obj)) - { - return hare->obj; - } - else - { - /* Prepare the trace along the stack. */ - struct t_trace new_hare; - hare->trace = &new_hare; - - /* The tortoise will make its step after the delay has elapsed. Note - * that in contrast to the typical hare-and-tortoise pattern, the step - * of the tortoise happens before the hare takes its steps. This is, in - * principle, no problem, except for the start of the algorithm: Then, - * it has to be made sure that the hare actually gets its advantage of - * two steps. */ - if (tortoise_delay == 0) - { - tortoise_delay = 1; - tortoise = tortoise->trace; - if (SCM_UNLIKELY (scm_is_eq (hare->obj, tortoise->obj))) - scm_wrong_type_arg_msg (FUNC_NAME, 1, hare->obj, - "expected non-circular data structure"); - } - else - { - --tortoise_delay; - } - - if (scm_is_vector (hare->obj)) - { - size_t length = SCM_SIMPLE_VECTOR_LENGTH (hare->obj); - SCM new_vector = scm_c_make_vector (length, SCM_UNSPECIFIED); - - /* Each vector element is copied by recursing into copy_tree, having - * the tortoise follow the hare into the depths of the stack. */ - unsigned long int i; - for (i = 0; i < length; ++i) - { - SCM new_element; - new_hare.obj = SCM_SIMPLE_VECTOR_REF (hare->obj, i); - new_element = copy_tree (&new_hare, tortoise, tortoise_delay); - SCM_SIMPLE_VECTOR_SET (new_vector, i, new_element); - } - - return new_vector; - } - else /* scm_is_pair (hare->obj) */ - { - SCM result; - SCM tail; - - SCM rabbit = hare->obj; - SCM turtle = hare->obj; - - SCM copy; - - /* The first pair of the list is treated specially, in order to - * preserve a potential source code position. */ - result = tail = scm_cons_source (rabbit, SCM_EOL, SCM_EOL); - new_hare.obj = SCM_CAR (rabbit); - copy = copy_tree (&new_hare, tortoise, tortoise_delay); - SCM_SETCAR (tail, copy); - - /* The remaining pairs of the list are copied by, horizontally, - * having the turtle follow the rabbit, and, vertically, having the - * tortoise follow the hare into the depths of the stack. */ - rabbit = SCM_CDR (rabbit); - while (scm_is_pair (rabbit)) - { - new_hare.obj = SCM_CAR (rabbit); - copy = copy_tree (&new_hare, tortoise, tortoise_delay); - SCM_SETCDR (tail, scm_cons (copy, SCM_UNDEFINED)); - tail = SCM_CDR (tail); - - rabbit = SCM_CDR (rabbit); - if (scm_is_pair (rabbit)) - { - new_hare.obj = SCM_CAR (rabbit); - copy = copy_tree (&new_hare, tortoise, tortoise_delay); - SCM_SETCDR (tail, scm_cons (copy, SCM_UNDEFINED)); - tail = SCM_CDR (tail); - rabbit = SCM_CDR (rabbit); - - turtle = SCM_CDR (turtle); - if (SCM_UNLIKELY (scm_is_eq (rabbit, turtle))) - scm_wrong_type_arg_msg (FUNC_NAME, 1, rabbit, - "expected non-circular data structure"); - } - } - - /* We have to recurse into copy_tree again for the last cdr, in - * order to handle the situation that it holds a vector. */ - new_hare.obj = rabbit; - copy = copy_tree (&new_hare, tortoise, tortoise_delay); - SCM_SETCDR (tail, copy); - - return result; - } - } -} -#undef FUNC_NAME - - -void -scm_init_trees () -{ -#include "trees.x" -} diff --git a/libguile/trees.h b/libguile/trees.h deleted file mode 100644 index aadc9e7d7..000000000 --- a/libguile/trees.h +++ /dev/null @@ -1,37 +0,0 @@ -#ifndef SCM_TREES_H -#define SCM_TREES_H - -/* Copyright 2009,2018 - Free Software Foundation, Inc. - - This file is part of Guile. - - Guile is free software: you can redistribute it and/or modify it - under the terms of the GNU Lesser General Public License as published - by the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Guile is distributed in the hope that it will be useful, but WITHOUT - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public - License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with Guile. If not, see - . */ - - - -#include "libguile/scm.h" - - - -SCM_API SCM scm_copy_tree (SCM obj); - - - -/* Guile internal functions */ - -SCM_INTERNAL void scm_init_trees (void); - -#endif /* SCM_TREES_H */ diff --git a/module/Makefile.am b/module/Makefile.am index d214987b3..45113b542 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -104,6 +104,7 @@ SOURCES = \ ice-9/command-line.scm \ ice-9/common-list.scm \ ice-9/control.scm \ + ice-9/copy-tree.scm \ ice-9/curried-definitions.scm \ ice-9/deprecated.scm \ ice-9/documentation.scm \ diff --git a/module/ice-9/copy-tree.scm b/module/ice-9/copy-tree.scm new file mode 100644 index 000000000..e1d91ad9e --- /dev/null +++ b/module/ice-9/copy-tree.scm @@ -0,0 +1,87 @@ +;;; copy-tree +;;; Copyright (C) 1995-2010,2018,2020 Free Software Foundation, Inc. +;;; +;;; This library is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation, either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this program. If not, see +;;; . + +;;; Commentary: +;;; +;;; Copying pairs and vectors of data, while detecting cycles. +;;; +;;; Code: + + +(define-module (ice-9 copy-tree) + #:use-module (ice-9 match) + #:use-module (srfi srfi-11) + #:replace (copy-tree)) + +;;; copy-tree creates deep copies of pairs and vectors, but not of any +;;; other data types. +;;; +;;; To avoid infinite recursion due to cyclic structures, the +;;; hare-and-tortoise pattern is used to detect cycles. + +(define (make-race obj) + (define (make-race advance-tortoise? tortoise-path hare-tail) + (define (advance! hare) + (let ((tail (list hare))) + (set-cdr! hare-tail tail) + (set! hare-tail tail)) + (when (eq? hare (car tortoise-path)) + (scm-error 'wrong-type-arg "copy-tree" + "Expected non-circular data structure: ~S" (list hare) #f)) + (when advance-tortoise? + (set! tortoise-path (cdr tortoise-path))) + (set! advance-tortoise? (not advance-tortoise?))) + (define (split!) + (make-race advance-tortoise? tortoise-path hare-tail)) + (values advance! split!)) + (let ((path (cons obj '()))) + (make-race #f path path))) + +(define (copy-tree obj) + "Recursively copy the data tree that is bound to @var{obj}, and return a\n" + "the new data structure. @code{copy-tree} recurses down the\n" + "contents of both pairs and vectors (since both cons cells and vector\n" + "cells may point to arbitrary objects), and stops recursing when it hits\n" + "any other object." + (define (trace? x) (or (pair? x) (vector? x))) + (define (visit obj advance! split!) + (define (visit-head obj) + (if (trace? obj) + (let-values (((advance! split!) (split!))) + (advance! obj) + (visit obj advance! split!)) + obj)) + (define (visit-tail obj) + (when (trace? obj) (advance! obj)) + (visit obj advance! split!)) + (cond + ((pair? obj) + (let* ((head (visit-head (car obj))) + (tail (visit-tail (cdr obj)))) + (cons head tail))) + ((vector? obj) + (let* ((len (vector-length obj)) + (v (make-vector len))) + (let lp ((i 0)) + (when (< i len) + (vector-set! v i (visit-head (vector-ref obj i))) + (lp (1+ i)))) + v)) + (else + obj))) + (let-values (((advance! split!) (make-race obj))) + (visit obj advance! split!))) diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index 85be82e95..4c4a484ca 100644 --- a/module/ice-9/deprecated.scm +++ b/module/ice-9/deprecated.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 2003, 2005, 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. +;;;; Copyright (C) 2017, 2020 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -15,7 +15,9 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; -(define-module (ice-9 deprecated)) +(define-module (ice-9 deprecated) + #:use-module (ice-9 copy-tree) + #:export ((copy-tree* . copy-tree))) (define-syntax-rule (define-deprecated name message exp) (begin @@ -31,3 +33,9 @@ "allow-legacy-syntax-objects? is deprecated and has no effect. Guile 3.0 has no legacy syntax objects." %allow-legacy-syntax-objects?) + +(define (copy-tree* x) + (issue-deprecation-warning + "copy-tree in the default environment is deprecated. Import it +from (ice-9 copy-tree) instead.") + (copy-tree x)) diff --git a/module/oop/goops/save.scm b/module/oop/goops/save.scm index 20c3b0541..5f0d6457e 100644 --- a/module/oop/goops/save.scm +++ b/module/oop/goops/save.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 2000,2001,2002, 2006, 2009, 2010, 2013, 2015 Free Software Foundation, Inc. +;;;; Copyright (C) 2000,2001,2002, 2006, 2009, 2010, 2013, 2015, 2020 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -19,11 +19,12 @@ (define-module (oop goops save) - :use-module (oop goops internal) - :export (make-unbound save-objects load-objects restore - enumerate! enumerate-component! - write-readably write-component write-component-procedure - literal? readable make-readable)) + #:use-module (ice-9 copy-tree) + #:use-module (oop goops internal) + #:export (make-unbound save-objects load-objects restore + enumerate! enumerate-component! + write-readably write-component write-component-procedure + literal? readable make-readable)) (define (make-unbound) *unbound*) diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm index d487da8cd..155bc7acb 100644 --- a/module/system/repl/common.scm +++ b/module/system/repl/common.scm @@ -26,6 +26,7 @@ #:use-module (system vm program) #:use-module (system vm loader) #:use-module (ice-9 control) + #:use-module (ice-9 copy-tree) #:use-module (ice-9 history) #:export ( make-repl repl-language repl-options repl-tm-stats repl-gc-stats repl-debug diff --git a/module/web/client.scm b/module/web/client.scm index 3d32cadc7..540dcdd44 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -34,6 +34,7 @@ (define-module (web client) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) + #:use-module (ice-9 copy-tree) #:use-module (ice-9 iconv) #:use-module (ice-9 rdelim) #:use-module (web request) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 8158aaf44..16fa2e952 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright 2001-2019 Software Foundation, Inc. +## Copyright 2001-2020 Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -38,6 +38,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/compiler.test \ tests/control.test \ tests/continuations.test \ + tests/copy-tree.test \ tests/coverage.test \ tests/cross-compilation.test \ tests/curried-definitions.test \ diff --git a/test-suite/tests/copy-tree.test b/test-suite/tests/copy-tree.test new file mode 100644 index 000000000..e0b31a0fd --- /dev/null +++ b/test-suite/tests/copy-tree.test @@ -0,0 +1,33 @@ +;;;; Copyright (C) 2000-2001,2003-2015,2017,2019,2020 +;;;; Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-suite test-copy-tree) + :use-module (test-suite lib) + :use-module (ice-9 copy-tree)) + +(with-test-prefix "copy-tree" + (pass-if "(#t . #(#t))" + (let* ((foo (cons #t (vector #t))) + (bar (copy-tree foo))) + (vector-set! (cdr foo) 0 #f) + (equal? bar '(#t . #(#t))))) + + (pass-if-exception "circular lists in forms" + '(wrong-type-arg . "") + (let ((foo (list #f))) + (set-cdr! foo foo) + (copy-tree foo)))) diff --git a/test-suite/tests/elisp.test b/test-suite/tests/elisp.test index baf85467b..d35e5e157 100644 --- a/test-suite/tests/elisp.test +++ b/test-suite/tests/elisp.test @@ -1,5 +1,5 @@ ;;;; elisp.test --- tests guile's elisp support -*- scheme -*- -;;;; Copyright (C) 2002, 2003, 2006, 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2002, 2003, 2006, 2009, 2010, 2020 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -16,6 +16,7 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-suite test-elisp) + #:use-module (ice-9 copy-tree) #:use-module (test-suite lib) #:use-module (system base compile) #:use-module (ice-9 weak-vector)) diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test index 71b06f756..9d20812f2 100644 --- a/test-suite/tests/eval.test +++ b/test-suite/tests/eval.test @@ -1,5 +1,5 @@ ;;;; eval.test --- tests guile's evaluator -*- scheme -*- -;;;; Copyright (C) 2000-2001,2003-2015,2017,2019 +;;;; Copyright (C) 2000-2001,2003-2015,2017,2019,2020 ;;;; Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -50,21 +50,6 @@ ;;; (with-test-prefix "memoization" - - (with-test-prefix "copy-tree" - - (pass-if "(#t . #(#t))" - (let* ((foo (cons #t (vector #t))) - (bar (copy-tree foo))) - (vector-set! (cdr foo) 0 #f) - (equal? bar '(#t . #(#t))))) - - (pass-if-exception "circular lists in forms" - exception:wrong-type-arg - (let ((foo (list #f))) - (set-cdr! foo foo) - (copy-tree foo)))) - (pass-if "transparency" (let ((x '(begin 1))) (eval x (current-module)) diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test index bce0e86da..dc3e47f50 100644 --- a/test-suite/tests/srfi-1.test +++ b/test-suite/tests/srfi-1.test @@ -1,6 +1,6 @@ ;;;; srfi-1.test --- Test suite for Guile's SRFI-1 functions. -*- scheme -*- ;;;; -;;;; Copyright 2003-2006, 2008-2011, 2014 Free Software Foundation, Inc. +;;;; Copyright 2003-2006, 2008-2011, 2014, 2020 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -18,6 +18,7 @@ (define-module (test-srfi-1) #:use-module (test-suite lib) + #:use-module (ice-9 copy-tree) #:use-module (srfi srfi-1))