tclsci fixed after 33ce445f981d
[scilab.git] / scilab / modules / tclsci / src / c / TCL_ArrayDim.c
1 /*
2  * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3  * Copyright (C) 2005 - INRIA - Allan CORNET
4  * Copyright (C) 2008-2008 - INRIA - Allan CORNET
5  *
6  * Copyright (C) 2012 - 2016 - Scilab Enterprises
7  *
8  * This file is hereby licensed under the terms of the GNU GPL v2.0,
9  * pursuant to article 5.3.4 of the CeCILL v.2.1.
10  * This file was originally licensed under the terms of the CeCILL v2.1,
11  * and continues to be available under such terms.
12  * For more information, see the COPYING file which you should have received
13  * along with this program.
14  *
15  */
16
17 #if defined(__linux__)
18 #define _GNU_SOURCE /* Bug 5673 fix: avoid dependency on GLIBC_2.7 */
19 #endif
20
21 #include <string.h>
22 #include "sci_malloc.h"
23 #include "TCL_ArrayDim.h"
24 #include "Scierror.h"
25 #include "localization.h"
26 #include "os_string.h"
27 /*--------------------------------------------------------------------------*/
28 #define TCL_ALL_INDEXES "TclScilabTmpVar1"
29 #define TCL_NUMERICAL_INDEXES "TclScilabTmpVar2"
30 #define CHAR_BLANK ' '
31 #define CHAR_PERIOD ','
32 /*--------------------------------------------------------------------------*/
33 #define MAX(a,b)        a >= b ? a : b
34 /*--------------------------------------------------------------------------*/
35
36 /*
37 ** TCL arrays are in fact Hastables. But we want to be able to store
38 ** and get arrays as Scilab Matrixes. Then we apply this alogorithm :
39 ** - Get all indexes
40 ** - Get all numerical indexes like ^[1-9][0-9]*,[1-9][0-9]*$
41 ** - IF they have the same length (means all indexes are numerical)
42 **      -> Take all indexes and complete list ex : ["1,1", "2,2"] -> ["1,1" "1,2" "2,1", "2,2"]
43 **      -> Return completed index list _AND_ modify value pointed by nb_lines, nb_columns
44 ** - ELSE (means we are accessing a hastable)
45 **      -> Return all indexes as Vector : nb_columns = 1.
46 */
47
48 char **TCL_ArrayDim(Tcl_Interp *TCLinterpreter, char *VarName, int *nb_lines, int *nb_columns)
49 {
50     char **index_list = NULL;
51
52     if (strcmp(VarName, TCL_ALL_INDEXES) && strcmp(VarName, TCL_NUMERICAL_INDEXES))
53     {
54         char MyTclCommand[2048];
55         char *StrArrayIndexes = NULL;
56         char *NumArrayIndexes = NULL;
57
58         /*
59         ** TCL Array are Hashtable
60         ** Get all keys into TCL_ALL_INDEXES
61         */
62         sprintf(MyTclCommand, "set %s [lsort -dictionary [array names %s *]];", TCL_ALL_INDEXES, VarName);
63
64         if ( Tcl_Eval(TCLinterpreter, MyTclCommand) == TCL_ERROR  )
65         {
66             Scierror(999, _("Tcl Error : %s\n"), Tcl_GetStringResult(TCLinterpreter));
67             return 0;
68         }
69         /*
70         ** Look if keys are like [1-9][0-9]*,[1-9][0-9]*
71         ** And get it into TCL_NUMERICAL_INDEXES
72         */
73         sprintf(MyTclCommand, "set %s [lsort -dictionary [array names %s -regexp {^[1-9][0-9]*,[1-9][0-9]*$}]];", TCL_NUMERICAL_INDEXES, VarName);
74
75         if ( Tcl_Eval(TCLinterpreter, MyTclCommand) == TCL_ERROR  )
76         {
77             Scierror(999, _("Tcl Error : %s\n"), Tcl_GetStringResult(TCLinterpreter));
78             return 0;
79         }
80
81
82         StrArrayIndexes = (char *) Tcl_GetVar(TCLinterpreter, TCL_ALL_INDEXES, TCL_GLOBAL_ONLY);
83         NumArrayIndexes = (char *) Tcl_GetVar(TCLinterpreter, TCL_NUMERICAL_INDEXES, TCL_GLOBAL_ONLY);
84
85         if (!StrArrayIndexes)
86         {
87             return NULL;
88         }
89
90         /*
91         ** Look if all indexes are numerical or not
92         */
93         if (strlen(StrArrayIndexes) == strlen(NumArrayIndexes))
94         {
95             char *current;
96             char **tmp_list = NULL;
97             int j , i = 0;
98             int current_line = 0;
99             int current_column = 0;
100
101             current = strtok(StrArrayIndexes, " ");
102
103             /*
104             ** Get all known indexes
105             */
106             while (current != NULL)
107             {
108                 tmp_list = REALLOC(tmp_list, (i + 1) * sizeof(char *));
109                 tmp_list[i] = os_strdup(current);
110                 sscanf(current, "%d,%d", &current_line, &current_column);
111                 *nb_lines = MAX(*nb_lines, current_line);
112                 *nb_columns = MAX(*nb_columns, current_column);
113                 current = strtok (NULL, " ");
114                 ++i;
115             }
116
117             /*
118             ** Create a complete list of NULL and insert only index we found at the right place
119             */
120             index_list = MALLOC(*nb_lines * *nb_columns * sizeof(char *));
121             for (j = 0; j < *nb_lines * *nb_columns ; ++j)
122             {
123                 index_list[j] = NULL;
124             }
125             for (j = 0; j < i ; ++j)
126             {
127                 sscanf(tmp_list[j], "%d,%d", &current_line, &current_column);
128                 index_list[(current_column - 1) * *nb_lines + current_line - 1] = tmp_list[j];
129             }
130             FREE(tmp_list);
131         }
132         else
133         {
134             /*
135             ** We found an Hastable...
136             ** Then return a Vector of index.
137             */
138             char *current;
139             *nb_lines = 0;
140             *nb_columns = 1;
141
142             current = strtok(StrArrayIndexes, " ");
143
144             while (current != NULL)
145             {
146                 index_list = REALLOC(index_list, (*nb_lines + 1) * sizeof(char *));
147                 index_list[*nb_lines] = os_strdup(current);
148                 current = strtok (NULL, " ");
149                 ++(*nb_lines);
150             }
151         }
152
153         /*
154         ** Unset temporary TCL Variables
155         */
156         Tcl_UnsetVar(TCLinterpreter, TCL_ALL_INDEXES, TCL_GLOBAL_ONLY);
157         Tcl_UnsetVar(TCLinterpreter, TCL_NUMERICAL_INDEXES, TCL_GLOBAL_ONLY);
158     }
159     return index_list;
160 }
161 /*--------------------------------------------------------------------------*/