Files
harbour-core/harbour/tests/tstasort.prg
Viktor Szakats e788d6d3e8 2012-07-18 13:54 UTC+0200 Viktor Szakats (harbour syenar.net)
+ contrib/hbgt/tests
  + contrib/hbgt/tests/test.prg
  + contrib/hbmisc/tests/rtfclass.prg
  - tests/rtfclass.prg
  - tests/test10.prg
  - tests/testgt.prg
  * tests/ac_test.prg
  * tests/alias.prg
  * tests/begin.prg
  * tests/boxtest.prg
  * tests/cdow.prg
  * tests/clasinh.prg
  * tests/dates.prg
  * tests/dates2.prg
  * tests/dates3.prg
  * tests/dates4.prg
  * tests/ddate.prg
  * tests/debugtst.prg
  * tests/delimtst.prg
  * tests/devtest.prg
  * tests/disptest.prg
  * tests/foreach.prg
  * tests/gtstdtst.prg
  * tests/ipclnt.prg
  * tests/ipsvr.prg
  * tests/langapi.prg
  * tests/memtst.prg
  * tests/memvar.prg
  * tests/menutest.prg
  * tests/mousetst.prg
  * tests/multiarg.prg
  * tests/newrdd.prg
  * tests/nums.prg
  * tests/objarr.prg
  * tests/objasign.prg
  * tests/objects.prg
  * tests/omacro.prg
  * tests/onidle.prg
  * tests/os.prg
  * tests/output.prg
  * tests/overload.prg
  * tests/parexpr.prg
  * tests/passref.prg
  * tests/procline.prg
  * tests/procname.prg
  * tests/recursiv.prg
  * tests/returns.prg
  * tests/round.prg
  * tests/say.prg
  * tests/sbartest.prg
  * tests/scroll.prg
  * tests/sdf_test.prg
  * tests/seconds.prg
  * tests/server.prg
  * tests/set_num.prg
  * tests/set_test.prg
  * tests/setkeys.prg
  * tests/sound.prg
  * tests/speed.prg
  * tests/statfun.prg
  * tests/statics.prg
  * tests/statics1.prg
  * tests/statics2.prg
  * tests/statinit.prg
  * tests/strdelim.prg
  * tests/stripem.prg
  * tests/switch.prg
  * tests/symbolt.prg
  * tests/t1.prg
  * tests/tb1.prg
  * tests/testbrdb.prg
  * tests/testbrw.prg
  * tests/testcdx.prg
  * tests/testcls.prg
  * tests/testdbf.prg
  * tests/testdecl.prg
  * tests/testerro.prg
  * tests/testfor.prg
  * tests/testget.prg
  * tests/testhrb.prg
  * tests/testhtml.prg
  * tests/testidle.prg
  * tests/testmem.prg
  * tests/testpers.prg
  * tests/testtok.prg
  * tests/testwarn.prg
  * tests/tstalias.prg
  * tests/tstasort.prg
  * tests/tstblock.prg
  * tests/tstdbi.prg
  * tests/tstmacro.prg
  * tests/varparam.prg
  * tests/wvt_fs.prg
    * cleaning up tests
2012-07-18 12:00:10 +00:00

66 lines
1.5 KiB
Plaintext

/*
* $Id$
*/
PROCEDURE Main()
LOCAL oError := ErrorNew()
LOCAL a := { 3, 2, 1 }
LOCAL b := { 10 }
LOCAL c := { 2, .T. , "B", NIL, { 1 }, {|| b }, oError, Date(), 1, .F. , "A", NIL, Date() - 1, { 0 }, {|| a }, oError }
LOCAL t
?
?
? "Original.....:", aDump( t := a )
? "Asort.c......:", aDump( ASort( t := AClone( a ) ) )
? "Asort.c.block:", aDump( ASort( t := AClone( a ), , , {| x, y | x < y } ) )
?
? "Original.....:", aDump( t := b )
? "Asort.c......:", aDump( ASort( t := AClone( b ) ) )
? "Asort.c.block:", aDump( ASort( t := AClone( b ), , , {| x, y | x < y } ) )
?
? "Original.....:", aDump( t := c )
? "Asort.c......:", aDump( ASort( t := AClone( c ) ) )
? "Asort.c.block:", aDump( ASort( t := AClone( c ), , , {| x, y | xToStr( x ) < xToStr( y ) } ) )
RETURN
FUNCTION aDump( a )
LOCAL cStr := ""
LOCAL n := Len( a )
LOCAL i
FOR i := 1 TO n
cStr += AllTrim( xToStr( a[ i ] ) ) + " "
NEXT
RETURN cStr
FUNCTION xToStr( xValue )
LOCAL cType := ValType( xValue )
DO CASE
CASE cType == "C" .OR. cType == "M"
RETURN xValue
CASE cType == "N"
RETURN AllTrim( Str( xValue ) )
CASE cType == "D"
RETURN DToC( xValue )
CASE cType == "L"
RETURN iif( xValue, ".T.", ".F." )
CASE cType == "U"
RETURN "NIL"
CASE cType == "A"
RETURN "{.}"
CASE cType == "B"
RETURN "{|| }"
CASE cType == "O"
RETURN "[O]"
ENDCASE
RETURN xValue