TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-12-22 20:36:01 +01:00
Code Issues Projects Releases Wiki Activity

Fixed qmckl_memory

Browse Source
This commit is contained in:
Anthony Scemama 2021-03-18 23:55:50 +01:00
parent d10c84acbb
commit 676d5867bd
3 changed files with 71 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
src/qmckl_context.org
View File

@ -231,6 +231,46 @@ munit_assert_int64( context, !=, QMCKL_NULL_CONTEXT );
munit_assert_int64( qmckl_context_check(context), ==, context );
#+end_src
** Access to the previous context
~qmckl_context_previous~ returns the previous context. It returns
~QMCKL_NULL_CONTEXT~ for the initial context and for the ~NULL~ context.
# Header
#+begin_src c :comments org :tangle (eval h) :exports none
qmckl_context qmckl_context_previous(const qmckl_context context);
#+end_src
# Source
#+begin_src c :tangle (eval c)
qmckl_context qmckl_context_previous(const qmckl_context context) {
const qmckl_context checked_context = qmckl_context_check(context);
if (checked_context == (qmckl_context) 0) {
return (qmckl_context) 0;
}
const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context;
return qmckl_context_check((qmckl_context) ctx->prev);
}
#+end_src
# Fortran interface
#+begin_src f90 :tangle (eval fh) :exports none
interface
integer (c_int64_t) function qmckl_context_previous(context) bind(C)
use, intrinsic :: iso_c_binding
integer (c_int64_t), intent(in), value :: context
end function qmckl_context_previous
end interface
#+end_src
# Test
#+begin_src c :comments link :tangle (eval c_test) :exports none
munit_assert_int64(qmckl_context_previous(context), ==, QMCKL_NULL_CONTEXT);
munit_assert_int64(qmckl_context_previous(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT);
#+end_src
** Locking
For thread safety, the context may be locked/unlocked. The lock is
@ -356,10 +396,10 @@ qmckl_context qmckl_context_copy(const qmckl_context context) {
# Test
#+begin_src c :comments link :tangle (eval c_test) :exports none
qmckl_context new_context = qmckl_context_copy(context);
munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT);
munit_assert_int64(new_context, !=, context);
munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
munit_assert_int64(qmckl_context_previous(new_context), ==, context);
#+end_src
** Destroy
@ -436,7 +476,6 @@ qmckl_context qmckl_context_destroy(const qmckl_context context) {
# Test
#+begin_src c :tangle (eval c_test) :exports none
munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT);
munit_assert_int64(qmckl_context_destroy(new_context), ==, context);
munit_assert_int64(qmckl_context_check(new_context), !=, new_context);
munit_assert_int64(qmckl_context_check(new_context), ==, QMCKL_NULL_CONTEXT);
@ -444,48 +483,6 @@ munit_assert_int64(qmckl_context_destroy(context), ==, QMCKL_NULL_CONTEXT);
munit_assert_int64(qmckl_context_destroy(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT);
#+end_src
** Access to the previous context
~qmckl_context_previous~ returns the previous context. It returns
~QMCKL_NULL_CONTEXT~ for the initial context and for the ~NULL~ context.
# Header
#+begin_src c :comments org :tangle (eval h) :exports none
qmckl_context qmckl_context_previous(const qmckl_context context);
#+end_src
# Source
#+begin_src c :tangle (eval c)
qmckl_context qmckl_context_previous(const qmckl_context context) {
const qmckl_context checked_context = qmckl_context_check(context);
if (checked_context == (qmckl_context) 0) {
return (qmckl_context) 0;
}
const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context;
return qmckl_context_check((qmckl_context) ctx->prev);
}
#+end_src
# Fortran interface
#+begin_src f90 :tangle (eval fh) :exports none
interface
integer (c_int64_t) function qmckl_context_previous(context) bind(C)
use, intrinsic :: iso_c_binding
integer (c_int64_t), intent(in), value :: context
end function qmckl_context_previous
end interface
#+end_src
# Test
#+begin_src c :comments link :tangle (eval c_test) :exports none
munit_assert_int64(qmckl_context_previous(new_context), !=, QMCKL_NULL_CONTEXT);
munit_assert_int64(qmckl_context_previous(new_context), ==, context);
munit_assert_int64(qmckl_context_previous(context), ==, QMCKL_NULL_CONTEXT);
munit_assert_int64(qmckl_context_previous(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT);
#+end_src
* Memory allocation handling
** Data structure

46
src/qmckl_memory.org
View File

@ -30,6 +30,10 @@ MunitResult test_<<filename()>>() {
#+end_src
*
:PROPERTIES:
:UNNUMBERED: t
:END:
Memory allocation inside the library should be done with
~qmckl_malloc~. It lets the library choose how the memory will be
allocated, and a pointer is returned to the user. The context is
@ -60,6 +64,7 @@ void* qmckl_malloc(qmckl_context context, const size_t size) {
return pointer;
}
#+end_src
# Fortran interface
#+begin_src f90 :tangle (eval fh) :noexport
interface
@ -71,24 +76,21 @@ void* qmckl_malloc(qmckl_context context, const size_t size) {
end interface
#+end_src
** Test :noexport:
# Test :noexport:
#+begin_src c :tangle (eval c_test)
int *a = NULL;
munit_assert(a == NULL);
a = (int*) qmckl_malloc( QMCKL_NULL_CONTEXT, 3*sizeof(int));
munit_assert(a != NULL);
a[0] = 1;
a[1] = 2;
a[2] = 3;
munit_assert_int(a[0], ==, 1);
munit_assert_int(a[1], ==, 2);
munit_assert_int(a[2], ==, 3);
qmckl_context context = qmckl_context_create();
int *a = (int*) qmckl_malloc(context, 3*sizeof(int));
munit_assert(a != NULL);
a[0] = 1; munit_assert_int(a[0], ==, 1);
a[1] = 2; munit_assert_int(a[1], ==, 2);
a[2] = 3; munit_assert_int(a[2], ==, 3);
#+end_src
* ~qmckl_free~
The context is passed, in case some important information has been
stored related to memory allocation and needs to be updated.
When freeing the memory with ~qmckl_free~, the context is passed, in
case some important information has been stored related to memory
allocation and needs to be updated.
#+begin_src c :tangle (eval h)
qmckl_exit_code qmckl_free(qmckl_context context,
@ -105,7 +107,7 @@ qmckl_exit_code qmckl_free(qmckl_context context,
end interface
#+end_src
** Source
# Source
#+begin_src c :tangle (eval c)
qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) {
if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) {
@ -127,11 +129,15 @@ qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) {
}
#+end_src
** Test :noexport:
#+begin_src c :tangle (eval c_test)
munit_assert(a != NULL);
# Test
#+begin_src c :tangle (eval c_test) :exports none
qmckl_exit_code rc;
rc = qmckl_free( (qmckl_context) 1, a);
munit_assert(a != NULL);
rc = qmckl_free(context, a);
munit_assert(rc == QMCKL_SUCCESS);
rc = qmckl_context_destroy(context);
munit_assert(rc == QMCKL_SUCCESS);
#+end_src

6
src/test_qmckl.org
View File

@ -65,9 +65,9 @@ echo "#+end_src"
#+begin_src c :tangle no
{ (char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
{ (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
{ (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
{ (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
{ (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
// { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
// { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
// { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
#+end_src
:end: