the return of call 98/17598/4
Antoine ELIAS [Mon, 28 Dec 2015 09:12:57 +0000 (10:12 +0100)]
Change-Id: I12f3c031df56f32bb7ce87ec98731f35d15a64c6

15 files changed:
scilab/modules/ast/Makefile.in
scilab/modules/dynamic_link/Makefile.am
scilab/modules/dynamic_link/Makefile.in
scilab/modules/dynamic_link/includes/gw_dynamic_link.h
scilab/modules/dynamic_link/sci_gateway/cpp/dynamic_link_gw.cpp
scilab/modules/dynamic_link/sci_gateway/cpp/dynamic_link_gw.vcxproj
scilab/modules/dynamic_link/sci_gateway/cpp/dynamic_link_gw.vcxproj.filters
scilab/modules/dynamic_link/sci_gateway/cpp/sci_call.cpp [new file with mode: 0644]
scilab/modules/dynamic_link/tests/nonreg_tests/bug_3647.dia.ref
scilab/modules/dynamic_link/tests/nonreg_tests/bug_3647.tst
scilab/modules/dynamic_link/tests/nonreg_tests/bug_4606.dia.ref
scilab/modules/dynamic_link/tests/nonreg_tests/bug_4606.tst
scilab/modules/dynamic_link/tests/unit_tests/call.dia.ref
scilab/modules/dynamic_link/tests/unit_tests/externals.f
scilab/modules/dynamic_link/tests/unit_tests/links.tst

index 6274268..cd4d106 100644 (file)
@@ -977,7 +977,6 @@ pdfdir = @pdfdir@
 prefix = @prefix@
 program_transform_name = @program_transform_name@
 psdir = @psdir@
-runstatedir = @runstatedir@
 sbindir = @sbindir@
 sharedstatedir = @sharedstatedir@
 srcdir = @srcdir@
index 4d6a03e..3222b76 100644 (file)
@@ -14,9 +14,6 @@ DYNAMIC_LINK_CPP_SOURCES = \
     src/cpp/dynamic_link.cpp \
     src/cpp/addinter.cpp
 
-#GATEWAY_C_SOURCES = \
-#    sci_gateway/c/sci_call.c
-
 GATEWAY_CPP_SOURCES = \
     sci_gateway/cpp/dynamic_link_gw.cpp \
     sci_gateway/cpp/sci_link.cpp \
@@ -24,7 +21,8 @@ GATEWAY_CPP_SOURCES = \
     sci_gateway/cpp/sci_ulink.cpp \
     sci_gateway/cpp/sci_ilib_verbose.cpp \
     sci_gateway/cpp/sci_getdynlibext.cpp \
-    sci_gateway/cpp/sci_addinter.cpp
+    sci_gateway/cpp/sci_addinter.cpp \
+    sci_gateway/cpp/sci_call.cpp
 
 libscidynamic_link_la_CPPFLAGS = \
        -I$(srcdir)/includes/ \
index 09f74a4..d411704 100644 (file)
@@ -203,7 +203,8 @@ am__objects_3 =  \
        sci_gateway/cpp/libscidynamic_link_la-sci_ulink.lo \
        sci_gateway/cpp/libscidynamic_link_la-sci_ilib_verbose.lo \
        sci_gateway/cpp/libscidynamic_link_la-sci_getdynlibext.lo \
-       sci_gateway/cpp/libscidynamic_link_la-sci_addinter.lo
+       sci_gateway/cpp/libscidynamic_link_la-sci_addinter.lo \
+       sci_gateway/cpp/libscidynamic_link_la-sci_call.lo
 am_libscidynamic_link_la_OBJECTS = $(am__objects_3)
 libscidynamic_link_la_OBJECTS = $(am_libscidynamic_link_la_OBJECTS)
 @MAINTAINER_MODE_FALSE@am_libscidynamic_link_la_rpath =
@@ -597,9 +598,6 @@ DYNAMIC_LINK_CPP_SOURCES = \
     src/cpp/dynamic_link.cpp \
     src/cpp/addinter.cpp
 
-
-#GATEWAY_C_SOURCES = \
-#    sci_gateway/c/sci_call.c
 GATEWAY_CPP_SOURCES = \
     sci_gateway/cpp/dynamic_link_gw.cpp \
     sci_gateway/cpp/sci_link.cpp \
@@ -607,7 +605,8 @@ GATEWAY_CPP_SOURCES = \
     sci_gateway/cpp/sci_ulink.cpp \
     sci_gateway/cpp/sci_ilib_verbose.cpp \
     sci_gateway/cpp/sci_getdynlibext.cpp \
-    sci_gateway/cpp/sci_addinter.cpp
+    sci_gateway/cpp/sci_addinter.cpp \
+    sci_gateway/cpp/sci_call.cpp
 
 libscidynamic_link_la_CPPFLAGS = \
        -I$(srcdir)/includes/ \
@@ -897,6 +896,9 @@ sci_gateway/cpp/libscidynamic_link_la-sci_getdynlibext.lo:  \
 sci_gateway/cpp/libscidynamic_link_la-sci_addinter.lo:  \
        sci_gateway/cpp/$(am__dirstamp) \
        sci_gateway/cpp/$(DEPDIR)/$(am__dirstamp)
+sci_gateway/cpp/libscidynamic_link_la-sci_call.lo:  \
+       sci_gateway/cpp/$(am__dirstamp) \
+       sci_gateway/cpp/$(DEPDIR)/$(am__dirstamp)
 
 libscidynamic_link.la: $(libscidynamic_link_la_OBJECTS) $(libscidynamic_link_la_DEPENDENCIES) $(EXTRA_libscidynamic_link_la_DEPENDENCIES) 
        $(AM_V_CXXLD)$(CXXLINK) $(am_libscidynamic_link_la_rpath) $(libscidynamic_link_la_OBJECTS) $(libscidynamic_link_la_LIBADD) $(LIBS)
@@ -951,6 +953,7 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscidynamic_link_la-dynamic_link_gw.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscidynamic_link_la-sci_addinter.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscidynamic_link_la-sci_c_link.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscidynamic_link_la-sci_call.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscidynamic_link_la-sci_getdynlibext.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscidynamic_link_la-sci_ilib_verbose.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscidynamic_link_la-sci_link.Plo@am__quote@
@@ -1101,6 +1104,13 @@ sci_gateway/cpp/libscidynamic_link_la-sci_addinter.lo: sci_gateway/cpp/sci_addin
 @AMDEP_TRUE@@am__fastdepCXX_FALSE@     DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libscidynamic_link_la_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) -c -o sci_gateway/cpp/libscidynamic_link_la-sci_addinter.lo `test -f 'sci_gateway/cpp/sci_addinter.cpp' || echo '$(srcdir)/'`sci_gateway/cpp/sci_addinter.cpp
 
+sci_gateway/cpp/libscidynamic_link_la-sci_call.lo: sci_gateway/cpp/sci_call.cpp
+@am__fastdepCXX_TRUE@  $(AM_V_CXX)$(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libscidynamic_link_la_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) -MT sci_gateway/cpp/libscidynamic_link_la-sci_call.lo -MD -MP -MF sci_gateway/cpp/$(DEPDIR)/libscidynamic_link_la-sci_call.Tpo -c -o sci_gateway/cpp/libscidynamic_link_la-sci_call.lo `test -f 'sci_gateway/cpp/sci_call.cpp' || echo '$(srcdir)/'`sci_gateway/cpp/sci_call.cpp
+@am__fastdepCXX_TRUE@  $(AM_V_at)$(am__mv) sci_gateway/cpp/$(DEPDIR)/libscidynamic_link_la-sci_call.Tpo sci_gateway/cpp/$(DEPDIR)/libscidynamic_link_la-sci_call.Plo
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@     $(AM_V_CXX)source='sci_gateway/cpp/sci_call.cpp' object='sci_gateway/cpp/libscidynamic_link_la-sci_call.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@     DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libscidynamic_link_la_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) -c -o sci_gateway/cpp/libscidynamic_link_la-sci_call.lo `test -f 'sci_gateway/cpp/sci_call.cpp' || echo '$(srcdir)/'`sci_gateway/cpp/sci_call.cpp
+
 mostlyclean-libtool:
        -rm -f *.lo
 
index 4918386..7fe5054 100644 (file)
 #ifndef __GW_DYNAMIC_LINK__
 #define __GW_DYNAMIC_LINK__
 
-#include "dynlib_dynamic_link.h"
-/*--------------------------------------------------------------------------*/
-DYNAMIC_LINK_IMPEXP int gw_dynamic_link(void);
+#include "dynlib_dynamic_link_gw.h"
+#include "c_gateway_prototype.h"
+
 /*--------------------------------------------------------------------------*/
 /* Declaration of all the profile function declared and */
 /* used in sci_gateway */
 /*--------------------------------------------------------------------------*/
-DYNAMIC_LINK_IMPEXP int sci_fort(char *fname, unsigned long fname_len);
-DYNAMIC_LINK_IMPEXP int sci_call(char *fname, unsigned long fname_len);
+DYNAMIC_LINK_GW_IMPEXP int sci_fort(char *fname, unsigned long fname_len);
+DYNAMIC_LINK_GW_IMPEXP  C_GATEWAY_PROTOTYPE(sci_call);
 
 #endif /* __GW_DYNAMIC_LINK__ */
 /*--------------------------------------------------------------------------*/
index d2494d9..a8b9dba 100644 (file)
@@ -28,5 +28,6 @@ int DynamicLinkModule::Load()
     symbol::Context::getInstance()->addFunction(types::Function::createFunction(L"c_link", &sci_c_link, MODULE_NAME));
     symbol::Context::getInstance()->addFunction(types::Function::createFunction(L"ilib_verbose", &sci_ilib_verbose, MODULE_NAME));
     symbol::Context::getInstance()->addFunction(types::Function::createFunction(L"addinter", &sci_addinter, MODULE_NAME));
+    symbol::Context::getInstance()->addFunction(types::Function::createFunction(L"call", &sci_call, MODULE_NAME));
     return 1;
 }
index 1e9665f..4dc8559 100644 (file)
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
 <Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
   <ItemGroup Label="ProjectConfigurations">
     <ProjectConfiguration Include="Debug|Win32">
   <ItemGroup>
     <ClCompile Include="dynamic_link_gw.cpp" />
     <ClCompile Include="sci_addinter.cpp" />
+    <ClCompile Include="sci_call.cpp" />
     <ClCompile Include="sci_c_link.cpp" />
     <ClCompile Include="sci_getdynlibext.cpp" />
     <ClCompile Include="sci_ilib_verbose.cpp" />
index 0f74aeb..6c30ed8 100644 (file)
@@ -35,6 +35,9 @@
     <ClCompile Include="sci_addinter.cpp">
       <Filter>Source Files</Filter>
     </ClCompile>
+    <ClCompile Include="sci_call.cpp">
+      <Filter>Source Files</Filter>
+    </ClCompile>
   </ItemGroup>
   <ItemGroup>
     <ClInclude Include="..\..\includes\dynamic_link_gw.hxx">
diff --git a/scilab/modules/dynamic_link/sci_gateway/cpp/sci_call.cpp b/scilab/modules/dynamic_link/sci_gateway/cpp/sci_call.cpp
new file mode 100644 (file)
index 0000000..517e095
--- /dev/null
@@ -0,0 +1,392 @@
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) Scilab Enterprises - 2015 - Antoine ELIAS
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution.  The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+#include <vector>
+#include "api_scilab.h"
+#include "configvariable.hxx"
+
+extern "C"
+{
+#include "gw_dynamic_link.h"
+#include "Scierror.h"
+#include "localization.h"
+}
+
+bool isOut(scilabEnv env, scilabVar var);
+
+typedef void(*fct)(void* p0, void* p1, void* p2, void* p3, void* p4, void* p5, void* p6, void* p7, void* p8, void* p9,
+                   void* p10, void* p11, void* p12, void* p13, void* p14, void* p15, void* p16, void* p17, void* p18, void* p19,
+                   void* p20, void* p21, void* p22, void* p23, void* p24, void* p25, void* p26, void* p27, void* p28, void* p29);
+
+
+struct Parameter
+{
+    Parameter() : data(nullptr), type(L'\0'), alloc(false), row(0), col(0) {}
+    ~Parameter()
+    {
+        if (alloc)
+        {
+            free(data);
+        }
+    }
+
+    void* data;
+    wchar_t type;
+    bool alloc;
+    int row;
+    int col;
+};
+
+static const char fname[] = "call";
+
+int sci_call(scilabEnv env, int nin, scilabVar* in, int nopt, scilabOpt opt, int nout, scilabVar* out)
+{
+    std::vector<Parameter> params(30);
+    std::vector<int> output_order(nout);
+    wchar_t* interf = NULL;
+    if (nin < 1)
+    {
+        Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), fname, 1);
+        return 1;
+    }
+
+    //1st is the interface name
+    if (scilab_isString(env, in[0]) == 0 || scilab_isScalar(env, in[0]) == 0)
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
+        return 1;
+    }
+
+    scilab_getString(env, in[0], &interf);
+
+    ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(interf);
+    if (func == NULL)
+    {
+        Scierror(999, _("%s: unable to find entry point %ls.\n"), fname, interf);
+        return 1;
+    }
+
+    int pos = 1;
+    bool hasOutputs = true;
+    //inputs
+    while (1)
+    {
+        //check "out" to break loop
+        if (isOut(env, in[pos]))
+        {
+            hasOutputs = true;
+            break;
+        }
+
+        if (pos > nin)
+        {
+            break;
+        }
+
+        int type = 0;
+        if (nin < pos + 2)
+        {
+            Scierror(77, _("%s: Wrong number of input argument(s).\n"), fname);
+            return 1;
+        }
+
+        type = scilab_getType(env, in[pos]);
+        if (type != sci_matrix && type != sci_strings)
+        {
+            Scierror(77, _("%s: Wrong type for input argument #%d: A real matrix or a string expected.\n"), fname, pos + 1);
+            return 1;
+        }
+
+        //data
+
+        //position
+        if (scilab_isDouble(env, in[pos + 1]) == 0 || scilab_isScalar(env, in[pos + 1]) == 0)
+        {
+            Scierror(77, _("%s: Wrong type for input argument #%d : A real scalar expected.\n"), fname, pos + 2);
+            return 1;
+        }
+
+        double param_pos = 0;
+        scilab_getDouble(env, in[pos + 1], &param_pos);
+
+        //type
+        if (scilab_isString(env, in[pos + 2]) == 0 || scilab_isScalar(env, in[pos + 2]) == 0)
+        {
+            Scierror(77, _("%s: Wrong type for input argument #%d : string expected.\n"), fname, pos + 3);
+            return 1;
+        }
+
+        void* data = NULL;
+        int row = 0;
+        int col = 0;
+
+        wchar_t* param_type = NULL;
+        scilab_getString(env, in[pos + 2], &param_type);
+
+        if (param_type[0] == L'c' || type == sci_strings)
+        {
+            if (param_type[0] != L'c' || type != sci_strings)
+            {
+                Scierror(77, _("%s: Wrong type for input argument #%d : string expected.\n"), fname, pos + 1);
+                return 1;
+            }
+        }
+        else
+        {
+            if (type != sci_matrix)
+            {
+                Scierror(77, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), fname, pos + 1);
+                return 1;
+            }
+        }
+
+        bool alloc = false;
+        switch (param_type[0])
+        {
+            case L'c':
+            {
+                wchar_t* strs = NULL;
+                scilab_getString(env, in[pos], &strs);
+                char* c = wide_string_to_UTF8(strs);
+                data = c;
+                alloc = true;
+                break;
+            }
+            case L'd':
+            {
+                double* dbls = NULL;
+                scilab_getDoubleArray(env, in[pos], &dbls);
+                data = dbls;
+                break;
+            }
+            case L'r':
+            {
+                double* dbls = NULL;
+                int size = scilab_getSize(env, in[pos]);
+                scilab_getDoubleArray(env, in[pos], &dbls);
+                float* f = (float*)malloc(size * sizeof(float));
+                for (int i = 0; i < size; ++i)
+                {
+                    f[i] = (float)dbls[i];
+                }
+
+                data = f;
+                alloc = true;
+                break;
+            }
+            case L'i':
+            {
+                double* dbls = NULL;
+                int size = scilab_getSize(env, in[pos]);
+                scilab_getDoubleArray(env, in[pos], &dbls);
+                int* ints = (int*)malloc(size * sizeof(int));
+                for (int i = 0; i < size; ++i)
+                {
+                    ints[i] = (int)dbls[i];
+                }
+
+                data = ints;
+                alloc = true;
+                break;
+            }
+            default:
+            {
+                Scierror(77, _("%s: Wrong value for input argument #%d: '%s', '%s', '%s' or '%s' expected.\n"), fname, pos + 3, "d", "r", "i", "c");
+                return 1;
+            }
+        }
+
+        scilab_getDim2d(env, in[pos], &row, &col);
+
+        Parameter& p = params[(int)param_pos - 1];
+        p.alloc = alloc;
+        p.data = data;
+        p.row = row;
+        p.col = col;
+        p.type = param_type[0];
+
+        pos += 3;
+    }
+
+    int output_pos = 0;
+    //outputs
+    if (hasOutputs)
+    {
+        ++pos; //avoid "out"
+        while (1)
+        {
+            //check if is 3 or 1 arg ...
+            if (scilab_isDouble(env, in[pos]) == 0)
+            {
+                Scierror(77, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), fname, pos + 1);
+                return 1;
+            }
+
+            if (scilab_isScalar(env, in[pos]))
+            {
+                double dorder = 0;
+                scilab_getDouble(env, in[pos], &dorder);
+                int order = (int)dorder;
+                if (params[order - 1].data == nullptr)
+                {
+                    Scierror(77, _("%s: Wrong value for input argument #%d.\n"), fname, pos + 1);
+                    return 1;
+                }
+
+                pos += 1;
+                output_order[output_pos] = order - 1;
+            }
+            else
+            {
+                //dims
+                double* dims = 0;
+                scilab_getDoubleArray(env, in[pos], &dims);
+                int size = (int)dims[0] * (int)dims[1];
+
+                //pos
+                if (scilab_isDouble(env, in[pos + 1]) == 0 || scilab_isScalar(env, in[pos + 1]) == 0)
+                {
+                    Scierror(77, _("%s: Wrong type for input argument #%d : A real scalar expected.\n"), fname, pos + 2);
+                    return 1;
+                }
+
+                double param_pos = 0;
+                scilab_getDouble(env, in[pos + 1], &param_pos);
+
+                //type
+                if (scilab_isString(env, in[pos + 2]) == 0 || scilab_isScalar(env, in[pos + 2]) == 0)
+                {
+                    Scierror(77, _("%s: Wrong type for input argument #%d : string expected.\n"), fname, pos + 3);
+                    return 1;
+                }
+
+                wchar_t* param_type = NULL;
+                scilab_getString(env, in[pos + 2], &param_type);
+
+                void* data = NULL;
+
+                switch (param_type[0])
+                {
+                    case L'c':
+                    {
+                        data = malloc((size + 1) * sizeof(char));
+                        break;
+                    }
+                    case L'd':
+                    {
+                        data = malloc(size * sizeof(double));
+                        break;
+                    }
+                    case L'r':
+                    {
+                        data = malloc(size * sizeof(float));
+                        break;
+                    }
+                    case L'i':
+                    {
+                        data = malloc(size * sizeof(int));
+                        break;
+                    }
+                }
+                Parameter& p = params[(int)param_pos - 1];
+                p.row = (int)dims[0];
+                p.col = (int)dims[1];
+                p.alloc = true;
+                p.type = param_type[0];
+                p.data = data;
+                pos += 3;
+                output_order[output_pos] = (int)param_pos - 1;
+            }
+
+            ++output_pos;
+
+            if (pos + 1 > nin)
+            {
+                break;
+            }
+        }
+
+    }
+    //the unbelievable call !
+    ((fct)func->functionPtr)(params[0].data, params[1].data, params[2].data, params[3].data, params[4].data, params[5].data, params[6].data, params[7].data, params[8].data, params[9].data,
+                             params[10].data, params[11].data, params[12].data, params[13].data, params[14].data, params[15].data, params[16].data, params[17].data, params[18].data, params[19].data,
+                             params[20].data, params[21].data, params[22].data, params[23].data, params[24].data, params[25].data, params[26].data, params[27].data, params[28].data, params[29].data);
+
+    //create output variables
+    for (int i = 0; i < nout; ++i)
+    {
+        Parameter& p = params[output_order[i]];
+
+        switch (p.type)
+        {
+            case L'c':
+            {
+                wchar_t* w = to_wide_string((char*)p.data);
+                scilabVar var = scilab_createString(env, w);
+                out[i] = var;
+                FREE(w);
+                break;
+            }
+            case L'd':
+            {
+                scilabVar var = scilab_createDoubleMatrix2d(env, p.row, p.col, 0);
+                scilab_setDoubleArray(env, var, (double*)p.data);
+                out[i] = var;
+                break;
+            }
+            case L'r':
+            {
+                double* d = NULL;
+                scilabVar var = scilab_createDoubleMatrix2d(env, p.row, p.col, 0);
+                scilab_getDoubleArray(env, var, &d);
+                int size = p.row * p.col;
+                for (int j = 0; j < size; ++j)
+                {
+                    d[j] = (double)((float*)p.data)[j];
+                }
+
+                out[i] = var;
+                break;
+            }
+            case L'i':
+            {
+                double* d = NULL;
+                scilabVar var = scilab_createDoubleMatrix2d(env, p.row, p.col, 0);
+                scilab_getDoubleArray(env, var, &d);
+                int size = p.row * p.col;
+                for (int j = 0; j < size; ++j)
+                {
+                    d[j] = (double)((int*)p.data)[j];
+                }
+
+                out[i] = var;
+                break;
+            }
+        }
+    }
+    return STATUS_OK;
+}
+
+bool isOut(scilabEnv env, scilabVar var)
+{
+    if (scilab_isString(env, var) && scilab_isScalar(env, var))
+    {
+        wchar_t* strs = NULL;
+        scilab_getString(env, var, &strs);
+        if (wcscmp(strs, L"out") == 0 || wcscmp(strs, L"sort") == 0)
+        {
+            return true;
+        }
+    }
+
+    return false;
+}
index e954298..5cf6842 100644 (file)
@@ -4,8 +4,10 @@
 //
 //  This file is distributed under the same license as the Scilab package.
 // =============================================================================
