Tcl/Tk Home
|
Overview
|
TclRCX
|
Tcl Plug-in
|
Apps.& Ext.
|
More Links

lambda_test.tcl

(use "save as..." on this link (lambda_test.tcl) if you want to save and use locally)
#
# test suite of expected comportement of lisp like features
#
# $Id: lambda_test.tcl,v 1.3 1994/01/03 21:59:39 dl Exp dl $
#
# $Log: lambda_test.tcl,v $
# Revision 1.3  1994/01/03  21:59:39  dl
# suppr backslash
#
# Revision 1.2  1993/12/29  16:09:25  dl
# ajout keywrd
#
#

# * very important *

if {[string compare test [info procs test]] == 1} then {source defs}
if {[string compare lambda [info procs lambda]] == 1} then {source lambda.tcl}

test test_name "descrp...." {
  set x [expr 1+2];
  set y [expr $x-5];
  set res $y;
} "-2"

test nullp "\t: testing null predicate" {
  list [nullp {}] [nullp "Qwert"];
} "1 0"

test p "  \t: testing true predicate" {
  list [p {}] [p "Qwert"];
} "0 1"

set lTst {lambda {arg1 arg2} {return $arg1+$arg2}}

test lambda-1 "\t: lambda basic \[returning a fct name\]" {
  regexp {^lambda_[0-9]?$} [eval $lTst] ;
} "1"

test lambda-2 "\t: lambda basic \[applied\]" {
  eval $lTst 742 876;
} "742+876";

test lambda-3 "\t: lambda basic \[error test (to)\]" {
  list [catch "$lTst 876" res] $res;
} "1 {$lTst 876 : no value given for parameter \"arg2\"}"

test lambda-4 "\t: lambda basic \[error test (nbr)\]" {
  list [catch "$lTst 876 1213 456" res] $res;
} "1 {$lTst 876 1213 456 : called with too many arguments}"

#
# lambda are passed an list of arguments, thus "{}" alone is illegal 
# [a lambda of 1 arg to which one want to send {} should be called :
#    lambda {arg} {body...} {{}}
# 
test lambda-5 "\t: lambda {}" {
  list [catch {lambda {x} {return 1${x}2} {}} res] $res;
} {1 {lambda {x} {return 1${x}2} {} : no value given for parameter "x"}}

test lambda-6 "\t: lamdaClean" {
  lambdaClean;
  eval $lTst;
} "lambda_1"

test mapply-1 "\t: mapply basic" {
  mapply {lambda {x} {expr 2*($x)}} {1 -2 {-3  3} 4+4 5-6}
} {2 -4 {-6 6} 16 -2}

test mapply-2 "\t: correct erasure of lambdas withing maply" {
  list [info procs lambda_*]  [set lambdaNum]
} "lambda_1 7"

test mapply-3 "\t: error test (nbr)" {
  list [info procs lambda_*] [catch {mapply $lTst {a1 a2 a3}} res] $res [info procs lambda_*]
} "lambda_1 1 {$lTst a1 : no value given for parameter \"arg2\"} lambda_1"

test mapply-4 "\t: more complex example" {
  set tl  {1 -2 {-3  3} 4+4 5-6}
  list [[listKmul 3] $tl] [[listKmul 5] $tl];
  } {{3 -6 {-9 9} 16 9} {5 -10 {-15 15} 24 19}}

test lambda-7 "\t: final lamdaClean" {
  list [lambdaClean] [lambdaClean];
} "0 0"


Tcl top | Overview | TclRCX | Tcl Plug-in | Apps.& Ext. | More Links

demailly.com © 1994-2009 Laurent Demailly, Last update: Sat Oct 24 1998