Skip to content
This repository

deferred callback execution #28

Closed
wants to merge 1 commit into from

2 participants

Yury Zavarin Duke Leto
Yury Zavarin

No description provided.

Yury Zavarin * support deferred callback execution of gsl_function
 * gsl_root_fsolver_iterate() and gsl_min_fminimizer_iterate() works now
2254916
Yury Zavarin

We delete default typemap(freearg) for gsl_function, because we want to destroy this somewhere in destructor, not immediately after execution of function that takes gsl_function as argument.

In the future we must remove this typemap only for specific functions, but I don't know hot implement it right now.
It works correctly for a current state of GSL code.

Yury Zavarin

we need such a line, because SWIG calls addintional desctuctor's code only if we made the object using new()
(see ACQUIRE() and DISOWN() methods in .pm file)
this is a way to say that gsl_min_fminimizer_alloc() creates new object

Yury Zavarin

we can extend C structures using SWIG
~gsl_min_fminimizer() means additional code for destructor

Yury Zavarin

make check for a case when we have called only gsl_min_fminimizer_alloc() without following gsl_min_fminimizer_set_with_values
(_alloc functions explicitly set NULL for pointers)

Yury Zavarin

$self->function breaks incapsulation, now we know that fminimizer struct have a field with name 'function'
but I don't know how to avoid this

Yury Zavarin

always allocates new memory for struct gsl_function_perl

Yury Zavarin

frees() allocated memory for struct gsl_function_perl

Yury Zavarin

I removed GSL_MIN_NEW_FREE tests because now we shouldn't call gsl_min_fminimizer_free() explicitly. DESTROY makes it for us.
If we call gsl_min_fminimizer_free() twice it will cause an error.

Duke Leto leto commented on the diff August 30, 2011
swig/Roots.i
@@ -3,6 +3,19 @@
3 3
 %include "typemaps.i"
4 4
 %include "renames.i"
5 5
 
  6
+%typemap(freearg) gsl_function *;
  7
+%newobject gsl_root_fsolver_alloc;
  8