+//
 // <-- ENGLISH IMPOSED -->
 // <-- CLI SHELL MODE -->
+//
 // <-- Non-regression test for bug 3647 -->
 //
 // <-- Bugzilla URL -->
 // <-- Short Description -->
 // C functions having more than 23 characters are not usable with scilab
 ilib_verbose(0);
-foo=['void verylongfunctionnamewithmore24characters(double *a,double *b,double *c)';
-     '{ *c = *a + *b; }'  ];
+foo=["void verylongfunctionnamewithmore24characters(double *a,double *b,double *c)";
+"{ *c = *a + *b; }"  ];
 // we use TMPDIR for compilation
-       
-if ~c_link('foo') then
-  curPath = pwd();
-  chdir(TMPDIR);
-  mputl(foo,'foo.c');
-  ilib_for_link(['verylongfunctionnamewithmore24characters'],'foo.c',[],"c");
-  // load the shared library
-  exec loader.sce ;
-  chdir(curPath) ;
-end    
+if ~c_link("foo") then
+    curPath = pwd();
+    chdir(TMPDIR);
+    mputl(foo,"foo.c");
+    ilib_for_link(["verylongfunctionnamewithmore24characters"],"foo.c",[],"c");
+    // load the shared library
+    exec loader.sce ;
+    chdir(curPath) ;
+end
 //5+7 by C function
