LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
dormlq_interface_check.patch
Go to the documentation of this file.
1 Description: Dormlq C interface error check (upstream bug #133)
2 Origin: backport, commit: r1586
3 Bug: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?f=13&t=4771
4 Reviewed-by: Sébastien Villemot <sebastien@debian.org>
5 Last-Update: 2015-10-31
6 ---
7 This patch header follows DEP-3: http://dep.debian.net/deps/dep3/
8 --- a/lapacke/src/lapacke_cunmlq_work.c
9 +++ b/lapacke/src/lapacke_cunmlq_work.c
10 @@ -41,6 +41,7 @@ lapack_int LAPACKE_cunmlq_work( int matr
11  lapack_complex_float* work, lapack_int lwork )
12  {
13  lapack_int info = 0;
14 + lapack_int r;
15  if( matrix_order == LAPACK_COL_MAJOR ) {
16  /* Call LAPACK function and adjust info */
17  LAPACK_cunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
18 @@ -49,12 +50,13 @@ lapack_int LAPACKE_cunmlq_work( int matr
19  info = info - 1;
20  }
21  } else if( matrix_order == LAPACK_ROW_MAJOR ) {
22 + r = LAPACKE_lsame( side, 'l' ) ? m : n;
23  lapack_int lda_t = MAX(1,k);
24  lapack_int ldc_t = MAX(1,m);
25  lapack_complex_float* a_t = NULL;
26  lapack_complex_float* c_t = NULL;
27  /* Check leading dimension(s) */
28 - if( lda < m ) {
29 + if( lda < r ) {
30  info = -8;
31  LAPACKE_xerbla( "LAPACKE_cunmlq_work", info );
32  return info;
33 --- a/lapacke/src/lapacke_dormlq_work.c
34 +++ b/lapacke/src/lapacke_dormlq_work.c
35 @@ -40,6 +40,7 @@ lapack_int LAPACKE_dormlq_work( int matr
36  double* work, lapack_int lwork )
37  {
38  lapack_int info = 0;
39 + lapack_int r;
40  lapack_int lda_t, ldc_t;
41  double *a_t = NULL, *c_t = NULL;
42  if( matrix_order == LAPACK_COL_MAJOR ) {
43 @@ -50,10 +51,11 @@ lapack_int LAPACKE_dormlq_work( int matr
44  info = info - 1;
45  }
46  } else if( matrix_order == LAPACK_ROW_MAJOR ) {
47 + r = LAPACKE_lsame( side, 'l' ) ? m : n;
48  lda_t = MAX(1,k);
49  ldc_t = MAX(1,m);
50  /* Check leading dimension(s) */
51 - if( lda < m ) {
52 + if( lda < r ) {
53  info = -8;
54  LAPACKE_xerbla( "LAPACKE_dormlq_work", info );
55  return info;
56 --- a/lapacke/src/lapacke_sormlq_work.c
57 +++ b/lapacke/src/lapacke_sormlq_work.c
58 @@ -40,6 +40,7 @@ lapack_int LAPACKE_sormlq_work( int matr
59  float* work, lapack_int lwork )
60  {
61  lapack_int info = 0;
62 + lapack_int r;
63  lapack_int lda_t, ldc_t;
64  float *a_t = NULL, *c_t = NULL;
65  if( matrix_order == LAPACK_COL_MAJOR ) {
66 @@ -50,10 +51,11 @@ lapack_int LAPACKE_sormlq_work( int matr
67  info = info - 1;
68  }
69  } else if( matrix_order == LAPACK_ROW_MAJOR ) {
70 + r = LAPACKE_lsame( side, 'l' ) ? m : n;
71  lda_t = MAX(1,k);
72  ldc_t = MAX(1,m);
73  /* Check leading dimension(s) */
74 - if( lda < m ) {
75 + if( lda < r ) {
76  info = -8;
77  LAPACKE_xerbla( "LAPACKE_sormlq_work", info );
78  return info;
79 --- a/lapacke/src/lapacke_zunmlq_work.c
80 +++ b/lapacke/src/lapacke_zunmlq_work.c
81 @@ -41,6 +41,7 @@ lapack_int LAPACKE_zunmlq_work( int matr
82  lapack_complex_double* work, lapack_int lwork )
83  {
84  lapack_int info = 0;
85 + lapack_int r;
86  if( matrix_order == LAPACK_COL_MAJOR ) {
87  /* Call LAPACK function and adjust info */
88  LAPACK_zunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
89 @@ -49,12 +50,13 @@ lapack_int LAPACKE_zunmlq_work( int matr
90  info = info - 1;
91  }
92  } else if( matrix_order == LAPACK_ROW_MAJOR ) {
93 + r = LAPACKE_lsame( side, 'l' ) ? m : n;
94  lapack_int lda_t = MAX(1,k);
95  lapack_int ldc_t = MAX(1,m);
96  lapack_complex_double* a_t = NULL;
97  lapack_complex_double* c_t = NULL;
98  /* Check leading dimension(s) */
99 - if( lda < m ) {
100 + if( lda < r ) {
101  info = -8;
102  LAPACKE_xerbla( "LAPACKE_zunmlq_work", info );
103  return info;