Menu
▾
▴
[Nsclspectcl-cvscommits] SF.net SVN: nsclspectcl:[1876] trunk/nextgen/bindings/tcl
|
From: <ro...@us...> - 2011-06-13 20:19:55
|
Revision: 1876
http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1876&view=rev
Author: ron-fox
Date: 2011-06-13 20:19:48 +0000 (Mon, 13 Jun 2011)
Log Message:
-----------
::spectcl::wsClose binding now works.
Modified Paths:
--------------
trunk/nextgen/bindings/tcl/Makefile.am
trunk/nextgen/bindings/tcl/packageStartup.cpp
trunk/nextgen/bindings/tcl/tcltests
Added Paths:
-----------
trunk/nextgen/bindings/tcl/TclWsClose.cpp
trunk/nextgen/bindings/tcl/TclWsClose.h
trunk/nextgen/bindings/tcl/TclWsOpen.cpp
trunk/nextgen/bindings/tcl/TclWsOpen.h
trunk/nextgen/bindings/tcl/wsclose.test
trunk/nextgen/bindings/tcl/wsopen.test
Modified: trunk/nextgen/bindings/tcl/Makefile.am
===================================================================
--- trunk/nextgen/bindings/tcl/Makefile.am 2011-06-13 14:24:19 UTC (rev 1875)
+++ trunk/nextgen/bindings/tcl/Makefile.am 2011-06-13 20:19:48 UTC (rev 1876)
@@ -12,7 +12,8 @@
TclEvtCreate.h TclEvtClose.h TclEvtOpen.h \
TclAttach.h TclDetach.h TclLoadEvents.h TclAugment.h \
TclEvRun.h TclEvtRunInfo.h TclEvtUUID.h
- TclWsCreate.h TclWsAttach.h TclWsDetach.h
+ TclWsCreate.h TclWsAttach.h TclWsDetach.h TclWsOpen.h \
+ TclWsClose.h
libSpecTclExperiment_la_SOURCES= packageStartup.cpp \
handleManager.cpp TclCreate.cpp TclOpen.cpp \
@@ -21,7 +22,8 @@
TclEvtCreate.cpp TclEvtClose.cpp TclEvtOpen.cpp TclAttach.cpp \
TclDetach.cpp TclLoadEvents.cpp TclAugment.cpp \
TclEvRun.cpp TclEvtRunInfo.cpp TclEvtUUID.cpp \
- TclWsCreate.cpp TclWsAttach.cpp TclWsDetach.cpp
+ TclWsCreate.cpp TclWsAttach.cpp TclWsDetach.cpp TclWsOpen.cpp \
+ TclWsClose.cpp
libSpecTclExperiment_la_CXXFLAGS=@TCL_FLAGS@ -I@top_builddir@/Utility -I@top_builddir@/TclPlus
libSpecTclExperiment_la_LIBADD=@top_builddir@/TclPlus/libtclPlus.la \
Added: trunk/nextgen/bindings/tcl/TclWsClose.cpp
===================================================================
--- trunk/nextgen/bindings/tcl/TclWsClose.cpp (rev 0)
+++ trunk/nextgen/bindings/tcl/TclWsClose.cpp 2011-06-13 20:19:48 UTC (rev 1876)
@@ -0,0 +1,68 @@
+/*
+ This software is Copyright by the Board of Trustees of Michigan
+ State University (c) Copyright 2008
+
+ You may use this software under the terms of the GNU public license
+ (GPL). The terms of this license are described at:
+
+ http://www.gnu.org/licenses/gpl.txt
+
+ Author:
+ Ron Fox
+ NSCL
+ Michigan State University
+ East Lansing, MI 48824-1321
+*/
+#include <config.h>
+#include "TclWsClose.h"
+#include "TclCreate.h"
+#include "spectcl_experiment.h"
+#include <TCLInterpreter.h>
+#include <TCLObject.h>
+#include <string>
+#include "handleManager.h"
+
+using namespace std;
+
+
+/**
+ ** Construction - base class does all the heavy lifting.
+ ** @param interp - Interpreter on which the command is being registered.
+ */
+CTclWsClose::CTclWsClose(CTCLInterpreter& interp) :
+ CTclDBCommand(interp, "wsClose", true)
+{}
+/**
+ ** Destruction - again base class does the work.
+ */
+CTclWsClose::~CTclWsClose() {}
+/**
+ * This handler is called by the Tcl intperpreter when the wsClose command is
+ * dispatched. For command syntax see the header file.
+ * @param interp The Tcl interpreter that is running this command.
+ * @param objv The set of encapsulated Tcl_Obj* that make up the command words.
+ * @return int
+ * @retval TCL_OK - Successful completion. The command does not return a value.
+ * @retval TCL_ERROR - Failure, the command return value is a human readable error message
+ */
+int
+CTclWsClose::operator()(CTCLInterpreter& interp,
+ std::vector<CTCLObject>& objv)
+{
+ try {
+ spectcl_workspace ws = getDatabaseHandle(interp,
+ objv,
+ 1,
+ "::spectcl::wsClose ");
+ int status = spectcl_workspace_close(ws);
+ if (status != SPEXP_OK) {
+ throw std::string(spectcl_experiment_error_msg(status));
+ }
+ getHandleManager()->unregister(objv[1]);
+ }
+ catch (std::string msg) {
+ interp.setResult(msg);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
Added: trunk/nextgen/bindings/tcl/TclWsClose.h
===================================================================
--- trunk/nextgen/bindings/tcl/TclWsClose.h (rev 0)
+++ trunk/nextgen/bindings/tcl/TclWsClose.h 2011-06-13 20:19:48 UTC (rev 1876)
@@ -0,0 +1,49 @@
+/*
+ This software is Copyright by the Board of Trustees of Michigan
+ State University (c) Copyright 2008
+
+ You may use this software under the terms of the GNU public license
+ (GPL). The terms of this license are described at:
+
+ http://www.gnu.org/licenses/gpl.txt
+
+ Author:
+ Ron Fox
+ NSCL
+ Michigan State University
+ East Lansing, MI 48824-1321
+*/
+
+#ifndef __TCLWSCLOSE_H
+#define __TCLWSCLOSE_H
+
+#ifndef _TCLDBCOMMAND_H
+#include "TclDBCommand.h"
+#endif
+
+
+/** This class implements the wsClose command.
+ * wsClose closes a SpecTcl workspace given a handle returned from
+ * wsOpen. The format of the command is:'
+ * \verbatim
+::spectcl::wsClose workspace-handle
+\endverbatim
+ * where workspace-handle was a handle returned froma call to
+ * ::spectcl::wsOpen.
+ */
+class CTclWsClose : public CTclDBCommand
+{
+
+ // Canonicals
+public:
+ CTclWsClose(CTCLInterpreter& interp);
+ virtual ~CTclWsClose();
+
+ // Interface for CTCLObject Processor
+public:
+ int operator()(CTCLInterpreter& interp,
+ std::vector<CTCLObject>& objv);
+
+};
+
+#endif
Added: trunk/nextgen/bindings/tcl/TclWsOpen.cpp
===================================================================
--- trunk/nextgen/bindings/tcl/TclWsOpen.cpp (rev 0)
+++ trunk/nextgen/bindings/tcl/TclWsOpen.cpp 2011-06-13 20:19:48 UTC (rev 1876)
@@ -0,0 +1,78 @@
+/*
+ This software is Copyright by the Board of Trustees of Michigan
+ State University (c) Copyright 2008
+
+ You may use this software under the terms of the GNU public license
+ (GPL). The terms of this license are described at:
+
+ http://www.gnu.org/licenses/gpl.txt
+
+ Author:
+ Ron Fox
+ NSCL
+ Michigan State University
+ East Lansing, MI 48824-1321
+*/
+#include <config.h>
+#include "TclWsOpen.h"
+
+#include "handleManager.h"
+#include <TCLInterpreter.h>
+#include <TCLObject.h>
+#include <spectcl_experiment.h>
+#include <string>
+#include <uuid/uuid.h>
+#include <iostream>
+
+/**
+ ** Constructor uses the base class to get the real work done.
+ ** @param interp - referencde to the TCL Intpereter on which the command is registered.
+ */
+CTclWsOpen::CTclWsOpen(CTCLInterpreter& interp) :
+ CTclDBCommand(interp, "wsOpen", true)
+{
+}
+/**
+ ** The destructor is also handled by the base class.
+ */
+CTclWsOpen::~CTclWsOpen()
+{}
+
+/**
+ * Command dispatch handler for the wsOpen command.
+ * Seethe header for program usage.
+ * @param interp - Interpreter that is executing this command.
+ * @param objv - Vector of references to encapsulated Tcl_Obj's that
+ * represent the words of the command.
+ * @return int
+ * @retval TCL_OK - the command succeeded its value is the Tcl handle to the
+ * database.
+ * @retval TCL_ERROR - the command failed in some way, it's value is the
+ * human readable reason for failure.
+ *
+ */
+int
+CTclWsOpen::operator()(CTCLInterpreter& interp,
+ std::vector<CTCLObject>& objv)
+{
+ try {
+
+ std::string path = getParameter<std::string>(interp, objv, 1);
+ spectcl_workspace ws = spectcl_workspace_open(path.c_str());
+ if (!ws) {
+ throw std::string(spectcl_experiment_error_msg(spectcl_experiment_errno));
+ }
+ // Assign the spectcl handle a Tcl handle:
+
+ CHandleManager* pMgr = getHandleManager();
+ interp.setResult(pMgr->add(ws));
+
+ }
+ catch (std::string msg) {
+ interp.setResult(msg);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
Added: trunk/nextgen/bindings/tcl/TclWsOpen.h
===================================================================
--- trunk/nextgen/bindings/tcl/TclWsOpen.h (rev 0)
+++ trunk/nextgen/bindings/tcl/TclWsOpen.h 2011-06-13 20:19:48 UTC (rev 1876)
@@ -0,0 +1,53 @@
+/*
+ This software is Copyright by the Board of Trustees of Michigan
+ State University (c) Copyright 2008
+
+ You may use this software under the terms of the GNU public license
+ (GPL). The terms of this license are described at:
+
+ http://www.gnu.org/licenses/gpl.txt
+
+ Author:
+ Ron Fox
+ NSCL
+ Michigan State University
+ East Lansing, MI 48824-1321
+*/
+#ifndef __TCLWSOPEN_H
+#define __TCLWSOPEN_H
+
+#ifndef _TCLDBCOMMAND_H
+#include "TclDBCommand.h"
+#endif
+
+/**
+ ** This class implements the expWsOpen command. expWsOpen
+ ** WsOpens an existing database.
+ ** The format of this command is:
+ ** \verbatim
+ ::spectcl::wsOpen path
+\enverbatim
+ **
+ ** where path is the path to the workstation file.
+ ** the command, when successful returns a handle to the
+ ** database which can be used in other Tcl commands that
+ ** require a Workspace handle.
+ **
+ */
+class CTclWsOpen : public CTclDBCommand
+{
+
+ // Canonicals
+public:
+ CTclWsOpen(CTCLInterpreter& interp);
+ virtual ~CTclWsOpen();
+
+ // Interface for CTCLObject Processor
+public:
+ int operator()(CTCLInterpreter& interp,
+ std::vector<CTCLObject>& objv);
+
+};
+
+
+#endif
Modified: trunk/nextgen/bindings/tcl/packageStartup.cpp
===================================================================
--- trunk/nextgen/bindings/tcl/packageStartup.cpp 2011-06-13 14:24:19 UTC (rev 1875)
+++ trunk/nextgen/bindings/tcl/packageStartup.cpp 2011-06-13 20:19:48 UTC (rev 1876)
@@ -36,6 +36,8 @@
#include "TclWsCreate.h"
#include "TclWsAttach.h"
#include "TclWsDetach.h"
+#include "TclWsOpen.h"
+#include "TclWsClose.h"
/** Include command processor headers here */
@@ -86,6 +88,8 @@
new CTclWsCreate(*interp);
new CTclWsAttach(*interp);
new CTclWsDetach(*interp);
+ new CTclWsOpen(*interp);
+ new CTclWsClose(*interp);
return TCL_OK;
}
void* gpTCLApplication(0);
Modified: trunk/nextgen/bindings/tcl/tcltests
===================================================================
--- trunk/nextgen/bindings/tcl/tcltests 2011-06-13 14:24:19 UTC (rev 1875)
+++ trunk/nextgen/bindings/tcl/tcltests 2011-06-13 20:19:48 UTC (rev 1876)
@@ -1,6 +1,6 @@
package require tcltest
-tcltest::matchFiles [list wsdetach.test]
+ tcltest::matchFiles [list wsclose.test]
tcltest::runAllTests
Added: trunk/nextgen/bindings/tcl/wsclose.test
===================================================================
--- trunk/nextgen/bindings/tcl/wsclose.test (rev 0)
+++ trunk/nextgen/bindings/tcl/wsclose.test 2011-06-13 20:19:48 UTC (rev 1876)
@@ -0,0 +1,69 @@
+#
+# Tests for the ::spectcl::wsOpen command.
+#
+package require tcltest
+
+load .libs/libSpecTclExperiment.so
+namespace import ::tcltest::*
+
+#---------------------- The tests ---------------------
+
+test exists {wsClose command must exist } \
+ -body {
+ set command [info commands ::spectcl::wsClose]
+ } -result ::spectcl::wsClose
+
+
+
+test fail_1 {wsClose needs a handle } \
+ -body {
+ set status [catch ::spectcl::wsClose msg]
+ list $status $msg
+ } -result [list 1 "Incorrect number of command line parameters"]
+
+test fail_2 {wsClose needs a handle that's known} \
+ -body {
+ set status [catch [list ::spectcl::wsClose dummy-handle] msg]
+ list $status $msg
+ } -result [list 1 "::spectcl::wsClose - invalid database handle dummy-handle"]
+
+test fail_3 {wsClose needs a handle that's to a workspace} \
+ -setup {
+ file delete ./exp.db
+ set handle [::spectcl::expcreate ./exp.db]
+ } \
+ -cleanup {
+ ::spectcl::expclose $handle
+ file delete ./exp.db
+ } \
+ -body {
+ set result [catch [list ::spectcl::wsClose $handle] msg]
+ list $result $msg
+ } \
+ -result [list 1 "NOT_WORKSPACE - The database is not a workspace"]
+
+test ok {wsClose should work if all parameters are right} \
+ -setup {
+ file delete ./exp.db
+ file delete ./ws.db
+ set handle [::spectcl::expcreate ./exp.db]
+ ::spectcl::wsCreate $handle ./ws.db
+ set wsHandle [::spectcl::wsOpen ./ws.db]
+
+ } \
+ -cleanup {
+ ::spectcl::expclose $handle
+ file delete ./exp.db
+ file delete ./ws.db
+ } \
+ -body {
+ set status [catch [list ::spectcl::wsClose $wsHandle] msg]
+ if {$result} {
+ set result [list $status $msg]
+ } else {
+ set result $status
+ }
+ set status
+ } -result 0
+
+cleanupTests
\ No newline at end of file
Added: trunk/nextgen/bindings/tcl/wsopen.test
===================================================================
--- trunk/nextgen/bindings/tcl/wsopen.test (rev 0)
+++ trunk/nextgen/bindings/tcl/wsopen.test 2011-06-13 20:19:48 UTC (rev 1876)
@@ -0,0 +1,63 @@
+#
+# Tests for the ::spectcl::wsOpen command.
+#
+package require tcltest
+package require sqlite3
+
+load .libs/libSpecTclExperiment.so
+namespace import ::tcltest::*
+
+#--------------------------- The tests ---------------------
+
+test exists {The command wsOpen must exists in the ::spectcl:: namespace} \
+ -body {
+ set result [info commands ::spectcl::wsOpen]
+ } -result ::spectcl::wsOpen
+
+
+test error_1 {wsOpen requires a path parameter} \
+ -body {
+ set result [catch ::spectcl::wsOpen msg]
+ list $result $msg
+ } -result [list 1 "Incorrect number of command line parameters"]
+
+test error_2 {wsOpen rquires a database that is a workspace} \
+ -setup {
+ file delete ./junk.db
+ sqlite3 db ./junk.db
+ } \
+ -cleanup {
+ db close
+ file delete ./junk.db
+ } \
+ -body {
+ set result [catch {::spectcl::wsOpen ./junk.db} msg]
+ list $result $msg
+
+ } -result [list 1 "NOT_WORKSPACE - The database is not a workspace"]
+
+test test_ok {wsOpen should give a handle when it works} \
+ -setup {
+ file delete ./expdb.db
+ file delete ./ws.db
+
+ set expHandle [::spectcl::expcreate ./expdb.db]
+ ::spectcl::wsCreate $expHandle ./ws.db
+ } \
+ -cleanup {
+ ::spectcl::expclose $expHandle
+ file delete ./expdb.db
+ file delete ./ws.db; # Need to close first in theory...chicken & egg problem.
+ } \
+ -match glob \
+ -body {
+ set result [catch [list ::spectcl::wsOpen ./ws.db] msg]
+ if {$result} {
+ set result [list $result $msg]
+ } else {
+ set result $msg
+ }
+ set result
+ } -result spectcl_*
+
+cleanupTests
\ No newline at end of file
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|