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 \
-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)
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) \
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 \
-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
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
/*
* 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;
+}
+++ /dev/null
-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
-
<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"/>
</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" />
</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" />
<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>
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);
// <-- CLI SHELL MODE -->
//
+// <-- JVM NOT MANDATORY -->
+
A = 2;
B = 4;
C = 6;
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");
projects / scilab.git / commitdiff