+%extend gsl_root_fsolver {
  9
+    ~gsl_root_fsolver() {
2
Duke Leto Owner
leto added a note August 30, 2011

Does this mean that people must have a C++ compiler to compile Math::GSL ? Or is there some SWIG voodoo going on?

Yury Zavarin
tadam added a note August 30, 2011

Yes, it is SWIG voodoo :-)
I had compiled it with llvm-gcc, not llvm-g++.

Actually this code makes following things:
1. SWIG creates function named delete_gsl_min_fminimizer() substituting there a code of ~gsl_root_fsolver()
2. SWIG uses this function in XS(_wrap_delete_gsl_min_fminimizer) {...}
3. Math::GSL::Min calls previous XS-mapped function function from DESTROY:
if (exists $OWNER{$self}) {
Math::GSL::Minc::delete_gsl_min_fminimizer($self);
delete $OWNER{$self};
}

I don't see any C++ specific code here. But if you can, please make additional check on your machine.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Duke Leto
Owner
leto commented August 30, 2011

This is awesome! Will test soon.

Duke Leto
Owner

The tests passed on my machine with gcc. Merged! If you are unsure which subsystem to hack on next, getting the ODE subsystem working next would be a killer feature. It would allow people to solve ODE's with C-like speed from Perl, which would attract a lot of new users.

Keep the pull requests coming!

Duke Leto leto closed this September 02, 2011
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Showing 1 unique commit by 1 author.

Aug 30, 2011
Yury Zavarin * support deferred callback execution of gsl_function
 * gsl_root_fsolver_iterate() and gsl_min_fminimizer_iterate() works now
2254916
This page is out of date. Refresh to see the latest.
10  pod/Min.pod
Source Rendered
... ...
@@ -1,8 +1,8 @@
1 1
 %perlcode %{
2 2
 
3 3
 @EXPORT_OK = qw/
4  
-   gsl_min_fminimizer_alloc 
5  
-   gsl_min_fminimizer_free 
  4
+   gsl_min_fminimizer_alloc
  5
+   gsl_min_fminimizer_free
6 6
    gsl_min_fminimizer_set 
7 7
    gsl_min_fminimizer_set_with_values
8 8
    gsl_min_fminimizer_iterate 
@@ -44,10 +44,16 @@ Here is a list of all the functions in this module :
44 44
 
45 45
 =item * C<gsl_min_fminimizer_free >
46 46
 
  47
+Don't call this function explicitly. It will be called automatically in DESTROY for fminimizer.
  48
+
47 49
 =item * C<gsl_min_fminimizer_set >
48 50
 
  51
+Don't apply this function twice to the same fminimizer. It will cause a memory leak. Instead of this you should create new fminimizer.
  52
+
49 53
 =item * C<gsl_min_fminimizer_set_with_values>
50 54
 
  55
+Don't apply this function twice to the same fminimizer. It will cause a memory leak. Instead of this you should create new fminimizer.
  56
+
51 57
 =item * C<gsl_min_fminimizer_iterate >
52 58
 
53 59
 =item * C<gsl_min_fminimizer_name >
3  pod/Roots.pod
Source Rendered
@@ -44,9 +44,10 @@ Here is a list of all the functions in this module :
44 44
 
45 45
 =item * C<gsl_root_fsolver_alloc($T)> - This function returns a pointer to a newly allocated instance of a solver of type $T. $T must be one of the constant included with this module. If there is insufficient memory to create the solver then the function returns a null pointer and the error handler is invoked with an error code of $GSL_ENOMEM.
46 46
 
47  
-=item * C<gsl_root_fsolver_free($s)> - This function frees all the memory associated with the solver $s. 
  47
+=item * C<gsl_root_fsolver_free($s)> - Don't call this function explicitly. It will be called automatically in DESTROY for fsolver.
48 48
 
49 49
 =item * C<gsl_root_fsolver_set($s, $f, $x_lower, $x_upper)> - This function initializes, or reinitializes, an existing solver $s to use the function $f and the initial search interval [$x_lower, $x_upper]. $f has to be of this form : sub { my $x=shift; function_with_$x }. For example, sub { my $x=shift; ($x-3.2)**3 } is a valid value for $f.
  50
+Don't apply this function twice to the same fsolver. It will cause a memory leak. Instead of this you should create new fsolver.
50 51
 
51 52
 =item * C<gsl_root_fsolver_iterate($s)> - This function performs a single iteration of the solver $s. If the iteration encounters an unexpected problem then an error code will be returned (the Math::GSL::Errno has to be included),
52 53
  $GSL_EBADFUNC - the iteration encountered a singular point where the function or its derivative evaluated to Inf or NaN.
14  swig/Min.i
@@ -3,6 +3,20 @@
3 3
 %include "gsl_typemaps.i"
4 4
 %include "renames.i"
5 5
 
  6
+%typemap(freearg) gsl_function *;
  7
+%newobject gsl_min_fminimizer_alloc;
  8
+%extend gsl_min_fminimizer {
  9
+    ~gsl_min_fminimizer() {
  10
+        struct gsl_function *gsl_f = (struct gsl_function *) $self->function;
  11
+        if (gsl_f != NULL) {
  12
+            struct gsl_function_perl *perl_f = (struct gsl_function_perl *) $self->function->params;
  13
+            gsl_function_perl_free(perl_f);
  14
+        }
  15
+        gsl_min_fminimizer_free($self);
  16
+    }
  17
+}
  18
+
  19
+
6 20
 %{
7 21
     #include "gsl/gsl_types.h"
8 22
     #include "gsl/gsl_min.h"
13  swig/Roots.i
@@ -3,6 +3,19 @@
3 3
 %include "typemaps.i"
4 4
 %include "renames.i"
5 5
 
  6
+%typemap(freearg) gsl_function *;
  7
+%newobject gsl_root_fsolver_alloc;
  8
+%extend gsl_root_fsolver {
  9
+    ~gsl_root_fsolver() {
  10
+        struct gsl_function *gsl_f = (struct gsl_function *) $self->function;
  11
+        if (gsl_f != NULL) {
  12
+            struct gsl_function_perl *perl_f = (struct gsl_function_perl *) $self->function->params;
  13
+            gsl_function_perl_free(perl_f);
  14
+        }
  15
+        gsl_root_fsolver_free($self);
  16
+    }
  17
+ }
  18
+
6 19
 %{
7 20
     #include "gsl/gsl_types.h"
8 21
     #include "gsl/gsl_roots.h"
29  swig/gsl_typemaps.i
@@ -393,6 +393,13 @@ void array_wrapper_free(array_wrapper * daw){
393 393
         SV * params;
394 394
     };
395 395
 
  396
+    void gsl_function_perl_free(struct gsl_function_perl * perl_f){
  397
+        if (perl_f != NULL) {
  398
+            SvREFCNT_dec(perl_f->function);
  399
+            SvREFCNT_dec(perl_f->params);
  400
+            Safefree(perl_f);
  401
+        }
  402
+    }
396 403
 
397 404
     /* These functions (C callbacks) calls the perl callbacks.
398 405
        Info for perl callback can be found using the 'void*params' parameter
@@ -528,9 +535,11 @@ void array_wrapper_free(array_wrapper * daw){
528 535
     $1         = &w_gsl_monte_function.C_gsl_monte_function;
529 536
 };
530 537
 
531  
-%typemap(in) gsl_function * (struct gsl_function_perl w_gsl_function) {
  538
+%typemap(in) gsl_function * {
532 539
     SV * function = 0;
533 540
     SV * params = 0;
  541
+    struct gsl_function_perl *w_gsl_function;
  542
+    Newx(w_gsl_function, 1, struct gsl_function_perl);
534 543
 
535 544
     if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
536 545
         AV* array=(AV*)SvRV($input);
@@ -562,12 +571,13 @@ void array_wrapper_free(array_wrapper * daw){
562 571
         params=&PL_sv_undef;
563 572
     }
564 573
     params = newSVsv(params);
565  
-            
566  
-    w_gsl_function.params = params;
567  
-    w_gsl_function.function = function;
568  
-    w_gsl_function.C_gsl_function.params   = &w_gsl_function;
569  
-    w_gsl_function.C_gsl_function.function = &call_gsl_function;
570  
-    $1         = &w_gsl_function.C_gsl_function;
  574
+
  575
+    w_gsl_function->params = params;
  576
+    w_gsl_function->function = function;
  577
+    w_gsl_function->C_gsl_function.params = w_gsl_function;
  578
+    w_gsl_function->C_gsl_function.function = &call_gsl_function;
  579
+
  580
+    $1 = &(w_gsl_function->C_gsl_function);
571 581
 };
572 582
 
573 583
 %typemap(freearg) gsl_monte_function * {
@@ -577,12 +587,13 @@ void array_wrapper_free(array_wrapper * daw){
577 587
     SvREFCNT_dec(p->params);
578 588
 };
579 589
 
  590
+
580 591
 %typemap(freearg) gsl_function * {
581 592
     struct gsl_function_perl *p=(struct gsl_function_perl *) $1->params;
582  
-    SvREFCNT_dec(p->function);
583  
-    SvREFCNT_dec(p->params);
  593
+    gsl_function_perl_free(p);
584 594
 };
585 595
 
  596
+
586 597
 /* TODO: same thing should be done for these kinds of callbacks */
587 598
 %typemap(in) gsl_function_fdf * {
588 599
     fprintf(stderr, 'FDF_FUNC');
41  t/Min.t
... ...
@@ -1,7 +1,7 @@
1 1
 package Math::GSL::Min::Test;
2 2
 use base q{Test::Class};
3 3
 use strict;
4  
-use Test::More tests => 23;
  4
+use Test::More tests => 22;
5 5
 use Math::GSL        qw/:all/;
6 6
 use Math::GSL::Min   qw/:all/;
7 7
 use Math::GSL::Test  qw/:all/;
@@ -12,6 +12,8 @@ use Data::Dumper;
12 12
 
13 13
 #trace 'off';
14 14
 
  15
+$| = 1;
  16
+
15 17
 BEGIN { gsl_set_error_handler_off(); }
16 18
 
17 19
 sub trace { }
@@ -24,11 +26,9 @@ sub make_fixture : Test(setup) {
24 26
 
25 27
 sub teardown : Test(teardown) {
26 28
     my $self = shift;
27  
-    #gsl_min_fminimizer_free($self->{min});
28  
-    #gsl_min_fminimizer_free($self->{brent});
29 29
 }
30 30
 
31  
-sub GSL_MIN_TYPES : Tests { 
  31
+sub GSL_MIN_TYPES : Tests {
32 32
 
33 33
     my $m = gsl_min_fminimizer_alloc($gsl_min_fminimizer_goldensection);
34 34
     isa_ok($m, 'Math::GSL::Min');
@@ -47,10 +47,11 @@ sub GSL_MIN_SET : Tests {
47 47
     my $self = shift;
48 48
     my $mini = $self->{min};
49 49
     ok_status(
50  
-            gsl_min_fminimizer_set($mini, 
51  
-                sub { cos($_[0]) }, 3, 0, 2*$M_PI     
  50
+            gsl_min_fminimizer_set($mini,
  51
+                sub { cos($_[0]) }, 3, 0, 2*$M_PI
52 52
             )
53 53
     );
  54
+
54 55
     # These are the first guesses first the initial iteration
55 56
     cmp_ok( $mini->{x_minimum}, '==', 3 );
56 57
     cmp_ok( $mini->{x_lower}, '==', 0 );
@@ -76,40 +77,24 @@ sub GSL_MIN_TEST_INTERVAL : Tests {
76 77
     my ($x_lower, $x_upper, $epsabs, $epsrel) = (0,1e-7, 1e-3,1e-5);
77 78
     ok_status(gsl_min_test_interval ($x_lower, $x_upper, $epsabs, $epsrel),
78 79
         $GSL_SUCCESS, 'gsl_min_test_interval'
79  
-    ); 
  80
+    );
80 81
 
81 82
     ($x_lower, $x_upper, $epsabs, $epsrel) = (0,1e-2, 1e-3,1e-5);
82 83
     ok_status(gsl_min_test_interval ($x_lower, $x_upper, $epsabs, $epsrel),
83 84
         $GSL_CONTINUE, 'gsl_min_test_interval'
84  
-    ); 
  85
+    );
85 86
 }
86 87
 
87 88
 sub GSL_MIN_ITERATE : Tests {
88 89
     my $self = shift;
89 90
     my $mini = $self->{min};
90  
-    #warn Dumper [ $mini, $mini->{state} ];
91  
-    ok_status(gsl_min_fminimizer_set_with_values($mini, 
92  
-        sub { cos($_[0]) }, 
  91
+    ok_status(gsl_min_fminimizer_set_with_values($mini,
  92
+        sub { cos($_[0]) },
93 93
         3, cos(3),
94 94
         0, cos(0),
95  
-        2*$M_PI, cos(2*$M_PI)     
  95
+        2*$M_PI, cos(2*$M_PI)
96 96
     ));
97  
-    #warn Dumper [ $mini, $mini->{state} ];
98  
-    #trace 'on';
99  
-    #warn Dumper [map { $mini->{$_} } qw(x_minimum x_lower x_upper f_minimum f_lower f_upper) ];
100  
-    local $TODO = 'iterate does not work';
101  
-    # This blows up
102  
-    #ok_status( gsl_min_fminimizer_iterate($mini));
103  
-    #trace 'off';
104  
-}
105  
-
106  
-sub GSL_MIN_NEW_FREE : Tests {
107  
-    my $self = shift;
108  
-    my $min = $self->{min};
109  
-    isa_ok($min, 'Math::GSL::Min');
110  
-
111  
-    gsl_min_fminimizer_free($min);
112  
-    ok(!$@, 'gsl_min_fminimizer_free');
  97
+    ok_status(gsl_min_fminimizer_iterate($mini));
113 98
 }
114 99
 
115 100
 Test::Class->runtests;
37  t/Roots.t
... ...
@@ -1,7 +1,7 @@
1 1
 package Math::GSL::Roots::Test;
2 2
 use strict;
3 3
 use base q{Test::Class};
4  
-use Test::More tests => 14;
  4
+use Test::More tests => 13;
5 5
 use Math::GSL        qw/:all/;
6 6
 use Math::GSL::Roots qw/:all/;
7 7
 use Math::GSL::Test  qw/:all/;
@@ -29,13 +29,6 @@ sub GSL_FDFSOLVER_BASIC : Tests {
29 29
     #));
30 30
 
31 31
 }
32  
-sub GSL_ROOTS_ALLOC_FREE : Tests {
33  
-    my $self = shift;
34  
-    my $x = $self->{solver};
35  
-    isa_ok($x, 'Math::GSL::Roots', 'gsl_root_fsolver_alloc' );
36  
-    gsl_root_fsolver_free($x);
37  
-    ok(!$@, 'gsl_root_fsolver_free');
38  
-}
39 32
 
40 33
 sub GSL_ROOTS_SET : Tests {
41 34
     my $self = shift;
@@ -54,30 +47,36 @@ sub GSL_ROOT_ITERATE : Tests {
54 47
         sub { my $x=shift; ($x-3.2)**3 },
55 48
         0, 5
56 49
     ));
57  
-    # This currently blows up
58  
-    #local $TODO = q{???};
59  
-    #ok_status( gsl_root_fsolver_iterate($solver));
60  
-    my $root = gsl_root_fsolver_root($solver);
61  
-    ok_similar([$root], [2.5], 'gsl_root_fsolver_root');
  50
+
  51
+    my ($status, $root);
  52
+    for (1..20) {
  53
+        $status = gsl_root_fsolver_iterate($solver);
  54
+        $root = gsl_root_fsolver_root($solver);
  55
+        my $x_lo = gsl_root_fsolver_x_lower($solver);
  56
+        my $x_hi = gsl_root_fsolver_x_upper($solver);
  57
+        $status = gsl_root_test_interval($x_lo, $x_hi, 3.1, 3.3);
  58
+    }
  59
+    ok_status($status);
  60
+    ok_similar([$root], [3.2], 'gsl_root_fsolver_root', 0.1);
62 61
 }
63 62
 
64 63
 sub SOlVER_TYPES : Tests {
65 64
     cmp_ok( $gsl_root_fsolver_bisection->{name}   ,'eq','bisection'  );
66 65
     cmp_ok( $gsl_root_fsolver_brent->{name}       ,'eq','brent'      );
67  
-    cmp_ok( $gsl_root_fsolver_falsepos->{name}    ,'eq','falsepos'   );     
68  
-    cmp_ok( $gsl_root_fdfsolver_newton->{name}    ,'eq','newton'     );    
69  
-    cmp_ok( $gsl_root_fdfsolver_secant->{name}    ,'eq','secant'     );   
70  
-    cmp_ok( $gsl_root_fdfsolver_steffenson->{name},'eq','steffenson' ); 
  66
+    cmp_ok( $gsl_root_fsolver_falsepos->{name}    ,'eq','falsepos'   );
  67
+    cmp_ok( $gsl_root_fdfsolver_newton->{name}    ,'eq','newton'     );
  68
+    cmp_ok( $gsl_root_fdfsolver_secant->{name}    ,'eq','secant'     );
  69
+    cmp_ok( $gsl_root_fdfsolver_steffenson->{name},'eq','steffenson' );
71 70
 }
72 71
 
73 72
 sub GSL_ROOTFSOLVER_NAME : Tests {
74 73
     my $self = shift;
75  
-    cmp_ok( gsl_root_fsolver_name($self->{solver})   ,'eq','bisection'  ); 
  74
+    cmp_ok( gsl_root_fsolver_name($self->{solver})   ,'eq','bisection'  );
76 75
 }
77 76
 
78 77
 sub GSL_FDFSOLVER_NAME : Tests {
79 78
     my $self = shift;
80  
-    cmp_ok( gsl_root_fdfsolver_name($self->{fdfsolver})   ,'eq','newton'  ); 
  79
+    cmp_ok( gsl_root_fdfsolver_name($self->{fdfsolver})   ,'eq','newton'  );
81 80
 }
82 81
 
83 82
 Test::Class->runtests;
Commit_comment_tip

Tip: You can add notes to lines in a file. Hover to the left of a line to make a note

Something went wrong with that request. Please try again.