fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2013-03-10 14:14 UTC+0100 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/hbtest/core.prg
    + use octal notation for all non-displayable bytes.
      It fixes few issues with previous escaping logic
      and avoids non-displayable chars in RTE test sources
      and results.
    + use more space for test results, less for line numbers

  * contrib/hbtest/tests/test.prg
    * adapted to above change
    + added more tests

  * contrib/hbamf/tests/test.prg
    * use octal notation in expected results

  * contrib/hbct/charone.c
    ! WordOne(): fixed when second parameter is not passed
      (previously it was a noop in this case)

  * contrib/hbct/tests/test.prg
    ! typos in comments

  * utils/hbtest/hbtest.prg
    + force switch to cp437 ("EN") under Harbour
    * runtime configuration moved right to startup

  * contrib/hbnf/popadder.prg
  * extras/gtwvw/docs/gtwvw.txt
  * utils/hbtest/rt_misc.prg
  * utils/hbtest/rt_str.prg
  * tests/setmode.prg
    ! avoid remaining non-ASCII, non-UTF8 chars in source

  * contrib/hbmisc/nconvert.prg
  * contrib/hbnf/netpv.prg
  * contrib/hbnf/popadder.prg
  * contrib/hbnf/round.prg
  * contrib/hbnf/sqzn.prg
  * tests/money.prg
  * tests/str.prg
    * use '^' operator instead of '**'

  * contrib/hbmisc/stringp.prg
  * contrib/hbwin/tests/prn2.prg
    * cleanups
This commit is contained in:
Viktor Szakats
2013-03-10 13:17:07 +00:00
parent ee8769162a
commit 1c0374484c
20 changed files with 234 additions and 143 deletions
Download Patch File Download Diff File Expand all files Collapse all files

46
harbour/ChangeLog.txt
View File

@@ -10,6 +10,52 @@
* Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment
*/
2013-03-10 14:14 UTC+0100 Viktor Szakats (harbour syenar.net)
* contrib/hbtest/core.prg
+ use octal notation for all non-displayable bytes.
It fixes few issues with previous escaping logic
and avoids non-displayable chars in RTE test sources
and results.
+ use more space for test results, less for line numbers
* contrib/hbtest/tests/test.prg
* adapted to above change
+ added more tests
* contrib/hbamf/tests/test.prg
* use octal notation in expected results
* contrib/hbct/charone.c
! WordOne(): fixed when second parameter is not passed
(previously it was a noop in this case)
* contrib/hbct/tests/test.prg
! typos in comments
* utils/hbtest/hbtest.prg
+ force switch to cp437 ("EN") under Harbour
* runtime configuration moved right to startup
* contrib/hbnf/popadder.prg
* extras/gtwvw/docs/gtwvw.txt
* utils/hbtest/rt_misc.prg
* utils/hbtest/rt_str.prg
* tests/setmode.prg
! avoid remaining non-ASCII, non-UTF8 chars in source
* contrib/hbmisc/nconvert.prg
* contrib/hbnf/netpv.prg
* contrib/hbnf/popadder.prg
* contrib/hbnf/round.prg
* contrib/hbnf/sqzn.prg
* tests/money.prg
* tests/str.prg
* use '^' operator instead of '**'
* contrib/hbmisc/stringp.prg
* contrib/hbwin/tests/prn2.prg
* cleanups
2013-03-09 14:06 UTC+0100 Viktor Szakats (harbour syenar.net)
* contrib/hbct/tests/charadd.prg
* contrib/hbct/tests/charand.prg

48
harbour/contrib/hbamf/tests/test.prg
View File

