diff options
Diffstat (limited to 'gnuradio-core/src/guile')
20 files changed, 0 insertions, 2850 deletions
diff --git a/gnuradio-core/src/guile/.gitignore b/gnuradio-core/src/guile/.gitignore deleted file mode 100644 index ea2593923..000000000 --- a/gnuradio-core/src/guile/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -/Makefile -/Makefile.in -/run_guile_tests -/guile.log -/gr-run-waveform-script diff --git a/gnuradio-core/src/guile/Makefile.am b/gnuradio-core/src/guile/Makefile.am deleted file mode 100644 index 122f05d97..000000000 --- a/gnuradio-core/src/guile/Makefile.am +++ /dev/null @@ -1,80 +0,0 @@ -# -# Copyright 2010 Free Software Foundation, Inc. -# -# This file is part of GNU Radio -# -# GNU Radio is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3, or (at your option) -# any later version. -# -# GNU Radio 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 General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/>. -# - -include $(top_srcdir)/Makefile.common - -if GUILE - -TESTS = run_guile_tests - -EXTRA_DIST += \ - run_guile_tests.in \ - $(nobase_guile_DATA) \ - $(GUILE_TESTS) - -bin_SCRIPTS = \ - gr-run-waveform-script - -# These are the hand-coded guile files for gnuradio-core. -# -# Swig/common.scm is glue that's required for the goops wrappers. -# gnuradio/export-safely.scm works around some problems in the goops generated wrappers. -# gnuradio/core.scm glues the 5 pieces of gnuradio_core_* into a single module. -# gnuradio/runtime-shim implements "guile friendly" versions of connect & disconnect. - -nobase_guile_DATA = \ - Swig/common.scm \ - gnuradio/core.scm \ - gnuradio/export-safely.scm \ - gnuradio/run-waveform.scm \ - gnuradio/runtime-shim.scm \ - gnuradio/waveform.scm \ - gnuradio/test-suite/guile-test \ - gnuradio/test-suite/lib.scm - -GUILE_TESTS = \ - tests/00_runtime_basics.test \ - tests/00_runtime_ctors.test \ - tests/filter_ctors.test \ - tests/general_ctors.test \ - tests/gengen_ctors.test \ - tests/hier_ctors.test \ - tests/io_ctors.test - -CLEANFILES = guile.log - - -scmlibdir = $(libdir) -scmdir = $(guiledir) - -scmlib_LTLIBRARIES = libguile-gnuradio-dynl-global.la - -libguile_gnuradio_dynl_global_la_SOURCES = dynl-global.c -libguile_gnuradio_dynl_global_la_CPPFLAGS = $(GUILE_CFLAGS) -libguile_gnuradio_dynl_global_la_LIBADD = $(GUILE_LIBS) - -# Create a symlink from gr-run-waveform-script to gr-run-waveform -install-exec-local: - -$(RM) $(DESTDIR)$(bindir)/gr-run-waveform - (cd $(DESTDIR)$(bindir) && $(LN_S) gr-run-waveform-script gr-run-waveform) - -uninstall-local: - -$(RM) $(DESTDIR)$(bindir)/gr-run-waveform - -endif diff --git a/gnuradio-core/src/guile/Swig/common.scm b/gnuradio-core/src/guile/Swig/common.scm deleted file mode 100644 index a51d3a71d..000000000 --- a/gnuradio-core/src/guile/Swig/common.scm +++ /dev/null @@ -1,76 +0,0 @@ -;;;************************************************************************ -;;;*common.scm -;;;* -;;;* This file contains generic SWIG GOOPS classes for generated -;;;* GOOPS file support -;;;* -;;;* Copyright (C) 2003 John Lenz (jelenz@wisc.edu) -;;;* Copyright (C) 2004 Matthias Koeppe (mkoeppe@mail.math.uni-magdeburg.de) -;;;* -;;;* This file may be freely redistributed without license or fee provided -;;;* this copyright message remains intact. -;;;************************************************************************ - -(define-module (Swig swigrun)) - -(define-module (Swig common) - #:use-module (oop goops) - #:use-module (Swig swigrun)) - -(define-class <swig-metaclass> (<class>) - (new-function #:init-value #f)) - -(define-method (initialize (class <swig-metaclass>) initargs) - (slot-set! class 'new-function (get-keyword #:new-function initargs #f)) - (next-method)) - -(define-class <swig> () - (swig-smob #:init-value #f) - #:metaclass <swig-metaclass> -) - -(define-method (initialize (obj <swig>) initargs) - (next-method) - (slot-set! obj 'swig-smob - (let ((arg (get-keyword #:init-smob initargs #f))) - (if arg - arg - (let ((ret (apply (slot-ref (class-of obj) 'new-function) (get-keyword #:args initargs '())))) - ;; if the class is registered with runtime environment, - ;; new-Function will return a <swig> goops class. In that case, extract the smob - ;; from that goops class and set it as the current smob. - (if (slot-exists? ret 'swig-smob) - (slot-ref ret 'swig-smob) - ret)))))) - -(define (display-address o file) - (display (number->string (object-address o) 16) file)) - -(define (display-pointer-address o file) - ;; Don't fail if the function SWIG-PointerAddress is not present. - (let ((address (false-if-exception (SWIG-PointerAddress o)))) - (if address - (begin - (display " @ " file) - (display (number->string address 16) file))))) - -(define-method (write (o <swig>) file) - ;; We display _two_ addresses to show the object's identity: - ;; * first the address of the GOOPS proxy object, - ;; * second the pointer address. - ;; The reason is that proxy objects are created and discarded on the - ;; fly, so different proxy objects for the same C object will appear. - (let ((class (class-of o))) - (if (slot-bound? class 'name) - (begin - (display "#<" file) - (display (class-name class) file) - (display #\space file) - (display-address o file) - (display-pointer-address o file) - (display ">" file)) - (next-method)))) - -(export <swig-metaclass> <swig>) - -;;; common.scm ends here diff --git a/gnuradio-core/src/guile/dynl-global.c b/gnuradio-core/src/guile/dynl-global.c deleted file mode 100644 index 3bf2741b1..000000000 --- a/gnuradio-core/src/guile/dynl-global.c +++ /dev/null @@ -1,123 +0,0 @@ -/* -*- c -*- */ -/* - * Copyright 2010 Free Software Foundation, Inc. - * - * This file is part of GNU Radio - * - * GNU Radio is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 3, or (at your option) - * any later version. - * - * GNU Radio 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 General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program. If not, see <http://www.gnu.org/licenses/>. - */ - -/* - * This file is an attempt to work around a problem that appears on - * certain Ubuntu (and perhaps other) systems. On those systems - * (10.04 is known to have the problem, while 10.10 and later work OK - * without this kludge), we end up with a situation where exceptions - * are not caught by the swig code, even though the swig generated - * code "looks right" and "is right". Details of the issue can be - * found in swig bug 1863647, - * http://sourceforge.net/tracker/index.php?func=detail&aid=1863647&group_id=1645&atid=101645 - * - * We work around the problem by loading swig generated guile modules - * using the equivalent of the dlopen's RTLD_GLOBAL flag. This is - * only possible on systems using libtool-2.*. Those systems contain - * the lt_dlavise_global function. - */ -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <ltdl.h> -#include <libguile.h> - -extern scm_t_bits scm_tc16_dynamic_obj; - -#ifdef HAVE_LT_DLADVISE_GLOBAL -/* - * Load shared module using the equivalent of the RTLD_GLOBAL flag - */ -static lt_dlhandle -dlopenext_global (const char *filename) -{ - lt_dlhandle handle = 0; - lt_dladvise advise; - - if (!lt_dladvise_init (&advise) - && !lt_dladvise_ext (&advise) - && !lt_dladvise_global(&advise)) - handle = lt_dlopenadvise (filename, advise); - - lt_dladvise_destroy (&advise); - return handle; -} - -#else - -/* - * We don't have lt_dladvise_global. Fall back to lt_dlopenext. - */ -static lt_dlhandle -dlopenext_global (const char *filename) -{ - return lt_dlopenext (filename); -} -#endif - - -static void * -sysdep_dynl_link_global (const char *fname, const char *subr) -{ - lt_dlhandle handle; - handle = dlopenext_global (fname); - if (NULL == handle) - { - SCM fn; - SCM msg; - - fn = scm_from_locale_string (fname); - msg = scm_from_locale_string (lt_dlerror ()); - scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg)); - } - return (void *) handle; -} - -SCM_DEFINE (scm_dynamic_link_global, "dynamic-link-global", 1, 0, 0, - (SCM filename), - "Find the shared object (shared library) denoted by\n" - "@var{filename} and link it into the running Guile\n" - "application. The returned\n" - "scheme object is a ``handle'' for the library which can\n" - "be passed to @code{dynamic-func}, @code{dynamic-call} etc.\n\n" - "Searching for object files is system dependent. Normally,\n" - "if @var{filename} does have an explicit directory it will\n" - "be searched for in locations\n" - "such as @file{/usr/lib} and @file{/usr/local/lib}.") -#define FUNC_NAME s_scm_dynamic_link_global -{ - void *handle; - char *file; - - scm_dynwind_begin (0); - file = scm_to_locale_string (filename); - scm_dynwind_free (file); - handle = sysdep_dynl_link_global (file, FUNC_NAME); - scm_dynwind_end (); - SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (filename), handle); -} -#undef FUNC_NAME - -void -scm_init_gnuradio_dynl_global_module(void) -{ - scm_c_define_gsubr (s_scm_dynamic_link_global, 1, 0, 0, (SCM (*)()) scm_dynamic_link_global); -} diff --git a/gnuradio-core/src/guile/gnuradio/core.scm b/gnuradio-core/src/guile/gnuradio/core.scm deleted file mode 100644 index 9c69cea42..000000000 --- a/gnuradio-core/src/guile/gnuradio/core.scm +++ /dev/null @@ -1,32 +0,0 @@ -;;; Glue the separate pieces of gnuradio-core into a single module - -(define-module (gnuradio core) - #:use-module (oop goops) - #:use-module (gnuradio gnuradio_core_runtime) - #:use-module (gnuradio runtime-shim) - #:use-module (gnuradio gnuradio_core_filter) - #:use-module (gnuradio gnuradio_core_io) - #:use-module (gnuradio gnuradio_core_general) - #:use-module (gnuradio gnuradio_core_gengen) - #:use-module (gnuradio gnuradio_core_hier) - #:duplicates (merge-generics replace check)) - -(re-export-all '(gnuradio gnuradio_core_runtime)) -(re-export-all '(gnuradio runtime-shim)) -(re-export-all '(gnuradio gnuradio_core_filter)) -(re-export-all '(gnuradio gnuradio_core_io)) -(re-export-all '(gnuradio gnuradio_core_general)) -(re-export-all '(gnuradio gnuradio_core_gengen)) -(re-export-all '(gnuradio gnuradio_core_hier)) - -;; Work around problem with gr:message-source -(define-generic gr:message-source) -(define-method (gr:message-source itemsize (msgq <gr-msg-queue-sptr>)) - (gr:message-source-msgq-ctor itemsize msgq)) -(define-method (gr:message-source itemsize (limit <integer>)) - (gr:message-source-limit-ctor itemsize limit)) -(export gr:message-source) - -;;; Return #t if x is not #f -(define-public (true? x) - (and x #t)) diff --git a/gnuradio-core/src/guile/gnuradio/export-safely.scm b/gnuradio-core/src/guile/gnuradio/export-safely.scm deleted file mode 100644 index 664292d2b..000000000 --- a/gnuradio-core/src/guile/gnuradio/export-safely.scm +++ /dev/null @@ -1,90 +0,0 @@ -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -;;; This module implements a macro, export-safely, that avoids -;;; exporting symbols that are actually generic-functions imported -;;; (explicity or implicitly) from elsewhere. -;;; -;;; This hackery is required so that the swig generated goops wrappers -;;; don't stomp on each other. For background on what this is about -;;; see this thread: -;;; -;;; http://lists.gnu.org/archive/html/guile-user/2006-05/msg00007.html -;;; -;;; Don't expect to understand what's going on here without looking at -;;; the guts of the module system (implemented in ice-9/boot-9.scm) and -;;; having a pretty good understanding of goops and generic-functions. - - -(define-module (gnuradio export-safely) - #:use-module (oop goops) - #:use-module (srfi srfi-1) - #:export-syntax (export-safely)) - -(define-public (generics-in-module module) - (let ((lst '())) - (module-for-each (lambda (sym var) - (if (variable-bound? var) - (let ((v (variable-ref var))) - (cond ((is-a? v <generic>) - (set! lst (cons v lst))))))) - module) - lst)) - -(define-public (generic-function-names-in-module module) - (map generic-function-name (generics-in-module module))) - -(define-public (generic-function-names-in-imported-modules module) - (concatenate (map generic-function-names-in-module (module-uses module)))) - -(define-public (export-syms-if-not-imported-gf list-of-syms) - (let ((gf-names (generic-function-names-in-imported-modules (current-module)))) - (let ((to-export (filter (lambda (sym) - (not (memq sym gf-names))) - (delete-duplicates list-of-syms)))) - (module-export! (current-module) to-export)))) - -(defmacro export-safely names - `(export-syms-if-not-imported-gf ',names)) - - -(define-public (names-in-module module) - (let ((lst '())) - (module-for-each (lambda (sym var) - (if (variable-bound? var) - (set! lst (cons sym lst)))) - module) - lst)) - -(define-public (names-in-imported-modules module) - (delete-duplicates (concatenate (map names-in-module (module-uses module))))) - -(define-public (re-export-all src-module-name) - (let ((current (current-module)) - (src-module (resolve-interface src-module-name))) - - (define (ok-to-re-export? name) - (let ((var (module-variable current name))) - (cond ((not var) #f) ; Undefined var - ((eq? var (module-local-variable current name)) #f) ; local var - (else #t)))) ; OK - - (module-re-export! current - (filter ok-to-re-export? - (names-in-module src-module))))) diff --git a/gnuradio-core/src/guile/gnuradio/run-waveform.scm b/gnuradio-core/src/guile/gnuradio/run-waveform.scm deleted file mode 100644 index 01930521c..000000000 --- a/gnuradio-core/src/guile/gnuradio/run-waveform.scm +++ /dev/null @@ -1,55 +0,0 @@ -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -;;; Load and run a waveform defined with define-waveform - - -;; I don't seem to be able to make this work... -;; I think it's some kind of interaction with the syntax-case -;; macro, define-waveform, and the module system. -;; -;;(define-module (gnuradio run-waveform) -;; #:use-module (oop goops) -;; #:use-module (gnuradio core) -;; #:use-module (gnuradio waveform) -;; #:duplicates (merge-generics replace check)) - -(use-modules (oop goops) - (gnuradio core) - (gnuradio waveform)) - - -(define (load-into-module filename module) - (let ((f (open-file filename "r"))) - (let loop ((form (read f))) - (cond ((eof-object? form) #t) - (else (eval form module) - (loop (read f))))))) - - -(define-public (run-waveform waveform-filename . args) - (debug-enable 'backtrace 'debug) - (load waveform-filename) - ;;(load-into-module waveform-filename (current-module)) - (let ((f (waveform-last-registered))) - (if (not f) - (error "No define-waveform found in file \n" filename)) - (gr:run (f args)) - ;; Attempt to get block destructors called now. - (gc))) diff --git a/gnuradio-core/src/guile/gnuradio/runtime-shim.scm b/gnuradio-core/src/guile/gnuradio/runtime-shim.scm deleted file mode 100644 index bba702670..000000000 --- a/gnuradio-core/src/guile/gnuradio/runtime-shim.scm +++ /dev/null @@ -1,129 +0,0 @@ -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -(define-module (gnuradio runtime-shim) - #:use-module (oop goops) - #:use-module (ice-9 threads) - #:use-module (gnuradio gnuradio_core_runtime) - #:duplicates (merge-generics replace check)) - -(define-class <gr-endpoint> (<object>) - (block #:accessor block #:init-keyword #:block) - (port #:init-value 0 #:accessor port #:init-keyword #:port)) - -(define (gr:ep block port) - (make <gr-endpoint> - #:block (coerce-to-basic-block block) #:port port)) - -(define (coerce-to-endpoint ep) - (cond ((is-a? ep <gr-endpoint>) ep) - ((false-if-exception (gr:to-basic-block ep)) - => (lambda (x) (gr:ep x 0))) - ((and (pair? ep) (= 2 (length ep)) - (false-if-exception (gr:to-basic-block (car ep)))) - => (lambda (x) (gr:ep x (cadr ep)))) - (else (error "Cannot coerce to an endpoint: " ep)))) - -(define (coerce-to-basic-block block) - (cond ((is-a? block <gr-basic-block-sptr>) block) - ((false-if-exception (gr:to-basic-block block)) => (lambda (x) x)) - (else (error "Cannot coerce to a gr_basic_block: " block)))) - -(define (coerce-to-top-block block) - (cond ((is-a? block <gr-top-block-sptr>) block) - ((false-if-exception (gr:to-top-block block)) => (lambda (x) x)) - (else (error "Cannot coerce to a gr_top_block: " block)))) - -(define (coerce-to-hier-block2 block) - (cond ((is-a? block <gr-hier-block2-sptr>) block) - ((false-if-exception (gr:to-hier-block2 block)) => (lambda (x) x)) - (else (error "Cannot coerce to a gr_hier_block2: " block)))) - - -;;; Connect one or more block endpoints. An endpoint is either a <gr-endpoint>, -;;; a 2-list (block port), or a block instance. In the latter case, the port number -;;; is assumed to be zero. -;;; -;;; If multiple arguments are provided, connect will attempt to wire them in series, -;;; interpreting the endpoints as inputs or outputs as appropriate. -(define-method (gr:connect hb . points) - (dis/connect "connect" gr:primitive-connect hb points)) - -;;; Disconnect one or more block endpoints... -(define-method (gr:disconnect hb . points) - (dis/connect "disconnect" gr:primitive-disconnect hb points)) - -(define (dis/connect name gf hb points) - (let ((hb (coerce-to-hier-block2 hb)) - (points (list->vector (map coerce-to-endpoint points)))) - - (define (op2 p0 p1) - (gf hb (block p0) (port p0) (block p1) (port p1))) - - (let ((len (vector-length points))) - (case len - ((0) (error (string-append name " requires at least 1 endpoint; None provided."))) - ((1) (gf hb (vector-ref points 0))) - (else - (let loop ((n 1)) - (cond ((< n len) - (op2 (vector-ref points (1- n)) (vector-ref points n)) - (loop (1+ n)))))))))) - - - - -(define-method (gr:run (self <gr-top-block-sptr>)) - (gr:start self) - (gr:wait self)) - - -(define-method (gr:wait (tb <gr-top-block-sptr>)) - - (define (sigint-handler sig) - ;;(display "\nSIGINT!\n" (current-error-port)) - ;; tell flow graph to stop - (gr:stop tb)) - - (let ((old-handler #f)) - (dynamic-wind - - ;; Called at entry - (lambda () - ;; Install SIGINT handler - (set! old-handler (sigaction SIGINT sigint-handler))) - - ;; Protected thunk - (lambda () - (let ((waiter (begin-thread (gr:top-block-wait-unlocked tb)))) - (join-thread waiter) - ;;(display "\nAfter join-thread\n" (current-error-port)) - )) - - ;; Called at exit - (lambda () - ;; Restore SIGINT handler - (if (not (car old-handler)) - ;; restore original C handler - (sigaction SIGINT #f) - ;; restore Scheme handler, SIG_IGN or SIG_DFL - (sigaction SIGINT (car old-handler) (cdr old-handler))))))) - - -(export-safely <gr-endpoint> gr:ep gr:connect gr:disconnect gr:run gr:wait) diff --git a/gnuradio-core/src/guile/gnuradio/test-suite/guile-test b/gnuradio-core/src/guile/gnuradio/test-suite/guile-test deleted file mode 100644 index 6dc1a9658..000000000 --- a/gnuradio-core/src/guile/gnuradio/test-suite/guile-test +++ /dev/null @@ -1,241 +0,0 @@ -#!/usr/bin/guile \ --e main -s -!# - -;;;; guile-test --- run the Guile test suite -;;;; Jim Blandy <jimb@red-bean.com> --- May 1999 -;;;; -;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program 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 General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;;;; Boston, MA 02110-1301 USA - - -;;;; Usage: [guile -e main -s] guile-test [OPTIONS] [TEST ...] -;;;; -;;;; Run tests from the Guile test suite. Report failures and -;;;; unexpected passes to the standard output, along with a summary of -;;;; all the results. Record each reported test outcome in the log -;;;; file, `guile.log'. The exit status is #f if any of the tests -;;;; fail or pass unexpectedly. -;;;; -;;;; Normally, guile-test scans the test directory, and executes all -;;;; files whose names end in `.test'. (It assumes they contain -;;;; Scheme code.) However, you can have it execute specific tests by -;;;; listing their filenames on the command line. -;;;; -;;;; The option `--test-suite' can be given to specify the test -;;;; directory. If no such option is given, the test directory is -;;;; taken from the environment variable TEST_SUITE_DIR (if defined), -;;;; otherwise a default directory that is hardcoded in this file is -;;;; used (see "Installation" below). -;;;; -;;;; If present, the `--log-file LOG' option tells `guile-test' to put -;;;; the log output in a file named LOG. -;;;; -;;;; If present, the `--debug' option will enable a debugging mode. -;;;; -;;;; If present, the `--flag-unresolved' option will cause guile-test -;;;; to exit with failure status if any tests are UNRESOLVED. -;;;; -;;;; -;;;; Installation: -;;;; -;;;; If you change the #! line at the top of this script to point at -;;;; the Guile interpreter you want to test, you can call this script -;;;; as an executable instead of having to pass it as a parameter to -;;;; guile via "guile -e main -s guile-test". Further, you can edit -;;;; the definition of default-test-suite to point to the parent -;;;; directory of the `tests' tree, which makes it unnecessary to set -;;;; the environment variable `TEST_SUITE_DIR'. -;;;; -;;;; -;;;; Shortcomings: -;;;; -;;;; At the moment, due to a simple-minded implementation, test files -;;;; must live in the test directory, and you must specify their names -;;;; relative to the top of the test directory. If you want to send -;;;; me a patch that fixes this, but still leaves sane test names in -;;;; the log file, that would be great. At the moment, all the tests -;;;; I care about are in the test directory, though. -;;;; -;;;; It would be nice if you could specify the Guile interpreter you -;;;; want to test on the command line. As it stands, if you want to -;;;; change which Guile interpreter you're testing, you need to edit -;;;; the #! line at the top of this file, which is stupid. - -(define (main . args) - (let ((module (resolve-module '(gnuradio test-suite guile-test)))) - (apply (module-ref module 'main) args))) - -(define-module (gnuradio test-suite guile-test) - :use-module (gnuradio test-suite lib) - :use-module (ice-9 getopt-long) - :use-module (ice-9 and-let-star) - :use-module (ice-9 rdelim) - :export (main data-file-name test-file-name)) - - -;;; User configurable settings: -(define default-test-suite - (string-append (getenv "HOME") "/bogus-path/test-suite")) - - -;;; Variables that will receive their actual values later. -(define test-suite default-test-suite) - -(define tmp-dir #f) - - -;;; General utilities, that probably should be in a library somewhere. - -;;; Enable debugging -(define (enable-debug-mode) - (write-line %load-path) - (set! %load-verbosely #t) - (debug-enable 'backtrace 'debug)) - -;;; Traverse the directory tree at ROOT, applying F to the name of -;;; each file in the tree, including ROOT itself. For a subdirectory -;;; SUB, if (F SUB) is true, we recurse into SUB. Do not follow -;;; symlinks. -(define (for-each-file f root) - - ;; A "hard directory" is a path that denotes a directory and is not a - ;; symlink. - (define (file-is-hard-directory? filename) - (eq? (stat:type (lstat filename)) 'directory)) - - (let visit ((root root)) - (let ((should-recur (f root))) - (if (and should-recur (file-is-hard-directory? root)) - (let ((dir (opendir root))) - (let loop () - (let ((entry (readdir dir))) - (cond - ((eof-object? entry) #f) - ((or (string=? entry ".") - (string=? entry "..") - (string=? entry "CVS") - (string=? entry "RCS")) - (loop)) - (else - (visit (string-append root "/" entry)) - (loop)))))))))) - - -;;; The test driver. - - -;;; Localizing test files and temporary data files. - -(define (data-file-name filename) - (in-vicinity tmp-dir filename)) - -(define (test-file-name test) - (in-vicinity test-suite test)) - -;;; Return a list of all the test files in the test tree. -(define (enumerate-tests test-dir) - (let ((root-len (+ 1 (string-length test-dir))) - (tests '())) - (for-each-file (lambda (file) - (if (has-suffix? file ".test") - (let ((short-name - (substring file root-len))) - (set! tests (cons short-name tests)))) - #t) - test-dir) - - ;; for-each-file presents the files in whatever order it finds - ;; them in the directory. We sort them here, so they'll always - ;; appear in the same order. This makes it easier to compare test - ;; log files mechanically. - (sort tests string<?))) - -(define (main args) - (let ((options (getopt-long args - `((test-suite - (single-char #\t) - (value #t)) - (flag-unresolved - (single-char #\u)) - (log-file - (single-char #\l) - (value #t)) - (debug - (single-char #\d)))))) - (define (opt tag default) - (let ((pair (assq tag options))) - (if pair (cdr pair) default))) - - (if (opt 'debug #f) - (enable-debug-mode)) - - (set! test-suite - (or (opt 'test-suite #f) - (getenv "TEST_SUITE_DIR") - default-test-suite)) - - ;; directory where temporary files are created. - ;; when run from "make check", this must be under the build-dir, - ;; not the src-dir. - (set! tmp-dir (getcwd)) - - (let* ((tests - (let ((foo (opt '() '()))) - (if (null? foo) - (enumerate-tests test-suite) - foo))) - (log-file - (opt 'log-file "guile.log"))) - - ;; Open the log file. - (let ((log-port (open-output-file log-file))) - - ;; Register some reporters. - (let ((global-pass #t) - (counter (make-count-reporter))) - (register-reporter (car counter)) - (register-reporter (make-log-reporter log-port)) - (register-reporter user-reporter) - (register-reporter (lambda results - (case (car results) - ((unresolved) - (and (opt 'flag-unresolved #f) - (set! global-pass #f))) - ((fail upass error) - (set! global-pass #f))))) - - ;; Run the tests. - (for-each (lambda (test) - (display (string-append "Running " test "\n")) - (with-test-prefix test - (load (test-file-name test)))) - tests) - - ;; Display the final counts, both to the user and in the log - ;; file. - (let ((counts ((cadr counter)))) - (print-counts counts) - (print-counts counts log-port)) - - (close-port log-port) - (quit global-pass)))))) - - -;;; Local Variables: -;;; mode: scheme -;;; End: diff --git a/gnuradio-core/src/guile/gnuradio/test-suite/lib.scm b/gnuradio-core/src/guile/gnuradio/test-suite/lib.scm deleted file mode 100644 index abdc89632..000000000 --- a/gnuradio-core/src/guile/gnuradio/test-suite/lib.scm +++ /dev/null @@ -1,627 +0,0 @@ -;;;; test-suite/lib.scm --- generic support for testing -;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program 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 General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;;;; Boston, MA 02110-1301 USA - -(define-module (gnuradio test-suite lib) - :use-module (ice-9 stack-catch) - :use-module (ice-9 regex) - :use-module (ice-9 syncase) - :use-module (ice-9 format) - :export ( - - ;; Exceptions which are commonly being tested for. - exception:bad-variable - exception:missing-expression - exception:out-of-range exception:unbound-var - exception:used-before-defined - exception:wrong-num-args exception:wrong-type-arg - exception:numerical-overflow - exception:struct-set!-denied - exception:system-error - exception:miscellaneous-error - exception:string-contains-nul - - ;; Reporting passes and failures. - run-test - pass-if expect-fail - pass-if-exception expect-fail-exception - pass-if-throw expect-fail-throw - - ;; Naming groups of tests in a regular fashion. - with-test-prefix with-test-prefix* current-test-prefix - format-test-name - - ;; Using the debugging evaluator. - with-debugging-evaluator with-debugging-evaluator* - - ;; Reporting results in various ways. - register-reporter unregister-reporter reporter-registered? - make-count-reporter print-counts - make-log-reporter - full-reporter - user-reporter - - ;; srfi-64 compatibility macros - test-equal - test-eqv - test-eq -)) - - -;;;; If you're using Emacs's Scheme mode: -;;;; (put 'with-test-prefix 'scheme-indent-function 1) - - -;;;; CORE FUNCTIONS -;;;; -;;;; The function (run-test name expected-result thunk) is the heart of the -;;;; testing environment. The first parameter NAME is a unique name for the -;;;; test to be executed (for an explanation of this parameter see below under -;;;; TEST NAMES). The second parameter EXPECTED-RESULT is a boolean value -;;;; that indicates whether the corresponding test is expected to pass. If -;;;; EXPECTED-RESULT is #t the test is expected to pass, if EXPECTED-RESULT is -;;;; #f the test is expected to fail. Finally, THUNK is the function that -;;;; actually performs the test. For example: -;;;; -;;;; (run-test "integer addition" #t (lambda () (= 2 (+ 1 1)))) -;;;; -;;;; To report success, THUNK should either return #t or throw 'pass. To -;;;; report failure, THUNK should either return #f or throw 'fail. If THUNK -;;;; returns a non boolean value or throws 'unresolved, this indicates that -;;;; the test did not perform as expected. For example the property that was -;;;; to be tested could not be tested because something else went wrong. -;;;; THUNK may also throw 'untested to indicate that the test was deliberately -;;;; not performed, for example because the test case is not complete yet. -;;;; Finally, if THUNK throws 'unsupported, this indicates that this test -;;;; requires some feature that is not available in the configured testing -;;;; environment. All other exceptions thrown by THUNK are considered as -;;;; errors. -;;;; -;;;; -;;;; Convenience macros for tests expected to pass or fail -;;;; -;;;; * (pass-if name body) is a short form for -;;;; (run-test name #t (lambda () body)) -;;;; * (expect-fail name body) is a short form for -;;;; (run-test name #f (lambda () body)) -;;;; -;;;; For example: -;;;; -;;;; (pass-if "integer addition" (= 2 (+ 1 1))) -;;;; -;;;; -;;;; Convenience macros to test for exceptions -;;;; -;;;; The following macros take exception parameters which are pairs -;;;; (type . message), where type is a symbol that denotes an exception type -;;;; like 'wrong-type-arg or 'out-of-range, and message is a string holding a -;;;; regular expression that describes the error message for the exception -;;;; like "Argument .* out of range". -;;;; -;;;; * (pass-if-exception name exception body) will pass if the execution of -;;;; body causes the given exception to be thrown. If no exception is -;;;; thrown, the test fails. If some other exception is thrown, is is an -;;;; error. -;;;; * (expect-fail-exception name exception body) will pass unexpectedly if -;;;; the execution of body causes the given exception to be thrown. If no -;;;; exception is thrown, the test fails expectedly. If some other -;;;; exception is thrown, it is an error. - - -;;;; TEST NAMES -;;;; -;;;; Every test in the test suite has a unique name, to help -;;;; developers find tests that are failing (or unexpectedly passing), -;;;; and to help gather statistics. -;;;; -;;;; A test name is a list of printable objects. For example: -;;;; ("ports.scm" "file" "read and write back list of strings") -;;;; ("ports.scm" "pipe" "read") -;;;; -;;;; Test names may contain arbitrary objects, but they always have -;;;; the following properties: -;;;; - Test names can be compared with EQUAL?. -;;;; - Test names can be reliably stored and retrieved with the standard WRITE -;;;; and READ procedures; doing so preserves their identity. -;;;; -;;;; For example: -;;;; -;;;; (pass-if "simple addition" (= 4 (+ 2 2))) -;;;; -;;;; In that case, the test name is the list ("simple addition"). -;;;; -;;;; In the case of simple tests the expression that is tested would often -;;;; suffice as a test name by itself. Therefore, the convenience macros -;;;; pass-if and expect-fail provide a shorthand notation that allows to omit -;;;; a test name in such cases. -;;;; -;;;; * (pass-if expression) is a short form for -;;;; (run-test 'expression #t (lambda () expression)) -;;;; * (expect-fail expression) is a short form for -;;;; (run-test 'expression #f (lambda () expression)) -;;;; -;;;; For example: -;;;; -;;;; (pass-if (= 2 (+ 1 1))) -;;;; -;;;; The WITH-TEST-PREFIX syntax and WITH-TEST-PREFIX* procedure establish -;;;; a prefix for the names of all tests whose results are reported -;;;; within their dynamic scope. For example: -;;;; -;;;; (begin -;;;; (with-test-prefix "basic arithmetic" -;;;; (pass-if "addition" (= (+ 2 2) 4)) -;;;; (pass-if "subtraction" (= (- 4 2) 2))) -;;;; (pass-if "multiplication" (= (* 2 2) 4))) -;;;; -;;;; In that example, the three test names are: -;;;; ("basic arithmetic" "addition"), -;;;; ("basic arithmetic" "subtraction"), and -;;;; ("multiplication"). -;;;; -;;;; WITH-TEST-PREFIX can be nested. Each WITH-TEST-PREFIX postpends -;;;; a new element to the current prefix: -;;;; -;;;; (with-test-prefix "arithmetic" -;;;; (with-test-prefix "addition" -;;;; (pass-if "integer" (= (+ 2 2) 4)) -;;;; (pass-if "complex" (= (+ 2+3i 4+5i) 6+8i))) -;;;; (with-test-prefix "subtraction" -;;;; (pass-if "integer" (= (- 2 2) 0)) -;;;; (pass-if "complex" (= (- 2+3i 1+2i) 1+1i)))) -;;;; -;;;; The four test names here are: -;;;; ("arithmetic" "addition" "integer") -;;;; ("arithmetic" "addition" "complex") -;;;; ("arithmetic" "subtraction" "integer") -;;;; ("arithmetic" "subtraction" "complex") -;;;; -;;;; To print a name for a human reader, we DISPLAY its elements, -;;;; separated by ": ". So, the last set of test names would be -;;;; reported as: -;;;; -;;;; arithmetic: addition: integer -;;;; arithmetic: addition: complex -;;;; arithmetic: subtraction: integer -;;;; arithmetic: subtraction: complex -;;;; -;;;; The Guile benchmarks use with-test-prefix to include the name of -;;;; the source file containing the test in the test name, to help -;;;; developers to find failing tests, and to provide each file with its -;;;; own namespace. - - -;;;; REPORTERS -;;;; -;;;; A reporter is a function which we apply to each test outcome. -;;;; Reporters can log results, print interesting results to the -;;;; standard output, collect statistics, etc. -;;;; -;;;; A reporter function takes two mandatory arguments, RESULT and TEST, and -;;;; possibly additional arguments depending on RESULT; its return value -;;;; is ignored. RESULT has one of the following forms: -;;;; -;;;; pass - The test named TEST passed. -;;;; Additional arguments are ignored. -;;;; upass - The test named TEST passed unexpectedly. -;;;; Additional arguments are ignored. -;;;; fail - The test named TEST failed. -;;;; Additional arguments are ignored. -;;;; xfail - The test named TEST failed, as expected. -;;;; Additional arguments are ignored. -;;;; unresolved - The test named TEST did not perform as expected, for -;;;; example the property that was to be tested could not be -;;;; tested because something else went wrong. -;;;; Additional arguments are ignored. -;;;; untested - The test named TEST was not actually performed, for -;;;; example because the test case is not complete yet. -;;;; Additional arguments are ignored. -;;;; unsupported - The test named TEST requires some feature that is not -;;;; available in the configured testing environment. -;;;; Additional arguments are ignored. -;;;; error - An error occurred while the test named TEST was -;;;; performed. Since this result means that the system caught -;;;; an exception it could not handle, the exception arguments -;;;; are passed as additional arguments. -;;;; -;;;; This library provides some standard reporters for logging results -;;;; to a file, reporting interesting results to the user, and -;;;; collecting totals. -;;;; -;;;; You can use the REGISTER-REPORTER function and friends to add -;;;; whatever reporting functions you like. If you don't register any -;;;; reporters, the library uses FULL-REPORTER, which simply writes -;;;; all results to the standard output. - - -;;;; MISCELLANEOUS -;;;; - -;;; Define some exceptions which are commonly being tested for. -(define exception:bad-variable - (cons 'syntax-error "Bad variable")) -(define exception:missing-expression - (cons 'misc-error "^missing or extra expression")) -(define exception:out-of-range - (cons 'out-of-range "^.*out of range")) -(define exception:unbound-var - (cons 'unbound-variable "^Unbound variable")) -(define exception:used-before-defined - (cons 'unbound-variable "^Variable used before given a value")) -(define exception:wrong-num-args - (cons 'wrong-number-of-args "^Wrong number of arguments")) -(define exception:wrong-type-arg - (cons 'wrong-type-arg "^Wrong type")) -(define exception:numerical-overflow - (cons 'numerical-overflow "^Numerical overflow")) -(define exception:struct-set!-denied - (cons 'misc-error "^set! denied for field")) -(define exception:system-error - (cons 'system-error ".*")) -(define exception:miscellaneous-error - (cons 'misc-error "^.*")) - -;; as per throw in scm_to_locale_stringn() -(define exception:string-contains-nul - (cons 'misc-error "^string contains #\\\\nul character")) - - -;;; Display all parameters to the default output port, followed by a newline. -(define (display-line . objs) - (for-each display objs) - (newline)) - -;;; Display all parameters to the given output port, followed by a newline. -(define (display-line-port port . objs) - (for-each (lambda (obj) (display obj port)) objs) - (newline port)) - - -;;;; CORE FUNCTIONS -;;;; - -;;; The central testing routine. -;;; The idea is taken from Greg, the GNUstep regression test environment. -(define run-test #f) -(let ((test-running #f)) - (define (local-run-test name expect-pass thunk) - (if test-running - (error "Nested calls to run-test are not permitted.") - (let ((test-name (full-name name))) - (set! test-running #t) - (catch #t - (lambda () - (let ((result (thunk))) - (if (eq? result #t) (throw 'pass)) - (if (eq? result #f) (throw 'fail)) - (throw 'unresolved))) - (lambda (key . args) - (case key - ((pass) - (report (if expect-pass 'pass 'upass) test-name)) - ((fail) - (report (if expect-pass 'fail 'xfail) test-name)) - ((unresolved untested unsupported) - (report key test-name)) - ((quit) - (report 'unresolved test-name) - (quit)) - (else - (report 'error test-name (cons key args)))))) - (set! test-running #f)))) - (set! run-test local-run-test)) - -;;; A short form for tests that are expected to pass, taken from Greg. -(defmacro pass-if (name . rest) - (if (and (null? rest) (pair? name)) - ;; presume this is a simple test, i.e. (pass-if (even? 2)) - ;; where the body should also be the name. - `(run-test ',name #t (lambda () ,name)) - `(run-test ,name #t (lambda () ,@rest)))) - -;;; A short form for tests that are expected to fail, taken from Greg. -(defmacro expect-fail (name . rest) - (if (and (null? rest) (pair? name)) - ;; presume this is a simple test, i.e. (expect-fail (even? 2)) - ;; where the body should also be the name. - `(run-test ',name #f (lambda () ,name)) - `(run-test ,name #f (lambda () ,@rest)))) - -;;; A helper function to implement the macros that test for exceptions. -;;; -;;; This doesn't work for all exceptions, just those that were -;;; raised by scm-error or error. This doesn't include those -;;; raised by throw in the general case, or SWIG in particular. -;;; -;;; See also run-raise-exception, pass-if-throw and expect-fail-throw -;;; for alternatives that work with all exceptions. -(define (run-test-exception name exception expect-pass thunk) - (run-test name expect-pass - (lambda () - (stack-catch (car exception) - (lambda () (thunk) #f) - (lambda (key proc message . rest) - (cond - ;; handle explicit key - ((string-match (cdr exception) message) - #t) - ;; handle `(error ...)' which uses `misc-error' for key and doesn't - ;; yet format the message and args (we have to do it here). - ((and (eq? 'misc-error (car exception)) - (list? rest) - (string-match (cdr exception) - (apply simple-format #f message (car rest)))) - #t) - ;; handle syntax errors which use `syntax-error' for key and don't - ;; yet format the message and args (we have to do it here). - ((and (eq? 'syntax-error (car exception)) - (list? rest) - (string-match (cdr exception) - (apply simple-format #f message (car rest)))) - #t) - ;; unhandled; throw again - (else - (apply throw key proc message rest)))))))) - -;;; A short form for tests that expect a certain exception to be thrown. -(defmacro pass-if-exception (name exception body . rest) - `(,run-test-exception ,name ,exception #t (lambda () ,body ,@rest))) - -;;; A short form for tests expected to fail to throw a certain exception. -(defmacro expect-fail-exception (name exception body . rest) - `(,run-test-exception ,name ,exception #f (lambda () ,body ,@rest))) - - -;;; Helper for macros below -(define (run-test-throw name exception-key expect-pass thunk) - (run-test name expect-pass - (lambda () - (stack-catch exception-key - (lambda () (thunk) #f) - (lambda (key . rest) #t))))) - -;;; A short form for tests that expect a certain exception to be thrown, -;;; where the exception is specified only by the exception-key symbol. -(defmacro pass-if-throw (name exception-key body . rest) - `(,run-test-throw ,name ,exception-key #t (lambda () ,body ,@rest))) - -;;; A short form for tests that expect a certain exception to be thrown, -;;; where the exception is specified only by the exception-key symbol. -(defmacro expect-fail-throw (name exception-key body . rest) - `(,run-test-throw ,name ,exception-key #f (lambda () ,body ,@rest))) - -;;;; TEST NAMES -;;;; - -;;;; Turn a test name into a nice human-readable string. -(define (format-test-name name) - (call-with-output-string - (lambda (port) - (let loop ((name name) - (separator "")) - (if (pair? name) - (begin - (display separator port) - (display (car name) port) - (loop (cdr name) ": "))))))) - -;;;; For a given test-name, deliver the full name including all prefixes. -(define (full-name name) - (append (current-test-prefix) (list name))) - -;;; A fluid containing the current test prefix, as a list. -(define prefix-fluid (make-fluid)) -(fluid-set! prefix-fluid '()) -(define (current-test-prefix) - (fluid-ref prefix-fluid)) - -;;; Postpend PREFIX to the current name prefix while evaluting THUNK. -;;; The name prefix is only changed within the dynamic scope of the -;;; call to with-test-prefix*. Return the value returned by THUNK. -(define (with-test-prefix* prefix thunk) - (with-fluids ((prefix-fluid - (append (fluid-ref prefix-fluid) (list prefix)))) - (thunk))) - -;;; (with-test-prefix PREFIX BODY ...) -;;; Postpend PREFIX to the current name prefix while evaluating BODY ... -;;; The name prefix is only changed within the dynamic scope of the -;;; with-test-prefix expression. Return the value returned by the last -;;; BODY expression. -(defmacro with-test-prefix (prefix . body) - `(with-test-prefix* ,prefix (lambda () ,@body))) - -;;; Call THUNK using the debugging evaluator. -(define (with-debugging-evaluator* thunk) - (let ((dopts #f)) - (dynamic-wind - (lambda () - (set! dopts (debug-options)) - (debug-enable 'debug)) - thunk - (lambda () - (debug-options dopts))))) - -;;; Evaluate BODY... using the debugging evaluator. -(define-macro (with-debugging-evaluator . body) - `(with-debugging-evaluator* (lambda () ,@body))) - - - -;;;; REPORTERS -;;;; - -;;; The global list of reporters. -(define reporters '()) - -;;; The default reporter, to be used only if no others exist. -(define default-reporter #f) - -;;; Add the procedure REPORTER to the current set of reporter functions. -;;; Signal an error if that reporter procedure object is already registered. -(define (register-reporter reporter) - (if (memq reporter reporters) - (error "register-reporter: reporter already registered: " reporter)) - (set! reporters (cons reporter reporters))) - -;;; Remove the procedure REPORTER from the current set of reporter -;;; functions. Signal an error if REPORTER is not currently registered. -(define (unregister-reporter reporter) - (if (memq reporter reporters) - (set! reporters (delq! reporter reporters)) - (error "unregister-reporter: reporter not registered: " reporter))) - -;;; Return true iff REPORTER is in the current set of reporter functions. -(define (reporter-registered? reporter) - (if (memq reporter reporters) #t #f)) - -;;; Send RESULT to all currently registered reporter functions. -(define (report . args) - (if (pair? reporters) - (for-each (lambda (reporter) (apply reporter args)) - reporters) - (apply default-reporter args))) - - -;;;; Some useful standard reporters: -;;;; Count reporters count the occurrence of each test result type. -;;;; Log reporters write all test results to a given log file. -;;;; Full reporters write all test results to the standard output. -;;;; User reporters write interesting test results to the standard output. - -;;; The complete list of possible test results. -(define result-tags - '((pass "PASS" "passes: ") - (fail "FAIL" "failures: ") - (upass "UPASS" "unexpected passes: ") - (xfail "XFAIL" "expected failures: ") - (unresolved "UNRESOLVED" "unresolved test cases: ") - (untested "UNTESTED" "untested test cases: ") - (unsupported "UNSUPPORTED" "unsupported test cases: ") - (error "ERROR" "errors: "))) - -;;; The list of important test results. -(define important-result-tags - '(fail upass unresolved error)) - -;;; Display a single test result in formatted form to the given port -(define (print-result port result name . args) - (let* ((tag (assq result result-tags)) - (label (if tag (cadr tag) #f))) - (if label - (begin - (display label port) - (display ": " port) - (display (format-test-name name) port) - (if (pair? args) - (begin - (display " - arguments: " port) - (write args port))) - (newline port)) - (error "(test-suite lib) FULL-REPORTER: unrecognized result: " - result)))) - -;;; Return a list of the form (COUNTER RESULTS), where: -;;; - COUNTER is a reporter procedure, and -;;; - RESULTS is a procedure taking no arguments which returns the -;;; results seen so far by COUNTER. The return value is an alist -;;; mapping outcome symbols (`pass', `fail', etc.) onto counts. -(define (make-count-reporter) - (let ((counts (map (lambda (tag) (cons (car tag) 0)) result-tags))) - (list - (lambda (result name . args) - (let ((pair (assq result counts))) - (if pair - (set-cdr! pair (+ 1 (cdr pair))) - (error "count-reporter: unexpected test result: " - (cons result (cons name args)))))) - (lambda () - (append counts '()))))) - -;;; Print a count reporter's results nicely. Pass this function the value -;;; returned by a count reporter's RESULTS procedure. -(define (print-counts results . port?) - (let ((port (if (pair? port?) - (car port?) - (current-output-port)))) - (newline port) - (display-line-port port "Totals for this test run:") - (for-each - (lambda (tag) - (let ((result (assq (car tag) results))) - (if result - (display-line-port port (caddr tag) (cdr result)) - (display-line-port port - "Test suite bug: " - "no total available for `" (car tag) "'")))) - result-tags) - (newline port))) - -;;; Return a reporter procedure which prints all results to the file -;;; FILE, in human-readable form. FILE may be a filename, or a port. -(define (make-log-reporter file) - (let ((port (if (output-port? file) file - (open-output-file file)))) - (lambda args - (apply print-result port args) - (force-output port)))) - -;;; A reporter that reports all results to the user. -(define (full-reporter . args) - (apply print-result (current-output-port) args)) - -;;; A reporter procedure which shows interesting results (failures, -;;; unexpected passes etc.) to the user. -(define (user-reporter result name . args) - (if (memq result important-result-tags) - (apply full-reporter result name args))) - -(set! default-reporter full-reporter) - - -;;; Macros for a bit of compatibility with srfi-64 -;;; (test-equal [name] expected test-expr) -(define-syntax test-equal - (syntax-rules () - ((_ expected test-expr) - (pass-if (verbose-equal? expected test-expr))) - ((_ name expected test-exprt) - (pass-if name (verbose-equal? expected test-expr))))) - -;;; (test-eqv [name] expected test-expr) -(define-syntax test-eqv - (syntax-rules () - ((_ expected test-expr) - (pass-if (eqv? expected test-expr))) - ((_ name expected test-exprt) - (pass-if name (eqv? expected test-expr))))) - -;;; (test-eq [name] expected test-expr) -(define-syntax test-eq - (syntax-rules () - ((_ expected test-expr) - (pass-if (eq? expected test-expr))) - ((_ name expected test-exprt) - (pass-if name (eq? expected test-expr))))) - - -(define-public (verbose-equal? expected actual) - (cond ((equal? expected actual) #t) - (else - (format #t "Expected:\n~y\n" expected) - (format #t "Actual:\n~y\n" actual) - #f))) diff --git a/gnuradio-core/src/guile/gnuradio/waveform.scm b/gnuradio-core/src/guile/gnuradio/waveform.scm deleted file mode 100644 index 0031be931..000000000 --- a/gnuradio-core/src/guile/gnuradio/waveform.scm +++ /dev/null @@ -1,54 +0,0 @@ -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -(define-module (gnuradio waveform) - #:use-module (ice-9 syncase) - #:export-syntax (define-waveform)) - - -(define *registry* '()) ; alist -(define *last-registered* #f) - - -(define-syntax define-waveform - (syntax-rules (vars blocks connections) - ((_ (name cmd-line-args) - (vars (v-name v-val) ...) - (blocks (b-name b-val) ...) - (connections (endpoint1 endpoint2 ...) ...)) - (waveform-register 'name - (lambda (cmd-line-args) - (let* ((v-name v-val) ... - (b-name b-val) ... - (tb (gr:top-block-swig "waveform-top-block"))) - (gr:connect tb endpoint1 endpoint2 ...) ... - tb)))))) - - -(define-public (waveform-register name thunk) - (set! *registry* (assoc-set! *registry* name thunk)) - (set! *last-registered* thunk) - #t) - -(define-public (waveform-lookup name) - (let ((r (assoc name *registry*))) - (and r (cdr r)))) - -(define-public (waveform-last-registered) - *last-registered*) diff --git a/gnuradio-core/src/guile/gr-run-waveform-script.in b/gnuradio-core/src/guile/gr-run-waveform-script.in deleted file mode 100644 index 651b387e9..000000000 --- a/gnuradio-core/src/guile/gr-run-waveform-script.in +++ /dev/null @@ -1,51 +0,0 @@ -#!/bin/sh - -# usage: prepend <path-varname> <dir> -prepend() { - if [ $# -ne 2 ] - then - echo "$0: prepend needs 2 args" 1>&2 - exit 1 - fi - local path="$1" dir="$2" contents="" - eval "contents=\$$path" - if [ "$dir" != "" ] - then - if [ "$contents" = "" ] - then - eval "$path=\"$dir\"" - else - eval "$path=\"$dir:$contents\"" - fi - fi - #echo end-of-prepend: $path=${!path} -} - -prefix="@prefix@" -exec_prefix="@exec_prefix@" - -prepend GUILE_LOAD_PATH "${prefix}/share/guile/site" -prepend LTDL_LIBRARY_PATH "@libdir@" -prepend DYLD_LIBRARY_PATH "@libdir@" - -export GUILE_LOAD_PATH LTDL_LIBRARY_PATH DYLD_LIBRARY_PATH - -export GUILE_WARN_DEPRECATED="no" - -exec @GUILE@ -e main -s $0 "$@" -!# - -;;; Load and run a waveform defined with define-waveform -;;; -;;; usage: gr-run-waveform filename.wfd [args...] - -(load-from-path "gnuradio/run-waveform") - -(define (main args) - (if (not (>= (length args) 2)) - (let ((port (current-error-port))) - (display "usage: " port) - (display (car args) port) - (display " filename.wfd [args...]\n" port) - (exit 1))) - (apply run-waveform (cdr args))) diff --git a/gnuradio-core/src/guile/run_guile_tests.in b/gnuradio-core/src/guile/run_guile_tests.in deleted file mode 100644 index 61968065e..000000000 --- a/gnuradio-core/src/guile/run_guile_tests.in +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/sh - -. @top_builddir@/setup_guile_test_env - -# Since we're in gnuradio-core, we don't need to add anything, -# but we do need to call add_local_paths to set everything up - -# 1st argument is absolute path to hand coded guile source directory -# 2nd argument is absolute path to component C++ shared library build directory -# 3nd argument is absolute path to component SWIG build directory - -add_local_paths \ - "" \ - "" \ - "" - -@GUILE@ -e main -c '(use-modules (gnuradio test-suite guile-test))' -t @srcdir@/tests diff --git a/gnuradio-core/src/guile/tests/00_runtime_basics.test b/gnuradio-core/src/guile/tests/00_runtime_basics.test deleted file mode 100644 index 4a5d967a1..000000000 --- a/gnuradio-core/src/guile/tests/00_runtime_basics.test +++ /dev/null @@ -1,159 +0,0 @@ -;;; -*- Scheme -*- -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -;;; If you're using Emacs's Scheme mode: -;;; (put 'with-test-prefix 'scheme-indent-function 1) - -;;; See the comments in gnuradio/test-suite/lib.scm for info on writing tests. -;;; See also the very end of the file, where the test-equal, test-eqv -;;; and test-eq macros are defined. - -(use-modules (gnuradio test-suite lib)) -(use-modules (gnuradio core)) -(use-modules (oop goops)) - -(define (vector-map f v) - (list->vector (map f (vector->list v)))) - -(pass-if "Guile was built with threads" (not (not (memq 'threads *features*)))) - -(with-test-prefix "connect-1" - (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) - (expected-result (vector-map (lambda (x) (* x 2)) src-data)) - (tb (gr:top-block-swig "QA top block")) - (src (gr:vector-source-i src-data #f)) - (op (gr:multiply-const-ii 2)) - (dst (gr:vector-sink-i))) - - ;; using gr:ep to create endpoints - (gr:connect tb (gr:ep src 0) (gr:ep op 0)) - (gr:connect tb (gr:ep op 0) (gr:ep dst 0)) - - (gr:run tb) - ;;(pass-if (equal? expected-result (gr:data dst))) - (test-equal expected-result (gr:data dst)) - )) - -(with-test-prefix "connect-2" - (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) - (expected-result (vector-map (lambda (x) (* x 2)) src-data)) - (tb (gr:top-block-swig "QA top block")) - (src (gr:vector-source-i src-data #f)) - (op (gr:multiply-const-ii 2)) - (dst (gr:vector-sink-i))) - - ;; using just blocks - (gr:connect tb src op) - (gr:connect tb op dst) - - (gr:run tb) - (test-equal expected-result (gr:data dst)))) - - -(with-test-prefix "connect-3" - (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) - (expected-result (vector-map (lambda (x) (* x 2)) src-data)) - (tb (gr:top-block-swig "QA top block")) - (src (gr:vector-source-i src-data #f)) - (op (gr:multiply-const-ii 2)) - (dst (gr:vector-sink-i))) - - ;; using lists to represent endpoints - (gr:connect tb `(,src 0) `(,op 0)) - (gr:connect tb `(,op 0) `(,dst 0)) - - (gr:run tb) - (test-equal expected-result (gr:data dst)))) - - -(with-test-prefix "connect-4" - (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) - (expected-result (vector-map (lambda (x) (* x 2)) src-data)) - (tb (gr:top-block-swig "QA top block")) - (src (gr:vector-source-i src-data #f)) - (op (gr:multiply-const-ii 2)) - (dst (gr:vector-sink-i))) - - ;; using multiple endpoints - (gr:connect tb src op dst) - - (gr:run tb) - (test-equal expected-result (gr:data dst)))) - -(with-test-prefix "connect-5" - (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) - (expected-result (vector-map (lambda (x) (* x 2)) src-data)) - (tb (gr:top-block-swig "QA top block")) - (src (gr:vector-source-i src-data #f)) - (op (gr:multiply-const-ii 2)) - (dst (gr:vector-sink-i))) - - (pass-if-throw "bad port exception" 'swig-exception - (gr:connect tb src op (gr:ep dst 1))) - )) - -(with-test-prefix "gr_top_block::start throw" - (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) - (expected-result (vector-map (lambda (x) (* x 2)) src-data)) - (tb (gr:top-block-swig "QA top block")) - (src (gr:vector-source-i src-data #f)) - (op (gr:multiply-const-ii 2)) - (dst (gr:vector-sink-i))) - - ;; We deliberately don't connect op's output - (gr:connect tb src op) - - ;; Which will lead to an exception here... - (pass-if-throw "throws std::runtime_error" 'swig-exception - (gr:run tb)) - )) - -(with-test-prefix "io-signature-1" - (let ((ios1 (gr:io-signature 1 2 8)) - (ios2 (gr:io-signature2 1 2 16 32)) - (ios3 (gr:io-signature3 1 -1 14 32 48)) - (iosv (gr:io-signaturev 1 4 '(1 2 3)))) - - (test-equal 1 (gr:min-streams ios1)) - (test-equal 2 (gr:max-streams ios1)) - (test-equal 8 (gr:sizeof-stream-item ios1 0)) - (test-equal 8 (gr:sizeof-stream-item ios1 1)) - - (test-equal 1 (gr:min-streams ios2)) - (test-equal 2 (gr:max-streams ios2)) - (test-equal 16 (gr:sizeof-stream-item ios2 0)) - (test-equal 32 (gr:sizeof-stream-item ios2 1)) - - (test-equal 1 (gr:min-streams ios3)) - (test-equal -1 (gr:max-streams ios3)) - (test-equal 14 (gr:sizeof-stream-item ios3 0)) - (test-equal 32 (gr:sizeof-stream-item ios3 1)) - (test-equal 48 (gr:sizeof-stream-item ios3 2)) - (test-equal '#(14 32 48) (gr:sizeof-stream-items ios3)) - - (test-equal 1 (gr:min-streams iosv)) - (test-equal 4 (gr:max-streams iosv)) - (test-equal 1 (gr:sizeof-stream-item iosv 0)) - (test-equal 2 (gr:sizeof-stream-item iosv 1)) - (test-equal 3 (gr:sizeof-stream-item iosv 2)) - (test-equal 3 (gr:sizeof-stream-item iosv 3)) - (test-equal '#(1 2 3) (gr:sizeof-stream-items iosv)) - )) - diff --git a/gnuradio-core/src/guile/tests/00_runtime_ctors.test b/gnuradio-core/src/guile/tests/00_runtime_ctors.test deleted file mode 100644 index 966d8c909..000000000 --- a/gnuradio-core/src/guile/tests/00_runtime_ctors.test +++ /dev/null @@ -1,54 +0,0 @@ -;;; -*- Scheme -*- -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -;;; If you're using Emacs's Scheme mode: -;;; (put 'with-test-prefix 'scheme-indent-function 1) - -;;; See the comments in gnuradio/test-suite/lib.scm for info on writing tests. -;;; See also the very end of the file where the test-equal, test-eqv -;;; and test-eq macros are defined. - -(use-modules (gnuradio test-suite lib)) -(use-modules (gnuradio core)) -(use-modules (oop goops)) - -;;; Add test code for all constructors in these files -;;; -;;; ./runtime/gr_hier_block2.h - -;;; ./runtime/gr_msg_queue.h - -(define (equal-message? a b) - (equal? (gr:to-string a) (gr:to-string b))) - -(with-test-prefix "gr:message/gr:msg-queue" - (let ((msg1 (gr:message-from-string "Hello")) - (msg2 (gr:message-from-string "World!")) - (q (gr:msg-queue))) - (pass-if (equal? "Hello" (gr:to-string msg1))) - (pass-if (equal? "World!" (gr:to-string msg2))) - (pass-if (gr:empty-p q)) - (gr:insert-tail q msg1) - (pass-if (not (gr:empty-p q))) - (gr:insert-tail q msg2) - (let ((r1 (gr:delete-head q)) - (r2 (gr:delete-head q))) - (pass-if (equal-message? r1 msg1)) - (pass-if (equal-message? r2 msg2))))) diff --git a/gnuradio-core/src/guile/tests/filter_ctors.test b/gnuradio-core/src/guile/tests/filter_ctors.test deleted file mode 100644 index fe1d9421d..000000000 --- a/gnuradio-core/src/guile/tests/filter_ctors.test +++ /dev/null @@ -1,245 +0,0 @@ -;;; -*- Scheme -*- -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -;;; If you're using Emacs's Scheme mode: -;;; (put 'with-test-prefix 'scheme-indent-function 1) - -;;; See the comments in gnuradio/test-suite/lib.scm for info on writing tests. -;;; See also the very end of the file, where the test-equal, test-eqv -;;; and test-eq macros are defined. - -(use-modules (gnuradio test-suite lib)) -(use-modules (gnuradio core)) -(use-modules (oop goops)) - -;;; Add test code for all constructors in these files -;;; - -;;; ./filter/gr_adaptive_fir_ccf.h WONTFIX: not wrapped -;; gr_adaptive_fir_ccf(char *name, int decimation, const std::vector<float> &taps); -;; (pass-if (true? (gr:adaptive-fir-ccf "foo" 0 #(1.0 2.0 3.0 4.0)))) - -;;; ./filter/gr_fft_filter_ccc.h -(pass-if (true? (gr:fft-filter-ccc 0 #(1+3i 23+5i)))) - -;;; ./filter/gr_fft_filter_fff.h -(pass-if (true? (gr:fft-filter-fff 0 #(1.0 2.0)))) - -;;; ./filter/gr_filter_delay_fc.h -(pass-if (true? (gr:filter-delay-fc #(1.0 2.0)))) - -;;; ./filter/gr_fir_ccc_generic. FIXME: Unbound variable: ~S" (gr:fir-ccc-generic) #f)) -;; (pass-if (true? (gr:fir-ccc-generic))) -;; (pass-if (true? (gr:fir-ccc-generic #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_ccc_simd.h FIXME: not found -;; (pass-if (true? (gr:fir-ccc-simd))) -;; (pass-if (true? (gr:fir-ccc-simd #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_ccc_x86.h FIXME: not found -;; (pass-if (true? (gr:fir-ccc-x86))) -;; (pass-if (true? (gr:fir-ccc-x86 #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_ccf_generic.h FIXME: not found -;; (pass-if (true? (gr:fir-ccf-generic))) -;; (pass-if (true? (gr:fir-ccf-generic #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_ccf_simd.h FIXME: not found -;; (pass-if (true? (gr:fir-ccf-simd 0 0 0 0))) - -;;; ./filter/gr_fir_ccf_x86.h FIXME: not found -;; (pass-if (true? (gr:fir-ccf-x86))) -;; (pass-if (true? (gr:fir-ccf-x86 #(1.0 2.0)))) - -;;; ./filter/gr_fir_fcc_generic.h FIXME: not found -;; (pass-if (true? (gr:fir-fcc-generic))) -;; (pass-if (true? (gr:fir-fcc-generic #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_fcc_simd.h FIXME: not found -;; (pass-if (true? (gr:fir-fcc-simd 0 0 0 0))) - -;;; ./filter/gr_fir_fcc_x86.h FIXME: not found -;; (pass-if (true? (gr:fir-fcc-x86))) -;; (pass-if (true? (gr:fir-fcc-x86 #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_fff_altivec.h FIXME: not found -;; (pass-if (true? (gr:fir-fff-altivec))) -;; (pass-if (true? (gr:fir-fff-altivec #(1.0 2.0)))) - -;;; ./filter/gr_fir_fff_armv7_a.h FIXME: not found -;; (pass-if (true? (gr:fir-fff-armv7-a))) -;; (pass-if (true? (gr:fir-fff-armv7-a #(1.0 2.0)))) - -;;; ./filter/gr_fir_fff_generic.h FIXME: not found -;; (pass-if (true? (gr:fir-fff-generic))) -;; (pass-if (true? (gr:fir-fff-generic #(1.0 2.0)))) - -;;; ./filter/gr_fir_fff_simd.h FIXME: not found -;; (pass-if (true? (gr:fir-fff-simd 0 0 0))) - -;;; ./filter/gr_fir_fff_x86.h FIXME: not found -;; (pass-if (true? (gr:fir-fff-x86))) -;; (pass-if (true? (gr:fir-fff-x86 #(1.0 2.0)))) - -;;; ./filter/gr_fir_filter_ccc.h FIXME: not found -;; (pass-if (true? (gr:fir-filter-ccc 1 #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_filter_ccf.h -(pass-if (true? (gr:fir-filter-ccf 1 #(1.0 2.0)))) - -;;; ./filter/gr_fir_filter_fcc.h -(pass-if (true? (gr:fir-filter-fcc 1 #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_filter_fff.h -(pass-if (true? (gr:fir-filter-fff 1 #(1.0 2.0)))) - -;;; ./filter/gr_fir_filter_fsf.h -(pass-if (true? (gr:fir-filter-fsf 1 #(1.0 2.0)))) - -;;; ./filter/gr_fir_filter_scc.h -(pass-if (true? (gr:fir-filter-scc 1 #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_fsf_generic.h FIXME: "Unbound variable: ~S" (gr:fir-fsf-generic) #f)) -;; (pass-if (true? (gr:fir-fsf-generic))) -;; (pass-if (true? (gr:fir-fsf-generic #(1.0 2.0)))) - -;;; ./filter/gr_fir_fsf_simd.h FIXME: not found -;; (pass-if (true? (gr:fir-fsf-simd 0 0 0))) - -;;; ./filter/gr_fir_fsf_x86.h FIXME: "Unbound variable: ~S" (gr:fir-fsf-x86) #f)) -;; (pass-if (true? (gr:fir-fsf-x86))) -;; (pass-if (true? (gr:fir-fsf-x86 #(1.0 2.0)))) - -;;; ./filter/gr_fir_scc_generic.h FIXME: file not found -;; (pass-if (true? (gr:fir-scc-generic))) -;; (pass-if (true? (gr:fir-scc-generic #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_scc_simd.h FIXME: Unbound variable: ~S" (gr:fir-scc-simd) #f)) -;; (pass-if (true? (gr:fir-scc-simd))) -;; (pass-if (true? (gr:fir-scc-simd #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_scc_x86.h FIXME: "Unbound variable: ~S" (gr:fir-scc-x86) #f)) -;; (pass-if (true? (gr:fir-scc-x86))) -;; (pass-if (true? (gr:fir-scc-x86 #(1+3i 23+5i)))) - -;;; ./filter/gr_fir_sysconfig_armv7_a.h FIXME: virtual methods -;; (pass-if (true? (gr:fir-sysconfig-armv7-a ))) - -;;; ./filter/gr_fir_sysconfig_generic.h FIXME: virtual methods -;; (pass-if (true? (gr:fir-sysconfig-generic ))) - -;;; ./filter/gr_fir_sysconfig_powerpc.h FIXME: virtual methods -;; (pass-if (true? (gr:fir-sysconfig-powerpc ))) - -;;; ./filter/gr_fir_sysconfig_x86.h FIXME: virtual methods -;; (pass-if (true? (gr:fir-sysconfig-x86 #(1+3i 23+5i)))) - -;;; ./filter/gr_fractional_interpolator_cc.h -(pass-if (true? (gr:fractional-interpolator-cc 1.0 1.0))) - -;;; ./filter/gr_fractional_interpolator_ff.h -(pass-if (true? (gr:fractional-interpolator-ff 1.0 1.0))) - -;;; ./filter/gr_freq_xlating_fir_filter_ccc.h -(pass-if (true? (gr:freq-xlating-fir-filter-ccc 1 #(1+3i 23+5i) 1.0 1.0))) - -;;; ./filter/gr_freq_xlating_fir_filter_ccf.h -(pass-if (true? (gr:freq-xlating-fir-filter-ccf 1 #(1.0 2.0) 1.0 1.0))) - -;;; ./filter/gr_freq_xlating_fir_filter_fcc.h -(pass-if (true? (gr:freq-xlating-fir-filter-fcc 1 #(1.0 2.0) 1.0 1.0))) - -;;; ./filter/gr_freq_xlating_fir_filter_fcf.h -(pass-if (true? (gr:freq-xlating-fir-filter-fcf 1 #(1.0 2.0) 1.0 1.0))) - -;;; ./filter/gr_freq_xlating_fir_filter_scc.h -(pass-if (true? (gr:freq-xlating-fir-filter-scc 1 #(1.0 2.0) 1.0 1.0))) - -;;; ./filter/gr_freq_xlating_fir_filter_scf.h -(pass-if (true? (gr:freq-xlating-fir-filter-scf 1 #(1.0 2.0) 1.0 1.0))) - -;;; ./filter/gr_goertzel_fc.h -(pass-if (true? (gr:goertzel-fc 1 1 1))) - -;;; ./filter/gr_hilbert_fc.h -(pass-if (true? (gr:hilbert-fc 1))) - -;;; ./filter/gr_iir_filter_ffd.h -(pass-if (true? (gr:iir-filter-ffd #(1.0 2.0) #(1.0 2.0)))) - -;;; ./filter/gr_interp_fir_filter_ccc.h FIXME: not found -;; (pass-if (true? (gr:interp-fir-filter-ccc #(1+3i 23+5i)))) - -;;; ./filter/gr_interp_fir_filter_ccf.h FIXME: not found -;; (pass-if (true? (gr:interp-fir-filter-ccf ))) - -;;; ./filter/gr_interp_fir_filter_fcc.h FIXME: not found -;; (pass-if (true? (gr:interp-fir-filter-fcc ))) - -;;; ./filter/gr_interp_fir_filter_fff.h FIXME: not found -;; (pass-if (true? (gr:interp-fir-filter-fff ))) - -;;; ./filter/gr_interp_fir_filter_fsf.h FIXME: not found -;; (pass-if (true? (gr:interp-fir-filter-fsf ))) - -;;; ./filter/gr_interp_fir_filter_scc.h FIXME: not found -;; (pass-if (true? (gr:interp-fir-filter-scc ))) - -;;; ./filter/gr_pfb_arb_resampler_ccf.h -(pass-if (true? (gr:pfb-arb-resampler-ccf 1.0 #(1.0 2.0) 32))) - -;;; ./filter/gr_pfb_channelizer_ccf.h -(pass-if (true? (gr:pfb-channelizer-ccf 1 #(1.0 2.0) 1))) - -;;; ./filter/gr_pfb_clock_sync_ccf.h -(pass-if (true? (gr:pfb-clock-sync-ccf 1.0 1.0 #(1.0 2.0) 32 0 1.5))) - -;;; ./filter/gr_pfb_clock_sync_fff.h -(pass-if (true? (gr:pfb-clock-sync-fff 1.0 1.0 #(1.0 2.0) 32 0 1.5))) - -;;; ./filter/gr_pfb_decimator_ccf.h -(pass-if (true? (gr:pfb-decimator-ccf 1 #(1.0 2.0) 0))) - -;;; ./filter/gr_pfb_interpolator_ccf.h -(pass-if (true? (gr:pfb-interpolator-ccf 1 #(1.0 2.0)))) - -;;; ./filter/gr_rational_resampler_base_ccc.h FIXME: not found -;; (pass-if (true? (gr:rational-resampler-base-ccc 1 1 #(1+3i 23+5i)))) - -;;; ./filter/gr_rational_resampler_base_ccf.h FIXME: not found -;; (pass-if (true? (gr:rational-resampler-base-ccf ))) - -;;; ./filter/gr_rational_resampler_base_fcc.h FIXME: not found -;; (pass-if (true? (gr:rational-resampler-base-fcc ))) - -;;; ./filter/gr_rational_resampler_base_fff.h FIXME: not found -;; (pass-if (true? (gr:rational-resampler-base-fff ))) - -;;; ./filter/gr_rational_resampler_base_fsf.h FIXME: not found -;; (pass-if (true? (gr:rational-resampler-base-fsf ))) - -;;; ./filter/gr_rational_resampler_base_scc.h FIXME: not found -;; (pass-if (true? (gr:rational-resampler-base-scc ))) - -;;; ./filter/gr_single_pole_iir_filter_cc.h -(pass-if (true? (gr:single-pole-iir-filter-cc 1.0 1))) - -;;; ./filter/gr_single_pole_iir_filter_ff.h -(pass-if (true? (gr:single-pole-iir-filter-ff 1.0 1))) diff --git a/gnuradio-core/src/guile/tests/general_ctors.test b/gnuradio-core/src/guile/tests/general_ctors.test deleted file mode 100644 index ca4d60460..000000000 --- a/gnuradio-core/src/guile/tests/general_ctors.test +++ /dev/null @@ -1,348 +0,0 @@ -;;; -*- Scheme -*- -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -;;; If you're using Emacs's Scheme mode: -;;; (put 'with-test-prefix 'scheme-indent-function 1) - -;;; See the comments in gnuradio/test-suite/lib.scm for info on writing tests. -;;; See also the very end of the file, where the test-equal, test-eqv -;;; and test-eq macros are defined. - -(use-modules (gnuradio test-suite lib)) -(use-modules (gnuradio core)) -(use-modules (oop goops)) -(use-modules (ice-9 format)) - - -;;; Test complex<float> scalars -(pass-if (equal? 5.0+5.0i (gr:complex-scalar-test0))) -(pass-if (equal? 1.5+0.5i (gr:complex-scalar-test1 1+1i))) - -;;; Test complex<float> vectors -(pass-if (verbose-equal? #(0+0i 1+1i 2+2i 3+3i 4+4i) - (gr:complex-vec-test0))) - -(pass-if (verbose-equal? #(1.5+0.5i 2.5+1.5i 3.5+2.5i) - (gr:complex-vec-test1 #(1+1i 2+2i 3+3i)))) - - -;;; Add test code for all constructors in these files - -;;; ./general/gr_additive_scrambler_bb.h -(pass-if (true? (gr:additive-scrambler-bb 0 0 0 0))) - -;; Here's one that will throw if its arg is 0 -(pass-if (true? (gr:unpack-k-bits-bb 10))) -(pass-if-throw "confirm throw gr:unpack-k-bits-bb" #t (true? (gr:unpack-k-bits-bb 0))) - -;;; ./general/gr_agc2_cc.h -(pass-if (true? (gr:agc2-cc 1e-1 1e-2 1.0 1.0 0.0))) - -;;; ./general/gr_agc2_ff.h -(pass-if (true? (gr:agc2-ff 0 0 0 0 0))) - -;;; ./general/gr_agc_cc.h -(pass-if (true? (gr:agc-cc 0 0 0 0))) - -;;; ./general/gr_agc_ff.h -(pass-if (true? (gr:agc-ff 0 0 0 0))) - -;;; ./general/gr_align_on_samplenumbers_ss.h -(pass-if (true? (gr:align-on-samplenumbers-ss 2 128))) -(pass-if-throw "confirm throw gr:align-on-samplenumbers-ss" #t (true? (gr:align-on-samplenumbers-ss 0 0))) - -;;; ./general/gr_bin_statistics_f.h WONTFIX: requires gr_feval_dd & swig directors -;;;(pass-if (true? (gr:bin-statistics-f 1 (gr:msg-queue) 0 0 0))) - -;;; ./general/gr_bytes_to_syms.h -(pass-if (true? (gr:bytes-to-syms))) - -;;; ./general/gr_char_to_float.h -(pass-if (true? (gr:char-to-float))) - -;;; ./general/gr_check_counting_s.h -(pass-if (true? (gr:check-counting-s #f))) - -;;; ./general/gr_check_lfsr_32k_s.h -(pass-if (true? (gr:check-lfsr-32k-s))) - -;;; ./general/gr_complex_to_interleaved_short.h -(pass-if (true? (gr:complex-to-interleaved-short))) - -;;; ./general/gr_complex_to_xxx.h -(pass-if (true? (gr:complex-to-float 1))) -(pass-if (true? (gr:complex-to-real 1))) -(pass-if (true? (gr:complex-to-imag 1))) -(pass-if (true? (gr:complex-to-mag 1))) -(pass-if (true? (gr:complex-to-mag-squared 1))) -(pass-if (true? (gr:complex-to-arg 1))) - -;;; ./general/gr_conjugate_cc.h -(pass-if (true? (gr:conjugate-cc))) - -;;; ./general/gr_copy.h -(pass-if (true? (gr:copy 1))) - -;;; ./general/gr_cpfsk_bc.h -(pass-if (true? (gr:cpfsk-bc 1 1 1))) - -;;; ./general/gr_ctcss_squelch_ff.h -(pass-if (true? (gr:ctcss-squelch-ff 0 0 0 0 0 #t))) - -;;; ./general/gr_decode_ccsds_27_fb.h -(pass-if (true? (gr:decode-ccsds-27-fb))) - -;;; ./general/gr_deinterleave.h -(pass-if (true? (gr:deinterleave 1))) - -;;; ./general/gr_delay.h -(pass-if (true? (gr:delay 1 1))) - -;;; ./general/gr_descrambler_bb.h -(pass-if (true? (gr:descrambler-bb 0 0 0))) - -;;; ./general/gr_diff_decoder_bb.h -(pass-if (true? (gr:diff-decoder-bb 0))) - -;;; ./general/gr_diff_encoder_bb.h -(pass-if (true? (gr:diff-encoder-bb 0))) - -;;; ./general/gr_diff_phasor_cc.h -(pass-if (true? (gr:diff-phasor-cc))) - -;;; ./general/gr_dpll_bb.h -(pass-if (true? (gr:dpll-bb 0 0))) - -;;; ./general/gr_encode_ccsds_27_bb.h -(pass-if (true? (gr:encode-ccsds-27-bb))) - -;;; ./general/gr_fake_channel_coder_pp.h -(pass-if (true? (gr:fake-channel-encoder-pp 1 1))) -(pass-if-throw "confirm throw" #t (true? (gr:fake-channel-encoder-pp -1 1))) - -;;; ./general/gr_feedforward_agc_cc.h -(pass-if (true? (gr:feedforward-agc-cc 1 1))) - -;;; ./general/gr_fft_vcc.h -(pass-if (true? (gr:fft-vcc 1 #f #(1.0 2.0) #t))) - -;;; ./general/gr_fft_vfc.h -(pass-if (true? (gr:fft-vfc 4 #t #(1.0 2.0 3.0 4.0)))) -(pass-if-throw "confirm throw gr:fft-vfc" #t (true? (gr:fft-vfc 4 #f #(1.0 2.0 3.0 4.0)))) - -;; ;;; ./general/gr_float_to_char.h -(pass-if (true? (gr:float-to-char))) - -;; ;;; ./general/gr_float_to_complex.h -(pass-if (true? (gr:float-to-complex 1))) - -;;; ./general/gr_float_to_short.h -(pass-if (true? (gr:float-to-short))) - -;;; ./general/gr_float_to_uchar.h -(pass-if (true? (gr:float-to-uchar))) - -;;; ./general/gr_fmdet_cf.h -(pass-if (true? (gr:fmdet-cf 0 0 0 0))) - -;;; ./general/gr_framer_sink_1.h -(pass-if (true? (gr:framer-sink-1 (gr:msg-queue)))) - -;;; ./general/gr_frequency_modulator_fc.h -(pass-if (true? (gr:frequency-modulator-fc 0))) - -;;; ./general/gr_glfsr_source_b.h -(pass-if (true? (gr:glfsr-source-b 1 #t 0 1))) -(pass-if-throw "confirm throw" #t (true? (gr:glfsr_source_b 33 #t 0 0))) - -;;; ./general/gr_glfsr_source_f.h -(pass-if (true? (gr:glfsr-source-f 1 #t 1 1))) -(pass-if-throw "confirm throw" #t (true? (gr:glfsr_source_f 33 #t 0 0))) - -;;; ./general/gr_head.h -(pass-if (true? (gr:head 1 1))) - -;;; ./general/gr_interleave.h -(pass-if (true? (gr:interleave 1))) - -;;; ./general/gr_interleaved_short_to_complex.h -(pass-if (true? (gr:interleaved-short-to-complex))) - -;;; ./general/gr_keep_one_in_n.h -(pass-if (true? (gr:keep-one-in-n 1 1))) - -;;; ./general/gr_kludge_copy.h -(pass-if (true? (gr:kludge-copy 1))) - -;;; ./general/gr_lfsr_32k_source_s.h -(pass-if (true? (gr:lfsr-32k-source-s))) - -;;; ./general/gr_map_bb.h -(pass-if (true? (gr:map-bb #(1 2)))) - -;;; ./general/gr_nlog10_ff.h -(pass-if (true? (gr:nlog10-ff 1 1 1))) - -;;; ./general/gr_nop.h -(pass-if (true? (gr:nop 1))) - -;;; ./general/gr_null_sink.h -(pass-if (true? (gr:null-sink 1))) - -;;; ./general/gr_null_source.h -(pass-if (true? (gr:null-source 1))) - -;;; ./general/gr_pa_2x2_phase_combiner.h -(pass-if (true? (gr:pa-2x2-phase-combiner))) - -;;; ./general/gr_packet_sink.h -(pass-if (true? (gr:packet-sink #(1 2) (gr:msg-queue) -1))) - -;;; ./general/gr_peak_detector2_fb.h -(pass-if (true? (gr:peak-detector2-fb 0 0 0))) - -;;; ./general/gr_phase_modulator_fc.h -(pass-if (true? (gr:phase-modulator-fc 0))) - -;;; ./general/gr_pll_carriertracking_cc.h -(pass-if (true? (gr:pll-carriertracking-cc 0 0 0))) - -;;; ./general/gr_pll_freqdet_cf.h -(pass-if (true? (gr:pll-freqdet-cf 0 0 0))) - -;;; ./general/gr_pll_refout_cc.h -(pass-if (true? (gr:pll-refout-cc 0 0 0))) - -;;; ./general/gr_pn_correlator_cc.h -(pass-if (true? (gr:pn-correlator-cc 1 1 1))) - -;;; ./general/gr_probe_avg_mag_sqrd_c.h -(pass-if (true? (gr:probe-avg-mag-sqrd-c 0 0))) - -;;; ./general/gr_probe_avg_mag_sqrd_cf.h -(pass-if (true? (gr:probe-avg-mag-sqrd-cf 0 0))) - -;;; ./general/gr_probe_avg_mag_sqrd_f.h -(pass-if (true? (gr:probe-avg-mag-sqrd-f 0 0))) - -;;; ./general/gr_probe_density_b.h -(pass-if (true? (gr:probe-density-b 0))) - -;;; ./general/gr_probe_mpsk_snr_c.h -(pass-if (true? (gr:probe-mpsk-snr-c 0))) - -;;; ./general/gr_probe_signal_f.h -(pass-if (true? (gr:probe-signal-f))) - -;;; ./general/gr_pwr_squelch_cc.h -(pass-if (true? (gr:pwr-squelch-cc 0 0 0 #f))) - -;;; ./general/gr_pwr_squelch_ff.h -(pass-if (true? (gr:pwr-squelch-ff 0.0 0.0 0 #f))) - -;;; ./general/gr_quadrature_demod_cf.h -(pass-if (true? (gr:quadrature-demod-cf 0))) - -;;; ./general/gr_rail_ff.h -(pass-if (true? (gr:rail-ff 0 0))) - -;;; ./general/gr_regenerate_bb.h -(pass-if (true? (gr:regenerate-bb 0 0))) - -;;; ./general/gr_repeat.h -(pass-if (true? (gr:repeat 1 1))) - -;;; ./general/gr_rms_cf.h -(pass-if (true? (gr:rms-cf 0))) - -;;; ./general/gr_rms_ff.h -(pass-if (true? (gr:rms-ff 0))) - -;;; ./general/gr_scrambler_bb.h -(pass-if (true? (gr:scrambler-bb 0 0 0))) - -;;; ./general/gr_short_to_float.h -(pass-if (true? (gr:short-to-float))) - -;;; ./general/gr_simple_correlator.h -(pass-if (true? (gr:simple-correlator 0))) - -;;; ./general/gr_simple_framer.h -(pass-if (true? (gr:simple-framer 0))) - -;;; ./general/gr_simple_squelch_cc.h -(pass-if (true? (gr:simple-squelch-cc 0 0))) - -;;; ./general/gr_skiphead.h -(pass-if (true? (gr:skiphead 1 1))) - -;;; ./general/gr_squash_ff.h -(pass-if (true? (gr:squash-ff #(1.0 2.0 3.0 4.0 5.0) #(1.0 2.0 3.0 4.0 5.0)))) - -;;; ./general/gr_squelch_base_cc.h WONTFIX: not wrapped -;;; (pass-if (true? (gr:squelch-base-cc "foo" 0 #f))) - -;;; ./general/gr_squelch_base_ff.h WONTFIX: not wrapped -;; (pass-if (true? (gr:squelch-base-ff "foo" 0 #f))) - -;;; ./general/gr_stream_mux.h -(pass-if (true? (gr:stream-mux 1 #(1 2)))) - -;;; ./general/gr_stream_to_streams.h -(pass-if (true? (gr:stream-to-streams 1 1))) - -;;; ./general/gr_stream_to_vector.h -(pass-if (true? (gr:stream-to-vector 1 1))) - -;;; ./general/gr_streams_to_stream.h -(pass-if (true? (gr:streams-to-stream 1 1))) - -;;; ./general/gr_streams_to_vector.h -(pass-if (true? (gr:streams-to-vector 1 1))) - -;;; ./general/gr_stretch_ff.h -(pass-if (true? (gr:stretch-ff 1 1))) - -;;; ./general/gr_test.h -(pass-if (true? (gr:test "foo" 1 1 1 1 1 1 1 1))) - -;;; ./general/gr_threshold_ff.h -(pass-if (true? (gr:threshold-ff 0 0))) - -;;; ./general/gr_throttle.h -(pass-if (true? (gr:throttle 1 1))) - -;;; ./general/gr_uchar_to_float.h -(pass-if (true? (gr:uchar-to-float))) - -;;; ./general/gr_vco_f.h -(pass-if (true? (gr:vco-f 0 0 0))) - -;;; ./general/gr_vector_to_stream.h -(pass-if (true? (gr:vector-to-stream 1 1))) - -;;; ./general/gr_vector_to_streams.h -(pass-if (true? (gr:vector-to-streams 1 1))) - -;;; ./general/gr_wavelet_ff.h -(pass-if (true? (gr:wavelet-ff 1024 20 #t))) - -;;; ./general/gr_wvps_ff.h -(pass-if (true? (gr:wvps-ff 2))) diff --git a/gnuradio-core/src/guile/tests/gengen_ctors.test b/gnuradio-core/src/guile/tests/gengen_ctors.test deleted file mode 100644 index 6e1213c63..000000000 --- a/gnuradio-core/src/guile/tests/gengen_ctors.test +++ /dev/null @@ -1,342 +0,0 @@ -;;; -*- Scheme -*- -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -;;; If you're using Emacs's Scheme mode: -;;; (put 'with-test-prefix 'scheme-indent-function 1) - -;;; See the comments in gnuradio/test-suite/lib.scm for info on writing tests. -;;; See also the very end of the file, where the test-equal, test-eqv -;;; and test-eq macros are defined. - -(use-modules (gnuradio test-suite lib)) -(use-modules (gnuradio core)) -(use-modules (oop goops)) - -;;; Add test code for all constructors in these files -;;; - -;;; ./gengen/gr_add_cc.h -(pass-if (true? (gr:add-cc 1))) - -;;; ./gengen/gr_add_const_cc.h -(pass-if (true? (gr:add-const-cc 0))) - -;;; ./gengen/gr_add_const_ff.h -(pass-if (true? (gr:add-const-ff 0))) - -;;; ./gengen/gr_add_const_ii.h -(pass-if (true? (gr:add-const-ii 0))) - -;;; ./gengen/gr_add_const_sf.h -(pass-if (true? (gr:add-const-sf 0))) - -;;; ./gengen/gr_add_const_ss.h -(pass-if (true? (gr:add-const-ss 0))) - -;;; ./gengen/gr_add_const_vcc.h -(pass-if (true? (gr:add-const-vcc #(1+3i 23+5i)))) - -;;; ./gengen/gr_add_const_vff.h -(pass-if (true? (gr:add-const-vff #(1.0 2.0)))) - -;;; ./gengen/gr_add_const_vii.h -(pass-if (true? (gr:add-const-vii #(1 2)))) - -;;; ./gengen/gr_add_const_vss.h -(pass-if (true? (gr:add-const-vss #(1 2)))) - -;;; ./gengen/gr_add_ff.h -(pass-if (true? (gr:add-ff 1))) - -;;; ./gengen/gr_add_ii.h -(pass-if (true? (gr:add-ii 1))) - -;;; ./gengen/gr_add_ss.h -(pass-if (true? (gr:add-ss 1))) - -;;; ./gengen/gr_and_bb.h -(pass-if (true? (gr:and-bb))) - -;;; ./gengen/gr_and_const_bb.h -(pass-if (true? (gr:and-const-bb 0))) - -;;; ./gengen/gr_and_const_ii.h -(pass-if (true? (gr:and-const-ii 0))) - -;;; ./gengen/gr_and_const_ss.h -(pass-if (true? (gr:and-const-ss 0))) - -;;; ./gengen/gr_and_ii.h -(pass-if (true? (gr:and-ii))) - -;;; ./gengen/gr_and_ss.h -(pass-if (true? (gr:and-ss))) - -;;; ./gengen/gr_argmax_fs.h -(pass-if (true? (gr:argmax-fs 1))) - -;;; ./gengen/gr_argmax_is.h -(pass-if (true? (gr:argmax-is 1))) - -;;; ./gengen/gr_argmax_ss.h -(pass-if (true? (gr:argmax-ss 1))) - -;;; ./gengen/gr_chunks_to_symbols_bc.h -(pass-if (true? (gr:chunks-to-symbols-bc #(1+3i 23+5i) 1))) - -;;; ./gengen/gr_chunks_to_symbols_bf.h -(pass-if (true? (gr:chunks-to-symbols-bf #(1.0 2.0) 1))) - -;;; ./gengen/gr_chunks_to_symbols_ic.h -(pass-if (true? (gr:chunks-to-symbols-ic #(1+3i 23+5i) 1))) - -;;; ./gengen/gr_chunks_to_symbols_if.h -(pass-if (true? (gr:chunks-to-symbols-if #(1.0 2.0) 1))) - -;;; ./gengen/gr_chunks_to_symbols_sc.h -(pass-if (true? (gr:chunks-to-symbols-sc #(1.0 2.0) 1))) - -;;; ./gengen/gr_chunks_to_symbols_sf.h -(pass-if (true? (gr:chunks-to-symbols-sf #(1.0 2.0) 1))) - -;;; ./gengen/gr_divide_cc.h -(pass-if (true? (gr:divide-cc 1))) - -;;; ./gengen/gr_divide_ff.h -(pass-if (true? (gr:divide-ff 1))) - -;;; ./gengen/gr_divide_ii.h -(pass-if (true? (gr:divide-ii 1))) - -;;; ./gengen/gr_divide_ss.h -(pass-if (true? (gr:divide-ss 1))) - -;;; ./gengen/gr_integrate_cc.h -(pass-if (true? (gr:integrate-cc 0))) - -;;; ./gengen/gr_integrate_ff.h -(pass-if (true? (gr:integrate-ff 0))) - -;;; ./gengen/gr_integrate_ii.h -(pass-if (true? (gr:integrate-ii 0))) - -;;; ./gengen/gr_integrate_ss.h -(pass-if (true? (gr:integrate-ss 0))) - -;;; ./gengen/gr_max_ff.h -(pass-if (true? (gr:max-ff 1))) - -;;; ./gengen/gr_max_ii.h -(pass-if (true? (gr:max-ii 1))) - -;;; ./gengen/gr_max_ss.h -(pass-if (true? (gr:max-ss 1))) - -;;; ./gengen/gr_moving_average_cc.h -(pass-if (true? (gr:moving-average-cc 1 1+3i 4096))) - -;;; ./gengen/gr_moving_average_ff.h -(pass-if (true? (gr:moving-average-ff 1 0 4096))) - -;;; ./gengen/gr_moving_average_ii.h -(pass-if (true? (gr:moving-average-ii 1 0 4096))) - -;;; ./gengen/gr_moving_average_ss.h -(pass-if (true? (gr:moving-average-ss 1 0 4096))) - -;;; ./gengen/gr_multiply_cc.h -(pass-if (true? (gr:multiply-cc 1))) - -;;; ./gengen/gr_multiply_const_cc.h -(pass-if (true? (gr:multiply-const-cc 1))) - -;;; ./gengen/gr_multiply_const_ff.h -(pass-if (true? (gr:multiply-const-ff 1))) - -;;; ./gengen/gr_multiply_const_ii.h -(pass-if (true? (gr:multiply-const-ii 1))) - -;;; ./gengen/gr_multiply_const_ss.h -(pass-if (true? (gr:multiply-const-ss 1))) - -;;; ./gengen/gr_multiply_const_vcc.h -(pass-if (true? (gr:multiply-const-vcc #(1+3i 23+5i)))) - -;;; ./gengen/gr_multiply_const_vff.h -(pass-if (true? (gr:multiply-const-vff #(1.0 2.0)))) - -;;; ./gengen/gr_multiply_const_vii.h -(pass-if (true? (gr:multiply-const-vii #(1 2)))) - -;;; ./gengen/gr_multiply_const_vss.h -(pass-if (true? (gr:multiply-const-vss #(1 2)))) - -;;; ./gengen/gr_multiply_ff.h -(pass-if (true? (gr:multiply-ff 1))) - -;;; ./gengen/gr_multiply_ii.h -(pass-if (true? (gr:multiply-ii 1))) - -;;; ./gengen/gr_multiply_ss.h -(pass-if (true? (gr:multiply-ss 1))) - -;;; ./gengen/gr_mute_cc.h FIXME: not found -(pass-if (true? (gr:mute-cc #f))) - -;;; ./gengen/gr_mute_ff.h FIXME: not found -(pass-if (true? (gr:mute-ff #f))) - -;;; ./gengen/gr_mute_ii.h FIXME: not found -(pass-if (true? (gr:mute-ii #f))) - -;;; ./gengen/gr_mute_ss.h FIXME: not found -(pass-if (true? (gr:mute-ss #f))) - -;;; ./gengen/gr_noise_source_c.h -(pass-if (true? (gr:noise-source-c 1 0 3021))) - -;;; ./gengen/gr_noise_source_f.h -(pass-if (true? (gr:noise-source-f 1 0 3021))) - -;;; ./gengen/gr_noise_source_i.h -(pass-if (true? (gr:noise-source-i 1 0 3021))) - -;;; ./gengen/gr_noise_source_s.h -(pass-if (true? (gr:noise-source-s 1 0 3021))) - -;;; ./gengen/gr_not_bb.h -(pass-if (true? (gr:not-bb))) - -;;; ./gengen/gr_not_ii.h -(pass-if (true? (gr:not-ii))) - -;;; ./gengen/gr_not_ss.h -(pass-if (true? (gr:not-ss))) - -;;; ./gengen/gr_or_bb.h -(pass-if (true? (gr:or-bb))) - -;;; ./gengen/gr_or_ii.h -(pass-if (true? (gr:or-ii))) - -;;; ./gengen/gr_or_ss.h -(pass-if (true? (gr:or-ss))) - -;;; ./gengen/gr_packed_to_unpacked_bb.h -(pass-if (true? (gr:packed-to-unpacked-bb 1 1))) - -;;; ./gengen/gr_packed_to_unpacked_ii.h -(pass-if (true? (gr:packed-to-unpacked-ii 1 1))) - -;;; ./gengen/gr_packed_to_unpacked_ss.h -(pass-if (true? (gr:packed-to-unpacked-ss 1 1))) - -;;; ./gengen/gr_peak_detector_fb.h -(pass-if (true? (gr:peak-detector-fb 0.25 0.40 10 0.001))) - -;;; ./gengen/gr_peak_detector_ib.h -(pass-if (true? (gr:peak-detector-ib 0.25 0.40 10 0.001))) - -;;; ./gengen/gr_peak_detector_sb.h -(pass-if (true? (gr:peak-detector-sb 0.25 0.40 10 0.001))) - -;;; ./gengen/gr_sample_and_hold_bb.h -(pass-if (true? (gr:sample-and-hold-bb))) - -;;; ./gengen/gr_sample_and_hold_ff.h -(pass-if (true? (gr:sample-and-hold-ff))) - -;;; ./gengen/gr_sample_and_hold_ii.h -(pass-if (true? (gr:sample-and-hold-ii))) - -;;; ./gengen/gr_sample_and_hold_ss.h -(pass-if (true? (gr:sample-and-hold-ss))) - -;;; ./gengen/gr_sig_source_c.h -(pass-if (true? (gr:sig-source-c 0 0 0 0 0))) - -;;; ./gengen/gr_sig_source_f.h -(pass-if (true? (gr:sig-source-f 0 0 0 0 0))) - -;;; ./gengen/gr_sig_source_i.h -(pass-if (true? (gr:sig-source-i 0 0 0 0 0))) - -;;; ./gengen/gr_sig_source_s.h -(pass-if (true? (gr:sig-source-s 0 0 0 0 0))) - -;;; ./gengen/gr_sub_cc.h -(pass-if (true? (gr:sub-cc 1))) - -;;; ./gengen/gr_sub_ff.h -(pass-if (true? (gr:sub-ff 1))) - -;;; ./gengen/gr_sub_ii.h -(pass-if (true? (gr:sub-ii 1))) - -;;; ./gengen/gr_sub_ss.h -(pass-if (true? (gr:sub-ss 1))) - -;;; ./gengen/gr_unpacked_to_packed_bb.h -(pass-if (true? (gr:unpacked-to-packed-bb 1 1))) - -;;; ./gengen/gr_unpacked_to_packed_ii.h -(pass-if (true? (gr:unpacked-to-packed-ii 1 1))) - -;;; ./gengen/gr_unpacked_to_packed_ss.h -(pass-if (true? (gr:unpacked-to-packed-ss 1 1))) - -;;; ./gengen/gr_vector_sink_b.h -(pass-if (true? (gr:vector-sink-b 1))) - -;;; ./gengen/gr_vector_sink_c.h -(pass-if (true? (gr:vector-sink-c 1))) - -;;; ./gengen/gr_vector_sink_f.h -(pass-if (true? (gr:vector-sink-f 1))) - -;;; ./gengen/gr_vector_sink_i.h -(pass-if (true? (gr:vector-sink-i 1))) - -;;; ./gengen/gr_vector_sink_s.h -(pass-if (true? (gr:vector-sink-s 1))) - -;;; ./gengen/gr_vector_source_b.h -;; (pass-if (true? (gr:vector-source-b #(1 2) #f 1))) - -;; ;;; ./gengen/gr_vector_source_c.h -;; (pass-if (true? (gr:vector-source-c #(1+3i 23+5i) #f 1))) - -;; ;;; ./gengen/gr_vector_source_f.h -;; (pass-if (true? (gr:vector-source-f #(1.0 2.0) #f 1))) - -;;; ./gengen/gr_vector_source_i.h -;; (pass-if (true? (gr:vector-source-i #(1 2) #f 1))) - -;;; ./gengen/gr_vector_source_s.h FIXME: not found -;; (pass-if (true? (gr:vector-source-s #(1 2) #f 1))) - -;;; ./gengen/gr_xor_bb.h -(pass-if (true? (gr:xor-bb))) - -;;; ./gengen/gr_xor_ii.h -(pass-if (true? (gr:xor-ii))) - -;;; ./gengen/gr_xor_ss.h -(pass-if (true? (gr:xor-ss))) diff --git a/gnuradio-core/src/guile/tests/hier_ctors.test b/gnuradio-core/src/guile/tests/hier_ctors.test deleted file mode 100644 index b79ee0f15..000000000 --- a/gnuradio-core/src/guile/tests/hier_ctors.test +++ /dev/null @@ -1,40 +0,0 @@ -;;; -*- Scheme -*- -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -;;; If you're using Emacs's Scheme mode: -;;; (put 'with-test-prefix 'scheme-indent-function 1) - -;;; See the comments in gnuradio/test-suite/lib.scm for info on writing tests. -;;; See also the very end of the file, where the test-equal, test-eqv -;;; and test-eq macros are defined. - -(use-modules (gnuradio test-suite lib)) -(use-modules (gnuradio core)) -(use-modules (oop goops)) - -;;; Add test code for all constructors in these files -;;; - -;;; ./hier/gr_channel_model.h FIXME: Unbound variable: ~S" (gr:channel_model) #f)) -;; gr_make_channel_model(double noise_voltage=0.0, double frequency_offset=0.0, -;; double epsilon=1.0, -;; const std::vector<gr_complex> &taps=std::vector<gr_complex>(1, 1), -;; double noise_seed=3021); -;; (pass-if (true? (gr:channel_model 0.0 0.0 1.0 #(1 1) 3021))) diff --git a/gnuradio-core/src/guile/tests/io_ctors.test b/gnuradio-core/src/guile/tests/io_ctors.test deleted file mode 100644 index 5f40d321c..000000000 --- a/gnuradio-core/src/guile/tests/io_ctors.test +++ /dev/null @@ -1,82 +0,0 @@ -;;; -*- Scheme -*- -;;; -;;; Copyright 2010 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Radio -;;; -;;; GNU Radio is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. -;;; -;;; GNU Radio 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 General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;; - -;;; If you're using Emacs's Scheme mode: -;;; (put 'with-test-prefix 'scheme-indent-function 1) - -;;; See the comments in gnuradio/test-suite/lib.scm for info on writing tests. -;;; See also the very end of the file, where the test-equal, test-eqv -;;; and test-eq macros are defined. - -(use-modules (gnuradio test-suite lib)) -(use-modules (gnuradio core)) -(use-modules (oop goops)) - - -(define (rm-foo) - (false-if-exception (delete-file "foo"))) - -;;; Add test code for all constructors in these files -;;; - -;;; ./io/gr_file_descriptor_sink.h -(pass-if (true? (gr:file-descriptor-sink 1 (dup 1)))) - -;;; ./io/gr_file_descriptor_source.h -(pass-if (true? (gr:file-descriptor-source 1 (dup 0) #f))) - -;;; ./io/gr_file_sink.h -(pass-if (true? (gr:file-sink 1 "foo"))) - -;;; ./io/gr_file_source.h -(pass-if (true? (gr:file-source 1 "foo" #f))) -(rm-foo) - -;;; ./io/gr_histo_sink_f.h -;; gr_make_histo_sink_f (gr_msg_queue_sptr msgq); -(pass-if (true? (gr:histo-sink-f (gr:msg-queue)))) - -;;; ./io/gr_message_sink.h -(pass-if (true? (gr:message-sink 1 (gr:msg-queue) #f))) - -;;; ./io/gr_message_source.h -(pass-if (true? (gr:message-source 1 1))) -(pass-if (true? (gr:message-source 1 (gr:msg-queue)))) - -;;; ./io/gr_oscope_sink_f.h -(pass-if (true? (gr:oscope-sink-f 1000 (gr:msg-queue)))) - -;;; ./io/gr_udp_sink.h -;;(pass-if (true? (gr:udp-sink 4 "localhost" 80 1472 #f))) -;;(pass-if-throw "confirm throw gr:udp-sink" #t -;; (true? (gr:udp-sink 4 "localhostx" 80 1472 #f))) - -;;; ./io/gr_udp_source.h -;;(pass-if (true? (gr:udp-source 4 "localhost" 0 1472 #f #t))) -;;(pass-if-throw "confirm throw gr:udp-source" #t -;; (true? (gr:udp-source 4 "localhostx" 0 1472 #f #t))) - -;;; ./io/gr_wavfile_sink.h -(pass-if (true? (gr:wavfile-sink "foo" 2 48000 16))) - -;;; ./io/gr_wavfile_source.h WONTFIX: buggy source won't accept file -;;; created immediately above. -;;(pass-if (true? (gr:wavfile-source "foo" #f))) -(rm-foo) |