2001-07-17 22:30 MEST Martin Vogel <vogel@inttec.de>
This commit is contained in:
@@ -1,3 +1,12 @@
|
||||
2001-07-17 22:30 MEST Martin Vogel <vogel@inttec.de>
|
||||
|
||||
* contrib/libct/tests/Makefile
|
||||
+ contrib/libct/tests/csetarge.prg
|
||||
+ Test program for the new CSETARGERR() function.
|
||||
|
||||
* contrib/libct/tests/*.prg
|
||||
+ added calls to CTINIT() and CTEXIT()
|
||||
|
||||
2001-07-17 21:50 UTC+1 JFL (mafact) <jfl@mafact.com>
|
||||
* source/vm/classes.c
|
||||
! Fixed Scoping where a protected var could be
|
||||
|
||||
@@ -63,8 +63,9 @@ PRG_SOURCES=\
|
||||
charswap.prg \
|
||||
charsub.prg \
|
||||
charxor.prg \
|
||||
csetref.prg \
|
||||
csetatmu.prg \
|
||||
csetarge.prg \
|
||||
csetref.prg \
|
||||
numtoken.prg \
|
||||
setatlik.prg \
|
||||
token.prg \
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local cStr := "This is a test!"
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of ADDASCII()")
|
||||
qout ("")
|
||||
// simple tests
|
||||
@@ -100,14 +102,6 @@ local cStr := "This is a test!"
|
||||
qout (" return value of addascii([AAAA],258,,.T.) call ('AABC')...:", addascii("AAAA",258,,.T.))
|
||||
qout (" return value of addascii([ABBA],-257,3,.T.) call ('AAAA').:", addascii("ABBA",-257,3,.T.))
|
||||
|
||||
// wrong parameter test
|
||||
qout ()
|
||||
qout ("Wrong parameter tests:")
|
||||
qout (" return value of valtype (addascii (5789676,1,2,.T.)) call ('C'): ", valtype(addascii(5789676,1,2,.T.)))
|
||||
qout (" return value of addascii ([ABCD],[A],2,.F.) call ('ABCD')......: ", addascii("ABCD","A",2,.F.))
|
||||
qout (" return value of addascii ([ABCD],1,5,.F.) call ('ABCD')........: ", addascii("ABCD",1,5,.F.))
|
||||
qout ()
|
||||
|
||||
qout ("End test of ADDASCII()")
|
||||
qout ("")
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local cStr := "...This...is...a...test!"
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of AFTERATNUM()")
|
||||
qout ("")
|
||||
qout (" Value of cStr is:"+chr(34)+cStr+chr(34))
|
||||
@@ -104,6 +106,8 @@ local cStr := "...This...is...a...test!"
|
||||
qout ("End test of AFTERATNUM()")
|
||||
qout ()
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of ASCIISUM()")
|
||||
qout ("")
|
||||
|
||||
@@ -69,6 +71,8 @@ procedure main
|
||||
qout ("End test of ASCIISUM()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of ASCPOS()")
|
||||
qout ("")
|
||||
|
||||
@@ -69,6 +71,8 @@ procedure main
|
||||
qout ("End test of ASCPOS()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -65,6 +65,8 @@ local aStr := {"Introduction: 1",;
|
||||
"Discussion: 21"}
|
||||
local ni
|
||||
|
||||
ctinit()
|
||||
|
||||
// Some simple tests
|
||||
qout ("Begin test of ATADJUST()")
|
||||
qout ("")
|
||||
@@ -98,6 +100,8 @@ local ni
|
||||
qout ("End test of ATADJUST()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local cStr := "...This...is...a...test!"
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of ATNUM()")
|
||||
qout ("")
|
||||
qout (" Value of cStr is:"+chr(34)+cStr+chr(34))
|
||||
@@ -104,6 +106,8 @@ local cStr := "...This...is...a...test!"
|
||||
qout ("End test of ATNUM()")
|
||||
qout ()
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -57,6 +57,8 @@
|
||||
|
||||
procedure main()
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of ATREPL()")
|
||||
qout ("")
|
||||
|
||||
@@ -73,6 +75,8 @@ procedure main()
|
||||
qout ("End test of ATREPL()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -61,6 +61,8 @@ procedure main
|
||||
local cStr := "...This...is...a...test!"
|
||||
local ni, npos
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of ATTOKEN()")
|
||||
qout ("")
|
||||
|
||||
@@ -85,6 +87,8 @@ local ni, npos
|
||||
qout ("End test of ATTOKEN()")
|
||||
qout ()
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local cStr := "...This...is...a...test!"
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of BEFORATNUM()")
|
||||
qout ("")
|
||||
qout (" Value of cStr is:"+chr(34)+cStr+chr(34))
|
||||
@@ -104,6 +106,8 @@ local cStr := "...This...is...a...test!"
|
||||
qout ("End test of BEFORATNUM()")
|
||||
qout ()
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARADD()")
|
||||
qout ("")
|
||||
|
||||
@@ -71,6 +73,8 @@ procedure main
|
||||
qout ("End test of CHARADD()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARAND()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of CHARAND()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHAREVEN()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of CHAREVEN()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -61,6 +61,8 @@ procedure main
|
||||
local aArr
|
||||
local nTotal := 0
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARHIST()")
|
||||
qout ("")
|
||||
|
||||
@@ -74,6 +76,8 @@ local nTotal := 0
|
||||
qout ("End test of CHARHIST()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARLIST()")
|
||||
qout ("")
|
||||
|
||||
@@ -69,6 +71,8 @@ procedure main
|
||||
qout ("End test of CHARLIST()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARMIRR()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of CHARMIRR()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARMIX()")
|
||||
qout ("")
|
||||
|
||||
@@ -73,6 +75,8 @@ procedure main
|
||||
qout ("End test of CHARMIX()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARNOLIST()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of CHARNOLIST()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local ni, cStr
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARNOT()")
|
||||
qout ("")
|
||||
|
||||
@@ -86,6 +88,8 @@ local ni, cStr
|
||||
qout ("End test of CHARNOT()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARODD()")
|
||||
qout ("")
|
||||
|
||||
@@ -69,6 +71,8 @@ procedure main
|
||||
qout ("End test of CHARODD()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARONE()")
|
||||
qout ("")
|
||||
|
||||
@@ -73,6 +75,8 @@ procedure main
|
||||
qout ("End test of CHARONE()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARONLY()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of CHARONLY()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHAROR()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of CHAROR()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARREM()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of CHARREM()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARREPL()")
|
||||
qout ("")
|
||||
|
||||
@@ -73,6 +75,8 @@ procedure main
|
||||
qout ("End test of CHARREPL()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local ni, cStr
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARRLL()")
|
||||
qout ("")
|
||||
|
||||
@@ -82,6 +84,8 @@ local ni, cStr
|
||||
qout ("End test of CHARRLL()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local ni, cStr
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARRLR()")
|
||||
qout ("")
|
||||
|
||||
@@ -82,6 +84,8 @@ local ni, cStr
|
||||
qout ("End test of CHARRLR()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local ni, cStr
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARSHL()")
|
||||
qout ("")
|
||||
|
||||
@@ -82,6 +84,8 @@ local ni, cStr
|
||||
qout ("End test of CHARSHL()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local ni, cStr
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARSHR()")
|
||||
qout ("")
|
||||
|
||||
@@ -82,6 +84,8 @@ local ni, cStr
|
||||
qout ("End test of CHARSHR()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARSLIST()")
|
||||
qout ("")
|
||||
|
||||
@@ -69,6 +71,8 @@ procedure main
|
||||
qout ("End test of CHARSLIST()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARSORT()")
|
||||
qout ("")
|
||||
|
||||
@@ -77,6 +79,8 @@ procedure main
|
||||
qout ("End test of CHARSORT()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARSUB()")
|
||||
qout ("")
|
||||
|
||||
@@ -71,6 +73,8 @@ procedure main
|
||||
qout ("End test of CHARSUB()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARSWAP()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of CHARSWAP()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CHARXOR()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of CHARXOR()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
302
harbour/contrib/libct/tests/csetarge.prg
Normal file
302
harbour/contrib/libct/tests/csetarge.prg
Normal file
@@ -0,0 +1,302 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* Test CT3 function CSETARGERR()
|
||||
*
|
||||
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
|
||||
* Author: Martin Vogel <vogel@inttec.de>
|
||||
*
|
||||
* www - http://www.harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
|
||||
#include "../ct.ch"
|
||||
|
||||
|
||||
procedure main
|
||||
|
||||
local cRet, olderr
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CSETARGERR()")
|
||||
qout ("")
|
||||
|
||||
qout ("")
|
||||
qout ("Local error handler: ")
|
||||
|
||||
olderr := errorblock ({|oerr|myerrhandler(oerr)})
|
||||
|
||||
// standard behaviour on argument error
|
||||
qout ("")
|
||||
qout ("Standard behaviour")
|
||||
qout (" Call to addascii (5789676,1,2,.T.):")
|
||||
cRet := addascii (5789676,1,2,.T.)
|
||||
qout (" return value was", cRet)
|
||||
qout ("")
|
||||
qout (" Call to charadd ('AA',.F.):")
|
||||
cRet := charadd ("AA",.F.)
|
||||
qout (" return value was", cRet, "<Press any key>")
|
||||
qout ("")
|
||||
inkey (0)
|
||||
|
||||
// CT_ARGERR_WHOCARES on argument error
|
||||
qout ("")
|
||||
qout ("CT_ARGERR_WHOCARES behaviour")
|
||||
CSETARGERR (CT_ARGERR_WHOCARES)
|
||||
qout (" Call to addascii (5789676,1,2,.T.):")
|
||||
cRet := addascii (5789676,1,2,.T.)
|
||||
qout (" return value was", cRet)
|
||||
qout ("")
|
||||
qout (" Call to charadd ('AA',.F.):")
|
||||
cRet := charadd ("AA",.F.)
|
||||
qout (" return value was", cRet, "<Press any key>")
|
||||
qout ("")
|
||||
inkey (0)
|
||||
|
||||
// CT_ARGERR_WARNING on argument error
|
||||
qout ("")
|
||||
qout ("CT_ARGERR_WARNING behaviour")
|
||||
CSETARGERR (CT_ARGERR_WARNING)
|
||||
qout (" Call to addascii (5789676,1,2,.T.):")
|
||||
cRet := addascii (5789676,1,2,.T.)
|
||||
qout (" return value was", cRet)
|
||||
qout ("")
|
||||
qout (" Call to charadd ('AA',.F.):")
|
||||
cRet := charadd ("AA",.F.)
|
||||
qout (" return value was", cRet, "<Press any key>")
|
||||
qout ("")
|
||||
inkey (0)
|
||||
|
||||
// CT_ARGERR_ERROR on argument error
|
||||
qout ("")
|
||||
qout ("CT_ARGERR_ERROR behaviour")
|
||||
CSETARGERR (CT_ARGERR_ERROR)
|
||||
qout (" Call to addascii (5789676,1,2,.T.):")
|
||||
cRet := addascii (5789676,1,2,.T.)
|
||||
qout (" return value was", cRet)
|
||||
qout ("")
|
||||
qout (" Call to charadd ('AA',.F.):")
|
||||
cRet := charadd ("AA",.F.)
|
||||
qout (" return value was", cRet, "<Press any key>")
|
||||
qout ("")
|
||||
inkey (0)
|
||||
|
||||
// CT_ARGERR_CATASTROPHIC on argument error
|
||||
qout ("")
|
||||
qout ("CT_ARGERR_CATASTROPHIC behaviour")
|
||||
CSETARGERR (CT_ARGERR_CATASTROPHIC)
|
||||
qout (" Call to addascii (5789676,1,2,.T.):")
|
||||
cRet := addascii (5789676,1,2,.T.)
|
||||
qout (" return value was", cRet)
|
||||
qout ("")
|
||||
qout (" Call to charadd ('AA',.F.):")
|
||||
cRet := charadd ("AA",.F.)
|
||||
qout (" return value was", cRet, "<Press any key>")
|
||||
qout ("")
|
||||
inkey (0)
|
||||
|
||||
qout ("")
|
||||
qout ("Standard error handler: ")
|
||||
errorblock (olderr)
|
||||
|
||||
// standard behaviour on argument error
|
||||
qout ("")
|
||||
qout ("Standard behaviour")
|
||||
qout (" Call to charadd ('AA',.F.):")
|
||||
cRet := charadd ("AA",.F.)
|
||||
qout (" return value was", cRet, "<Press any key>")
|
||||
qout ("")
|
||||
inkey (0)
|
||||
|
||||
// CT_ARGERR_WHOCARES on argument error
|
||||
qout ("")
|
||||
qout ("CT_ARGERR_WHOCARES behaviour")
|
||||
CSETARGERR (CT_ARGERR_WHOCARES)
|
||||
qout (" Call to charadd ('AA',.F.):")
|
||||
cRet := charadd ("AA",.F.)
|
||||
qout (" return value was", cRet, "<Press any key>")
|
||||
qout ("")
|
||||
inkey (0)
|
||||
|
||||
// CT_ARGERR_WARNING on argument error
|
||||
qout ("")
|
||||
qout ("CT_ARGERR_WARNING behaviour")
|
||||
CSETARGERR (CT_ARGERR_WARNING)
|
||||
qout (" Call to charadd ('AA',.F.):")
|
||||
cRet := charadd ("AA",.F.)
|
||||
qout (" return value was", cRet, "<Press any key>")
|
||||
qout ("")
|
||||
inkey (0)
|
||||
|
||||
// CT_ARGERR_ERROR on argument error
|
||||
qout ("")
|
||||
qout ("CT_ARGERR_ERROR behaviour")
|
||||
CSETARGERR (CT_ARGERR_ERROR)
|
||||
qout (" Call to charadd ('AA',.F.):")
|
||||
cRet := charadd ("AA",.F.)
|
||||
qout (" return value was", cRet, "<Press any key>")
|
||||
qout ("")
|
||||
inkey (0)
|
||||
|
||||
// CT_ARGERR_CATASTROPHIC on argument error
|
||||
qout ("")
|
||||
qout ("CT_ARGERR_CATASTROPHIC behaviour")
|
||||
CSETARGERR (CT_ARGERR_CATASTROPHIC)
|
||||
qout (" Call to charadd ('AA',.F.):")
|
||||
cRet := charadd ("AA",.F.)
|
||||
qout (" return value was", cRet, "<Press any key>")
|
||||
qout ("")
|
||||
inkey (0)
|
||||
|
||||
qout ("End test of CSETARGERR()")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
function myerrhandler (oerr)
|
||||
|
||||
local ni, nDigit
|
||||
|
||||
memvar Input
|
||||
|
||||
qout (" Error handler called:")
|
||||
qout (" err:severity.....:",oerr:severity)
|
||||
qout (" err:subSystem....:",oerr:subSystem)
|
||||
qout (" err:operation....:",oerr:operation)
|
||||
qout (" len(err:args)....:",len(oerr:args))
|
||||
for ni := 1 to len (oerr:args)
|
||||
qout (" err:args["+alltrim(str(ni))+"]..:",oerr:args[ni])
|
||||
next ni
|
||||
qout (" err:genCode......:",oerr:genCode)
|
||||
qout (" err:subCode......:",oerr:subCode)
|
||||
qout (" err:osCode.......:",oerr:osCode)
|
||||
qout (" err:filename.....:",oerr:filename)
|
||||
qout (" err:tries........:",oerr:tries)
|
||||
qout (" err:cargo........:",oerr:cargo)
|
||||
qout (" err:canDefault...:",oerr:canDefault)
|
||||
qout (" err:canRetry.....:",oerr:canRetry)
|
||||
qout (" err:canSubstitute:",oerr:canSubstitute)
|
||||
qout()
|
||||
|
||||
if oerr:canSubstitute
|
||||
|
||||
private Input := ""
|
||||
|
||||
qout (" Error handler can substitute return value, so please")
|
||||
ACCEPT " type in return value <Return for default>: " TO Input
|
||||
|
||||
if empty (Input)
|
||||
qout (" You have chosen the default return value. Ok, this should ")
|
||||
qout (" be now problem, since the last digit of err:subCode indicates")
|
||||
qout (" the type of the return value:")
|
||||
qout (" 0 is NIL, 1 is String, 2 is Integer,")
|
||||
qout (" 3 is Float, 4 is Boolean, 5 is Date")
|
||||
qout (" 6 is Block, 7 is Array, 8 is Object")
|
||||
qout (" 9 is unknown")
|
||||
nDigit = int (oerr:subCode%10)
|
||||
qout (" Here it's a "+alltrim(str(nDigit))+", so I return a ")
|
||||
do case
|
||||
case nDigit == 0
|
||||
qqout ("NIL.")
|
||||
Input := NIL
|
||||
|
||||
case nDigit == 1
|
||||
qqout ("String.")
|
||||
Input := ""
|
||||
|
||||
case nDigit == 2
|
||||
qqout ("Integer.")
|
||||
Input := 0
|
||||
|
||||
case nDigit == 3
|
||||
qqout ("Float.")
|
||||
Input := 0.0
|
||||
|
||||
case nDigit == 4
|
||||
qqout ("Boolean.")
|
||||
Input := .F.
|
||||
|
||||
case nDigit == 5
|
||||
qqout ("Date.")
|
||||
Input := ctod ("")
|
||||
|
||||
case nDigit == 6
|
||||
qqout ("Block.")
|
||||
Input := {||NIL}
|
||||
|
||||
case nDigit == 7
|
||||
qqout ("Array.")
|
||||
Input := {}
|
||||
|
||||
case nDigit == 8
|
||||
qqout ("Object.")
|
||||
Input := GetNew()
|
||||
|
||||
case nDigit == 9
|
||||
qqout ("<don't know, NIL would be best.")
|
||||
Input := NIL
|
||||
|
||||
endcase
|
||||
|
||||
endif
|
||||
|
||||
return (Input)
|
||||
|
||||
endif
|
||||
|
||||
if oerr:canDefault
|
||||
qout (" Subsystem can set the default value itself, so this error")
|
||||
qout (" is only informative.")
|
||||
endif
|
||||
|
||||
return (.F.)
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CSETATMUPA()")
|
||||
qout (" Default switch should be .F., is..................................", csetatmupa())
|
||||
qout (" Setting switch to .T., return value should be .F., is.............", csetatmupa (.T.))
|
||||
@@ -66,4 +68,6 @@ procedure main
|
||||
qout ("End test of CSETATMUPA()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of CSETREF()")
|
||||
qout (" Default switch should be .F., is..................................", csetref())
|
||||
qout (" Setting switch to .T., return value should be .F., is.............", csetref (.T.))
|
||||
@@ -66,4 +68,6 @@ procedure main
|
||||
qout ("End test of CSETREF()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local cStr := ".,.This.,.is.,.a.,.test!"
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of NUMTOKEN()")
|
||||
qout ("")
|
||||
|
||||
@@ -82,6 +84,8 @@ local cStr := ".,.This.,.is.,.a.,.test!"
|
||||
qout ("End test of NUMTOKEN()")
|
||||
qout ()
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local cWildcard := " "
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of SETATLIKE()")
|
||||
qout (" Default mode should be 0, is................................", setatlike())
|
||||
qout (" Setting mode to 1, return value should be 0, is.............", setatlike (1))
|
||||
@@ -75,4 +77,6 @@ procedure main
|
||||
qout ("End test of SETATLIKE()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
@@ -63,6 +63,8 @@ local ni, npos
|
||||
local cPre := " "
|
||||
local cPost := " "
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of TOKEN()")
|
||||
qout ("")
|
||||
|
||||
@@ -95,6 +97,8 @@ local cPost := " "
|
||||
qout ("End test of TOKEN()")
|
||||
qout ()
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local cStr := ".,.This.,.is.,.a.,.test!"
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of TOKENLOWER()")
|
||||
qout ("")
|
||||
|
||||
@@ -86,6 +88,8 @@ local cStr := ".,.This.,.is.,.a.,.test!"
|
||||
qout ("End test of TOKENLOWER()")
|
||||
qout ()
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -63,6 +63,8 @@ local ni, npos
|
||||
local cPre := " "
|
||||
local cPost := " "
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of TOKENSEP()")
|
||||
qout ("")
|
||||
|
||||
@@ -88,6 +90,8 @@ local cPost := " "
|
||||
qout ("End test of TOKENSEP()")
|
||||
qout ()
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -60,6 +60,8 @@ procedure main
|
||||
|
||||
local cStr := ".,.This.,.is.,.a.,.test!"
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of TOKENUPPER()")
|
||||
qout ("")
|
||||
|
||||
@@ -86,6 +88,8 @@ local cStr := ".,.This.,.is.,.a.,.test!"
|
||||
qout ("End test of TOKENUPPER()")
|
||||
qout ()
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of VALPOS()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of VALPOS()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of WORDONE()")
|
||||
qout ("")
|
||||
|
||||
@@ -71,6 +73,8 @@ procedure main
|
||||
qout ("End test of WORDONE()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of WORDONLY()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of WORDONLY()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of WORDREM()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of WORDREM()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of WORDREPL()")
|
||||
qout ("")
|
||||
|
||||
@@ -77,6 +79,8 @@ procedure main
|
||||
qout ("End test of WORDREPL()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
@@ -58,6 +58,8 @@
|
||||
|
||||
procedure main
|
||||
|
||||
ctinit()
|
||||
|
||||
qout ("Begin test of WORDSWAP()")
|
||||
qout ("")
|
||||
|
||||
@@ -70,6 +72,8 @@ procedure main
|
||||
qout ("End test of WORDSWAP()")
|
||||
qout ("")
|
||||
|
||||
ctexit()
|
||||
|
||||
return
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user