@@ -11,34 +11,34 @@ PROCEDURE Main()
hb_cdpSelect( "UTF8EX" )
HBTEST _enc( {} ) IS "09 01 01"
HBTEST _enc( "a" ) IS "06 03 61"
HBTEST _enc( "ą" ) IS "06 05 C4 85"
HBTEST _enc( 1 ) IS "04 01"
HBTEST _enc( 1000 ) IS "04 87 68"
HBTEST _enc( 1000000 ) IS "04 BD 84 40"
HBTEST _enc( 268435455 ) IS "04 BF FF FF FF"
HBTEST _enc( 268435456 ) IS "05 41 B0 00 00 00 00 00 00"
HBTEST _enc( 268435456000 ) IS "05 42 4F 40 00 00 00 00 00"
HBTEST _enc( -1 ) IS "04 FF FF FF FF"
HBTEST _enc( 9007199254740990 ) IS "05 43 3F FF FF FF FF FF FE"
HBTEST _enc( amf3_Decode( amf3_Encode( 9007199254740990 ) ) ) IS "05 43 3F FF FF FF FF FF FE"
HBTEST _enc( 9007199254740991 ) IS "05 43 3F FF FF FF FF FF FF"
HBTEST _enc( amf3_Decode( amf3_Encode( 9007199254740991 ) ) ) IS "05 43 3F FF FF FF FF FF FF"
HBTEST _enc( 9007199254740991.00 ) IS "05 43 3F FF FF FF FF FF FF"
HBTEST _enc( 6969.69 ) IS "05 40 BB 39 B0 A3 D7 0A 3D"
HBTEST _enc( NIL ) IS "01"
HBTEST _enc( .T. ) IS "03"
HBTEST _enc( .F. ) IS "02"
HBTEST _enc( { 1, -1 } ) IS "09 05 01 04 01 04 FF FF FF FF"
HBTEST _enc( { "ONE" => 0xcafe, "TWO" => 0xbabe } ) IS "09 01 07 4F 4E 45 04 83 95 7E 07 54 57 4F 04 82 F5 3E 01"
HBTEST amf3_Encode( {} ) IS e"\011\001\001"
HBTEST amf3_Encode( "a" ) IS e"\006\003a"
HBTEST amf3_Encode( "ą" ) IS e"\006\005\304\205"
HBTEST amf3_Encode( 1 ) IS e"\004\001"
HBTEST amf3_Encode( 1000 ) IS e"\004\207h"
HBTEST amf3_Encode( 1000000 ) IS e"\004\275\204@"
HBTEST amf3_Encode( 268435455 ) IS e"\004\277\377\377\377"
HBTEST amf3_Encode( 268435456 ) IS e"\005A\260\000\000\000\000\000\000"
HBTEST amf3_Encode( 268435456000 ) IS e"\005BO@\000\000\000\000\000"
HBTEST amf3_Encode( -1 ) IS e"\004\377\377\377\377"
HBTEST amf3_Encode( 9007199254740990 ) IS e"\005C?\377\377\377\377\377\376"
HBTEST amf3_Encode( amf3_Decode( amf3_Encode( 9007199254740990 ) ) ) IS e"\005C?\377\377\377\377\377\376"
HBTEST amf3_Encode( 9007199254740991 ) IS e"\005C?\377\377\377\377\377\377"
HBTEST amf3_Encode( amf3_Decode( amf3_Encode( 9007199254740991 ) ) ) IS e"\005C?\377\377\377\377\377\377"
HBTEST amf3_Encode( 9007199254740991.00 ) IS e"\005C?\377\377\377\377\377\377"
HBTEST amf3_Encode( 6969.69 ) IS e"\005@\2739\260\243\327\012="
HBTEST amf3_Encode( NIL ) IS e"\001"
HBTEST amf3_Encode( .T. ) IS e"\003"
HBTEST amf3_Encode( .F. ) IS e"\002"
HBTEST amf3_Encode( { 1, -1 } ) IS e"\011\005\001\004\001\004\377\377\377\377"
HBTEST amf3_Encode( { "ONE" => 0xCAFE, "TWO" => 0xBABE } ) IS e"\011\001\007ONE\004\203\225~\007TWO\004\202\365>\001"
RETURN
STATIC FUNCTION _enc( a )
#if 0
STATIC FUNCTION _enchex( a ) /* for hex notation */
RETURN hb_StrToHex( amf3_Encode( a ), " " )
#if 0
STATIC FUNCTION _encsum( a ) /* for longer values */
STATIC FUNCTION _encsum( a ) /* for longer values */
RETURN hb_NumToHex( hb_CRC( amf3_Encode( a ) ), 4 )
#endif

2
harbour/contrib/hbct/charone.c
View File

