TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-12-31 16:46:03 +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

87
src/qmckl_context.org
View File

@ -9,7 +9,7 @@
signed integer, defined in the ~qmckl_context~ type. signed integer, defined in the ~qmckl_context~ type.
A value of ~QMCKL_NULL_CONTEXT~ for the context is equivalent to a A value of ~QMCKL_NULL_CONTEXT~ for the context is equivalent to a
~NULL~ pointer. ~NULL~ pointer.
#+begin_src c :comments org :tangle (eval h) #+begin_src c :comments org :tangle (eval h)
typedef int64_t qmckl_context ; typedef int64_t qmckl_context ;
#define QMCKL_NULL_CONTEXT (qmckl_context) 0 #define QMCKL_NULL_CONTEXT (qmckl_context) 0
@ -231,6 +231,46 @@ munit_assert_int64( context, !=, QMCKL_NULL_CONTEXT );
munit_assert_int64( qmckl_context_check(context), ==, context ); munit_assert_int64( qmckl_context_check(context), ==, context );
#+end_src #+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 ** Locking
For thread safety, the context may be locked/unlocked. The lock is 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 # Test
#+begin_src c :comments link :tangle (eval c_test) :exports none #+begin_src c :comments link :tangle (eval c_test) :exports none
qmckl_context new_context = qmckl_context_copy(context); qmckl_context new_context = qmckl_context_copy(context);
munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT); munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT);
munit_assert_int64(new_context, !=, context); munit_assert_int64(new_context, !=, context);
munit_assert_int64(qmckl_context_check(new_context), ==, new_context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
munit_assert_int64(qmckl_context_previous(new_context), ==, context);
#+end_src #+end_src
** Destroy ** Destroy
@ -436,7 +476,6 @@ qmckl_context qmckl_context_destroy(const qmckl_context context) {
# Test # Test
#+begin_src c :tangle (eval c_test) :exports none #+begin_src c :tangle (eval c_test) :exports none
munit_assert_int64(qmckl_context_check(new_context), ==, new_context); 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_destroy(new_context), ==, context);
munit_assert_int64(qmckl_context_check(new_context), !=, new_context); munit_assert_int64(qmckl_context_check(new_context), !=, new_context);
munit_assert_int64(qmckl_context_check(new_context), ==, QMCKL_NULL_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); munit_assert_int64(qmckl_context_destroy(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT);
#+end_src #+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 * Memory allocation handling
** Data structure ** Data structure

46
src/qmckl_memory.org
View File

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

6
src/test_qmckl.org
View File

@ -65,9 +65,9 @@ echo "#+end_src"
#+begin_src c :tangle no #+begin_src c :tangle no
{ (char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (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_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_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_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_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
#+end_src #+end_src
:end: :end: