spice::vectoblt

This commit is contained in:
stefanjones 2007-03-20 17:26:43 +00:00
parent 478425163e
commit 0afcb916c0
3 changed files with 134 additions and 0 deletions

View File

@ -1,3 +1,7 @@
2007-03-20 Lionel Sainte Cluque
* Added spice::vectoblt function
2006-08-31 Stefan Jones <stefan.jones@multigig.com>
* configure.in:

54
src/tcl/test_vectoblt.tcl Normal file
View File

@ -0,0 +1,54 @@
package require spice
spice::source "diffpair.cir"
spice::op
spice::let Vd = V(5) - V(4)
blt::vector imag
blt::vector real
set ok 0
###################
puts " Vd is a real vector of length 1"
###################
#too many arguments
if {[catch {spice::vectoblt raul ibrahim ector karim} erreur] != 0} {puts "ERROR EXPECTED: TEST 1 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 1 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#no acceptable argument
if {[catch {spice::vectoblt raul ibrahim ector} erreur] != 0} {puts "ERROR EXPECTED: TEST 2 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 2 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#no acceptable blt vector
if {[catch {spice::vectoblt Vd ibrahim} erreur] != 0} {puts "ERROR EXPECTED: TEST 3 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 3 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#real part affectation
if {[catch {spice::vectoblt Vd real} erreur] == 0} {puts "NO ERROR IN AFFECTATION. TEST 4 OK:\n\t (Blank line)"; set ok [expr {$ok + 1}]} else {puts "TEST 4 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#no acceptable blt vector (2 vectors)
if {[catch {spice::vectoblt Vd ibrahim ector} erreur] != 0} {puts "ERROR EXPECTED: TEST 5 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 5 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#no acceptable imaginary vector
if {[catch {spice::vectoblt Vd real ector} erreur] != 0} {puts "ERROR EXPECTED: TEST 6 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 6 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#real and imaginary part affectation
if {[catch {spice::vectoblt Vd real imag} erreur] == 0} {puts "NO ERROR IN AFFECTATION. TEST 7 OK:\n\t (Blank line)"; set ok [expr {$ok + 1}]} else {puts "TEST 7 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#all good vectors, but another argument invited himself
if {[catch {spice::vectoblt Vd real imag karim} erreur] != 0} {puts "ERROR EXPECTED: TEST 8 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 8 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
###################
puts " Vd is a complex vector of length 10"
###################
spice::op
spice::ac dec 10 100 1000
spice::let Vd = V(5) - V(4)
#too many arguments
if {[catch {spice::vectoblt raul ibrahim ector karim} erreur] != 0} {puts "ERROR EXPECTED: TEST 1 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 1 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#no acceptable argument
if {[catch {spice::vectoblt raul ibrahim ector} erreur] != 0} {puts "ERROR EXPECTED: TEST 2 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 2 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#no acceptable blt vector
if {[catch {spice::vectoblt Vd ibrahim} erreur] != 0} {puts "ERROR EXPECTED: TEST 3 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 3 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#real part affectation
if {[catch {spice::vectoblt Vd real} erreur] == 0} {puts "NO ERROR IN AFFECTATION. TEST 4 OK:\n\t (Blank line)"; set ok [expr {$ok + 1}]} else {puts "TEST 4 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#no acceptable blt vector (2 vectors)
if {[catch {spice::vectoblt Vd ibrahim ector} erreur] != 0} {puts "ERROR EXPECTED: TEST 5 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 5 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#no acceptable imaginary vector
if {[catch {spice::vectoblt Vd real ector} erreur] != 0} {puts "ERROR EXPECTED: TEST 6 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 6 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#real and imaginary part affectation
if {[catch {spice::vectoblt Vd real imag} erreur] == 0} {puts "NO ERROR IN AFFECTATION. TEST 7 OK:\n\t (Blank line)"; set ok [expr {$ok + 1}]} else {puts "TEST 7 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
#all good vectors, but another argument invited himself
if {[catch {spice::vectoblt Vd real imag karim} erreur] != 0} {puts "ERROR EXPECTED: TEST 8 OK:\n\t$erreur"; set ok [expr {$ok + 1}]} else {puts "TEST 8 ERROR\n\t Test 1 should return TCL_ERROR, but it does not"}
puts "\n\n"
if {$ok == 16} {puts "spice::vectoblt OK ($ok/16 tests ok)"} else {puts "spice::vectoblt KO:\n\t$ok/16 tests ok"}

View File

@ -414,6 +414,81 @@ static int get_value TCL_CMDPROCARGS(clientData,interp,argc,argv) {
return TCL_OK;
}
}
/*
* arg1: spice vector name
* arg2: real data blt vector
* arg3: Optional: imaginary data blt vector*/
static int vectoblt TCL_CMDPROCARGS(clientData,interp,argc,argv) {
Blt_Vector *real_BltVector, *imag_BltVector;
char *realBlt, *imagBlt, *var;
struct dvec *var_dvec;
double *realData, *compData;
if (argc < 3 || argc > 4){
Tcl_SetResult(interp, "Wrong # args. spice::vectoblt spice_variable real_bltVector [imag_bltVector]",TCL_STATIC);
return TCL_ERROR;
}
real_BltVector = NULL;
imag_BltVector = NULL;
var = (char *)argv[1];
var_dvec = vec_get(var);
if ( var_dvec == NULL ){
Tcl_SetResult(interp, "Bad spice vector",TCL_STATIC);
Tcl_AppendResult(interp, (char *)var, TCL_STATIC);
return TCL_ERROR;
}
realBlt = (char *)argv[2];
if(Blt_GetVector(interp,realBlt,&real_BltVector)){
Tcl_SetResult(interp, "Bad real blt vector ",TCL_STATIC);
Tcl_AppendResult(interp, (char *)realBlt, TCL_STATIC);
return TCL_ERROR;
}
if (argc == 4) {
imagBlt = (char *)argv[3];
if(Blt_GetVector(interp,imagBlt,&imag_BltVector)){
Tcl_SetResult(interp, "Bad imag blt vector ",TCL_STATIC);
Tcl_AppendResult(interp, (char *)imagBlt, TCL_STATIC);
return TCL_ERROR;
}
}
/*If data is complex, it is harder (more complex :) to export...*/
int compIndex; //index to loop inside the vectors' data
if (var_dvec->v_realdata==NULL){
if (var_dvec->v_compdata==NULL){
Tcl_SetResult(interp, "The vector contains no data",TCL_STATIC);
Tcl_AppendResult(interp, (char *)var, TCL_STATIC);
}
else{
realData = (double *)tmalloc((unsigned) sizeof(double)*(var_dvec->v_length));
for (compIndex=0; compIndex<var_dvec->v_length; compIndex++){
realData[compIndex] = ((var_dvec->v_compdata+compIndex)->cx_real);
}
Blt_ResetVector(real_BltVector, realData, var_dvec->v_length, var_dvec->v_length, TCL_VOLATILE);
if (imag_BltVector != NULL) {
compData = (double *)tmalloc((unsigned) sizeof(double)*(var_dvec->v_length));
for (compIndex=0; compIndex<var_dvec->v_length; compIndex++){
compData[compIndex] = ((var_dvec->v_compdata+compIndex)->cx_imag);
}
Blt_ResetVector(imag_BltVector, compData, var_dvec->v_length, var_dvec->v_length, TCL_VOLATILE);
}
};
} else
{
Blt_ResetVector(real_BltVector, var_dvec->v_realdata, var_dvec->v_length, var_dvec->v_length, TCL_VOLATILE);
if (imag_BltVector != NULL) {
compData = (double *)tmalloc((unsigned) sizeof(double)*(var_dvec->v_length));
for (compIndex=0; compIndex<var_dvec->v_length; compIndex++){
compData[compIndex] = 0;
}
Blt_ResetVector(imag_BltVector, compData, var_dvec->v_length, var_dvec->v_length, TCL_VOLATILE);
}
}
Tcl_SetResult(interp, "finished!",TCL_STATIC);
return TCL_OK;
}
/*agr1: spice variable name
*arg2: blt_vector
@ -2128,6 +2203,7 @@ bot:
Tcl_CreateCommand(interp, TCLSPICE_prefix "spice_header", spice_header, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, TCLSPICE_prefix "spice_data", spice_data, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, TCLSPICE_prefix "spicetoblt", spicetoblt, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, TCLSPICE_prefix "vectoblt", vectoblt, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, TCLSPICE_prefix "lastVector", lastVector, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, TCLSPICE_prefix "get_value", get_value, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, TCLSPICE_prefix "spice", _spice_dispatch, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);