From 15b3efacc3996773c6bfc682d3529e35c567aa45 Mon Sep 17 00:00:00 2001 From: Packit Service Date: Dec 10 2020 12:33:47 +0000 Subject: Prepare for a new update Reverting patches so we can apply the latest update and changes can be seen in the spec file and sources. --- diff --git a/gsl-config.in b/gsl-config.in index 5babee0..3f3fa61 100755 --- a/gsl-config.in +++ b/gsl-config.in @@ -58,16 +58,16 @@ while test $# -gt 0; do ;; --cflags) - echo -I$includedir + echo @GSL_CFLAGS@ ;; --libs) : ${GSL_CBLAS_LIB=-lgslcblas} - echo -lgsl $GSL_CBLAS_LIB -lm + echo @GSL_LIBS@ $GSL_CBLAS_LIB @GSL_LIBM@ ;; --libs-without-cblas) - echo -lgsl -lm + echo @GSL_LIBS@ @GSL_LIBM@ ;; *) usage diff --git a/gsl-config.in.lib64 b/gsl-config.in.lib64 deleted file mode 100755 index 3f3fa61..0000000 --- a/gsl-config.in.lib64 +++ /dev/null @@ -1,80 +0,0 @@ -#! /bin/sh - -prefix=@prefix@ -exec_prefix=@exec_prefix@ -includedir=@includedir@ - -usage() -{ - cat <epsrel); - double scale = 1.0; - - for (j = 0; j < problem->ntries; ++j) - { - double eps_scale = epsrel * scale; - - test_fdf(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - eps_scale, scale, problem, NULL); - test_fdfridge(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - eps_scale, scale, problem, NULL); - - /* test finite difference Jacobian */ - { - gsl_multifit_function_fdf fdf; - fdf.df = problem->fdf->df; - problem->fdf->df = NULL; - test_fdf(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - 1.0e5 * eps_scale, 1.0, problem, NULL); - test_fdfridge(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - 1.0e5 * eps_scale, 1.0, problem, NULL); - problem->fdf->df = fdf.df; - } - - scale *= 10.0; - } - - test_fdf(gsl_multifit_fdfsolver_lmniel, xtol, gtol, ftol, - 10.0 * epsrel, 1.0, problem, NULL); - } - - /* More tests */ - for (i = 0; test_fdf_more[i] != NULL; ++i) - { - test_fdf_problem *problem = test_fdf_more[i]; - double epsrel = *(problem->epsrel); - double scale = 1.0; - - for (j = 0; j < problem->ntries; ++j) - { - double eps_scale = epsrel * scale; - - test_fdf(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - eps_scale, scale, problem, NULL); - test_fdfridge(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - eps_scale, scale, problem, NULL); - - /* test finite difference Jacobian */ - { - gsl_multifit_function_fdf fdf; - fdf.df = problem->fdf->df; - problem->fdf->df = NULL; - test_fdf(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - 1.0e5 * eps_scale, 1.0, problem, NULL); - test_fdfridge(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - 1.0e5 * eps_scale, 1.0, problem, NULL); - problem->fdf->df = fdf.df; - } - - scale *= 10.0; - } - - test_fdf(gsl_multifit_fdfsolver_lmniel, xtol, gtol, ftol, - 10.0 * epsrel, 1.0, problem, NULL); - } - - /* NIST tests */ - for (i = 0; test_fdf_nist[i] != NULL; ++i) - { - test_fdf_problem *problem = test_fdf_nist[i]; - double epsrel = *(problem->epsrel); - double scale = 1.0; - - for (j = 0; j < problem->ntries; ++j) - { - double eps_scale = epsrel * scale; - - test_fdf(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - eps_scale, scale, problem, NULL); - test_fdf(gsl_multifit_fdfsolver_lmder, xtol, gtol, ftol, - eps_scale, scale, problem, NULL); - - /* test finite difference Jacobian */ - { - gsl_multifit_function_fdf fdf; - fdf.df = problem->fdf->df; - problem->fdf->df = NULL; - test_fdf(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - eps_scale, 1.0, problem, NULL); - test_fdf(gsl_multifit_fdfsolver_lmder, xtol, gtol, ftol, - eps_scale, scale, problem, NULL); - problem->fdf->df = fdf.df; - } - - scale *= 10.0; - } - - test_fdf(gsl_multifit_fdfsolver_lmniel, xtol, gtol, ftol, - epsrel, 1.0, problem, NULL); - } - - /* test weighted nonlinear least squares */ - - /* internal weighting in _f and _df functions */ - test_fdf(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - wnlin_epsrel, 1.0, &wnlin_problem1, NULL); - test_fdf(gsl_multifit_fdfsolver_lmniel, xtol, gtol, ftol, - wnlin_epsrel, 1.0, &wnlin_problem1, NULL); - test_fdfridge(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - wnlin_epsrel, 1.0, &wnlin_problem1, NULL); - test_fdfridge(gsl_multifit_fdfsolver_lmniel, xtol, gtol, ftol, - wnlin_epsrel, 1.0, &wnlin_problem1, NULL); - - /* weighting through fdfsolver_wset */ - test_fdf(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - wnlin_epsrel, 1.0, &wnlin_problem2, wnlin_W); - test_fdf(gsl_multifit_fdfsolver_lmniel, xtol, gtol, ftol, - wnlin_epsrel, 1.0, &wnlin_problem2, wnlin_W); - test_fdfridge(gsl_multifit_fdfsolver_lmsder, xtol, gtol, ftol, - wnlin_epsrel, 1.0, &wnlin_problem2, wnlin_W); - test_fdfridge(gsl_multifit_fdfsolver_lmniel, xtol, gtol, ftol, - wnlin_epsrel, 1.0, &wnlin_problem2, wnlin_W); -} - -/* -test_fdf() - Test a weighted nonlinear least squares problem - -Inputs: T - solver to use - xtol - tolerance in x - gtol - tolerance in gradient - ftol - tolerance in residual vector - epsrel - relative error tolerance in solution - x0_scale - to test robustness against starting points, - the standard starting point in 'problem' is - multiplied by this scale factor: - x0 <- x0 * x0_scale - If x0 = 0, then all components of x0 are set to - x0_scale - problem - contains the nonlinear problem and solution point - wts - weight vector (NULL for unweighted) -*/ - -static void -test_fdf(const gsl_multifit_fdfsolver_type * T, const double xtol, - const double gtol, const double ftol, - const double epsrel, const double x0_scale, - test_fdf_problem *problem, - const double *wts) -{ - gsl_multifit_function_fdf *fdf = problem->fdf; - const size_t n = fdf->n; - const size_t p = fdf->p; - const size_t max_iter = 1500; - gsl_vector *x0 = gsl_vector_alloc(p); - gsl_vector_view x0v = gsl_vector_view_array(problem->x0, p); - gsl_multifit_fdfsolver *s = gsl_multifit_fdfsolver_alloc (T, n, p); - const char *pname = problem->name; - char sname[2048]; - int status, info; - - sprintf(sname, "%s/scale=%g%s", - gsl_multifit_fdfsolver_name(s), x0_scale, - problem->fdf->df ? "" : "/fdiff"); - - /* scale starting point x0 */ - gsl_vector_memcpy(x0, &x0v.vector); - test_scale_x0(x0, x0_scale); - - if (wts) - { - gsl_vector_const_view wv = gsl_vector_const_view_array(wts, n); - gsl_multifit_fdfsolver_wset(s, fdf, x0, &wv.vector); - } - else - gsl_multifit_fdfsolver_set(s, fdf, x0); - - status = gsl_multifit_fdfsolver_driver(s, max_iter, xtol, gtol, - ftol, &info); - gsl_test(status, "%s/%s did not converge, status=%s", - sname, pname, gsl_strerror(status)); - - /* check solution */ - test_fdf_checksol(sname, pname, epsrel, s, problem); - - if (wts == NULL) - { - /* test again with weighting matrix W = I */ - gsl_vector *wv = gsl_vector_alloc(n); - - sprintf(sname, "%s/scale=%g%s/weights", - gsl_multifit_fdfsolver_name(s), x0_scale, - problem->fdf->df ? "" : "/fdiff"); - - gsl_vector_memcpy(x0, &x0v.vector); - test_scale_x0(x0, x0_scale); - - gsl_vector_set_all(wv, 1.0); - gsl_multifit_fdfsolver_wset(s, fdf, x0, wv); - - status = gsl_multifit_fdfsolver_driver(s, max_iter, xtol, gtol, - ftol, &info); - gsl_test(status, "%s/%s did not converge, status=%s", - sname, pname, gsl_strerror(status)); - - test_fdf_checksol(sname, pname, epsrel, s, problem); - - gsl_vector_free(wv); - } - - gsl_multifit_fdfsolver_free(s); - gsl_vector_free(x0); -} - -/* -test_fdfridge() - Test a nonlinear least squares problem - -Inputs: T - solver to use - xtol - tolerance in x - gtol - tolerance in gradient - ftol - tolerance in residual vector - epsrel - relative error tolerance in solution - x0_scale - to test robustness against starting points, - the standard starting point in 'problem' is - multiplied by this scale factor: - x0 <- x0 * x0_scale - If x0 = 0, then all components of x0 are set to - x0_scale - problem - contains the nonlinear problem and solution point - wts - weight vector -*/ - -static void -test_fdfridge(const gsl_multifit_fdfsolver_type * T, const double xtol, - const double gtol, const double ftol, - const double epsrel, const double x0_scale, - test_fdf_problem *problem, const double *wts) -{ - gsl_multifit_function_fdf *fdf = problem->fdf; - const size_t n = fdf->n; - const size_t p = fdf->p; - const size_t max_iter = 1500; - gsl_vector *x0 = gsl_vector_alloc(p); - gsl_vector_view x0v = gsl_vector_view_array(problem->x0, p); - gsl_multifit_fdfridge *w = gsl_multifit_fdfridge_alloc (T, n, p); - const char *pname = problem->name; - char sname[2048]; - int status, info; - double lambda = 0.0; - - sprintf(sname, "ridge/%s", gsl_multifit_fdfridge_name(w)); - - /* scale starting point x0 */ - gsl_vector_memcpy(x0, &x0v.vector); - test_scale_x0(x0, x0_scale); - - /* test undamped case with lambda = 0 */ - if (wts) - { - gsl_vector_const_view wv = gsl_vector_const_view_array(wts, n); - gsl_multifit_fdfridge_wset(w, fdf, x0, lambda, &wv.vector); - } - else - gsl_multifit_fdfridge_set(w, fdf, x0, lambda); - - status = gsl_multifit_fdfridge_driver(w, max_iter, xtol, gtol, - ftol, &info); - gsl_test(status, "%s/%s did not converge, status=%s", - sname, pname, gsl_strerror(status)); - - /* check solution */ - test_fdf_checksol(sname, pname, epsrel, w->s, problem); - - /* test for self consisent solution with L = \lambda I */ - { - const double eps = 1.0e-10; - gsl_matrix *L = gsl_matrix_calloc(p, p); - gsl_vector_view diag = gsl_matrix_diagonal(L); - gsl_multifit_fdfridge *w2 = gsl_multifit_fdfridge_alloc (T, n, p); - gsl_vector *y0 = gsl_vector_alloc(p); - size_t i; - - /* pick some value for lambda and set L = \lambda I */ - lambda = 5.0; - gsl_vector_set_all(&diag.vector, lambda); - - /* scale initial vector */ - gsl_vector_memcpy(x0, &x0v.vector); - test_scale_x0(x0, x0_scale); - gsl_vector_memcpy(y0, x0); - - if (wts) - { - gsl_vector_const_view wv = gsl_vector_const_view_array(wts, n); - gsl_multifit_fdfridge_wset(w, fdf, x0, lambda, &wv.vector); - gsl_multifit_fdfridge_wset3(w2, fdf, y0, L, &wv.vector); - } - else - { - gsl_multifit_fdfridge_set(w, fdf, x0, lambda); - gsl_multifit_fdfridge_set3(w2, fdf, y0, L); - } - - /* solve with scalar lambda routine */ - status = gsl_multifit_fdfridge_driver(w, max_iter, xtol, gtol, - ftol, &info); - gsl_test(status, "%s/lambda/%s did not converge, status=%s", - sname, pname, gsl_strerror(status)); - - /* solve with general matrix routine */ - status = gsl_multifit_fdfridge_driver(w2, max_iter, xtol, gtol, - ftol, &info); - gsl_test(status, "%s/L/%s did not converge, status=%s", - sname, pname, gsl_strerror(status)); - - /* test x = y */ - for (i = 0; i < p; ++i) - { - double xi = gsl_vector_get(w->s->x, i); - double yi = gsl_vector_get(w2->s->x, i); - - if (fabs(xi) < eps) - { - gsl_test_abs(yi, xi, eps, "%s/%s ridge lambda=%g i=%zu", - sname, pname, lambda, i); - } - else - { - gsl_test_rel(yi, xi, eps, "%s/%s ridge lambda=%g i=%zu", - sname, pname, lambda, i); - } - } - - gsl_matrix_free(L); - gsl_vector_free(y0); - gsl_multifit_fdfridge_free(w2); - } - - gsl_multifit_fdfridge_free(w); - gsl_vector_free(x0); -} - -static void -test_fdf_checksol(const char *sname, const char *pname, - const double epsrel, gsl_multifit_fdfsolver *s, - test_fdf_problem *problem) -{ - gsl_multifit_function_fdf *fdf = problem->fdf; - const double *sigma = problem->sigma; - gsl_vector *f = gsl_multifit_fdfsolver_residual(s); - gsl_vector *x = gsl_multifit_fdfsolver_position(s); - double sumsq; - - /* check solution vector x and sumsq = ||f||^2 */ - gsl_blas_ddot(f, f, &sumsq); - (problem->checksol)(x->data, sumsq, epsrel, sname, pname); - -#if 1 - /* check variances */ - if (sigma) - { - const size_t n = fdf->n; - const size_t p = fdf->p; - size_t i; - gsl_matrix * J = gsl_matrix_alloc(n, p); - gsl_matrix * covar = gsl_matrix_alloc (p, p); - - gsl_multifit_fdfsolver_jac (s, J); - gsl_multifit_covar(J, 0.0, covar); - - for (i = 0; i < p; i++) - { - double ei = sqrt(sumsq/(n-p))*sqrt(gsl_matrix_get(covar,i,i)); - gsl_test_rel (ei, sigma[i], epsrel, - "%s/%s, sigma(%d)", sname, pname, i) ; - } - - gsl_matrix_free (J); - gsl_matrix_free (covar); - } -#endif -} - -static void -test_scale_x0(gsl_vector *x0, const double scale) -{ - double nx = gsl_blas_dnrm2(x0); - - if (nx == 0.0) - gsl_vector_set_all(x0, scale); - else - gsl_vector_scale(x0, scale); -} /* test_scale_x0() */ diff --git a/multifit/test_powell1.c b/multifit/test_powell1.c index 76dcc1a..572de3b 100644 --- a/multifit/test_powell1.c +++ b/multifit/test_powell1.c @@ -4,7 +4,7 @@ #define powell1_NTRIES 4 static double powell1_x0[powell1_P] = { 3.0, -1.0, 0.0, 1.0 }; -static double powell1_epsrel = 2.0e-5; +static double powell1_epsrel = 1.0e-5; static void powell1_checksol(const double x[], const double sumsq, diff --git a/multifit/test_powell1.c.tol b/multifit/test_powell1.c.tol deleted file mode 100644 index 572de3b..0000000 --- a/multifit/test_powell1.c.tol +++ /dev/null @@ -1,97 +0,0 @@ -#define powell1_N 4 -#define powell1_P 4 - -#define powell1_NTRIES 4 - -static double powell1_x0[powell1_P] = { 3.0, -1.0, 0.0, 1.0 }; -static double powell1_epsrel = 1.0e-5; - -static void -powell1_checksol(const double x[], const double sumsq, - const double epsrel, const char *sname, - const char *pname) -{ - size_t i; - const double sumsq_exact = 0.0; - - gsl_test_rel(sumsq, sumsq_exact, epsrel, "%s/%s sumsq", - sname, pname); - - for (i = 0; i < powell1_P; ++i) - { - gsl_test_rel(x[i], 0.0, epsrel, "%s/%s i=%zu", - sname, pname, i); - } -} - -static int -powell1_f (const gsl_vector * x, void *params, gsl_vector * f) -{ - double x1 = gsl_vector_get (x, 0); - double x2 = gsl_vector_get (x, 1); - double x3 = gsl_vector_get (x, 2); - double x4 = gsl_vector_get (x, 3); - - gsl_vector_set(f, 0, x1 + 10.0*x2); - gsl_vector_set(f, 1, sqrt(5.0) * (x3 - x4)); - gsl_vector_set(f, 2, pow(x2 - 2.0*x3, 2.0)); - gsl_vector_set(f, 3, sqrt(10.0) * pow((x1 - x4), 2.0)); - - return GSL_SUCCESS; -} - -static int -powell1_df (const gsl_vector * x, void *params, gsl_matrix * J) -{ - double x1 = gsl_vector_get (x, 0); - double x2 = gsl_vector_get (x, 1); - double x3 = gsl_vector_get (x, 2); - double x4 = gsl_vector_get (x, 3); - double term1 = x2 - 2.0*x3; - double term2 = x1 - x4; - - gsl_matrix_set(J, 0, 0, 1.0); - gsl_matrix_set(J, 0, 1, 10.0); - gsl_matrix_set(J, 0, 2, 0.0); - gsl_matrix_set(J, 0, 3, 0.0); - - gsl_matrix_set(J, 1, 0, 0.0); - gsl_matrix_set(J, 1, 1, 0.0); - gsl_matrix_set(J, 1, 2, sqrt(5.0)); - gsl_matrix_set(J, 1, 3, -sqrt(5.0)); - - gsl_matrix_set(J, 2, 0, 0.0); - gsl_matrix_set(J, 2, 1, 2.0*term1); - gsl_matrix_set(J, 2, 2, -4.0*term1); - gsl_matrix_set(J, 2, 3, 0.0); - - gsl_matrix_set(J, 3, 0, 2.0*sqrt(10.0)*term2); - gsl_matrix_set(J, 3, 1, 0.0); - gsl_matrix_set(J, 3, 2, 0.0); - gsl_matrix_set(J, 3, 3, -2.0*sqrt(10.0)*term2); - - return GSL_SUCCESS; -} - -static gsl_multifit_function_fdf powell1_func = -{ - &powell1_f, - &powell1_df, - NULL, - powell1_N, - powell1_P, - NULL, - 0, - 0 -}; - -static test_fdf_problem powell1_problem = -{ - "powell_singular", - powell1_x0, - NULL, - &powell1_epsrel, - powell1_NTRIES, - &powell1_checksol, - &powell1_func -}; diff --git a/multifit/test_powell3.c b/multifit/test_powell3.c index a3f6dd2..7c83384 100644 --- a/multifit/test_powell3.c +++ b/multifit/test_powell3.c @@ -4,7 +4,7 @@ #define powell3_NTRIES 1 static double powell3_x0[powell3_P] = { 0.0, 1.0 }; -static double powell3_epsrel = 1.0e-8; +static double powell3_epsrel = 1.0e-12; static void powell3_checksol(const double x[], const double sumsq, diff --git a/multifit/test_powell3.c.tol b/multifit/test_powell3.c.tol deleted file mode 100644 index 7c83384..0000000 --- a/multifit/test_powell3.c.tol +++ /dev/null @@ -1,77 +0,0 @@ -#define powell3_N 2 -#define powell3_P 2 - -#define powell3_NTRIES 1 - -static double powell3_x0[powell3_P] = { 0.0, 1.0 }; -static double powell3_epsrel = 1.0e-12; - -static void -powell3_checksol(const double x[], const double sumsq, - const double epsrel, const char *sname, - const char *pname) -{ - size_t i; - const double sumsq_exact = 0.0; - const double powell3_x[powell3_P] = { 1.09815932969975976e-05, - 9.10614673986700218 }; - - gsl_test_rel(sumsq, sumsq_exact, epsrel, "%s/%s sumsq", - sname, pname); - - for (i = 0; i < powell3_P; ++i) - { - gsl_test_rel(x[i], powell3_x[i], epsrel, "%s/%s i=%zu", - sname, pname, i); - } -} - -static int -powell3_f (const gsl_vector * x, void *params, gsl_vector * f) -{ - double x1 = gsl_vector_get(x, 0); - double x2 = gsl_vector_get(x, 1); - - gsl_vector_set(f, 0, 1.0e4*x1*x2 - 1.0); - gsl_vector_set(f, 1, exp(-x1) + exp(-x2) - 1.0001); - - return GSL_SUCCESS; -} - -static int -powell3_df (const gsl_vector * x, void *params, gsl_matrix * J) -{ - double x1 = gsl_vector_get(x, 0); - double x2 = gsl_vector_get(x, 1); - - gsl_matrix_set(J, 0, 0, 1.0e4*x2); - gsl_matrix_set(J, 0, 1, 1.0e4*x1); - - gsl_matrix_set(J, 1, 0, -exp(-x1)); - gsl_matrix_set(J, 1, 1, -exp(-x2)); - - return GSL_SUCCESS; -} - -static gsl_multifit_function_fdf powell3_func = -{ - &powell3_f, - &powell3_df, - NULL, - powell3_N, - powell3_P, - NULL, - 0, - 0 -}; - -static test_fdf_problem powell3_problem = -{ - "powell_badly_scaled", - powell3_x0, - NULL, - &powell3_epsrel, - powell3_NTRIES, - &powell3_checksol, - &powell3_func -}; diff --git a/test/results.c b/test/results.c index 0e3ba55..0e37eff 100644 --- a/test/results.c +++ b/test/results.c @@ -131,10 +131,6 @@ gsl_test_rel (double result, double expected, double relative_error, { status = -1; } - else if (fabs(result-expected) < relative_error) - { - status = 0; - } else if (expected != 0 ) { status = (fabs(result-expected)/fabs(expected) > relative_error) ; diff --git a/test/results.c.test b/test/results.c.test deleted file mode 100644 index 0e37eff..0000000 --- a/test/results.c.test +++ /dev/null @@ -1,461 +0,0 @@ -/* err/test_results.c - * - * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2007 Gerard Jungman, Brian Gough - * - * 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 3 of the License, 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 program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - */ - -#include -#include -#include -#include -#include -#include -#include - -#if HAVE_VPRINTF -#ifdef STDC_HEADERS -#include -#else -#include -#endif -#endif - -#include - -static unsigned int tests = 0; -static unsigned int passed = 0; -static unsigned int failed = 0; - -static unsigned int verbose = 0; - -static void -initialise (void) -{ - const char * p = getenv("GSL_TEST_VERBOSE"); - - /* 0 = show failures only (we always want to see these) */ - /* 1 = show passes and failures */ - - if (p == 0) /* environment variable is not set */ - return ; - - if (*p == '\0') /* environment variable is empty */ - return ; - - verbose = strtoul (p, 0, 0); - - return; -} - -static void -update (int s) -{ - tests++; - - if (s == 0) - { - passed++; - } - else - { - failed++; - } -} - -void -gsl_test (int status, const char *test_description,...) -{ - if (!tests) initialise(); - - update (status); - - if (status || verbose) - { - printf (status ? "FAIL: " : "PASS: "); - -#if HAVE_VPRINTF - { - va_list ap; -#ifdef STDC_HEADERS - va_start (ap, test_description); -#else - va_start (ap); -#endif - vprintf (test_description, ap); - va_end (ap); - } -#endif - - if (status && !verbose) - printf(" [%u]", tests); - - printf("\n"); - fflush (stdout); - } -} - - -void -gsl_test_rel (double result, double expected, double relative_error, - const char *test_description,...) -{ - int status ; - - if (!tests) initialise(); - - /* Check for NaN vs inf vs number */ - - if (gsl_isnan(result) || gsl_isnan(expected)) - { - status = gsl_isnan(result) != gsl_isnan(expected); - } - else if (gsl_isinf(result) || gsl_isinf(expected)) - { - status = gsl_isinf(result) != gsl_isinf(expected); - } - else if ((expected > 0 && expected < GSL_DBL_MIN) - || (expected < 0 && expected > -(GSL_DBL_MIN))) - { - status = -1; - } - else if (expected != 0 ) - { - status = (fabs(result-expected)/fabs(expected) > relative_error) ; - } - else - { - status = (fabs(result) > relative_error) ; - } - - update (status); - - if (status || verbose) - { - printf (status ? "FAIL: " : "PASS: "); - -#if HAVE_VPRINTF - { - va_list ap; -#ifdef STDC_HEADERS - va_start (ap, test_description); -#else - va_start (ap); -#endif - vprintf (test_description, ap); - va_end (ap); - } -#endif - - if (status == 0) - { - if (strlen(test_description) < 45) - { - printf(" (%g observed vs %g expected)", result, expected) ; - } - else - { - printf(" (%g obs vs %g exp)", result, expected) ; - } - } - else - { - printf(" (%.18g observed vs %.18g expected)", result, expected) ; - } - - if (status == -1) - { - printf(" [test uses subnormal value]") ; - } - - if (status && !verbose) - printf(" [%u]", tests); - - printf ("\n") ; - fflush (stdout); - } -} - -void -gsl_test_abs (double result, double expected, double absolute_error, - const char *test_description,...) -{ - int status ; - - if (!tests) initialise(); - - /* Check for NaN vs inf vs number */ - - if (gsl_isnan(result) || gsl_isnan(expected)) - { - status = gsl_isnan(result) != gsl_isnan(expected); - } - else if (gsl_isinf(result) || gsl_isinf(expected)) - { - status = gsl_isinf(result) != gsl_isinf(expected); - } - else if ((expected > 0 && expected < GSL_DBL_MIN) - || (expected < 0 && expected > -(GSL_DBL_MIN))) - { - status = -1; - } - else - { - status = fabs(result-expected) > absolute_error ; - } - - update (status); - - if (status || verbose) - { - printf (status ? "FAIL: " : "PASS: "); - -#if HAVE_VPRINTF - { - va_list ap; - -#ifdef STDC_HEADERS - va_start (ap, test_description); -#else - va_start (ap); -#endif - vprintf (test_description, ap); - va_end (ap); - } -#endif - - if (status == 0) - { - if (strlen(test_description) < 45) - { - printf(" (%g observed vs %g expected)", result, expected) ; - } - else - { - printf(" (%g obs vs %g exp)", result, expected) ; - } - } - else - { - printf(" (%.18g observed vs %.18g expected)", result, expected) ; - } - - if (status == -1) - { - printf(" [test uses subnormal value]") ; - } - - if (status && !verbose) - printf(" [%u]", tests); - - printf ("\n") ; - fflush (stdout); - } -} - - -void -gsl_test_factor (double result, double expected, double factor, - const char *test_description,...) -{ - int status; - - if (!tests) initialise(); - - if ((expected > 0 && expected < GSL_DBL_MIN) - || (expected < 0 && expected > -(GSL_DBL_MIN))) - { - status = -1; - } - else if (result == expected) - { - status = 0; - } - else if (expected == 0.0) - { - status = (result > expected || result < expected); - } - else - { - double u = result / expected; - status = (u > factor || u < 1.0 / factor) ; - } - - update (status); - - if (status || verbose) - { - printf (status ? "FAIL: " : "PASS: "); - -#if HAVE_VPRINTF - { - va_list ap; - -#ifdef STDC_HEADERS - va_start (ap, test_description); -#else - va_start (ap); -#endif - vprintf (test_description, ap); - va_end (ap); - } -#endif - if (status == 0) - { - if (strlen(test_description) < 45) - { - printf(" (%g observed vs %g expected)", result, expected) ; - } - else - { - printf(" (%g obs vs %g exp)", result, expected) ; - } - } - else - { - printf(" (%.18g observed vs %.18g expected)", result, expected) ; - } - - if (status == -1) - { - printf(" [test uses subnormal value]") ; - } - - if (status && !verbose) - printf(" [%u]", tests); - - printf ("\n") ; - fflush (stdout); - } -} - -void -gsl_test_int (int result, int expected, const char *test_description,...) -{ - int status = (result != expected) ; - - if (!tests) initialise(); - - update (status); - - if (status || verbose) - { - printf (status ? "FAIL: " : "PASS: "); - -#if HAVE_VPRINTF - { - va_list ap; - -#ifdef STDC_HEADERS - va_start (ap, test_description); -#else - va_start (ap); -#endif - vprintf (test_description, ap); - va_end (ap); - } -#endif - if (status == 0) - { - printf(" (%d observed vs %d expected)", result, expected) ; - } - else - { - printf(" (%d observed vs %d expected)", result, expected) ; - } - - if (status && !verbose) - printf(" [%u]", tests); - - printf ("\n"); - fflush (stdout); - } -} - -void -gsl_test_str (const char * result, const char * expected, - const char *test_description,...) -{ - int status = strcmp(result,expected) ; - - if (!tests) initialise(); - - update (status); - - if (status || verbose) - { - printf (status ? "FAIL: " : "PASS: "); - -#if HAVE_VPRINTF - { - va_list ap; - -#ifdef STDC_HEADERS - va_start (ap, test_description); -#else - va_start (ap); -#endif - vprintf (test_description, ap); - va_end (ap); - } -#endif - if (status) - { - printf(" (%s observed vs %s expected)", result, expected) ; - } - - if (status && !verbose) - printf(" [%u]", tests); - - printf ("\n"); - fflush (stdout); - } -} - -void -gsl_test_verbose (int v) -{ - verbose = v; -} - -int -gsl_test_summary (void) -{ - if (verbose && 0) /* FIXME: turned it off, this annoys me */ - printf ("%d tests, passed %d, failed %d.\n", tests, passed, failed); - - if (failed != 0) - { - return EXIT_FAILURE; - } - - if (tests != passed + failed) - { - if (verbose) - printf ("TEST RESULTS DO NOT ADD UP %d != %d + %d\n", - tests, passed, failed); - return EXIT_FAILURE; - } - - if (passed == tests) - { - if (!verbose) /* display a summary of passed tests */ - printf ("Completed [%d/%d]\n", passed, tests); - - return EXIT_SUCCESS; - } - - return EXIT_FAILURE; -}