-v = call('verylongfunctionnamewithmore24characters',5,1,'d',7,2,'d','out',[1,1],3,'d');
+v = call("verylongfunctionnamewithmore24characters",5,1,"d",7,2,"d","out",[1,1],3,"d");
 if v <> 12 then bugmes();quit;end
 //================================================
index 9bb928e..165e874 100644 (file)
@@ -4,11 +4,10 @@
 //
 //  This file is distributed under the same license as the Scilab package.
 // =============================================================================
-// <-- NOT FIXED -->
-
+//
 // <-- ENGLISH IMPOSED -->
 // <-- CLI SHELL MODE -->
-
+//
 // <-- Non-regression test for bug 3647 -->
 //
 // <-- Bugzilla URL -->
 
 ilib_verbose(0);
 
-foo=['void verylongfunctionnamewithmore24characters(double *a,double *b,double *c)';
-     '{ *c = *a + *b; }'  ];
+foo=["void verylongfunctionnamewithmore24characters(double *a,double *b,double *c)";
+"{ *c = *a + *b; }"  ];
+
+// we use TMPDIR for compilation
+
+if ~c_link("foo") then
+    curPath = pwd();
+    chdir(TMPDIR);
+    mputl(foo,"foo.c");
+
+    ilib_for_link(["verylongfunctionnamewithmore24characters"],"foo.c",[],"c");
 
-// we use TMPDIR for compilation 
-       
-if ~c_link('foo') then
-  curPath = pwd(); 
-  chdir(TMPDIR); 
-  mputl(foo,'foo.c');
-  
-  ilib_for_link(['verylongfunctionnamewithmore24characters'],'foo.c',[],"c");
-  
-  // load the shared library 
-  exec loader.sce ;
-  chdir(curPath) ;
-end    
+    // load the shared library
+    exec loader.sce ;
+    chdir(curPath) ;
+end
 
 //5+7 by C function
-v = call('verylongfunctionnamewithmore24characters',5,1,'d',7,2,'d','out',[1,1],3,'d');
+v = call("verylongfunctionnamewithmore24characters",5,1,"d",7,2,"d","out",[1,1],3,"d");
 if v <> 12 then pause,end
 //================================================
