htswanalysis/MACS/lib/gsl/gsl-1.11/vector/test_source.c

   1 /* vector/test_source.c
   2  *
   3  * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2007 Gerard Jungman, Brian Gough
   4  *
   5  * This program is free software; you can redistribute it and/or modify
   6  * it under the terms of the GNU General Public License as published by
   7  * the Free Software Foundation; either version 3 of the License, or (at
   8  * your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful, but
  11  * WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this program; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18  */
  19
  20 void FUNCTION (test, func) (size_t stride, size_t N);
  21 void FUNCTION (test, ops) (size_t stride1, size_t stride2, size_t N);
  22 void FUNCTION (test, file) (size_t stride, size_t N);
  23 void FUNCTION (test, text) (size_t stride, size_t N);
  24 void FUNCTION (test, trap) (size_t stride, size_t N);
  25 TYPE (gsl_vector) * FUNCTION(create, vector) (size_t stride, size_t N);
  26
  27 #define TEST(expr,desc) gsl_test((expr), NAME(gsl_vector) desc " stride=%d, N=%d", stride, N)
  28 #define TEST2(expr,desc) gsl_test((expr), NAME(gsl_vector) desc " stride1=%d, stride2=%d, N=%d", stride1, stride2, N)
  29
  30 TYPE (gsl_vector) *
  31 FUNCTION(create, vector) (size_t stride, size_t N)
  32 {
  33     TYPE (gsl_vector) * v = FUNCTION (gsl_vector, calloc) (N*stride);
  34     v->stride = stride;
  35     v->size = N;
  36     return v;
  37 }
  38
  39 void
  40 FUNCTION (test, func) (size_t stride, size_t N)
  41 {
  42   TYPE (gsl_vector) * v0;
  43   TYPE (gsl_vector) * v;
  44   QUALIFIED_VIEW(gsl_vector,view) view;
  45
  46   size_t i, j;
  47
  48   if (stride == 1)
  49     {
  50       v = FUNCTION (gsl_vector, calloc) (N);
  51
  52       TEST(v->data == 0, "_calloc pointer");
  53       TEST(v->size != N, "_calloc size");
  54       TEST(v->stride != 1, "_calloc stride");
  55
  56       {
  57         int status = (FUNCTION(gsl_vector,isnull)(v) != 1);
  58         TEST (status, "_isnull" DESC " on calloc vector");
  59
  60         status = (FUNCTION(gsl_vector,ispos)(v) != 0);
  61         TEST (status, "_ispos" DESC " on calloc vector");
  62
  63         status = (FUNCTION(gsl_vector,isneg)(v) != 0);
  64         TEST (status, "_isneg" DESC " on calloc vector");
  65
  66         status = (FUNCTION(gsl_vector,isnonneg)(v) != 1);
  67         TEST (status, "_isnonneg" DESC " on calloc vector");
  68
  69       }
  70
  71       FUNCTION (gsl_vector, free) (v);      /* free whatever is in v */
  72     }
  73
  74   if (stride == 1)
  75     {
  76       v = FUNCTION (gsl_vector, alloc) (N);
  77
  78       TEST(v->data == 0, "_alloc pointer");
  79       TEST(v->size != N, "_alloc size");
  80       TEST(v->stride != 1, "_alloc stride");
  81
  82       FUNCTION (gsl_vector, free) (v);      /* free whatever is in v */
  83     }
  84
  85   if (stride == 1)
  86     {
  87       v0 = FUNCTION (gsl_vector, alloc) (N);
  88       view = FUNCTION (gsl_vector, subvector) (v0, 0, N);
  89       v = &view.vector;
  90     }
  91   else
  92     {
  93       v0 = FUNCTION (gsl_vector, alloc) (N * stride);
  94
  95       for (i = 0; i < N*stride; i++)
  96         {
  97           v0->data[i] = i;
  98         }
  99
 100       view = FUNCTION (gsl_vector, subvector_with_stride) (v0, 0, stride, N);
 101       v = &view.vector;
 102     }
 103
 104   {
 105     int status = 0;
 106
 107     for (i = 0; i < N; i++)
 108       {
 109         FUNCTION (gsl_vector, set) (v, i, (ATOMIC) i);
 110       }
 111
 112     for (i = 0; i < N; i++)
 113       {
 114         if (v->data[i*stride] != (ATOMIC) (i))
 115           status = 1;
 116       };
 117
 118     TEST(status,"_set" DESC " writes into array");
 119   }
 120
 121
 122   {
 123     int status = 0;
 124
 125     for (i = 0; i < N; i++)
 126       {
 127         if (FUNCTION (gsl_vector, get) (v, i) != (ATOMIC) (i))
 128           status = 1;
 129       };
 130
 131     TEST (status, "_get" DESC " reads from array");
 132   }
 133
 134   {
 135     int status = 0;
 136
 137     for (i = 0; i < N; i++)
 138       {
 139         if (FUNCTION (gsl_vector, ptr) (v, i) != v->data + i*stride)
 140           status = 1;
 141       };
 142
 143     TEST (status, "_ptr" DESC " access to array");
 144   }
 145
 146
 147   {
 148     int status = 0;
 149
 150     for (i = 0; i < N; i++)
 151       {
 152         if (FUNCTION (gsl_vector, const_ptr) (v, i) != v->data + i*stride)
 153           status = 1;
 154       };
 155
 156     TEST (status, "_const_ptr" DESC " access to array");
 157   }
 158
 159
 160   {
 161     int status = 0;
 162
 163     for (i = 0; i < N; i++)
 164       {
 165         FUNCTION (gsl_vector, set) (v, i, (ATOMIC) 0);
 166       }
 167
 168     status = (FUNCTION(gsl_vector,isnull)(v) != 1);
 169     TEST (status, "_isnull" DESC " on null vector") ;
 170
 171     status = (FUNCTION(gsl_vector,ispos)(v) != 0);
 172     TEST (status, "_ispos" DESC " on null vector") ;
 173
 174     status = (FUNCTION(gsl_vector,isneg)(v) != 0);
 175     TEST (status, "_isneg" DESC " on null vector") ;
 176
 177     status = (FUNCTION(gsl_vector,isnonneg)(v) != 1);
 178     TEST (status, "_isnonneg" DESC " on null vector") ;
 179
 180   }
 181
 182   {
 183     int status = 0;
 184
 185     for (i = 0; i < N; i++)
 186       {
 187         FUNCTION (gsl_vector, set) (v, i, (ATOMIC) (i % 10));
 188       }
 189
 190     status = (FUNCTION(gsl_vector,isnull)(v) != 0);
 191     TEST (status, "_isnull" DESC " on non-negative vector") ;
 192
 193     status = (FUNCTION(gsl_vector,ispos)(v) != 0);
 194     TEST (status, "_ispos" DESC " on non-negative vector") ;
 195
 196     status = (FUNCTION(gsl_vector,isneg)(v) != 0);
 197     TEST (status, "_isneg" DESC " on non-negative vector") ;
 198
 199     status = (FUNCTION(gsl_vector,isnonneg)(v) != 1);
 200     TEST (status, "_isnonneg" DESC " on non-negative vector") ;
 201   }
 202
 203
 204 #ifndef UNSIGNED
 205   {
 206     int status = 0;
 207
 208     for (i = 0; i < N; i++)
 209       {
 210         ATOMIC vi = (i % 10) - (ATOMIC) 5;
 211         FUNCTION (gsl_vector, set) (v, i, vi);
 212       }
 213
 214     status = (FUNCTION(gsl_vector,isnull)(v) != 0);
 215     TEST (status, "_isnull" DESC " on mixed vector") ;
 216
 217     status = (FUNCTION(gsl_vector,ispos)(v) != 0);
 218     TEST (status, "_ispos" DESC " on mixed vector") ;
 219
 220     status = (FUNCTION(gsl_vector,isneg)(v) != 0);
 221     TEST (status, "_isneg" DESC " on mixed vector") ;
 222
 223     status = (FUNCTION(gsl_vector,isnonneg)(v) != 0);
 224     TEST (status, "_isnonneg" DESC " on mixed vector") ;
 225   }
 226
 227   {
 228     int status = 0;
 229
 230     for (i = 0; i < N; i++)
 231       {
 232         FUNCTION (gsl_vector, set) (v, i, -(ATOMIC) (i % 10));
 233       }
 234
 235     status = (FUNCTION(gsl_vector,isnull)(v) != 0);
 236     TEST (status, "_isnull" DESC " on non-positive vector") ;
 237
 238     status = (FUNCTION(gsl_vector,ispos)(v) != 0);
 239     TEST (status, "_ispos" DESC " on non-positive vector") ;
 240
 241     status = (FUNCTION(gsl_vector,isneg)(v) != 0);
 242     TEST (status, "_isneg" DESC " on non-positive non-null vector") ;
 243
 244     status = (FUNCTION(gsl_vector,isnonneg)(v) != 0);
 245     TEST (status, "_isnonneg" DESC " on non-positive non-null vector") ;
 246   }
 247 #endif
 248
 249   {
 250     int status = 0;
 251
 252     for (i = 0; i < N; i++)
 253       {
 254         FUNCTION (gsl_vector, set) (v, i, (ATOMIC) (i % 10 + 1));
 255       }
 256
 257     status = (FUNCTION(gsl_vector,isnull)(v) != 0);
 258     TEST (status, "_isnull" DESC " on positive vector") ;
 259
 260     status = (FUNCTION(gsl_vector,ispos)(v) != 1);
 261     TEST (status, "_ispos" DESC " on positive vector") ;
 262
 263     status = (FUNCTION(gsl_vector,isneg)(v) != 0);
 264     TEST (status, "_isneg" DESC " on positive vector") ;
 265
 266     status = (FUNCTION(gsl_vector,isnonneg)(v) != 1);
 267     TEST (status, "_isnonneg" DESC " on positive vector") ;
 268   }
 269
 270
 271 #if (!defined(UNSIGNED) && !defined(BASE_CHAR))
 272   {
 273     int status = 0;
 274
 275     for (i = 0; i < N; i++)
 276       {
 277         FUNCTION (gsl_vector, set) (v, i, -(ATOMIC) (i % 10 + 1));
 278       }
 279
 280     status = (FUNCTION(gsl_vector,isnull)(v) != 0);
 281     TEST (status, "_isnull" DESC " on negative vector") ;
 282
 283     status = (FUNCTION(gsl_vector,ispos)(v) != 0);
 284     TEST (status, "_ispos" DESC " on negative vector") ;
 285
 286     status = (FUNCTION(gsl_vector,isneg)(v) != 1);
 287     TEST (status, "_isneg" DESC " on negative vector") ;
 288
 289     status = (FUNCTION(gsl_vector,isnonneg)(v) != 0);
 290     TEST (status, "_isnonneg" DESC " on negative vector") ;
 291   }
 292 #endif
 293
 294   {
 295     int status = 0;
 296
 297     FUNCTION (gsl_vector, set_zero) (v);
 298
 299     for (i = 0; i < N; i++)
 300       {
 301         if (FUNCTION (gsl_vector, get) (v, i) != (ATOMIC)0)
 302           status = 1;
 303       };
 304
 305     TEST (status, "_setzero" DESC " on non-null vector") ;
 306   }
 307
 308   {
 309     int status = 0;
 310
 311     FUNCTION (gsl_vector, set_all) (v, (ATOMIC)27);
 312
 313     for (i = 0; i < N; i++)
 314       {
 315         if (FUNCTION (gsl_vector, get) (v, i) != (ATOMIC) (27))
 316           status = 1;
 317       };
 318
 319     TEST (status, "_setall" DESC " to non-zero value") ;
 320   }
 321
 322
 323   {
 324     int status = 0;
 325
 326     for (i = 0; i < N; i++)
 327       {
 328         FUNCTION (gsl_vector, set_basis) (v, i);
 329
 330         for (j = 0; j < N; j++)
 331           {
 332             if (i == j)
 333               {
 334                 if (FUNCTION (gsl_vector, get) (v, j) != (ATOMIC)1)
 335                   status = 1 ;
 336               }
 337             else
 338               {
 339                 if (FUNCTION (gsl_vector, get) (v, j) != (ATOMIC)(0))
 340                   status = 1;
 341               }
 342           };
 343       }
 344
 345     TEST (status, "_setbasis" DESC " over range") ;
 346   }
 347
 348   {
 349     int status = 0;
 350
 351     for (i = 0; i < N; i++)
 352       {
 353         FUNCTION (gsl_vector, set) (v, i, (ATOMIC) i);
 354       }
 355
 356     FUNCTION (gsl_vector, scale) (v, 2.0);
 357
 358     for (i = 0; i < N; i++)
 359       {
 360         if (FUNCTION (gsl_vector, get) (v, i) != (ATOMIC) (i*2.0))
 361           status = 1;
 362       };
 363
 364     TEST (status, "_scale" DESC " by 2") ;
 365   }
 366
 367   {
 368     int status = 0;
 369
 370     FUNCTION (gsl_vector, add_constant) (v, (ATOMIC)7);
 371
 372     for (i = 0; i < N; i++)
 373       {
 374         if (FUNCTION (gsl_vector, get) (v, i) != (ATOMIC) (i*2.0 + 7))
 375           status = 1;
 376       };
 377
 378     TEST (status, "_add_constant" DESC) ;
 379   }
 380
 381   {
 382     int status = 0;
 383
 384     for (i = 0; i < N; i++)
 385       {
 386         FUNCTION (gsl_vector, set) (v, i, (ATOMIC) i);
 387       }
 388
 389     FUNCTION (gsl_vector,swap_elements) (v, 2, 5) ;
 390
 391     status = (FUNCTION(gsl_vector,get)(v,2) != 5) ;
 392     status |= (FUNCTION(gsl_vector,get)(v,5) != 2) ;
 393
 394     FUNCTION (gsl_vector,swap_elements) (v, 2, 5) ;
 395
 396     status |= (FUNCTION(gsl_vector,get)(v,2) != 2) ;
 397     status |= (FUNCTION(gsl_vector,get)(v,5) != 5) ;
 398
 399     TEST (status, "_swap_elements" DESC " (2,5)") ;
 400   }
 401
 402   {
 403     int status = 0;
 404
 405     FUNCTION (gsl_vector,reverse) (v) ;
 406
 407     for (i = 0; i < N; i++)
 408       {
 409         status |= (FUNCTION (gsl_vector, get) (v, i) !=  (ATOMIC) (N - i - 1));
 410       }
 411
 412     TEST (status, "_reverse" DESC " reverses elements") ;
 413   }
 414
 415
 416   {
 417     int status = 0;
 418
 419     QUALIFIED_VIEW(gsl_vector,view) v1 = FUNCTION(gsl_vector, view_array) (v->data, N*stride);
 420
 421     for (i = 0; i < N; i++)
 422       {
 423         if (FUNCTION (gsl_vector, get) (&v1.vector, i*stride) != FUNCTION (gsl_vector, get) (v, i))
 424           status = 1;
 425       };
 426
 427     TEST (status, "_view_array" DESC);
 428   }
 429
 430   {
 431     int status = 0;
 432
 433     QUALIFIED_VIEW(gsl_vector,view) v1 = FUNCTION(gsl_vector, view_array_with_stride) (v->data, stride, N*stride);
 434
 435     for (i = 0; i < N; i++)
 436       {
 437         if (FUNCTION (gsl_vector, get) (&v1.vector, i) != FUNCTION (gsl_vector, get) (v, i))
 438           status = 1;
 439       };
 440
 441     TEST (status, "_view_array_with_stride" DESC);
 442   }
 443
 444
 445   {
 446     int status = 0;
 447
 448     QUALIFIED_VIEW(gsl_vector,view) v1 = FUNCTION(gsl_vector, subvector) (v, N/3, N/2);
 449
 450     for (i = 0; i < N/2; i++)
 451       {
 452         if (FUNCTION (gsl_vector, get) (&v1.vector, i) != FUNCTION (gsl_vector, get) (v, (N/3) + i))
 453           status = 1;
 454       };
 455
 456     TEST (status, "_view_subvector" DESC);
 457   }
 458
 459   {
 460     int status = 0;
 461
 462     QUALIFIED_VIEW(gsl_vector,view) v1 = FUNCTION(gsl_vector, subvector_with_stride) (v, N/5, 3, N/4);
 463
 464     for (i = 0; i < N/4; i++)
 465       {
 466         if (FUNCTION (gsl_vector, get) (&v1.vector, i) != FUNCTION (gsl_vector, get) (v, (N/5) + 3*i))
 467           status = 1;
 468       };
 469
 470     TEST (status, "_view_subvector_with_stride" DESC);
 471   }
 472
 473
 474   {
 475     BASE exp_max = FUNCTION(gsl_vector,get)(v, 0);
 476     BASE exp_min = FUNCTION(gsl_vector,get)(v, 0);
 477     size_t exp_imax = 0, exp_imin = 0;
 478
 479     for (i = 0; i < N; i++)
 480       {
 481         BASE k = FUNCTION(gsl_vector, get) (v, i) ;
 482         if (k < exp_min) {
 483           exp_min = FUNCTION(gsl_vector, get) (v, i);
 484           exp_imin = i;
 485         }
 486       }
 487
 488     for (i = 0; i < N; i++)
 489       {
 490         BASE k = FUNCTION(gsl_vector, get) (v, i) ;
 491         if (k > exp_max) {
 492           exp_max = FUNCTION(gsl_vector, get) (v, i) ;
 493           exp_imax = i;
 494         }
 495       }
 496
 497     {
 498       BASE max = FUNCTION(gsl_vector, max) (v) ;
 499       TEST (max != exp_max, "_max returns correct maximum value");
 500     }
 501
 502     {
 503       BASE min = FUNCTION(gsl_vector, min) (v) ;
 504       TEST (min != exp_min, "_min returns correct minimum value");
 505     }
 506
 507     {
 508       BASE min, max;
 509       FUNCTION(gsl_vector, minmax) (v, &min, &max);
 510
 511       TEST (max != exp_max, "_minmax returns correct maximum value");
 512       TEST (min != exp_min, "_minmax returns correct minimum value");
 513     }
 514
 515
 516     {
 517       size_t imax =  FUNCTION(gsl_vector, max_index) (v) ;
 518       TEST (imax != exp_imax, "_max_index returns correct maximum i");
 519     }
 520
 521     {
 522       size_t imin = FUNCTION(gsl_vector, min_index) (v) ;
 523       TEST (imin != exp_imin, "_min_index returns correct minimum i");
 524     }
 525
 526     {
 527       size_t imin, imax;
 528
 529       FUNCTION(gsl_vector, minmax_index) (v,  &imin, &imax);
 530
 531       TEST (imax != exp_imax, "_minmax_index returns correct maximum i");
 532       TEST (imin != exp_imin, "_minmax_index returns correct minimum i");
 533     }
 534
 535 #if FP
 536     i = N/2;
 537     FUNCTION(gsl_vector, set) (v, i, GSL_NAN);
 538     exp_max = GSL_NAN; exp_min = GSL_NAN;
 539     exp_imax = i; exp_imin = i;
 540
 541     {
 542       BASE max = FUNCTION(gsl_vector, max) (v) ;
 543       gsl_test_abs (max, exp_max, 0, "_max returns correct maximum value for NaN");
 544     }
 545
 546     {
 547       BASE min = FUNCTION(gsl_vector, min) (v) ;
 548       gsl_test_abs (min, exp_min, 0, "_min returns correct minimum value for NaN");
 549     }
 550
 551     {
 552       BASE min, max;
 553       FUNCTION(gsl_vector, minmax) (v, &min, &max);
 554
 555       gsl_test_abs (max, exp_max, 0, "_minmax returns correct maximum value for NaN");
 556       gsl_test_abs (min, exp_min, 0, "_minmax returns correct minimum value for NaN");
 557     }
 558
 559
 560     {
 561       size_t imax =  FUNCTION(gsl_vector, max_index) (v) ;
 562       TEST (imax != exp_imax, "_max_index returns correct maximum i for NaN");
 563     }
 564
 565     {
 566       size_t imin = FUNCTION(gsl_vector, min_index) (v) ;
 567       TEST (imin != exp_imin, "_min_index returns correct minimum i for NaN");
 568     }
 569
 570     {
 571       size_t imin, imax;
 572
 573       FUNCTION(gsl_vector, minmax_index) (v,  &imin, &imax);
 574
 575       TEST (imax != exp_imax, "_minmax_index returns correct maximum i for NaN");
 576       TEST (imin != exp_imin, "_minmax_index returns correct minimum i for NaN");
 577     }
 578 #endif
 579
 580   }
 581
 582
 583   FUNCTION (gsl_vector, free) (v0);      /* free whatever is in v */
 584 }
 585
 586 void
 587 FUNCTION (test, ops) (size_t stride1, size_t stride2, size_t N)
 588 {
 589   size_t i;
 590   TYPE (gsl_vector) * a = FUNCTION (create, vector) (stride1, N);
 591   TYPE (gsl_vector) * b = FUNCTION (create, vector) (stride2, N);
 592   TYPE (gsl_vector) * v = FUNCTION (create, vector) (stride1, N);
 593
 594   for (i = 0; i < N; i++)
 595     {
 596       FUNCTION (gsl_vector, set) (a, i, (BASE)(3 + i));
 597       FUNCTION (gsl_vector, set) (b, i, (BASE)(3 + 2 * i));
 598     }
 599
 600   FUNCTION(gsl_vector, memcpy) (v, a);
 601   FUNCTION(gsl_vector, add) (v, b);
 602
 603   {
 604     int status = 0;
 605
 606     for (i = 0; i < N; i++)
 607       {
 608         BASE r = FUNCTION(gsl_vector,get) (v,i);
 609         BASE x = FUNCTION(gsl_vector,get) (a,i);
 610         BASE y = FUNCTION(gsl_vector,get) (b,i);
 611         BASE z = x + y;
 612         if (r != z)
 613           status = 1;
 614       }
 615     TEST2 (status, "_add vector addition");
 616   }
 617
 618   {
 619     int status = 0;
 620
 621     FUNCTION(gsl_vector, swap) (a, b);
 622
 623     for (i = 0; i < N; i++)
 624       {
 625         status |= (FUNCTION (gsl_vector, get) (a, i) != (BASE)(3 + 2 * i));
 626         status |= (FUNCTION (gsl_vector, get) (b, i) != (BASE)(3 + i));
 627       }
 628
 629     FUNCTION(gsl_vector, swap) (a, b);
 630
 631     for (i = 0; i < N; i++)
 632       {
 633         status |= (FUNCTION (gsl_vector, get) (a, i) != (BASE)(3 + i));
 634         status |= (FUNCTION (gsl_vector, get) (b, i) != (BASE)(3 + 2 * i));
 635       }
 636
 637     TEST2 (status, "_swap exchange vectors");
 638   }
 639
 640   FUNCTION(gsl_vector, memcpy) (v, a);
 641   FUNCTION(gsl_vector, sub) (v, b);
 642
 643   {
 644     int status = 0;
 645
 646     for (i = 0; i < N; i++)
 647       {
 648         BASE r = FUNCTION(gsl_vector,get) (v,i);
 649         BASE x = FUNCTION(gsl_vector,get) (a,i);
 650         BASE y = FUNCTION(gsl_vector,get) (b,i);
 651         BASE z = x - y;
 652         if (r != z)
 653           status = 1;
 654       }
 655
 656     TEST2 (status, "_sub vector subtraction");
 657   }
 658
 659   FUNCTION(gsl_vector, memcpy) (v, a);
 660   FUNCTION(gsl_vector, mul) (v, b);
 661
 662   {
 663     int status = 0;
 664
 665     for (i = 0; i < N; i++)
 666       {
 667         BASE r = FUNCTION(gsl_vector,get) (v,i);
 668         BASE x = FUNCTION(gsl_vector,get) (a,i);
 669         BASE y = FUNCTION(gsl_vector,get) (b,i);
 670         BASE z = x * y;
 671         if (r != z)
 672           status = 1;
 673       }
 674
 675     TEST2 (status, "_mul multiplication");
 676   }
 677
 678   FUNCTION(gsl_vector, memcpy) (v, a);
 679   FUNCTION(gsl_vector, div) (v, b);
 680
 681   {
 682     int status = 0;
 683
 684     for (i = 0; i < N; i++)
 685       {
 686         BASE r = FUNCTION(gsl_vector,get) (v,i);
 687         BASE x = FUNCTION(gsl_vector,get) (a,i);
 688         BASE y = FUNCTION(gsl_vector,get) (b,i);
 689         BASE z = x / y;
 690         if (fabs(r - z) > 2 * GSL_FLT_EPSILON * fabs(z))
 691           status = 1;
 692       }
 693     TEST2 (status, "_div division");
 694   }
 695
 696   FUNCTION(gsl_vector, free) (a);
 697   FUNCTION(gsl_vector, free) (b);
 698   FUNCTION(gsl_vector, free) (v);
 699 }
 700
 701
 702 void
 703 FUNCTION (test, file) (size_t stride, size_t N)
 704 {
 705   TYPE (gsl_vector) * v = FUNCTION (create, vector) (stride, N);
 706   TYPE (gsl_vector) * w = FUNCTION (create, vector) (stride, N);
 707
 708   size_t i;
 709
 710   {
 711     FILE *f = fopen ("test.dat", "wb");
 712
 713     for (i = 0; i < N; i++)
 714       {
 715         FUNCTION (gsl_vector, set) (v, i, (ATOMIC) (N - i));
 716       };
 717
 718     FUNCTION (gsl_vector, fwrite) (f, v);
 719
 720     fclose (f);
 721   }
 722
 723   {
 724     FILE *f = fopen ("test.dat", "rb");
 725
 726     FUNCTION (gsl_vector, fread) (f, w);
 727
 728     status = 0;
 729     for (i = 0; i < N; i++)
 730       {
 731         if (w->data[i*stride] != (ATOMIC) (N - i))
 732           status = 1;
 733       };
 734
 735     TEST (status, "_write and read");
 736
 737     fclose (f);
 738   }
 739
 740   FUNCTION (gsl_vector, free) (v);      /* free whatever is in v */
 741   FUNCTION (gsl_vector, free) (w);      /* free whatever is in w */
 742 }
 743
 744 #if USES_LONGDOUBLE && ! HAVE_PRINTF_LONGDOUBLE
 745 /* skip this test */
 746 #else
 747 void
 748 FUNCTION (test, text) (size_t stride, size_t N)
 749 {
 750   TYPE (gsl_vector) * v = FUNCTION (create, vector) (stride, N);
 751   TYPE (gsl_vector) * w = FUNCTION (create, vector) (stride, N);
 752
 753   size_t i;
 754
 755   {
 756     FILE *f = fopen ("test.txt", "w");
 757
 758     for (i = 0; i < N; i++)
 759       {
 760         FUNCTION (gsl_vector, set) (v, i, (ATOMIC) i);
 761       };
 762
 763     FUNCTION (gsl_vector, fprintf) (f, v, OUT_FORMAT);
 764
 765     fclose (f);
 766   }
 767
 768   {
 769     FILE *f = fopen ("test.txt", "r");
 770
 771     FUNCTION (gsl_vector, fscanf) (f, w);
 772
 773     status = 0;
 774     for (i = 0; i < N; i++)
 775       {
 776         if (w->data[i*stride] != (ATOMIC) i)
 777           status = 1;
 778       };
 779
 780     gsl_test (status, NAME (gsl_vector) "_fprintf and fscanf");
 781
 782     fclose (f);
 783   }
 784
 785   FUNCTION (gsl_vector, free) (v);
 786   FUNCTION (gsl_vector, free) (w);
 787 }
 788 #endif
 789
 790 void
 791 FUNCTION (test, trap) (size_t stride, size_t N)
 792 {
 793   double x;
 794   size_t j = 0;
 795   TYPE (gsl_vector) * v = FUNCTION (create, vector) (stride, N);
 796   v->size = N;
 797   v->stride = stride;
 798
 799   status = 0;
 800   FUNCTION (gsl_vector, set) (v, j - 1, (ATOMIC)0);
 801   TEST (!status, "_set traps index below lower bound");
 802
 803   status = 0;
 804   FUNCTION (gsl_vector, set) (v, N + 1, (ATOMIC)0);
 805   TEST (!status, "_set traps index above upper bound");
 806
 807   status = 0;
 808   FUNCTION (gsl_vector, set) (v, N, (ATOMIC)0);
 809   TEST (!status, "_set traps index at upper bound");
 810
 811   status = 0;
 812   x = FUNCTION (gsl_vector, get) (v, j - 1);
 813   TEST (!status, "_get traps index below lower bound");
 814   TEST (x != 0, "_get returns zero for index below lower bound");
 815
 816   status = 0;
 817   x = FUNCTION (gsl_vector, get) (v, N + 1);
 818   TEST (!status, "_get traps index above upper bound");
 819   TEST (x != 0, "_get returns zero for index above upper bound");
 820
 821   status = 0;
 822   x = FUNCTION (gsl_vector, get) (v, N);
 823   TEST (!status, "_get traps index at upper bound");
 824   TEST (x != 0, "_get returns zero for index at upper bound");
 825
 826   FUNCTION (gsl_vector, free) (v);      /* free whatever is in v */
 827 }
 828
 829
 830
 831
 832