@@ -124,7 +124,7 @@ static void do_charone( int iSwitch )
break;
case DO_CHARONE_WORDONE:
if( sStrLen > 3 && sDeleteSetLen >= 2 )
if( sStrLen > 3 && ( pcDeleteSet == NULL || sDeleteSetLen >= 2 ) )
{
const char * pcSub;
char * pcRet;

6
harbour/contrib/hbct/tests/test.prg
View File

@@ -25,12 +25,12 @@ PROCEDURE Main()
HBTEST AscPos( "0123456789" ) IS 57
HBTEST AscPos( "0123456789", 1 ) IS 48
HBTEST AscPos( "0123456789", 11 ) IS 0 // <nPosition> to large !
HBTEST AscPos( "0123456789", 11 ) IS 0 // <nPosition> too large !
HBTEST ValPos( "1234x56789" ) IS 9
HBTEST ValPos( "1234x56789", 1 ) IS 1
HBTEST ValPos( "1234x56789", 11 ) IS 0 // <nPosition> to large !
HBTEST ValPos( "1234x56789", 5 ) IS 0 // "x" is not a digit !
HBTEST ValPos( "1234x56789", 11 ) IS 0 // <nPosition> too large !
HBTEST ValPos( "1234x56789", 5 ) IS 0 // "x" is not a digit !
HBTEST AfterAtNum( "..", "..This..is..a..test!" ) IS "test!"
HBTEST AfterAtNum( "..", "..This..is..a..test!", 2 ) IS "is..a..test!"

6
harbour/contrib/hbmisc/nconvert.prg
View File

@@ -148,7 +148,7 @@ FUNCTION BinToDec( cString )
LOCAL nLen := Len( cNewString )
FOR nX := 1 TO nLen
nNumber += ( At( SubStr( cNewString, nX, 1 ), "01" ) - 1 ) * ( 2 ** ( nLen - nX ) )
nNumber += ( At( SubStr( cNewString, nX, 1 ), "01" ) - 1 ) * ( 2 ^ ( nLen - nX ) )
NEXT
RETURN nNumber
@@ -160,7 +160,7 @@ FUNCTION OctalToDec( cString )
LOCAL nLen := Len( cNewString )
FOR nX := 1 TO nLen
nNumber += ( At( SubStr( cNewString, nX, 1 ), "01234567" ) - 1 ) * ( 8 ** ( nLen - nX ) )
nNumber += ( At( SubStr( cNewString, nX, 1 ), "01234567" ) - 1 ) * ( 8 ^ ( nLen - nX ) )
NEXT
RETURN nNumber
@@ -172,7 +172,7 @@ FUNCTION HexaToDec( cString )
LOCAL nLen := Len( cNewString )
FOR nX := 1 TO nLen
nNumber += ( At( SubStr( cNewString, nX, 1 ), "0123456789ABCDEF" ) - 1 ) * ( 16 ** ( nLen - nX ) )
nNumber += ( At( SubStr( cNewString, nX, 1 ), "0123456789ABCDEF" ) - 1 ) * ( 16 ^ ( nLen - nX ) )
NEXT
RETURN nNumber

33
harbour/contrib/hbmisc/stringp.prg
View File

@@ -55,23 +55,23 @@
/*
* Convert to character
*
* ToChar( <xTxt>, [cSeparator], [lDebug] ) --> <cOut>
* <xTxt> : Item to write
* [cSeparator] : Separator for arrays
* [lDebug] : .T. -> Write debug output
* ToChar( <xValue>, [<cSeparator>], [<lDebug>] ) --> <cOut>
* <xValue> : Item to write
* <cSeparator> : Separator for arrays
* <lDebug> : .T. -> Write debug output
*
* In DEBUG mode :
* In <lDebug> mode:
*
* It will show the xItem according to the following format :
* It will show the xItem according to the following format:
*
* Numerical <num>
* Date yyyy-mm-dd
* Character "<chr>"
* Array {<el1>, <el2>, ...}
* NIL NIL
* Logical .T. / .F.
* Object <ClassName>(<ClassH>):{<DataSymbol1>:<val1>, ...}
*
* <num> Numerical
* yyyy-mm-dd Date
* "<chr>" Character
* {<el1>, <el2>, ...} Array
* NIL NIL
* .T. / .F. Boolean
* <ClassName>(<ClassH>):{<DataSymbol1>:<val1>, ... }
* Object
*/
FUNCTION ToChar( xTxt, cSeparator, lDebug )
@@ -94,10 +94,9 @@ FUNCTION ToChar( xTxt, cSeparator, lDebug )
CASE "B" ; RETURN iif( lDebug, "Block", Eval( xTxt ) )
CASE "A"
cOut := ""
IF lDebug
cOut := "{"
ELSE
cOut := ""
cOut += "{"
ENDIF
nLen := Len( xTxt )
FOR n := 1 TO nLen // For each item : Recurse !

2
harbour/contrib/hbnf/netpv.prg
View File

@@ -32,7 +32,7 @@ FUNCTION ft_NetPV( nInitialInvestment, nInterestRate, aCashFlow, nNoOfCashFlows
AEval( aCashFlow, ;
{| nElement, nElementNo | ;
nNetPresentValue += nElement / ;
( ( 1 + ( nInterestRate / 100 ) ) ** nElementNo ) }, ;
( ( 1 + ( nInterestRate / 100 ) ) ^ nElementNo ) }, ;
1, nNoOfCashFlows )
RETURN nNetPresentValue -= nInitialInvestment

5
harbour/contrib/hbnf/popadder.prg
View File

@@ -428,7 +428,7 @@ STATIC FUNCTION _ftProcessNumb( aAdder, nKey )
IF lDecSet // Decimal set
IF nDecDigit < nMaxDeci // Check how many decimals are allowed
nDecDigit := ++nDecDigit
nNumTotal := nNumTotal + nNum / ( 10 ** nDecDigit )
nNumTotal := nNumTotal + nNum / ( 10 ^ nDecDigit )
ENDIF
ELSE
nNumTotal := nNumTotal * 10 + nNum
@@ -1065,7 +1065,8 @@ STATIC FUNCTION _ftStuffComma( cStrToStuff, lTrimStuffedStr )
cStrToStuff := _ftPosIns( cStrToStuff, ".", iif( "C" $ cStrToStuff .OR. ;
"E" $ cStrToStuff .OR. "+" $ cStrToStuff .OR. "-" $ cStrToStuff ;
.OR. "X" $ cStrToStuff .OR. "*" $ cStrToStuff .OR. ;
"" $ cStrToStuff .OR. "/" $ cStrToStuff .OR. "=" $ cStrToStuff, ;
Chr( 4 ) /* LOW-ASCII "♦" */ $ cStrToStuff .OR. ;
"/" $ cStrToStuff .OR. "=" $ cStrToStuff, ;
Len( cStrToStuff ) - 1, Len( cStrToStuff ) + 1 ) )
IF cStrToStuff == " " .OR. cStrToStuff == "0"

4
harbour/contrib/hbnf/round.prg
View File

@@ -38,7 +38,7 @@ FUNCTION ft_Round( nNumber, nRoundToAmount, cRoundType, cRoundDirection, ;
__defaultNIL( @nRoundToAmount, 2 )
__defaultNIL( @cRoundType, NEAREST_DECIMAL )
__defaultNIL( @cRoundDirection, ROUND_NORMAL )
__defaultNIL( @nAcceptableError, 1 / ( nRoundToAmount ** 2 ) )
__defaultNIL( @nAcceptableError, 1 / ( nRoundToAmount ^ 2 ) )
// Are We Rounding to the Nearest Whole
// Number or to Zero Decimal Places??
@@ -50,7 +50,7 @@ FUNCTION ft_Round( nNumber, nRoundToAmount, cRoundType, cRoundDirection, ;
IF Left( cRoundType, 1 ) == NEAREST_DECIMAL
// Yes, Convert to Nearest Fraction
nRoundToAmount := 10 ** nRoundToAmount
nRoundToAmount := 10 ^ nRoundToAmount
ENDIF

2
harbour/contrib/hbnf/sqzn.prg
View File

@@ -27,7 +27,7 @@ FUNCTION ft_Sqzn( nValue, nSize, nDecimals )
__defaultNIL( @nSize, 10 )
__defaultNIL( @nDecimals, 0 )
nValue := nValue * ( 10 ** nDecimals )
nValue := nValue * ( 10 ^ nDecimals )
nSize := iif( ( nSize / 2 ) != Int( nSize / 2 ), nSize + 1, nSize )
tmpstr := Str( Abs( nValue ), nSize )
tmpstr := StrTran( tmpstr, " ", "0" )

55
harbour/contrib/hbtest/core.prg
View File

@@ -53,8 +53,8 @@
#include "error.ch"
#define TEST_RESULT_COL1_WIDTH 1
#define TEST_RESULT_COL2_WIDTH 15
#define TEST_RESULT_COL3_WIDTH 40
#define TEST_RESULT_COL2_WIDTH 11
#define TEST_RESULT_COL3_WIDTH 44
#define TEST_RESULT_COL4_WIDTH 85
THREAD STATIC t_hParams := { => }
@@ -210,28 +210,51 @@ STATIC FUNCTION ErrorMessage( oError )
STATIC FUNCTION XToStr( xValue, lInString )
STATIC sc_hReplace := { ;
Chr( 0 ) => '" + Chr( 0 ) + "', ;
Chr( 1 ) => '" + Chr( 1 ) + "', ;
Chr( 2 ) => '" + Chr( 2 ) + "', ;
Chr( 7 ) => '" + Chr( 7 ) + "', ;
Chr( 8 ) => '" + Chr( 8 ) + "', ;
Chr( 9 ) => '" + Chr( 9 ) + "', ;
Chr( 10 ) => '" + Chr( 10 ) + "', ;
Chr( 11 ) => '" + Chr( 11 ) + "', ;
Chr( 12 ) => '" + Chr( 12 ) + "', ;
Chr( 13 ) => '" + Chr( 13 ) + "' }
SWITCH ValType( xValue )
CASE "N" ; RETURN hb_ntos( xValue )
CASE "D" ; RETURN iif( lInString, "0d" + iif( Empty( xValue ), "00000000", DToS( xValue ) ), 'hb_SToD( "' + DToS( xValue ) + '" )' )
CASE "U" ; RETURN "NIL"
CASE "C"
xValue := hb_StrReplace( xValue, sc_hReplace )
xValue := __StrToExp( xValue )
RETURN iif( lInString, xValue, '"' + xValue + '"' )
CASE "M"
xValue := hb_StrReplace( xValue, sc_hReplace )
xValue := __StrToExp( xValue )
RETURN "M:" + iif( lInString, xValue, '"' + xValue + '"' )
ENDSWITCH
RETURN hb_CStr( xValue )
STATIC FUNCTION __StrToExp( cStr )
LOCAL cResult := ""
LOCAL nLen, nPos
LOCAL nByte, cByte
nLen := hb_BLen( cStr )
FOR nPos := 1 TO nLen
cByte := hb_BSubStr( cStr, nPos, 1 )
nByte := hb_BCode( cByte )
IF ! __ByteIsDisplayable( nByte ) .OR. cByte == '"'
cResult += "\" + __ByteToOctal( nByte )
ELSE
cResult += cByte
ENDIF
NEXT
RETURN cResult
STATIC FUNCTION __ByteIsDisplayable( nByte )
RETURN nByte >= 32 .AND. nByte < 128
STATIC FUNCTION __ByteToOctal( nValue )
LOCAL cResult := ""
LOCAL nExp
FOR nExp := 2 TO 0 STEP -1
cResult += SubStr( "01234567", Int( nValue / ( 8 ^ nExp ) ) + 1, 1 )
nValue %= 8 ^ nExp
NEXT
RETURN cResult

33
harbour/contrib/hbtest/tests/test.prg
View File

@@ -6,17 +6,26 @@
PROCEDURE Main()
HBTEST 2 + 2 IS 4
HBTEST 2 + 2 IS 5
HBTEST "a" + "b" IS "ab"
HBTEST 2 + "" IS "E 1 BASE 1081 Argument error (+) OS:0 #:0 A:2:N:2;C: F:S"
HBTEST 2 + Chr( 9 ) IS "E 1 BASE 1081 Argument error (+) OS:0 #:0 A:2:N:2;C:" + Chr( 9 ) + " F:S"
HBTEST Chr( 0 ) IS Chr( 0 )
HBTEST 0d20111213 IS 0d20111213
HBTEST NIL IS NIL
HBTEST .T. IS .T.
HBTEST .T. IS .F.
HBTEST .T. - .F. IS "E 1 BASE 1082 Argument error (-) OS:0 #:0 A:2:L:.T.;L:.F. F:S"
HBTEST " " + " " IS " "
HBTEST 2 + 2 IS 4
HBTEST "a" + "b" IS "ab"
HBTEST Chr( 0 ) IS Chr( 0 )
HBTEST 0d20111213 IS 0d20111213
HBTEST NIL IS NIL
HBTEST .T. IS .T.
HBTEST " " + " " IS " "
/* RTEs */
HBTEST 2 + "" IS "E 1 BASE 1081 Argument error (+) OS:0 #:0 A:2:N:2;C: F:S"
HBTEST 2 + Chr( 9 ) IS "E 1 BASE 1081 Argument error (+) OS:0 #:0 A:2:N:2;C:\011 F:S"
HBTEST 2 + '"' IS "E 1 BASE 1081 Argument error (+) OS:0 #:0 A:2:N:2;C:\042 F:S"
HBTEST 2 + "'" IS "E 1 BASE 1081 Argument error (+) OS:0 #:0 A:2:N:2;C:' F:S"
HBTEST "" + 0d20111213 IS "E 1 BASE 1081 Argument error (+) OS:0 #:0 A:2:C:;D:0d20111213 F:S"
HBTEST .T. - .F. IS "E 1 BASE 1082 Argument error (-) OS:0 #:0 A:2:L:.T.;L:.F. F:S"
/* mismatches */
HBTEST hb_BChar( 254 ) IS hb_BChar( 255 )
HBTEST 0d20111213 IS 0d20111214
HBTEST 2 + 2 IS 5
HBTEST .T. IS .F.
RETURN

11
harbour/contrib/hbwin/tests/prn2.prg
View File

@@ -34,10 +34,19 @@ PROCEDURE Main()
STATIC PROCEDURE PrnTest( cPrinter, cFileName )
LOCAL lDelete
IF Empty( cFileName )
hb_MemoWrit( cFileName := "_hbtest.prn", "Hello World!" + Chr( 12 ) )
hb_MemoWrit( cFileName := hb_FNameExtSet( __FILE__, ".prn" ), "Hello World!" + Chr( 12 ) )
lDelete := .T.
ELSE
lDelete := .F.
ENDIF
Alert( "win_PrintFileRaw() returned: " + hb_ntos( win_PrintFileRaw( cPrinter, cFileName, "testing raw printing" ) ) )
IF lDelete
FErase( cFileName )
ENDIF
RETURN

4
harbour/extras/gtwvw/docs/gtwvw.txt
View File

@@ -66,10 +66,10 @@ GTWVW was initially created based on:
based on
Bcc ConIO Video subsystem by
Copyright 2002 Marek Paliwoda <paliwoda@inteia.pl>
Copyright 2002 Przemys³aw Czerpak <druzus@polbox.com>
Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
Video subsystem for Win32 compilers
Copyright 1999-2000 Paul Tucker <ptucker@sympatico.ca>
Copyright 2002 Przemys³aw Czerpak <druzus@polbox.com>
Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
The following parts are Copyright of the individual authors.
www - http://www.harbour-project.org

2
harbour/tests/money.prg
View File

@@ -75,7 +75,7 @@ METHOD new( nValue, nDec ) CLASS Money
hb_default( @nValue, 0 )
::nDec := nDec
::nMul := Int( 10 ** nDec )
::nMul := Int( 10 ^ nDec )
::Set( nValue )
RETURN Self

2
harbour/tests/setmode.prg
View File

@@ -65,7 +65,7 @@ PROCEDURE TESTBOX( cMode )
@ 0, 3 SAY cMode
@ MaxRow(), 3 SAY " Press a key "
@ 8, 0 SAY Replicate( " ", 20 )
@ 8, 0 SAY Replicate( Chr( 25 ) /* LOW-ASCII "↓" */ + " ", 20 )
@ 9, 0 SAY Replicate( "0123456789", 20 )
FOR nRow := 0 TO MaxRow()

4
harbour/tests/str.prg
View File

@@ -38,7 +38,7 @@ PROCEDURE test()
?? "3: "
?? a % b
?? a ** b
?? a ^ b
?
c := a * b
@@ -70,7 +70,7 @@ PROCEDURE test()
FOR nI := 1 TO 20
?
?? Str( 6 + nI ) + ": "
?? 10 ** nI + ( 1.02 * 1.02 )
?? 10 ^ nI + ( 1.02 * 1.02 )
NEXT
?

35
harbour/utils/hbtest/hbtest.prg
View File

@@ -203,13 +203,26 @@ STATIC PROCEDURE TEST_BEGIN( cParam )
s_nStartTime := Seconds()
s_lShowAll := ;
"/ALL" $ Upper( cParam ) .OR. ;
"-ALL" $ Upper( cParam )
/* Set up the initial state */
s_aSkipList := ListToNArray( CMDLGetValue( Upper( cParam ), "/SKIP:", "" ) )
#ifdef __HARBOUR__
hb_cdpSelect( "EN" )
hb_langSelect( "en" )
#endif
Set( _SET_DATEFORMAT, "yyyy-mm-dd" )
SET EXACT OFF
FErase( "NOT_HERE.$$$" )
/* Options */
s_lShowAll := ;
"/all" $ Lower( cParam ) .OR. ;
"-all" $ Lower( cParam )
s_aSkipList := ListToNArray( CMDLGetValue( Lower( cParam ), "/skip:", "" ) )
IF Empty( s_aSkipList )
s_aSkipList := ListToNArray( CMDLGetValue( Upper( cParam ), "-SKIP:", "" ) )
s_aSkipList := ListToNArray( CMDLGetValue( Lower( cParam ), "-skip:", "" ) )
ENDIF
/* Detect presence of shortcutting optimization */
@@ -225,16 +238,6 @@ STATIC PROCEDURE TEST_BEGIN( cParam )
s_nPass := 0
s_nFail := 0
/* Set up the initial state */
#ifdef __HARBOUR__
hb_langSelect( "en" )
#endif
Set( _SET_DATEFORMAT, "yyyy-mm-dd" )
SET EXACT OFF
FErase( "NOT_HERE.$$$" )
/* Feedback */
OutMsg( s_nFhnd, ;
@@ -247,7 +250,7 @@ STATIC PROCEDURE TEST_BEGIN( cParam )
OutMsg( s_nFhnd, ;
" OS: " + OS() + hb_eol() +;
" Date, Time: " + DToC( Date() ) + " " + Time() + hb_eol() +;
"Shortcut opt.: " + iif( s_lShortcut, "ON", "OFF" ) + hb_eol() +;
"Shortcut opt.: " + iif( s_lShortcut, "On", "Off" ) + hb_eol() +;
" Switches: " + cParam + hb_eol() +;
"===========================================================================" + hb_eol() )

27
harbour/utils/hbtest/rt_misc.prg
View File

@@ -402,8 +402,8 @@ PROCEDURE Main_MISC()
HBTEST SoundEx( "Cold" ) IS "C430"
HBTEST SoundEx( "Colt" ) IS "C430"
HBTEST SoundEx( "C" + Chr( 0 ) + "olt" ) IS "C430"
HBTEST SoundEx( "µ A<C2A0>‚" ) IS "A000"
HBTEST SoundEx( "12345" ) IS "0000"
HBTEST SoundEx( Chr( 181 ) + Chr( 160 ) + "A" + Chr( 144 ) + Chr( 130 ) ) IS "A000"
#endif
/* NATION functions (do not exist in 5.2e US) */
@@ -615,10 +615,11 @@ PROCEDURE Main_MISC()
HBTEST Descend( NIL ) IS NIL
HBTEST Descend( { "A", "B" } ) IS NIL
#ifdef __HARBOUR__
HBTEST Descend( @scString ) IS "¸»´´±" /* Bug in CA-Cl*pper, it will return NIL */
HBTEST Descend( @scString ) IS Chr( 184 ) + Chr( 187 ) + Chr( 180 ) + Chr( 180 ) + Chr( 177 ) /* Bug in CA-Cl*pper, it will return NIL */
#endif
HBTEST Descend( scString ) IS "¸»´´±"
HBTEST Descend( scString ) IS "¸»´´±"
HBTEST Descend( scString ) IS Chr( 184 ) + Chr( 187 ) + Chr( 180 ) + Chr( 180 ) + Chr( 177 )
HBTEST Descend( scString ) IS Chr( 184 ) + Chr( 187 ) + Chr( 180 ) + Chr( 180 ) + Chr( 177 )
HBTEST Descend( Descend( scString ) ) IS "HELLO"
HBTEST Descend( .F. ) IS .T.
HBTEST Descend( .T. ) IS .F.
@@ -637,8 +638,8 @@ PROCEDURE Main_MISC()
HBTEST Descend( -100000 ) IS 100000.00
HBTEST Descend( "" ) IS ""
HBTEST Descend( Chr( 0 ) ) IS Chr( 0 )
HBTEST Descend( Chr( 0 ) + "Hello" ) IS Chr( 0 ) + "¸›””‘"
HBTEST Descend( "Hello" + Chr( 0 ) + "wo" ) IS "¸›””‘" + Chr( 0 ) + "‰‘"
HBTEST Descend( Chr( 0 ) + "Hello" ) IS Chr( 0 ) + Chr( 184 ) + Chr( 155 ) + Chr( 148 ) + Chr( 148 ) + Chr( 145 )
HBTEST Descend( "Hello" + Chr( 0 ) + "wo" ) IS Chr( 184 ) + Chr( 155 ) + Chr( 148 ) + Chr( 148 ) + Chr( 145 ) + Chr( 0 ) + Chr( 137 ) + Chr( 145 )
HBTEST Descend( hb_SToD( "" ) ) IS 5231808
HBTEST Descend( hb_SToD( "01000101" ) ) IS 3474223
HBTEST Descend( hb_SToD( "19801220" ) ) IS 2787214
@@ -775,8 +776,8 @@ PROCEDURE Main_MISC()
HBTEST I2Bin( 0 ) IS Chr( 0 ) + Chr( 0 )
HBTEST I2Bin( 16961 ) IS "AB"
HBTEST I2Bin( 16706 ) IS "BA"
HBTEST I2Bin( 255 ) IS "ÿ" + Chr( 0 )
HBTEST I2Bin( -1 ) IS "ÿÿ"
HBTEST I2Bin( 255 ) IS Chr( 255 ) + Chr( 0 )
HBTEST I2Bin( -1 ) IS Chr( 255 ) + Chr( 255 )
HBTEST I2Bin( 0 ) IS Chr( 0 ) + Chr( 0 )
HBTEST I2Bin( 1 ) IS Chr( 1 ) + Chr( 0 )
HBTEST I2Bin( 65 ) IS "A" + Chr( 0 )
@@ -791,8 +792,8 @@ PROCEDURE Main_MISC()
HBTEST L2Bin( 0 ) IS Chr( 0 ) + Chr( 0 ) + Chr( 0 ) + Chr( 0 )
HBTEST L2Bin( 1145258561 ) IS "ABCD"
HBTEST L2Bin( 1094861636 ) IS "DCBA"
HBTEST L2Bin( 255 ) IS "ÿ" + Chr( 0 ) + Chr( 0 ) + Chr( 0 )
HBTEST L2Bin( 16777215 ) IS "ÿÿÿ" + Chr( 0 )
HBTEST L2Bin( 255 ) IS Chr( 255 ) + Chr( 0 ) + Chr( 0 ) + Chr( 0 )
HBTEST L2Bin( 16777215 ) IS Chr( 255 ) + Chr( 255 ) + Chr( 255 ) + Chr( 0 )
HBTEST L2Bin( -1 ) IS Chr( 255 ) + Chr( 255 ) + Chr( 255 ) + Chr( 255 )
HBTEST L2Bin( 0 ) IS Chr( 0 ) + Chr( 0 ) + Chr( 0 ) + Chr( 0 )
HBTEST L2Bin( 1 ) IS Chr( 1 ) + Chr( 0 ) + Chr( 0 ) + Chr( 0 )
@@ -876,7 +877,7 @@ PROCEDURE Main_MISC()
HBTEST MemoTran( "M"+CR+"s"+CR+LF+"w"+SO+"w"+SO+LF+"h"+CR, "111", "222" ) IS "M" + Chr( 13 ) + "s1w" + Chr( 141 ) + "w2h" + Chr( 13 )
HBTEST MemoTran( "M"+CR+"s"+CR+LF+"w"+SO+"w"+SO+LF+"h"+CR, "", "" ) IS "M" + Chr( 13 ) + "s" + Chr( 0 ) + "w" + Chr( 141 ) + "w" + Chr( 0 ) + "h" + Chr( 13 )
/* MEMOWRITE()/MemoRead() */
/* MemoWrit()/MemoRead() */
#ifndef __XPP__
HBTEST MemoWrit() IS .F.
@@ -1102,8 +1103,8 @@ PROCEDURE Main_OPOVERL()
HBTEST oString .AND. "TST" IS "Hello AND TST"
HBTEST oString .OR. "TST" IS "Hello OR TST"
ENDIF
HBTEST .NOT. oString IS "¸›””‘"
HBTEST !oString IS "¸›””‘"
HBTEST .NOT. oString IS Chr( 184 ) + Chr( 155 ) + Chr( 148 ) + Chr( 148 ) + Chr( 145 )
HBTEST ! oString IS Chr( 184 ) + Chr( 155 ) + Chr( 148 ) + Chr( 148 ) + Chr( 145 )
HBTEST oString++ IS "HB_TSTRING Object"
HBTEST oString:cValue IS "Hello "
HBTEST oString-- IS "HB_TSTRING Object"

50
harbour/utils/hbtest/rt_str.prg
View File

@@ -187,9 +187,9 @@ PROCEDURE Main_STR()
HBTEST Chr( NIL ) IS "E 1 BASE 1104 Argument error (CHR) OS:0 #:0 A:1:U:NIL F:S"
HBTEST Chr( "A" ) IS "E 1 BASE 1104 Argument error (CHR) OS:0 #:0 A:1:C:A F:S"
HBTEST Chr( "ADDDDDD" ) IS "E 1 BASE 1104 Argument error (CHR) OS:0 #:0 A:1:C:ADDDDDD F:S"
HBTEST Chr( -10000000.0 ) IS "€"
HBTEST Chr( -100000 ) IS "`"
HBTEST Chr( -65 ) IS "¿"
HBTEST Chr( -10000000.0 ) IS Chr( 128 )
HBTEST Chr( -100000 ) IS Chr( 96 )
HBTEST Chr( -65 ) IS Chr( 191 )
HBTEST Chr( snIntP1 ) IS "A"
#ifdef __HARBOUR__
HBTEST Chr( @snIntP1 ) IS "A" /* Bug in CA-Cl*pper, it returns: "E 1 BASE 1104 Argument error (CHR) OS:0 #:0 A:1:U:65 F:S" */
@@ -206,19 +206,19 @@ PROCEDURE Main_STR()
HBTEST Chr( 66.4 ) IS "B"
HBTEST Chr( 66.5 ) IS "B"
HBTEST Chr( 66.6 ) IS "B"
HBTEST Chr( 255 ) IS "ÿ"
HBTEST Chr( 255 ) IS Chr( 255 ) /* somewhat pointless test ;) */
HBTEST Chr( 256 ) IS "" /* Due to a bug in CA-Cl*pper compiler optimizer. It should return Chr( 0 ) */
HBTEST Chr( 256.0 ) IS Chr( 0 )
HBTEST Chr( 256.1 ) IS Chr( 0 )
HBTEST Chr( ( 256 ) ) IS Chr( 0 ) /* Double paranthesis should be used here to avoid the optimizer of the CA-Cl*pper compiler */
HBTEST Chr( 257 ) IS ""
HBTEST Chr( 257 ) IS Chr( 1 )
HBTEST Chr( ( 512 ) ) IS Chr( 0 ) /* Double paranthesis should be used here to avoid the optimizer of the CA-Cl*pper compiler */
HBTEST Chr( 1023 ) IS "ÿ"
HBTEST Chr( 1023 ) IS Chr( 255 )
HBTEST Chr( ( 1024 ) ) IS Chr( 0 ) /* Double paranthesis should be used here to avoid the optimizer of the CA-Cl*pper compiler */
HBTEST Chr( 1025 ) IS ""
HBTEST Chr( 1000 ) IS "è"
HBTEST Chr( 100000 ) IS " "
HBTEST Chr( 100000.0 ) IS " "
HBTEST Chr( 1025 ) IS Chr( 1 )
HBTEST Chr( 1000 ) IS Chr( 232 )
HBTEST Chr( 100000 ) IS Chr( 160 )
HBTEST Chr( 100000.0 ) IS Chr( 160 )
#ifdef __HARBOUR__
/* enable Harbour extensions and test correct results results */
#pragma -kh+
@@ -229,19 +229,19 @@ PROCEDURE Main_STR()
HBTEST Chr( 66.4 ) IS "B"
HBTEST Chr( 66.5 ) IS "B"
HBTEST Chr( 66.6 ) IS "B"
HBTEST Chr( 255 ) IS "ÿ"
HBTEST Chr( 255 ) IS Chr( 255 )
HBTEST Chr( 256 ) IS Chr( 0 )
HBTEST Chr( 256.0 ) IS Chr( 0 )
HBTEST Chr( 256.1 ) IS Chr( 0 )
HBTEST Chr( ( 256 ) ) IS Chr( 0 )
HBTEST Chr( 257 ) IS ""
HBTEST Chr( 257 ) IS Chr( 1 )
HBTEST Chr( ( 512 ) ) IS Chr( 0 )
HBTEST Chr( 1023 ) IS "ÿ"
HBTEST Chr( 1023 ) IS Chr( 255 )
HBTEST Chr( ( 1024 ) ) IS Chr( 0 )
HBTEST Chr( 1025 ) IS ""
HBTEST Chr( 1000 ) IS "è"
HBTEST Chr( 100000 ) IS " "
HBTEST Chr( 100000.0 ) IS " "
HBTEST Chr( 1025 ) IS Chr( 1 )
HBTEST Chr( 1000 ) IS Chr( 232 )
HBTEST Chr( 100000 ) IS Chr( 160 )
HBTEST Chr( 100000.0 ) IS Chr( 160 )
#endif
/* Asc() */
@@ -325,8 +325,8 @@ PROCEDURE Main_STR()
HBTEST IsUpper( "K" ) IS .T.
HBTEST IsUpper( "Z" ) IS .T.
HBTEST IsUpper( "z" ) IS .F.
HBTEST IsUpper( "™" ) IS .F.
HBTEST IsUpper( "”" ) IS .F.
HBTEST IsUpper( Chr( 153 ) ) IS .F.
HBTEST IsUpper( Chr( 148 ) ) IS .F.
/* IsLower() */
@@ -345,8 +345,8 @@ PROCEDURE Main_STR()
HBTEST IsLower( "K" ) IS .F.
HBTEST IsLower( "Z" ) IS .F.
HBTEST IsLower( "z" ) IS .T.
HBTEST IsLower( "™" ) IS .F.
HBTEST IsLower( "”" ) IS .F.
HBTEST IsLower( Chr( 153 ) ) IS .F.
HBTEST IsLower( Chr( 148 ) ) IS .F.
/* AllTrim() */
@@ -478,8 +478,8 @@ PROCEDURE Main_STR()
HBTEST Upper( "AazazA" ) IS "AAZAZA"
HBTEST Upper( "Aaz" + Chr( 0 ) + "zA" ) IS "AAZ" + Chr( 0 ) + "ZA"
HBTEST Upper( "z" ) IS "Z"
HBTEST Upper( " µ" ) IS " µ"
HBTEST Upper( "H rbor 8-) µ" ) IS "H RBOR 8-) µ"
HBTEST Upper( Chr( 160 ) + Chr( 181 ) ) IS Chr( 160 ) + Chr( 181 )
HBTEST Upper( "H" + Chr( 160 ) + "rbor 8-) " + Chr( 181 ) ) IS "H" + Chr( 160 ) + "RBOR 8-) " + Chr( 181 )
/* Lower() */
@@ -497,8 +497,8 @@ PROCEDURE Main_STR()
HBTEST Lower( "AazazA" ) IS "aazaza"
HBTEST Lower( "Aaz" + Chr( 0 ) + "zA" ) IS "aaz" + Chr( 0 ) + "za"
HBTEST Lower( "z" ) IS "z"
HBTEST Lower( " µ" ) IS " µ"
HBTEST Lower( "H rbor 8-) µ" ) IS "h rbor 8-) µ"
HBTEST Lower( Chr( 160 ) + Chr( 181 ) ) IS Chr( 160 ) + Chr( 181 )
HBTEST Lower( "H" + Chr( 160 ) + "rbor 8-) " + Chr( 181 ) ) IS "h" + Chr( 160 ) + "rbor 8-) " + Chr( 181 )
/* At() */