Rewrite clear GW in C. 49/10449/9
Bruno JOFRET [Wed, 13 Feb 2013 17:37:04 +0000 (18:37 +0100)]
Change-Id: I7179c0ba9d6eae5465d430e91d9d4499b6cc835c

scilab/modules/core/Makefile.am
scilab/modules/core/Makefile.in
scilab/modules/core/sci_gateway/c/sci_clear.c
scilab/modules/core/sci_gateway/fortran/sci_f_clear.f [deleted file]
scilab/modules/core/src/fortran/core_f.vfproj
scilab/modules/core/src/fortran/core_f2c.vcxproj
scilab/modules/core/src/fortran/core_f2c.vcxproj.filters
scilab/modules/core/tests/unit_tests/clear.dia.ref
scilab/modules/core/tests/unit_tests/clear.tst

index 587fd6f..66ff496 100644 (file)
@@ -268,7 +268,6 @@ sci_gateway/fortran/sci_f_ieee.f \
 sci_gateway/fortran/sci_f_macrovar.f \
 sci_gateway/fortran/sci_f_exists.f \
 sci_gateway/fortran/sci_f_errcatch.f \
-sci_gateway/fortran/sci_f_clear.f \
 sci_gateway/fortran/sci_f_argn.f \
 sci_gateway/fortran/sci_f_setbpt.f \
 sci_gateway/fortran/sci_f_clearglobal.f \
@@ -297,6 +296,7 @@ libscicore_la_CPPFLAGS = -I$(srcdir)/includes/ \
        -I$(top_srcdir)/modules/history_manager/includes/ \
        -I$(top_srcdir)/modules/preferences/includes/ \
        -I$(top_srcdir)/modules/external_objects/includes/ \
+       -I$(top_srcdir)/modules/functions/includes/ \
        $(XML_FLAGS) \
     $(AM_CPPFLAGS)
 
index 6b87412..559adce 100644 (file)
@@ -358,9 +358,9 @@ am__objects_6 = libscicore_la-sci_stacksize.lo \
 am__objects_7 = sci_f_global.lo sci_f_mtlb_mode.lo sci_f_resume.lo \
        sci_f_dispbpt.lo sci_f_intppty.lo sci_f_ieee.lo \
        sci_f_macrovar.lo sci_f_exists.lo sci_f_errcatch.lo \
-       sci_f_clear.lo sci_f_argn.lo sci_f_setbpt.lo \
-       sci_f_clearglobal.lo sci_f_delbpt.lo where.lo sci_f_iserror.lo \
-       sci_f_comp.lo sci_f_isglobal.lo
+       sci_f_argn.lo sci_f_setbpt.lo sci_f_clearglobal.lo \
+       sci_f_delbpt.lo where.lo sci_f_iserror.lo sci_f_comp.lo \
+       sci_f_isglobal.lo
 am_libscicore_la_OBJECTS = $(am__objects_6) $(am__objects_7)
 libscicore_la_OBJECTS = $(am_libscicore_la_OBJECTS)
 libscicore_la_LINK = $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) \
@@ -808,7 +808,6 @@ sci_gateway/fortran/sci_f_ieee.f \
 sci_gateway/fortran/sci_f_macrovar.f \
 sci_gateway/fortran/sci_f_exists.f \
 sci_gateway/fortran/sci_f_errcatch.f \
-sci_gateway/fortran/sci_f_clear.f \
 sci_gateway/fortran/sci_f_argn.f \
 sci_gateway/fortran/sci_f_setbpt.f \
 sci_gateway/fortran/sci_f_clearglobal.f \
@@ -836,7 +835,8 @@ libscicore_la_CPPFLAGS = -I$(srcdir)/includes/ -I$(srcdir)/src/c/ \
        -I$(top_srcdir)/modules/history_manager/includes/ \
        -I$(top_srcdir)/modules/preferences/includes/ \
        -I$(top_srcdir)/modules/external_objects/includes/ \
-       $(XML_FLAGS) $(AM_CPPFLAGS) $(am__append_3)
+       -I$(top_srcdir)/modules/functions/includes/ $(XML_FLAGS) \
+       $(AM_CPPFLAGS) $(am__append_3)
 @MAINTAINER_MODE_TRUE@pkglib_LTLIBRARIES = libscicore.la
 @MAINTAINER_MODE_FALSE@noinst_LTLIBRARIES = libscicore-algo.la libscicore.la
 @MAINTAINER_MODE_TRUE@noinst_LTLIBRARIES = libscicore-algo.la
