From fadfcad8be40740a96740ddcf8b4f6972aa203dc Mon Sep 17 00:00:00 2001
From: Jonathan Leto <jonathan@leto.net>
Date: Fri, 29 Aug 2008 20:50:36 -0700
Subject: [PATCH] Work on failing CBLAS test

---
 CBLAS.i                    |  7 ++++---
 gsl_typemaps.i             |  2 +-
 lib/Math/GSL/CBLAS/Test.pm | 50 +++++++++++++++++++++++-----------------------
 3 files changed, 30 insertions(+), 29 deletions(-)

diff --git a/CBLAS.i b/CBLAS.i
index 0b1ef64..ca90bac 100644
--- a/CBLAS.i
+++ b/CBLAS.i
@@ -1,16 +1,17 @@
 %module "Math::GSL::CBLAS"
 %include "typemaps.i"
+%include "gsl_typemaps.i"
 
-%apply double *INPUT { const double *X };
-%apply float *INPUT { const float *X };
+%apply double *INPUT { float const *X };
+%apply float *INPUT  { double const *X };
 
+%apply double *OUTPUT { float *C };
 %{
     #include "gsl/gsl_cblas.h"
 %}
 
 %include "gsl/gsl_cblas.h"
 
-
 %perlcode %{
 @EXPORT_OK = qw/
                cblas_sdsdot 
diff --git a/gsl_typemaps.i b/gsl_typemaps.i
index 5b7930d..d077ca8 100644
--- a/gsl_typemaps.i
+++ b/gsl_typemaps.i
@@ -18,7 +18,6 @@
     }
 }
 
-
 %apply double const [] { double *data, double *dest, double *f_in, double *f_out, double data[] };
 %apply double const [] { double x[], double a[], double b[] };
 %apply double const [] { const double * x, const double * y, const double * w };
@@ -27,3 +26,4 @@
 %apply double const [] { const double xrange[], const double yrange[] };
 %apply double const [] { const double * array };
 %apply double const [] { const double data2[], const double w[] };
+%apply double const [] { float const *A, float const *B, float const *C, float *C};
diff --git a/lib/Math/GSL/CBLAS/Test.pm b/lib/Math/GSL/CBLAS/Test.pm
index 8f06304..6cb485e 100644
--- a/lib/Math/GSL/CBLAS/Test.pm
+++ b/lib/Math/GSL/CBLAS/Test.pm
@@ -7,37 +7,37 @@ use Data::Dumper;
 use Math::GSL::Errno qw/:all/;
 use strict;
 
+BEGIN{ gsl_set_error_handler_off() }
+
 sub make_fixture : Test(setup) {
 }
 
 sub teardown : Test(teardown) {
 }
 
-#sub TEST_CBLAS : Tests {
-#
-#       my $A = [ 0.11, 0.12, 0.13,
-#                  0.21, 0.22, 0.23 ];
-#       my $lda = 3;
-#
-#       my $B   = [ 1011, 1012,
-#                   1021, 1022,
-#                   1031, 1032 ];
-#       my $ldb = 2;
-#
-#
-#       my $C    = [0.00, 0.00,
-#                  0.00, 0.00 ];
-#       my $ldc = 2;
-#
-#       # Compute C = A * B 
-#       # C  = [ 367.76 368.12 ]
-#        #     [ 674.06 674.72 ]
-#       local $TODO = "need typemap for float const *";
-#       cblas_sgemm ($CblasRowMajor,
-#                    $CblasNoTrans, $CblasNoTrans, 2, 2, 3,
-#                    1.0, $A, $lda, $B, $ldb, 0.0, $C, $ldc);
-#       print Dumper [ $C ];
-#}
+sub TEST_CBLAS : Tests {
+       local $TODO = "need to figure out how to reture more that just first element";
+
+       my $A = [ 0.11, 0.12, 0.13,
+                  0.21, 0.22, 0.23 ];
+       my $lda = 3;
+       my $B   = [ 1011, 1012,
+                   1021, 1022,
+                   1031, 1032 ];
+       my $ldb = 2;
+       my $C    = [0.00, 0.00,
+                  0.00, 0.00 ];
+       my $ldc = 2.0;
+
+       # Compute C = A * B 
+       # C  = [ 367.76 368.12 ]
+        #     [ 674.06 674.72 ]
+       my @stuff = cblas_sgemm ($CblasRowMajor,
+                    $CblasNoTrans, $CblasNoTrans, 2, 2, 3,
+                    1.0, $A, $lda, $B, $ldb, 0.0, $ldc);
+       #warn Dumper [ @stuff ];
+       ok(is_similar_relative( \@stuff, [ 367.76, 368.12 , 674.06, 674.72 ], '.01' ),'cblas_sgemm');
+}
 
 sub CBLAS_IDAMAX : Tests {
    my $N = 1;
-- 
2.11.4.GIT