index ebfa938..8bd4ff3 100644 (file)
 ilib_verbose(0);
 chdir(TMPDIR);
 //Example of the use of ilib_for_link with  a simple C code
-f1=['#include <math.h>'
-    'void fooc(double c[],double a[],double *b,int *m,int *n)'
-    '{'
-    '   int i;'
-    '   for ( i =0 ; i < (*m)*(*n) ; i++) '
-    '     c[i] = sin(a[i]) + *b; '
-    '}'];
- mputl(f1,'fooc.c');
-//creating the shared library: a Makefile and a loader are 
+f1=["#include <math.h>"
+"void fooc(double c[],double a[],double *b,int *m,int *n)"
+"{"
+"   int i;"
+"   for ( i =0 ; i < (*m)*(*n) ; i++) "
+"     c[i] = sin(a[i]) + *b; "
+"}"];
+mputl(f1,"fooc.c");
+//creating the shared library: a Makefile and a loader are
 //generated, the code is compiled and a shared library built.
-ilib_for_link('fooc','fooc.c',[],"c");
-exec('loader.sce');
+ilib_for_link("fooc","fooc.c",[],"c");
+exec("loader.sce");
 // call the new linked entry point
 a=linspace(0,%pi,10);
 b=5;
-y1=call('fooc',a,2,'d',b,3,'d',size(a,1),4,'i',size(a,2),5,'i','out',size(a),1,'d');
-y1-(sin(a)+b);
-exec('cleaner.sce');
+y1=call("fooc",a,2,"d",b,3,"d",size(a,1),4,"i",size(a,2),5,"i","out",size(a),1,"d");
+assert_checkalmostequal(y1, sin(a) + b);
+exec("cleaner.sce");
index 0667087..4c0d759 100644 (file)
 ilib_verbose(0);
 chdir(TMPDIR);
 //Example of the use of ilib_for_link with  a simple C code
-f1=['#include <math.h>'
-    'void fooc(double c[],double a[],double *b,int *m,int *n)'
-    '{'
-    '   int i;'
-    '   for ( i =0 ; i < (*m)*(*n) ; i++) '
-    '     c[i] = sin(a[i]) + *b; '
-    '}'];
+f1=["#include <math.h>"
+"void fooc(double c[],double a[],double *b,int *m,int *n)"
+"{"
+"   int i;"
+"   for ( i =0 ; i < (*m)*(*n) ; i++) "
+"     c[i] = sin(a[i]) + *b; "
+"}"];
 
- mputl(f1,'fooc.c');
+mputl(f1,"fooc.c");
 
-//creating the shared library: a Makefile and a loader are 
+//creating the shared library: a Makefile and a loader are
 //generated, the code is compiled and a shared library built.
-ilib_for_link('fooc','fooc.c',[],"c");
-exec('loader.sce');
+ilib_for_link("fooc","fooc.c",[],"c");
+exec("loader.sce");
 // call the new linked entry point
 a=linspace(0,%pi,10);
 b=5;
-y1=call('fooc',a,2,'d',b,3,'d',size(a,1),4,'i',size(a,2),5,'i','out',size(a),1,'d');
-y1-(sin(a)+b);
-exec('cleaner.sce');
\ No newline at end of file
+y1=call("fooc",a,2,"d",b,3,"d",size(a,1),4,"i",size(a,2),5,"i","out",size(a),1,"d");
+assert_checkalmostequal(y1, sin(a) + b);
+exec("cleaner.sce");
\ No newline at end of file
index 0972e56..5445b85 100644 (file)
@@ -12,17 +12,17 @@ ilib_verbose(0);
 //================================================
 foo=['void foo(double *a,double *b,double *c)';
      '{ *c = *a + *b; }'  ];
-// we use TMPDIR for compilation
-       
+// we use TMPDIR for compilation 
 if ~c_link('foo') then
-  curPath = pwd();
-  chdir(TMPDIR);
+  curPath = pwd(); 
+  chdir(TMPDIR); 
   mputl(foo,'foo.c');
+  
   ilib_for_link(['foo'],'foo.c',[],"c");
-  // load the shared library
+  // load the shared library 
   exec loader.sce ;
   chdir(curPath) ;
-end    
+end
 //5+7 by C function
 v = call('foo',5,1,'d',7,2,'d','out',[1,1],3,'d');
 if v <> 12 then bugmes();quit;end
index 07bf972..23dec12 100644 (file)
@@ -51,109 +51,6 @@ c     -------------------------------------
       return
       end
 c      