@@ -2646,9 +2646,6 @@ sci_f_exists.lo: sci_gateway/fortran/sci_f_exists.f
 sci_f_errcatch.lo: sci_gateway/fortran/sci_f_errcatch.f
        $(LIBTOOL)  --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_f_errcatch.lo `test -f 'sci_gateway/fortran/sci_f_errcatch.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_f_errcatch.f
 
-sci_f_clear.lo: sci_gateway/fortran/sci_f_clear.f
-       $(LIBTOOL)  --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_f_clear.lo `test -f 'sci_gateway/fortran/sci_f_clear.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_f_clear.f
-
 sci_f_argn.lo: sci_gateway/fortran/sci_f_argn.f
        $(LIBTOOL)  --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_f_argn.lo `test -f 'sci_gateway/fortran/sci_f_argn.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_f_argn.f
 
index 43c0f5c..d71ef4e 100644 (file)
 /*
  * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
  * Copyright (C) 2006 - INRIA - Allan CORNET
- * 
+ * Copyright (C) 2011 - DIGITEO - Allan CORNET
+ *
  * 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    
+ * are also available at
  * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
  *
  */
+#include <ctype.h>
+#include <string.h>
+#include <stdlib.h>
 #include "gw_core.h"
 #include "machine.h"
+#include "stack-c.h"
+#include "BOOL.h"
+#include "localization.h"
+#include "Scierror.h"
+#include "MALLOC.h"
+#include "call_scilab.h"
+#include "isScilabFunction.h"
+#include "api_scilab.h"
+
+/*--------------------------------------------------------------------------*/
+static int clearAllVariablesOnStack(void);
+/*--------------------------------------------------------------------------*/
+static int sci_clear_no_rhs(const char *fname);
+static int sci_clear_n_rhs(const char *fname);
 /*--------------------------------------------------------------------------*/
-extern int C2F(intclear)(char *fname,unsigned long fname_len);
+extern int C2F(stackp)(int *, int *); /* fortran subroutine */
 /*--------------------------------------------------------------------------*/
 int C2F(sci_clear)(char *fname,unsigned long fname_len)
 {
-       C2F(intclear)(fname,fname_len);
-       return 0;
+    if (Rhs == 0)
+    {
+        sci_clear_no_rhs(fname);
+    }
+    else
+    {
+        sci_clear_n_rhs(fname);
+    }
+    return 0;
+}
+/*--------------------------------------------------------------------------*/
+static int sci_clear_no_rhs(const char *fname)
+{
+    if (C2F(recu).macr != 0 || C2F(recu).paus != 0)
+    {
+        int k = 0;
+        if (C2F(recu).rstk[C2F(recu).pt - 3] == 909)
+        {
+            /* clear within an exec'd macro */
+            return clearAllVariablesOnStack();
+        }
+        /* clear within a macro, an execstr, an exec or a pause */
+        k = C2F(iop).lpt[0] - 19;
+        if (C2F(iop).lin[k + 6] != 0 && ((int *)&C2F(stack))[C2F(iop).lin[k + 5] - 1] == 10)
+        {
+            PutLhsVar();
+            return 0;
+        }
+        /* clear within a macro, an exec or a pause */
+        /* Computing MIN */
+        Bot = Min(C2F(vstk).bbot, C2F(iop).lin[k + 4]);
+        PutLhsVar();
+        return 0;
+    }
+    return clearAllVariablesOnStack();
 }
 /*--------------------------------------------------------------------------*/
+static int sci_clear_n_rhs(const char *fname)
+{
+    int k = 0;
+    int i = 0;
+    int nbVariables = Rhs;
+    char **VariableNameToClear = (char **)MALLOC(sizeof(char*) * nbVariables);
+
+    if (!VariableNameToClear)
+    {
+        Scierror(999,_("%s: No more memory.\n"), fname);
+        return 0;
+    }
+
+    for (k = 0; k < nbVariables; k++)
+    {
+        int *piAddressVar = NULL;
+        SciErr sciErr = getVarAddressFromPosition(pvApiCtx, k + 1, &piAddressVar);
+        if (!sciErr.iErr)
+        {
+            if (isScalar(pvApiCtx, piAddressVar) && isStringType(pvApiCtx, piAddressVar))
+            {
+                char *variablename = NULL;
+                if (getAllocatedSingleString(pvApiCtx, piAddressVar, &variablename) == 0)
+                {
+                    VariableNameToClear[i] =  variablename;
+                    i++;
+                 }
+                else
+                {
+                    freeAllocatedMatrixOfString(i, 1, VariableNameToClear);
+                    VariableNameToClear = NULL;
+                    Scierror(999,_("%s: No more memory.\n"), fname);
+                    return 0;
+                }
+            }
+            else
+            {
+                freeAllocatedMatrixOfString(i, 1, VariableNameToClear);
+                VariableNameToClear = NULL;
+
+                if (isScalar(pvApiCtx, piAddressVar))
+                {
+                    Scierror(201, _("%s: Wrong type for argument %d: Valid variable name expected.\n"), fname, k + 1);
+                    return 0;
+                }
+                else
+                {
+                    Scierror(999, _("%s: Wrong size for argument %d: Valid variable name expected.\n"), fname, k + 1);
+                    return 0;
+                }
+            }
+        }
+    }
+
+    for (k = 0; k < nbVariables; k++)
+    {
+        deleteNamedVariable(NULL, VariableNameToClear[k]);
+    }
+
+    if (VariableNameToClear)
+    {
+        freeAllocatedMatrixOfString(nbVariables, 1, VariableNameToClear);
+        VariableNameToClear = NULL;
+    }
+    PutLhsVar();
+    return 0;
+}
+/*--------------------------------------------------------------------------*/
+int clearAllVariablesOnStack(void)
+{
+    /* clear all variables */
+    int il = 0;
+    Fin = 0;
+    C2F(adre).is = Fin;
+    Bot = C2F(vstk).bbot;
+
+    //create a null matrix a the Top of the stack
+    Top = Top + 1;
+    il = iadr(*Lstk(Top));
+    *istk(il) = 0;
+    *Lstk(Top + 1) = *Lstk(Top) + 1;
+    return 0;
+}
diff --git a/scilab/modules/core/sci_gateway/fortran/sci_f_clear.f b/scilab/modules/core/sci_gateway/fortran/sci_f_clear.f
deleted file mode 100644 (file)
index 359e844..0000000
+++ /dev/null
@@ -1,103 +0,0 @@
-c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
-c Copyright (C) INRIA
-c 
-c This file must be used under the terms of the CeCILL.
-c This source file is licensed as described in the file COPYING, which
-c you should have received as part of this distribution.  The terms
-c are also available at    
-c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
-      subroutine intclear(fname)
-      include 'stack.h'
-c     
-      parameter (nz3=nsiz-3,nz2=nsiz-2)
-      character*(*) fname
-      integer top0,id(nsiz)
-      logical getsmat,checkval,checklhs
-      integer iadr
-      integer a, blank,percen,helps(nsiz)
-
-
-      data a/10/,blank/40/,percen/56/
-      data helps /353243448,673717273,nz2*673720360/
-      
-      iadr(l)=l+l-1
-
-c
-      if(.not.checklhs(fname,1,1)) return
-
-      if(rhs.le.0) then
-         if (macr.ne.0 .or. paus.ne.0) then
-            if(rstk(pt-2).eq.909) then
-c     .     clear within an exec'd macro
-               goto 01
-            endif
-c     .     clear within a macro, an execstr, an exec or a pause
-            k = lpt(1) - (13+nsiz)
-            if(lin(k+7).ne.0.and.istk(lin(k+6)).eq.10) goto 02
-c     .     clear within a macro, an exec or a pause
-            bot = min(bbot,lin(k+5))
-            goto 02
-         endif
-
- 01      continue
-c     .  clear all variable
-
-c     .  preserve %help variable
-         i1=bbot
-         fin=-1
-         call stackg(helps)
-         if(err.gt.0) return
-         if (fin.gt.0) i1=min(fin,i1)
-
-         fin=0
-         call stackg(helps)
-         if(err.gt.0) return
-         ih=fin
-
-         fin=0
-         is=fin
-         bot = bbot 
-         if(ih.eq.-1) then
-            call stackp(helps,0)
-            if(err.gt.0) return
-         endif
- 02      top=top+1
-         il = iadr(lstk(top))
-         istk(il) = 0
-         lstk(top+1) = lstk(top) + 1
-         return
-      endif
-     
-      top0=top
-      do 10 k=1,rhs
-         if(.not.getsmat(fname,top0,top,m,n,1,1,lr,nlr)) return
-         if(.not.checkval(fname,m*n,1)) return
-         if(nlr.eq.0) then
-            top=top-1
-            goto 10
-         endif
-c        . check for valid variable name
-         do 05 i=0,nlr-1
-            ic=abs(istk(lr+i))
-            if((ic.gt.blank.and.(i.gt.0.and.ic.eq.percen)).or.
-     $           (i.eq.0.and.ic.lt.a)) then
-               err=rhs+1-k
-               call error(248)
-               return
-            endif
- 05      continue
-         call namstr(id,istk(lr),nlr,0)
-         il = iadr(lstk(top))
-         istk(il) = 0
-         lstk(top+1) = lstk(top) + 1
-         rhs = 0
-         call stackp(id,0)
-         if (err .gt. 0.or.err1.gt.0) return
-         fin = 1
- 10   continue
-      top=top+1
-      il = iadr(lstk(top))
-      istk(il) = 0
-      lstk(top+1) = lstk(top) + 1
-      end
-      
index ce1eac1..ee72082 100644 (file)
                <File RelativePath="ref2val.f"/>
                <File RelativePath="savlod.f"/>
                <File RelativePath="..\..\sci_gateway\fortran\sci_f_argn.f"/>
-               <File RelativePath="..\..\sci_gateway\fortran\sci_f_clear.f"/>
                <File RelativePath="..\..\sci_gateway\fortran\sci_f_clearglobal.f"/>
                <File RelativePath="..\..\sci_gateway\fortran\sci_f_comp.f"/>
                <File RelativePath="..\..\sci_gateway\fortran\sci_f_delbpt.f"/>
index d014152..38756ee 100644 (file)
@@ -321,7 +321,6 @@ cd ..
   </ItemDefinitionGroup>
   <ItemGroup>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_argn.c" />
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_clear.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_clearglobal.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_comp.c" />
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_delbpt.c" />
@@ -430,7 +429,6 @@ cd ..
   </ItemGroup>
   <ItemGroup>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_argn.f" />
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_clear.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_clearglobal.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_comp.f" />
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_delbpt.f" />
index 8c61bf4..e78c0df 100644 (file)
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_argn.c">
       <Filter>Source Files</Filter>
     </ClCompile>
-    <ClCompile Include="..\..\sci_gateway\fortran\sci_f_clear.c">
-      <Filter>Source Files</Filter>
-    </ClCompile>
     <ClCompile Include="..\..\sci_gateway\fortran\sci_f_clearglobal.c">
       <Filter>Source Files</Filter>
     </ClCompile>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_argn.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
-    <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_clear.f">
-      <Filter>Fortran Files</Filter>
-    </f2c_rule>
     <f2c_rule Include="..\..\sci_gateway\fortran\sci_f_clearglobal.f">
       <Filter>Fortran Files</Filter>
     </f2c_rule>
index f3fdc94..543ba09 100644 (file)
@@ -32,7 +32,7 @@ msg_ref = msprintf(gettext("Redefining permanent variable.\n"));
 assert_checkequal (msg_err, msg_ref);
 ierr = execstr("clear(1)", "errcatch");
 assert_checkequal(ierr, 201);
-msg_ref = msprintf(gettext("%s: Wrong type for argument #%d: String matrix expected.\n"), "clear", 1);
+msg_ref = msprintf(gettext("%s: Wrong type for argument %d: Valid variable name expected.\n"), "clear", 1);
 assert_checkerror ("clear(1)", msg_ref);
 ierr = execstr("clear toto", "errcatch");
 assert_checkequal(ierr, 0);
index 02d3301..bb169f6 100644 (file)
@@ -7,6 +7,8 @@
 // <-- CLI SHELL MODE -->
 //
 
+// <-- JVM NOT MANDATORY -->
+
 A = 2;
 B = 4;
 C = 6;
@@ -37,7 +39,7 @@ assert_checkequal (msg_err, msg_ref);
 
 ierr = execstr("clear(1)", "errcatch");
 assert_checkequal(ierr, 201);
-msg_ref = msprintf(gettext("%s: Wrong type for argument #%d: String matrix expected.\n"), "clear", 1);
+msg_ref = msprintf(gettext("%s: Wrong type for argument %d: Valid variable name expected.\n"), "clear", 1);
 assert_checkerror ("clear(1)", msg_ref);
 
 ierr = execstr("clear toto", "errcatch");