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

   1 /* vector/test_complex_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
  67       FUNCTION (gsl_vector, free) (v);      /* free whatever is in v */
  68     }
  69
  70   if (stride == 1)
  71     {
  72       v = FUNCTION (gsl_vector, alloc) (N);
  73
  74       TEST(v->data == 0, "_alloc pointer");
  75       TEST(v->size != N, "_alloc size");
  76       TEST(v->stride != 1, "_alloc stride");
  77
  78       FUNCTION (gsl_vector, free) (v);      /* free whatever is in v */
  79     }
  80
  81   if (stride == 1)
  82     {
  83       v0 = FUNCTION (gsl_vector, alloc) (N);
  84       view = FUNCTION (gsl_vector, subvector) (v0, 0, N);
  85       v = &view.vector;
  86     }
  87   else
  88     {
  89       v0 = FUNCTION (gsl_vector, alloc) (N * stride);
  90
  91       for (i = 0; i < N*stride; i++)
  92         {
  93           BASE x = ZERO;
  94           GSL_REAL (x) = (ATOMIC)i;
  95           GSL_IMAG (x) = (ATOMIC)(i + 1234);
  96           FUNCTION (gsl_vector, set) (v0, i, x);
  97         }
  98
  99       view = FUNCTION (gsl_vector, subvector_with_stride) (v0, 0, stride, N);
 100       v = &view.vector;
 101     }
 102
 103   {
 104     int status = 0;
 105
 106     for (i = 0; i < N; i++)
 107       {
 108         BASE x = ZERO;
 109         GSL_REAL (x) = (ATOMIC)i;
 110         GSL_IMAG (x) = (ATOMIC)(i + 1234);
 111         FUNCTION (gsl_vector, set) (v, i, x);
 112       }
 113
 114     for (i = 0; i < N; i++)
 115       {
 116         if (v->data[2*i*stride] != (ATOMIC) (i) || v->data[2 * i * stride + 1] != (ATOMIC) (i + 1234))
 117           status = 1;
 118       };
 119
 120     TEST(status,"_set" DESC " writes into array");
 121   }
 122
 123
 124   {
 125     int status = 0;
 126
 127     for (i = 0; i < N; i++)
 128       {
 129         BASE x, y;
 130         GSL_REAL (x) = (ATOMIC)i;
 131         GSL_IMAG (x) = (ATOMIC)(i + 1234);
 132         y = FUNCTION (gsl_vector, get) (v, i);
 133         if (!GSL_COMPLEX_EQ (x, y))
 134           status = 1;
 135       };
 136
 137     TEST (status, "_get" DESC " reads from array");
 138   }
 139
 140   {
 141     int status = 0;
 142
 143     for (i = 0; i < N; i++)
 144       {
 145         if (FUNCTION (gsl_vector, ptr) (v, i) != (BASE *)v->data + i*stride)
 146           status = 1;
 147       };
 148
 149     TEST (status, "_ptr" DESC " access to array");
 150   }
 151
 152
 153   {
 154     int status = 0;
 155
 156     for (i = 0; i < N; i++)
 157       {
 158         if (FUNCTION (gsl_vector, const_ptr) (v, i) != (BASE *)v->data + i*stride)
 159           status = 1;
 160       };
 161
 162     TEST (status, "_const_ptr" DESC " access to array");
 163   }
 164
 165   {
 166     int status = 0;
 167
 168     for (i = 0; i < N; i++)
 169       {
 170         BASE x = ZERO;
 171         FUNCTION (gsl_vector, set) (v, i, x);
 172       }
 173
 174     status = (FUNCTION(gsl_vector,isnull)(v) != 1);
 175     TEST (status, "_isnull" DESC " on null vector") ;
 176
 177     status = (FUNCTION(gsl_vector,ispos)(v) != 0);
 178     TEST (status, "_ispos" DESC " on null vector") ;
 179
 180     status = (FUNCTION(gsl_vector,isneg)(v) != 0);
 181     TEST (status, "_isneg" DESC " on null vector") ;
 182   }
 183
 184   {
 185     int status = 0;
 186
 187     for (i = 0; i < N; i++)
 188       {
 189         BASE x = ZERO;
 190         GSL_REAL (x) = (ATOMIC)i;
 191         GSL_IMAG (x) = (ATOMIC)(i + 1234);
 192         FUNCTION (gsl_vector, set) (v, i, x);
 193       }
 194
 195     status = (FUNCTION(gsl_vector,isnull)(v) != 0);
 196     TEST (status, "_isnull" DESC " on non-null vector") ;
 197
 198     status = (FUNCTION(gsl_vector,ispos)(v) != 0);
 199     TEST (status, "_ispos" DESC " on non-null vector") ;
 200
 201     status = (FUNCTION(gsl_vector,ispos)(v) != 0);
 202     TEST (status, "_isneg" DESC " on non-null vector") ;
 203   }
 204
 205   {
 206     int status = 0;
 207
 208     FUNCTION (gsl_vector, set_zero) (v);
 209
 210     for (i = 0; i < N; i++)
 211       {
 212         BASE x, y = ZERO;
 213         x = FUNCTION (gsl_vector, get) (v, i);
 214         if (!GSL_COMPLEX_EQ (x, y))
 215           status = 1;
 216       };
 217
 218     TEST (status, "_setzero" DESC " on non-null vector") ;
 219   }
 220
 221   {
 222     int status = 0;
 223
 224     BASE x;
 225     GSL_REAL (x) = (ATOMIC)27;
 226     GSL_IMAG (x) = (ATOMIC)(27 + 1234);
 227
 228     FUNCTION (gsl_vector, set_all) (v, x);
 229
 230     for (i = 0; i < N; i++)
 231       {
 232         BASE y = FUNCTION (gsl_vector, get) (v, i);
 233         if (!GSL_COMPLEX_EQ (x, y))
 234           status = 1;
 235       };
 236
 237     TEST (status, "_setall" DESC " to non-zero value") ;
 238   }
 239
 240
 241   {
 242     int status = 0;
 243
 244     for (i = 0; i < N; i++)
 245       {
 246         FUNCTION (gsl_vector, set_basis) (v, i);
 247
 248         for (j = 0; j < N; j++)
 249           {
 250             BASE x = FUNCTION (gsl_vector, get) (v, j);
 251             BASE one = ONE;
 252             BASE zero = ZERO;
 253
 254             if (i == j)
 255               {
 256                 if (!GSL_COMPLEX_EQ (x, one))
 257                   status = 1 ;
 258               }
 259             else
 260               {
 261                 if (!GSL_COMPLEX_EQ (x, zero))
 262                   status = 1;
 263               }
 264           };
 265       }
 266
 267     TEST (status, "_setbasis" DESC " over range") ;
 268   }
 269
 270   for (i = 0; i < N; i++)
 271     {
 272       BASE x = ZERO;
 273       GSL_REAL (x) = (ATOMIC)i;
 274       GSL_IMAG (x) = (ATOMIC)(i + 1234);
 275       FUNCTION (gsl_vector, set) (v, i, x);
 276     }
 277
 278   {
 279     int status;
 280     BASE x, y, r, s ;
 281     GSL_REAL(x) = 2 ;
 282     GSL_IMAG(x) = 2 + 1234;
 283     GSL_REAL(y) = 5 ;
 284     GSL_IMAG(y) = 5 + 1234;
 285
 286     FUNCTION (gsl_vector,swap_elements) (v, 2, 5) ;
 287
 288     r = FUNCTION(gsl_vector,get)(v,2);
 289     s = FUNCTION(gsl_vector,get)(v,5);
 290
 291     status = ! GSL_COMPLEX_EQ(r,y) ;
 292     status |= ! GSL_COMPLEX_EQ(s,x) ;
 293
 294     FUNCTION (gsl_vector,swap_elements) (v, 2, 5) ;
 295
 296     r = FUNCTION(gsl_vector,get)(v,2);
 297     s = FUNCTION(gsl_vector,get)(v,5);
 298
 299     status |= ! GSL_COMPLEX_EQ(r,x) ;
 300     status |= ! GSL_COMPLEX_EQ(s,y) ;
 301
 302     TEST (status, "_swap_elements" DESC " exchanges elements") ;
 303   }
 304
 305   {
 306     int status = 0;
 307
 308     FUNCTION (gsl_vector,reverse) (v) ;
 309
 310     for (i = 0; i < N; i++)
 311       {
 312         BASE x,r ;
 313         GSL_REAL(x) = (ATOMIC)(N - i - 1) ;
 314         GSL_IMAG(x) = (ATOMIC)(N - i - 1 + 1234);
 315
 316         r = FUNCTION (gsl_vector, get) (v, i);
 317
 318         status |= !GSL_COMPLEX_EQ(r,x);
 319       }
 320
 321     gsl_test (status, NAME(gsl_vector) "_reverse" DESC " reverses elements") ;
 322   }
 323
 324   {
 325     int status = 0;
 326
 327     QUALIFIED_VIEW(gsl_vector,view) v1 = FUNCTION(gsl_vector, view_array) (v->data, N*stride);
 328
 329     for (i = 0; i < N; i++)
 330       {
 331         BASE x = FUNCTION (gsl_vector, get) (&v1.vector, i*stride) ;
 332         BASE y = FUNCTION (gsl_vector, get) (v, i);
 333         if (!GSL_COMPLEX_EQ(x,y))
 334           status = 1;
 335       };
 336
 337     TEST (status, "_view_array" DESC);
 338   }
 339
 340   {
 341     int status = 0;
 342
 343     QUALIFIED_VIEW(gsl_vector,view) v1 = FUNCTION(gsl_vector, view_array_with_stride) (v->data, stride, N*stride);
 344
 345     for (i = 0; i < N; i++)
 346       {
 347         BASE x = FUNCTION (gsl_vector, get) (&v1.vector, i) ;
 348         BASE y = FUNCTION (gsl_vector, get) (v, i);
 349         if (!GSL_COMPLEX_EQ(x,y))
 350           status = 1;
 351       };
 352
 353     TEST (status, "_view_array_with_stride" DESC);
 354   }
 355
 356
 357   {
 358     int status = 0;
 359
 360     QUALIFIED_VIEW(gsl_vector,view) v1 = FUNCTION(gsl_vector, subvector) (v, N/3, N/2);
 361
 362     for (i = 0; i < N/2; i++)
 363       {
 364         BASE x = FUNCTION (gsl_vector, get) (&v1.vector, i) ;
 365         BASE y = FUNCTION (gsl_vector, get) (v, (N/3)+i);
 366         if (!GSL_COMPLEX_EQ(x,y))
 367           status = 1;
 368       };
 369
 370     TEST (status, "_view_subvector" DESC);
 371   }
 372
 373   {
 374     int status = 0;
 375
 376     QUALIFIED_VIEW(gsl_vector,view) v1 = FUNCTION(gsl_vector, subvector_with_stride) (v, N/5, 3, N/4);
 377
 378     for (i = 0; i < N/4; i++)
 379       {
 380         BASE x = FUNCTION (gsl_vector, get) (&v1.vector, i) ;
 381         BASE y = FUNCTION (gsl_vector, get) (v, (N/5)+3*i);
 382         if (!GSL_COMPLEX_EQ(x,y))
 383           status = 1;
 384       };
 385
 386     TEST (status, "_view_subvector_with_stride" DESC);
 387   }
 388
 389
 390   {
 391     int status = 0;
 392
 393     QUALIFIED_REAL_VIEW(gsl_vector,view) vv = FUNCTION(gsl_vector, real) (v);
 394
 395     for (i = 0; i < N; i++)
 396       {
 397         ATOMIC xr = REAL_VIEW (gsl_vector, get) (&vv.vector, i) ;
 398         BASE y = FUNCTION (gsl_vector, get) (v, i);
 399         ATOMIC yr = GSL_REAL(y);
 400
 401         if (xr != yr)
 402           status = 1;
 403       };
 404
 405     TEST (status, "_real" DESC);
 406   }
 407
 408   {
 409     int status = 0;
 410
 411     QUALIFIED_REAL_VIEW(gsl_vector,view) vv = FUNCTION(gsl_vector, imag) (v);
 412
 413     for (i = 0; i < N; i++)
 414       {
 415         ATOMIC xr = REAL_VIEW (gsl_vector, get) (&vv.vector, i) ;
 416         BASE y = FUNCTION (gsl_vector, get) (v, i);
 417         ATOMIC yr = GSL_IMAG(y);
 418
 419         if (xr != yr)
 420           status = 1;
 421       };
 422
 423     TEST (status, "_imag" DESC);
 424   }
 425
 426
 427   FUNCTION (gsl_vector, free) (v0);      /* free whatever is in v */
 428 }
 429
 430 void
 431 FUNCTION (test, file) (size_t stride, size_t N)
 432 {
 433   TYPE (gsl_vector) * v = FUNCTION (create, vector) (stride, N);
 434   TYPE (gsl_vector) * w = FUNCTION (create, vector) (stride, N);
 435
 436   size_t i;
 437
 438   {
 439     FILE *f = fopen ("test.dat", "wb");
 440
 441     for (i = 0; i < N; i++)
 442       {
 443         BASE x = ZERO;
 444         GSL_REAL (x) = (ATOMIC)(N - i);
 445         GSL_IMAG (x) = (ATOMIC)(N - i + 1);
 446         FUNCTION (gsl_vector, set) (v, i, x);
 447       };
 448
 449     FUNCTION (gsl_vector, fwrite) (f, v);
 450
 451     fclose (f);
 452   }
 453
 454   {
 455     FILE *f = fopen ("test.dat", "rb");
 456
 457     FUNCTION (gsl_vector, fread) (f, w);
 458
 459     status = 0;
 460     for (i = 0; i < N; i++)
 461       {
 462         if (w->data[2 * i * stride] != (ATOMIC) (N - i) || w->data[2 * i * stride + 1] != (ATOMIC) (N - i + 1))
 463           status = 1;
 464       };
 465     fclose (f);
 466   }
 467
 468   FUNCTION (gsl_vector, free) (v);
 469   FUNCTION (gsl_vector, free) (w);
 470
 471   gsl_test (status, NAME (gsl_vector) "_write and read work");
 472
 473 }
 474
 475 #if USES_LONGDOUBLE && ! HAVE_PRINTF_LONGDOUBLE
 476 /* skip this test */
 477 #else
 478 void
 479 FUNCTION (test, text) (size_t stride, size_t N)
 480 {
 481   TYPE (gsl_vector) * v = FUNCTION (create, vector) (stride, N);
 482   TYPE (gsl_vector) * w = FUNCTION (create, vector) (stride, N);
 483
 484   size_t i;
 485
 486   {
 487     FILE *f = fopen ("test.txt", "w");
 488
 489     for (i = 0; i < N; i++)
 490       {
 491         BASE x;
 492         GSL_REAL (x) = (ATOMIC)i;
 493         GSL_IMAG (x) = (ATOMIC)(i + 1);
 494         FUNCTION (gsl_vector, set) (v, i, x);
 495       };
 496
 497     FUNCTION (gsl_vector, fprintf) (f, v, OUT_FORMAT);
 498
 499     fclose (f);
 500   }
 501
 502   {
 503     FILE *f = fopen ("test.txt", "r");
 504
 505     FUNCTION (gsl_vector, fscanf) (f, w);
 506
 507     status = 0;
 508     for (i = 0; i < N; i++)
 509       {
 510         if (w->data[2 * i * stride] != (ATOMIC) i || w->data[2 * i * stride + 1] != (ATOMIC) (i + 1))
 511           status = 1;
 512       };
 513     fclose (f);
 514   }
 515
 516   FUNCTION (gsl_vector, free) (v);
 517   FUNCTION (gsl_vector, free) (w);
 518
 519   gsl_test (status, NAME (gsl_vector) "_fprintf and fscanf");
 520 }
 521 #endif
 522
 523 void
 524 FUNCTION (test, trap) (size_t stride, size_t N)
 525 {
 526   TYPE (gsl_vector) * vc = FUNCTION (create, vector) (stride, N);
 527
 528   BASE z = {{(ATOMIC)1.2, (ATOMIC)3.4}};
 529   BASE z1 = {{(ATOMIC)4.5, (ATOMIC)6.7}};
 530
 531   size_t j = 0;
 532
 533   status = 0;
 534   FUNCTION (gsl_vector, set) (vc, j - 1, z);
 535   gsl_test (!status,
 536             NAME (gsl_vector) "_set traps index below lower bound");
 537
 538   status = 0;
 539   FUNCTION (gsl_vector, set) (vc, N + 1, z);
 540   gsl_test (!status,
 541             NAME (gsl_vector) "_set traps index above upper bound");
 542
 543   status = 0;
 544   FUNCTION (gsl_vector, set) (vc, N, z);
 545   gsl_test (!status, NAME (gsl_vector) "_set traps index at upper bound");
 546
 547   status = 0;
 548   z1 = FUNCTION (gsl_vector, get) (vc, j - 1);
 549   gsl_test (!status,
 550             NAME (gsl_vector) "_get traps index below lower bound");
 551
 552   gsl_test (GSL_REAL (z1) != 0,
 553             NAME (gsl_vector) "_get returns zero real below lower bound");
 554   gsl_test (GSL_IMAG (z1) != 0,
 555             NAME (gsl_vector) "_get returns zero imag below lower bound");
 556
 557   status = 0;
 558   z1 = FUNCTION (gsl_vector, get) (vc, N + 1);
 559   gsl_test (!status,
 560             NAME (gsl_vector) "_get traps index above upper bound");
 561   gsl_test (GSL_REAL (z1) != 0,
 562             NAME (gsl_vector) "_get returns zero real above upper bound");
 563   gsl_test (GSL_IMAG (z1) != 0,
 564             NAME (gsl_vector) "_get returns zero imag above upper bound");
 565
 566   status = 0;
 567   z1 = FUNCTION (gsl_vector, get) (vc, N);
 568   gsl_test (!status, NAME (gsl_vector) "_get traps index at upper bound");
 569   gsl_test (GSL_REAL (z1) != 0,
 570             NAME (gsl_vector) "_get returns zero real at upper bound");
 571   gsl_test (GSL_IMAG (z1) != 0,
 572             NAME (gsl_vector) "_get returns zero imag at upper bound");
 573
 574   FUNCTION (gsl_vector, free) (vc);
 575 }
 576
 577
 578
 579