-c     -------------------------------------------
-      subroutine ext4f(n,a,b,c)
-c     -------------------------------------------      
-c     example 4 (reading a chain)
-c     -->link('ext4f.o','ext4f');
-c     -->a=[1,2,3];b=[4,5,6];n=3;yes='yes'
-c     -->c=call('ext4f',n,1,'i',a,2,'d',b,3,'d','out',[1,3],4,'d')
-c     -->c=sin(a)+cos(b)
-c     -->yes='no'
-c     -->c=a+b
-c     -->clear yes  --> undefined variable : yes
-      double precision a(*),b(*),c(*)
-      logical creadchain
-      parameter (ichmax=10)
-      character ch*(ichmax)
-
-c     If chain named yes exists reads it in ch else return
-      lch=ichmax
-      if(.not.creadchain('yes'//char(0),lch,ch)) return
-c     *********************************     
-      if(ch(1:lch).eq.'yes') then
-         do 1 k=1,n
-            c(k)=sin(a(k))+cos(b(k))
- 1       continue
-      else
-         do 2 k=1,n
-            c(k)=a(k)+b(k)
- 2       continue
-      endif
-      return
-      end
-c      
-c     -------------------------------------------      
-      subroutine ext5f(b,c)
-c     -------------------------------------------      
-c     example 5
-c     reading a vector in scilab internal stack using creadmat
-c     (see SCIDIR/system2/creadmat.f)
-c     -->link('ext5f.o','ext5f')
-c     -->a=[1,2,3];b=[2,3,4];
-c     -->c=call('ext5f',b,1,'d','out',[1,3],2,'d')
-c     -->c=a+2*b
-      double precision a(3),b(*),c(*)
-      logical creadmat
-
-c     If 'a' exists reads it else return
-      if(.not.creadmat('a'//char(0),m,n,a)) then
-         write(6,*) 'ext5', m,n,a(1),a(2),a(3)
-         return
-      endif
-      do 1 k=1,n
-         c(k)=a(k)+2.0d0*b(k)
- 1    continue
-      return
-      end
-c      
-c     -------------------------------------------      
-      subroutine ext6f(aname,b,c)
-c     -------------------------------------------      
-c     example 6
-c     reading a vector in scilab internal stack using creadmat interface
-c     -->link('ext6f.o','ext6f')
-c     -->a=[1,2,3];b=[2,3,4];
-c     -->c=call('ext6f','a',1,'c',b,2,'d','out',[1,3],3,'d')
-c     -->c=a+2*b
-      double precision a(3),b(*),c(*)
-      logical creadmat
-      character*(*) aname
-
-c     If aname exists reads it (in a) else return
-      if(.not.creadmat(aname,m,n,a)) return
-c     
-c     [m,n]=size(a)  here m=1 n=3
-      do 1 k=1,n
-         c(k)=a(k)+2.0d0*b(k)
- 1    continue
-      return
-      end
-c      
-c     -------------------------------------------      
-      subroutine ext7f(a,b)
-c     -------------------------------------------      
-c     example 7
-c     creating vector c in scilab internal stack
-c     -->link('ext7f.o','ext7f')
-c     -->a=[1,2,3]; b=[2,3,4];
-c     c does not exist (c made by the call to matz)
-c     -->call('ext7f',a,1,'d',b,2,'d','out',1);
-c     c now exists
-c     -->c=a+2*b
-      double precision a(3),b(3),c(3),w
-      logical cwritemat,cwritechain
-      do 1 k=1,3
-         c(k)=a(k)+2.0d0*b(k)
- 1    continue
-c     sending c array values to c Scilab variable 
-c     of size [1,3]
-      if (.not.cwritemat('c'//char(0),1,3,c)) return
-c     sending string 'test' (size 4) to Scilab variable d
-      if (.not.cwritechain('d'//char(0),4,'test')) return
-      return
-      end
-c      
 c     -------------------------------------------      
       subroutine ext8f(n, t, y, ydot)
 c     -------------------------------------------      
@@ -222,40 +119,18 @@ c
       ydot(2) = -ydot(1) - ydot(3)
       end
 c
-c     -------------------------------------------      
-      subroutine ext10f(neq, t, y, ydot)
 c     -------------------------------------------
-c     exemple with a call to creadmat routine
-c     -->param=[0.04,10000,3d+7];
-c     -->link('ext10f.o','ext10f')
-c     -->y=ode([1;0;0],0,[0.4,4],'ext10f')
-c     param must be defined as a scilab variable
-      double precision t, y, ydot, param
-      logical creadmat
-      dimension y(3), ydot(3), param(3)
-
-c     If "param" does not exists return else loads param
-      if(.not.creadmat('param'//char(0),m,n,param)) return
-c     ***********************************
-
-      ydot(1) = -param(1)*y(1) + param(2)*y(2)*y(3)
-      ydot(3) = param(3)*y(2)*y(2)
-      ydot(2) = -ydot(1) - ydot(3)
-      return
-      end
-c      
-c     -------------------------------------------            
       subroutine ext11f(n,a)
-c     -------------------------------------------                  
+c     -------------------------------------------
       common/cmntest/b(10)
       real a(*)
       do 1 k=1,max(n,10)
  1       b(k)=a(k)
       end
-c      
-c     -------------------------------------------      
+c
+c     -------------------------------------------
       subroutine ext12f(n,c)
-c     -------------------------------------------      
+c     -------------------------------------------
       common/cmntest/b(10)
       real c(*)
       do 1 k=1,max(n,10)
index d802cea..1db22a8 100644 (file)
 
 ilib_verbose(0);
 
-curPath = pwd(); 
-pref='ext';
-suf='f';
-routines=[pref(ones(1,12))+string(1:12)+suf(ones(1,12))];
-copyfile(SCI+filesep()+'modules'+filesep()+'dynamic_link'+filesep()+'tests'+filesep()+'unit_tests'+filesep()+'externals.f', TMPDIR);
+curPath = pwd();
+pref="ext";
+suf="f";
+routines=["ext1f","ext2f","ext3f","ext8f","ext9f","ext11f","ext12f"];//[pref(ones(1,12))+string(1:12)+suf(ones(1,12))];
+copyfile(SCI+filesep()+"modules"+filesep()+"dynamic_link"+filesep()+"tests"+filesep()+"unit_tests"+filesep()+"externals.f", TMPDIR);
 chdir(TMPDIR);
-ilib_for_link(routines,'externals.f',[],"f");
+ilib_for_link(routines,"externals.f",[],"f");
 
-// load the shared library 
+// load the shared library
 exec loader.sce ;
 
 //===========================================================
 //(very) simple example 1
 //===========================================================
 a=[1,2,3];b=[4,5,6];n=3;
-c=call('ext1f',n,1,'i',a,2,'d',b,3,'d','out',[1,3],4,'d');
+c=call("ext1f",n,1,"i",a,2,"d",b,3,"d","out",[1,3],4,"d");
 if norm(c-(a+b)) > %eps then pause,end
 
 //===========================================================
 //Simple example #2
 //===========================================================
 a=[1,2,3];b=[4,5,6];n=3;
-c=call('ext2f',n,1,'i',a,2,'d',b,3,'d','out',[1,3],4,'d');
+c=call("ext2f",n,1,"i",a,2,"d",b,3,"d","out",[1,3],4,"d");
 if norm(c-(sin(a)+cos(b))) > %eps then pause,end
 
 //===========================================================
 //Example #3
 //===========================================================
 a=[1,2,3];b=[4,5,6];n=3;
-c=call('ext3f','yes',1,'c',n,2,'i',a,3,'d',b,4,'d','out',[1,3],5,'d');
+c=call("ext3f","yes",1,"c",n,2,"i",a,3,"d",b,4,"d","out",[1,3],5,"d");
 if norm(c-(sin(a)+cos(b)))> %eps then pause,end
-c=call('ext3f','no',1,'c',n,2,'i',a,3,'d',b,4,'d','out',[1,3],5,'d');
+c=call("ext3f","no",1,"c",n,2,"i",a,3,"d",b,4,"d","out",[1,3],5,"d");
 if norm(c-(a+b)) > %eps then pause,end
 
 //===========================================================
-//Example #4 
-//===========================================================
-a=[1,2,3];b=[4,5,6];n=3;yes='yes';
-c=call('ext4f',n,1,'i',a,2,'d',b,3,'d','out',[1,3],4,'d');
-if norm(c-(sin(a)+cos(b))) > %eps then pause,end
-yes='no';
-c=call('ext4f',n,1,'i',a,2,'d',b,3,'d','out',[1,3],4,'d');
-if norm(c-(a+b)) > %eps then pause,end
-//clear yes  --> undefined variable : yes
-
-//===========================================================
-//Example #5 
-//===========================================================
-// reading vector a in scilab internal stack
-a=[1,2,3];b=[2,3,4];
-c=call('ext5f',b,1,'d','out',[1,3],2,'d');
-if norm(c-(a+2*b)) > %eps then pause,end
-
-//===========================================================
-//Example #6
-//===========================================================
-//reading  vector with name='a' in scilab internal stack
-a=[1,2,3];b=[2,3,4];
-c=call('ext6f','a',1,'c',b,2,'d','out',[1,3],3,'d');
-if norm(c-(a+2*b)) > %eps then pause,end
-
-//===========================================================
-//Example #7
-//===========================================================
-//creating vector c in scilab internal stack
-clear c;
-a=[1,2,3]; b=[2,3,4];
-//c does not exist (c made by ext7f)
-c1=call('ext7f',a,1,'d',b,2,'d','out',2);
-if norm(c1-b) > %eps then pause,end
-//c now exists
-if norm(c-(a+2*b)) > %eps then pause,end
-//d exists 
-if d<>"test" then pause,end
-
-//===========================================================
 //Example #8
 //===========================================================
 //call ext8f argument function with dynamic link
-yref=ode([1;0;0],0,[0.4,4],'ext8f');
+yref=ode([1;0;0],0,[0.4,4],"ext8f");
 
 //===========================================================
 //Example #9
 //===========================================================
 //passing a parameter to ext9f routine by a list:
-param=[0.04,10000,3d+7];    
-y=ode([1;0;0],0,[0.4,4],list('ext9f',param));
-if norm(y-yref) > 10000*%eps then pause,end
-
-//===========================================================
-//Example #10
-//===========================================================
-//Passing a parameter to argument function of ode
 param=[0.04,10000,3d+7];
-y=ode([1;0;0],0,[0.4,4],'ext10f');
-//param must be defined as a scilab variable upon calling ode
+y=ode([1;0;0],0,[0.4,4],list("ext9f",param));
 if norm(y-yref) > 10000*%eps then pause,end
 
 //===========================================================
@@ -115,8 +65,8 @@ if norm(y-yref) > 10000*%eps then pause,end
 //sharing common data
 a=1:10;
 n=10;a=1:10;
-call('ext11f',n,1,'i',a,2,'r','out',2);  //loads b with a
-c=call('ext12f',n,1,'i','out',[1,10],2,'r');  //loads c with b
+call("ext11f",n,1,"i",a,2,"r","out",2);  //loads b with a
+c=call("ext12f",n,1,"i","out",[1,10],2,"r");  //loads c with b
 if norm(c-a) > %eps then pause,end
 
 //===========================================================