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

2012-09-30 23:08 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
+ contrib/hbct/tests/dates4.prg
  - tests/dates4.prg
  * contrib/hbnf/byt2bit.prg
  * contrib/hbnf/dectobin.prg
  * contrib/hbnf/popadder.prg
  * tests/ac_test2.prg
  * tests/ainstest.prg
  * tests/and_or.prg
  * tests/array16.prg
  * tests/arrays.prg
  * tests/begin.prg
  * tests/byref.prg
  * tests/calling.prg
  * tests/clasinh.prg
  * tests/clasinit.prg
  * tests/classes.prg
  * tests/clsnv.prg
  * tests/codebloc.prg
  * tests/dates.prg
  * tests/debugtst.prg
  * tests/destruct.prg
  * tests/dirtest.prg
  * tests/dynobj.prg
  * tests/exittest.prg
  * tests/fib.prg
  * tests/files.prg
  * tests/fornext.prg
  * tests/fsplit.prg
  * tests/gtchars.prg
  * tests/ifelse.prg
  * tests/inherit.prg
  * tests/inifiles.prg
  * tests/initexit.prg
  * tests/inkeytst.prg
  * tests/inline.prg
  * tests/iotest.prg
  * tests/iotest2.prg
  * tests/longdev.prg
  * tests/longstr2.prg
  * tests/memvar.prg
  * tests/multiarg.prg
  * tests/newrdd.prg
  * tests/nums.prg
  * tests/objasign.prg
  * tests/objects.prg
  * tests/overload.prg
  * tests/passref.prg
  * tests/procname.prg
  * tests/readhrb.prg
  * tests/returns.prg
  * tests/rto_get.prg
  * tests/rto_tb.prg
  * tests/sbartest.prg
  * tests/setkeys.prg
  * tests/speed.prg
  * tests/statfun.prg
  * tests/statics.prg
  * tests/stripem.prg
  * tests/switch.prg
  * tests/tb1.prg
  * tests/test_all.prg
  * tests/testbrw.prg
  * tests/testcls.prg
  * tests/testerro.prg
  * tests/testfor.prg
  * tests/testmem.prg
  * tests/testntx.prg
  * tests/testop.prg
  * tests/testpp.prg
  * tests/testrdd2.prg
  * tests/teststr.prg
  * tests/testvars.prg
  * tests/testwarn.prg
  * tests/tstasort.prg
  * tests/tstdbi.prg
  * tests/tstmacro.prg
  * tests/varparam.prg
  * tests/vidtest.prg
    * various cleanups, fixes and formatting
      now most tests are warning and error free
This commit is contained in:
Viktor Szakats
2012-09-30 21:12:01 +00:00
parent 3c50df518c
commit 986df3694e
78 changed files with 425 additions and 322 deletions
Download Patch File Download Diff File Expand all files Collapse all files

82
harbour/ChangeLog
View File

@@ -16,6 +16,88 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-09-30 23:08 UTC+0200 Viktor Szakats (harbour syenar.net)
+ contrib/hbct/tests/dates4.prg
- tests/dates4.prg
* contrib/hbnf/byt2bit.prg
* contrib/hbnf/dectobin.prg
* contrib/hbnf/popadder.prg
* tests/ac_test2.prg
* tests/ainstest.prg
* tests/and_or.prg
* tests/array16.prg
* tests/arrays.prg
* tests/begin.prg
* tests/byref.prg
* tests/calling.prg
* tests/clasinh.prg
* tests/clasinit.prg
* tests/classes.prg
* tests/clsnv.prg
* tests/codebloc.prg
* tests/dates.prg
* tests/debugtst.prg
* tests/destruct.prg
* tests/dirtest.prg
* tests/dynobj.prg
* tests/exittest.prg
* tests/fib.prg
* tests/files.prg
* tests/fornext.prg
* tests/fsplit.prg
* tests/gtchars.prg
* tests/ifelse.prg
* tests/inherit.prg
* tests/inifiles.prg
* tests/initexit.prg
* tests/inkeytst.prg
* tests/inline.prg
* tests/iotest.prg
* tests/iotest2.prg
* tests/longdev.prg
* tests/longstr2.prg
* tests/memvar.prg
* tests/multiarg.prg
* tests/newrdd.prg
* tests/nums.prg
* tests/objasign.prg
* tests/objects.prg
* tests/overload.prg
* tests/passref.prg
* tests/procname.prg
* tests/readhrb.prg
* tests/returns.prg
* tests/rto_get.prg
* tests/rto_tb.prg
* tests/sbartest.prg
* tests/setkeys.prg
* tests/speed.prg
* tests/statfun.prg
* tests/statics.prg
* tests/stripem.prg
* tests/switch.prg
* tests/tb1.prg
* tests/test_all.prg
* tests/testbrw.prg
* tests/testcls.prg
* tests/testerro.prg
* tests/testfor.prg
* tests/testmem.prg
* tests/testntx.prg
* tests/testop.prg
* tests/testpp.prg
* tests/testrdd2.prg
* tests/teststr.prg
* tests/testvars.prg
* tests/testwarn.prg
* tests/tstasort.prg
* tests/tstdbi.prg
* tests/tstmacro.prg
* tests/varparam.prg
* tests/vidtest.prg
* various cleanups, fixes and formatting
now most tests are warning and error free
2012-09-30 14:51 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/gtalleg/gtalleg.hbc
* contrib/gtwvg/gtwvg.hbc

10
harbour/tests/dates4.prg → harbour/contrib/hbct/tests/dates4.prg
View File

@@ -10,18 +10,18 @@ PROCEDURE Main()
LOCAL i
LOCAL dDate := Date()
SET( _SET_DATEFORMAT, "dd/mm/yyyy" )
SET DATE ANSI
for i := 7 TO 49 STEP 7
FOR i := 7 TO 49 STEP 7
CheckDate( dDate )
dDate += i
next
NEXT
RETURN
FUNCTION CheckDate( dDate )
OutStd( "Testing date:", dDate , hb_eol() )
OutStd( "Testing date:", dDate, hb_eol() )
OutStd( "Days in month..:", daysinmonth( dDate ), hb_eol() )
OutStd( "Day of year....:", doy( dDate ), hb_eol() )
OutStd( "Begin of month.:", bom( dDate ), hb_eol() )
@@ -33,4 +33,4 @@ FUNCTION CheckDate( dDate )
__Accept( "Press ENTER to continue..." )
OutStd( Chr( 10 ), Chr( 10 ) )
RETURN nil
RETURN NIL

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

@@ -29,7 +29,7 @@ FUNCTION FT_BYT2BIT( cByte )
IF HB_ISSTRING( cByte )
xBitString := ""
FOR nCounter := 7 TO 0 step - 1
FOR nCounter := 7 TO 0 STEP -1
xBitString += iif( FT_ISBIT( cByte, nCounter ), "1", "0" )
NEXT
ELSE

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

@@ -27,7 +27,7 @@ FUNCTION FT_DEC2BIN( x )
LOCAL i, buffer := { "0", "0", "0", "0", "0", "0", "0", "0" }
FOR i := 8 TO 1 step - 1
FOR i := 8 TO 1 STEP -1
IF x >= 2 ^ ( i - 1 )
x -= 2 ^ ( i - 1 )
buffer[ 9 - i ] := "1"

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

@@ -1374,11 +1374,11 @@ STATIC FUNCTION _ftStuffComma( cStrToStuff, lTrimStuffedStr )
IF Len( Left( LTrim(_ftCharRem("-",cStrToStuff ) ), ;
At( ".", LTrim( _ftCharRem("-",cStrToStuff ) ) ) - 1 ) ) > 3
IF lTrimStuffedStr // Do we trim the number each time we insert a comma
FOR x := nDecPosit - 3 TO 2 + _ftCountLeft( cStrToStuff, " " ) STEP - 4
FOR x := nDecPosit - 3 TO 2 + _ftCountLeft( cStrToStuff, " " ) STEP -4
cStrToStuff := SubStr( _ftPosIns( cStrToStuff,",",x ), 2 )
NEXT
ELSE
FOR x := nDecPosit - 3 TO 2 + _ftCountLeft( cStrToStuff, " " ) STEP - 3
FOR x := nDecPosit - 3 TO 2 + _ftCountLeft( cStrToStuff, " " ) STEP -3
cStrToStuff := _ftPosIns( cStrToStuff, ",", x )
NEXT
ENDIF

9
harbour/tests/ac_test2.prg
View File

@@ -21,6 +21,8 @@
#include "inkey.ch"
#include "achoice.ch"
MEMVAR lHiLiTest
PROCEDURE Main()
// NIL, empty, numeric, and "not handled" - items
@@ -83,11 +85,13 @@ FUNCTION cUF( nMode, nCurElement, nRowPos )
LOCAL nRetVal := AC_CONT
LOCAL nKey := LastKey()
HB_SYMBOL_UNUSED( nCurElement )
HB_SYMBOL_UNUSED( nRowPos )
IF lHiLiTest
DispBox( 0, 0, MaxRow(), MaxCol(), Replicate( "#", 9 ), "GR+/G" )
ENDIF
IF nMode == AC_NOITEM
nRetVal := AC_ABORT
ELSEIF nMode == AC_EXCEPT
@@ -109,6 +113,9 @@ FUNCTION cUF2( nMode, nCurElement, nRowPos )
LOCAL nRetVal := AC_CONT
LOCAL nKey := LastKey()
HB_SYMBOL_UNUSED( nCurElement )
HB_SYMBOL_UNUSED( nRowPos )
DispBox( 0, 0, MaxRow(), MaxCol(), Replicate( "!", 9 ), "GR+/G" )
IF nMode == AC_NOITEM

2
harbour/tests/ainstest.prg
View File

@@ -90,4 +90,4 @@ FUNCTION aDump( aShow )
NEXT
QQOut( hb_eol() )
RETURN nil
RETURN NIL

2
harbour/tests/and_or.prg
View File

@@ -39,4 +39,4 @@ FUNCTION AndOr( lValue1, lValue2 )
QOut( "None of them are true" )
ENDIF
RETURN nil
RETURN NIL

14
harbour/tests/array16.prg
View File

@@ -41,19 +41,19 @@ PROCEDURE Main()
QOut( Len( b ) )
b[ 100 ] := 10
Test( b[ 100 ] ++ )
Test( b[ 100 ]++ )
QOut( b[ 100 ] )
b[ 100 ] := 10
Test( ++ b[ 100 ] )
Test( ++b[ 100 ] )
QOut( b[ 100 ] )
b := { 1, { 2, { 4, 5 } } }
Test( b[ 2 ][ 2 ][ 1 ] ++ )
Test( b[ 2 ][ 2 ][ 1 ]++ )
QOut( b[ 2 ][ 2 ][ 1 ] )
b[ 2 ][ 2 ][ 1 ] := 2
Test( ++ b[ 2 ][ 2 ][ 1 ] )
Test( ++b[ 2 ][ 2 ][ 1 ] )
QOut( b[ 2 ][ 2 ][ 1 ] )
ReleaseTest()
@@ -64,10 +64,12 @@ FUNCTION Test( n )
QOut( n )
RETURN nil
RETURN NIL
FUNCTION ReleaseTest()
LOCAL a := { 1, 2, 3 }
RETURN nil
HB_SYMBOL_UNUSED( a )
RETURN NIL

6
harbour/tests/arrays.prg
View File

@@ -62,10 +62,12 @@ FUNCTION Test( n )
QOut( n )
RETURN nil
RETURN NIL
FUNCTION ReleaseTest()
LOCAL a := { 1, 2, 3 }
RETURN nil
HB_SYMBOL_UNUSED( a )
RETURN NIL

4
harbour/tests/begin.prg
View File

@@ -85,8 +85,6 @@ PROCEDURE Break1()
BREAK M->mPrivate
RETURN
PROCEDURE Break2()
BEGIN SEQUENCE
@@ -130,5 +128,3 @@ PROCEDURE Break4( cValue )
LOCAL oLocal := " detached Break4 "
Break( {| x | oLocal + x + cValue } )
RETURN

8
harbour/tests/byref.prg
View File

@@ -30,7 +30,7 @@ FUNCTION ref1( x )
Ref2( @x )
QOut( " In ref1 after ref2 =", x )
RETURN nil
RETURN NIL
FUNCTION ref2( x )
@@ -39,7 +39,7 @@ FUNCTION ref2( x )
Ref3( @x )
QOut( " In ref2 after ref3 =", x )
RETURN nil
RETURN NIL
FUNCTION ref3( x )
@@ -51,11 +51,11 @@ FUNCTION ref3( x )
Ref4( @a )
QOut( " In ref3 after ref4 =", x )
RETURN nil
RETURN NIL
FUNCTION ref4( a )
a[ 1 ]++
QOut( " In ref4 =", a[ 1 ] )
RETURN nil
RETURN NIL

6
harbour/tests/calling.prg
View File

@@ -20,16 +20,16 @@ FUNCTION SecondOne()
Third()
RETURN nil
RETURN NIL
FUNCTION Third()
QOut( "Ok, this is from Third() function call" )
RETURN nil
RETURN NIL
FUNCTION Fourth( cText )
QOut( cText )
RETURN nil
RETURN NIL

3
harbour/tests/clasinh.prg
View File

@@ -11,6 +11,9 @@ PROCEDURE Main()
oObject := TAnyClass():New()
oBase := TClassBase():New()
HB_SYMBOL_UNUSED( oObject )
HB_SYMBOL_UNUSED( oBase )
RETURN
CREATE CLASS TClassBase

4
harbour/tests/clasinit.prg
View File

@@ -28,7 +28,7 @@ FUNCTION TForm()
STATIC oClass
IF oClass == nil
IF oClass == NIL
oClass := HBClass():New( "TFORM" ) // starts a new class definition
oClass:AddData( "cName" ) // define this class objects datas
@@ -59,4 +59,4 @@ STATIC FUNCTION Show()
QOut( "lets show a form from here :-)" )
RETURN nil
RETURN NIL

4
harbour/tests/classes.prg
View File

@@ -18,7 +18,7 @@ FUNCTION TForm()
STATIC oClass
IF oClass == nil
IF oClass == NIL
oClass := HBClass():New( "TFORM" ) // starts a new class definition
oClass:AddData( "cName" ) // define this class objects datas
@@ -52,4 +52,4 @@ STATIC FUNCTION Show()
QOut( "lets show a form from here :-)" )
RETURN nil
RETURN NIL

2
harbour/tests/clsnv.prg
View File

@@ -18,7 +18,7 @@
PROCEDURE Main()
LOCAL o := myclass3():new(), i, cbErr
LOCAL o := myclass3():new()
? Date(), Time(), Version(), OS()
?

4
harbour/tests/codebloc.prg
View File

@@ -14,6 +14,8 @@ PROCEDURE Main()
LOCAL YY, X
LOCAL x1, x2
HB_SYMBOL_UNUSED( b )
OutStd( "this should print first" )
OutStd( hb_eol() )
@@ -47,7 +49,7 @@ PROCEDURE Main()
OutStd( ar[ 1 ] )
OutStd( hb_eol() )
a := {|| ar[ 1 ] ++ }
a := {|| ar[ 1 ]++ }
Eval( a )
OutStd( ar[ 1 ] )
OutStd( hb_eol() )

16
harbour/tests/dates.prg
View File

@@ -15,18 +15,18 @@ PROCEDURE Main()
TestCentury()
OutStd( hb_eol(), "" )
OutStd( hb_eol(), "dDate := CToD( '02/04/1999' ) =>", dDate := CToD( "02/04/1999" ) )
OutStd( hb_eol(), "dDate := CToD( '02/04/1999' ) =>", dDate := CToD( "02/04/1999" ) )
OutStd( hb_eol(), "ValType( dDate ) =", ValType( dDate ) )
OutStd( hb_eol(), "ValType( dDate ) =", ValType( dDate ) )
OutStd( hb_eol(), "Day( dDate ) =", Day( dDate ) )
OutStd( hb_eol(), "Month( dDate ) =", Month( dDate ) )
OutStd( hb_eol(), "Year( dDate ) =", Year( dDate ), hb_eol() )
OutStd( hb_eol(), "Day( dDate ) =", Day( dDate ) )
OutStd( hb_eol(), "Month( dDate ) =", Month( dDate ) )
OutStd( hb_eol(), "Year( dDate ) =", Year( dDate ), hb_eol() )
OutStd( hb_eol(), "dDate + 5 =", dDate2 := dDate + 5 )
OutStd( hb_eol(), "dDate - 5 =", dDate - 5, hb_eol() )
OutStd( hb_eol(), "dDate + 5 =", dDate2 := dDate + 5 )
OutStd( hb_eol(), "dDate - 5 =", dDate - 5, hb_eol() )
OutStd( hb_eol(), "dDate2 - dDate =", dDate2 - dDate )
OutStd( hb_eol(), "dDate2 - dDate =", dDate2 - dDate )
OutStd( hb_eol(), "" )
OutStd( hb_eol(), dDate, DToS( dDate ) )

130
harbour/tests/debugtst.prg
View File

@@ -17,6 +17,8 @@
* Placed in the public domain
*/
#pragma warninglevel=1
PROCEDURE Main()
LOCAL oForm := TForm():New()
@@ -101,7 +103,7 @@ FUNCTION FuncSecond( nParam, cParam, uParam )
Pause()
RETURN nil
RETURN NIL
/* $Doc$
@@ -113,7 +115,7 @@ FUNCTION TForm()
STATIC oClass
IF oClass == nil
IF oClass == NIL
oClass := HBClass():New( "TFORM" ) // starts a new class definition
oClass:AddData( "cName" ) // define this class objects datas
@@ -162,67 +164,67 @@ STATIC FUNCTION Show()
QOut( "lets show a form from here :-)" )
RETURN nil
RETURN NIL
//
// <xRet> TForm:Transfer( [<xArg,..>] )
//
// Generic object import and export function
//
// <xArg> is present.
//
// Maximum number of arguments passed is limited to 10 !
//
// An argument can be one of the following :
//
// { <cSymbol>, <xValue> } Set DATA <cSymbol> to <xValue>
// { { <cSym1>, <xVal1> }, { <cSym2>, <xVal2> }, ... }
// Set a whole list symbols to value
// Normal way of set objects from external
// sources, like memo files.
// <oObject> Set self according to the DATA
// contained in <oObject>
// Can be used to transfer info from
// one class to another
//
// If <xArg> is not present, the current object will be returned as an array
// for description see __objSetValueList / __objGetValueList.
//
// The method aExcept() is called to determine the DATA which should not
// be returned. Eg. hWnd ( do not copy this DATA from external source )
//
// Say we want to copy oSource into oTarget we say :
//
// oTarget:Transfer( oSource )
//
// If we do not want 'cName' duplicated we have to use __objGetValueList :
//
// aNewExcept := aClone( oSource:aExcept() )
// aAdd( aNewExcept, "cName" ) /* Add cName to exception list */
// oTarget:Transfer( __objGetValueList( oSource, aNewExcept ) )
// /* Get DATA from oSource with new exceptions */
// /* Transfer DATA to oTarget */
//
// To set two DATA of oTarget :
//
// oTarget:Transfer( { "nLeft", 10 }, { "nRight", 5 } )
//
// or :
//
// aCollect := {}
// aAdd( aCollect, { "nLeft" , 10 } )
// aAdd( aCollect, { "nRight", 5 } )
// oTarget:Transfer( aCollect )
//
// Copy oSource to a memo field :
//
// DbObject->Memo := oSource:Transfer()
//
// (Re)create oTarget from the memo field :
//
// oTarget := TTarget():New()
// oTarget:Transfer( DbObject->Memo )
//
//
// <xRet> TForm:Transfer( [<xArg,..>] )
//
// Generic object import and export function
//
// <xArg> is present.
//
// Maximum number of arguments passed is limited to 10 !
//
// An argument can be one of the following :
//
// { <cSymbol>, <xValue> } Set DATA <cSymbol> to <xValue>
// { { <cSym1>, <xVal1> }, { <cSym2>, <xVal2> }, ... }
// Set a whole list symbols to value
// Normal way of set objects from external
// sources, like memo files.
// <oObject> Set self according to the DATA
// contained in <oObject>
// Can be used to transfer info from
// one class to another
//
// If <xArg> is not present, the current object will be returned as an array
// for description see __objSetValueList / __objGetValueList.
//
// The method aExcept() is called to determine the DATA which should not
// be returned. Eg. hWnd ( do not copy this DATA from external source )
//
// Say we want to copy oSource into oTarget we say :
//
// oTarget:Transfer( oSource )
//
// If we do not want 'cName' duplicated we have to use __objGetValueList :
//
// aNewExcept := aClone( oSource:aExcept() )
// aAdd( aNewExcept, "cName" ) /* Add cName to exception list */
// oTarget:Transfer( __objGetValueList( oSource, aNewExcept ) )
// /* Get DATA from oSource with new exceptions */
// /* Transfer DATA to oTarget */
//
// To set two DATA of oTarget :
//
// oTarget:Transfer( { "nLeft", 10 }, { "nRight", 5 } )
//
// or :
//
// aCollect := {}
// aAdd( aCollect, { "nLeft" , 10 } )
// aAdd( aCollect, { "nRight", 5 } )
// oTarget:Transfer( aCollect )
//
// Copy oSource to a memo field :
//
// DbObject->Memo := oSource:Transfer()
//
// (Re)create oTarget from the memo field :
//
// oTarget := TTarget():New()
// oTarget:Transfer( DbObject->Memo )
//
STATIC FUNCTION Transfer( x1, x2, x3, x4, x5, x6, x7, x8, x9, x10 ) /* etc */
@@ -236,7 +238,7 @@ STATIC FUNCTION Transfer( x1, x2, x3, x4, x5, x6, x7, x8, x9, x10 ) /* etc */
IF nLen == 0
xRet := __objGetValueLIST( self, ::aExcept() )
ELSE
for n := 1 TO nLen
FOR n := 1 TO nLen
xData := aParam[ n ]
IF ValType( xData ) == "A"
@@ -253,7 +255,7 @@ STATIC FUNCTION Transfer( x1, x2, x3, x4, x5, x6, x7, x8, x9, x10 ) /* etc */
QOut( "TRANSFER: Incorrect argument(", n, ") ", xData )
ENDIF
next n
NEXT
ENDIF
RETURN xRet

6
harbour/tests/destruct.prg
View File

@@ -56,7 +56,7 @@ STATIC PROCEDURE SIMPLETEST( type )
? "=> o := NIL"
BEGIN SEQUENCE
o := NIL
end
END
RETURN
@@ -68,8 +68,8 @@ STATIC PROCEDURE GCFREETEST( type )
? "=> o := myClass():new( " + hb_ntos( type ) + " )"
o := myClass():new( type )
? "=> o:className() ->", o:className()
? "=> create corss reference: a := { o, nil }; a[ 2 ] := a; a := NIL"
a := { o, nil }; a[ 2 ] := a; a := NIL
? "=> create corss reference: a := { o, NIL }; a[ 2 ] := a; a := NIL"
a := { o, NIL }; a[ 2 ] := a; a := NIL
? "=> o := NIL"
BEGIN SEQUENCE
o := NIL

4
harbour/tests/dirtest.prg
View File

@@ -8,8 +8,8 @@
PROCEDURE Main( filespec, attribs, cshort )
LOCAL aDir := {}
LOCAL x := 0, lShort := .F.
LOCAL aDir
LOCAL x, lShort := .F.
IF ! cshort == NIL .AND. ( Upper( cShort ) == "TRUE" .OR. Upper( cShort ) == ".T." )
lShort := .T.

7
harbour/tests/dynobj.prg
View File

@@ -16,7 +16,6 @@
PROCEDURE Main()
LOCAL oForm := TForm():New()
LOCAL nSeq
QOut( "What methods are in the class :" )
Debug( __objGetMethodList( oForm ) )
@@ -110,7 +109,7 @@ FUNCTION TForm()
STATIC oClass
IF oClass == nil
IF oClass == NIL
oClass := HBClass():New( "TFORM" ) // starts a new class definition
oClass:AddData( "cText" ) // define this class objects datas
@@ -142,7 +141,7 @@ STATIC FUNCTION Smile()
LOCAL self := QSelf()
if ::CalcArea() == 300
IF ::CalcArea() == 300
QOut( ":-)" )
ELSE
QOut( ":-(" )
@@ -162,4 +161,4 @@ FUNCTION Pause()
__Accept( "Pause :" )
RETURN nil
RETURN NIL

2
harbour/tests/exittest.prg
View File

@@ -9,7 +9,7 @@ PROCEDURE Main()
LOCAL x := 0
DO WHILE x < 10
++ x
++x
IF x == 5
EXIT
ENDIF

2
harbour/tests/fib.prg
View File

@@ -39,7 +39,7 @@ FUNCTION FibI( n )
nFib := nFibMin1 + nFibMinN1
nFibMinN1 := nFibMin1
nFibMin1 := nFib
++ i
++i
ENDDO
ENDIF

38
harbour/tests/files.prg
View File

@@ -11,21 +11,21 @@
// use only *one* at a time
// dejar solo una de las dos lineas siguientes:
#define CON_DBFCDX
//#define CON_ADS
#define WITH_DBFCDX
//#define WITH_ADS
#ifdef CON_ADS
#ifdef WITH_ADS
#include "ads.ch"
REQUEST _ADS
#endif
STATIC aCampos := { {"Codigo", "C", 6, 0}, {"Nombre", "C", 35, 0} }
PROCEDURE Main()
PROCEDURE FILES()
LOCAL aCampos := { { "Codigo", "C", 6, 0 }, { "Nombre", "C", 35, 0 } }
Local n := 0, h:=Array(NFILES)
LOCAL n := 0, h := Array( NFILES )
#ifdef CON_ADS
#ifdef WITH_ADS
rddRegister( "ADS", 1 )
rddsetdefault( "ADS" )
@@ -33,7 +33,7 @@ PROCEDURE FILES()
SET FILETYPE TO CDX
SET CHARTYPE TO OEM
SET AXS LOCKING ON
AdsRightsCheck(.F.)
AdsRightsCheck( .F. )
#endif
@@ -41,12 +41,12 @@ PROCEDURE FILES()
AFill( h, 0 )
DO WHILE n < NFILES
n++
@10,0 SAY "Building files.... "+Str( n )
DbCreate( "File" + LTrim( Str( n ) ), aCampos )
USE ( "File" + LTrim( Str( n ) ) ) NEW
@ 10, 0 SAY "Building files.... " + Str( n )
dbCreate( "file" + LTrim( Str( n ) ), aCampos )
USE ( "file" + LTrim( Str( n ) ) ) NEW
#ifdef CON_ADS
INDEX ON CODIGO TAG CODIGO TO ( "File" + LTrim( Str( n ) ) )
#ifdef WITH_ADS
INDEX ON CODIGO TAG CODIGO TO ( "file" + LTrim( Str( n ) ) )
#endif
CLOSE DATA
@@ -56,10 +56,10 @@ PROCEDURE FILES()
DO WHILE n < NFILES
n++
@12,0 SAY "Opening files.... "+Str( n )
USE ( "File" + LTrim( Str( n ) ) ) NEW
@ 12, 0 SAY "Opening files.... " + Str( n )
USE ( "file" + LTrim( Str( n ) ) ) NEW
#ifdef CON_ADS
#ifdef WITH_ADS
SET ORDER TO TAG CODIGO
#endif
@@ -71,8 +71,8 @@ PROCEDURE FILES()
DO WHILE n < NFILES
n++
@14,0 SAY "Deleting files.... "+Str( n )
FErase ( "File" + LTrim( Str( n ) ) + ".dbf" )
@ 14, 0 SAY "Deleting files.... " + Str( n )
FErase( "file" + LTrim( Str( n ) ) + ".dbf" )
ENDDO
RETURN NIL
RETURN

6
harbour/tests/fornext.prg
View File

@@ -12,7 +12,7 @@
PROCEDURE Main()
LOCAL n := 1
LOCAL n
QOut( "Testing Harbour For Next loops. Going up quick" )
@@ -22,7 +22,7 @@ PROCEDURE Main()
QOut( "Going down" )
FOR n := 10 TO 1 step - 1
FOR n := 10 TO 1 STEP -1
QOut( n )
NEXT n
@@ -34,7 +34,7 @@ PROCEDURE Main()
QOut( "No production" )
FOR n := 1 TO 10 step - 1
FOR n := 1 TO 10 STEP -1
QOut( n )
NEXT n

17
harbour/tests/fsplit.prg
View File

@@ -14,13 +14,12 @@ FUNCTION fsplit( csource, csplit, nbyte )
LOCAL i // general counter
LOCAL ccommand := "" // dos command for joining files
LOCAL cexist := "" // batch file error checker
LOCAL nbufsize := 8 // default buffer Read/Write size
LOCAL hsource := 0 // file handle for source file
LOCAL hdestination := 0 // file handle for destination file
LOCAL nbufsize // default buffer Read/Write size
LOCAL hsource // file handle for source file
LOCAL hdestination // file handle for destination file
LOCAL cbuffer := "" // buffer for read/write
LOCAL lsplit := .F. // return value
LOCAL nblock := 0 // bytes read
LOCAL nblock // bytes read
LOCAL ncurrent := 0 // total bytes copied
LOCAL nsplit := 1 // destination file name extension
LOCAL cbat := "join.bat" // for joining split files
@@ -28,8 +27,8 @@ FUNCTION fsplit( csource, csplit, nbyte )
LOCAL hbat // file handle for join.bat
LOCAL afile := {} // for information upon completion
LOCAL nseconds := Seconds() // time elapsed
LOCAL nfilesize := 0 // file size to be split
LOCAL hfile := 0 // split file sizes
LOCAL nfilesize // file size to be split
LOCAL hfile // split file sizes
LOCAL cret := Chr( 13 ) + Chr( 10 ) // carriage return
LOCAL ctmp := "@echo off" + cret // 1st line in join.bat
LOCAL nfile
@@ -45,7 +44,7 @@ FUNCTION fsplit( csource, csplit, nbyte )
ENDIF
// default destination name
csplit := iif( csplit == nil, "split.", csplit + "." )
csplit := iif( csplit == NIL, "split.", csplit + "." )
// default size of each split file 360 x 1024 bytes
nbufsize := iif( Empty( nbyte ), 360, nbyte )
@@ -65,7 +64,7 @@ FUNCTION fsplit( csource, csplit, nbyte )
hbat := FCreate( cbat ) // join.bat
IF hbat != F_ERROR
ELSE
break
BREAK
ENDIF
ctmp += "rem source file " + csource + " size " + hb_ntos( nfilesize ) + cret
ctmp += "rem split on " + DToC( Date() ) + " " + Time() + cret

2
harbour/tests/gtchars.prg
View File

@@ -92,4 +92,4 @@ FUNCTION dspboxch( cStr )
SetPos( r, c + 1 )
NEXT
RETURN nil
RETURN NIL

2
harbour/tests/ifelse.prg
View File

@@ -35,4 +35,4 @@ FUNCTION TestValue( x )
QOut( "Ok!" )
RETURN nil
RETURN NIL

41
harbour/tests/inherit.prg
View File

@@ -15,6 +15,8 @@
* Placed in the public domain
*/
#xtranslate Default( <Var>, <xVal> ) => iif( <Var> == NIL, <xVal>, <Var> )
PROCEDURE Main()
LOCAL oFrom
@@ -149,16 +151,16 @@ FUNCTION New( cFileName, cMode, nBlock )
::cFileName := cFileName
::cMode := Default( cMode, "R" )
if ::cMode == "R"
IF ::cMode == "R"
::hFile := FOpen( cFileName )
elseif ::cMode == "W"
ELSEIF ::cMode == "W"
::hFile := FCreate( cFileName )
ELSE
QOut( "DosFile Init: Unknown file mode:", ::cMode )
ENDIF
::nError := FError()
if ::nError != 0
IF ::nError != 0
::lEoF := .T.
QOut( "Error ", ::nError )
ENDIF
@@ -171,7 +173,7 @@ FUNCTION RUN( xTxt, lCRLF )
LOCAL self := QSelf()
LOCAL xRet
if ::cMode == "R"
IF ::cMode == "R"
xRet := ::Read()
ELSE
xRet := ::WriteLn( xTxt, lCRLF )
@@ -188,11 +190,11 @@ FUNCTION Dispose()
LOCAL self := QSelf()
::cBlock := NIL
if ::hFile != - 1
if ::cMode == "W" .AND. ::nError != 0
IF ::hFile != - 1
IF ::cMode == "W" .AND. ::nError != 0
::Write( Chr( 26 ) ) // Do not forget EOF marker
ENDIF
IF !FClose( ::hFile )
IF ! FClose( ::hFile )
::nError := FError()
QOut( "Dos Error closing ", ::cFileName, " Code ", ::nError )
ENDIF
@@ -211,11 +213,10 @@ FUNCTION READ()
LOCAL cBlock
LOCAL nCrPos
LOCAL nEoFPos
LOCAL nRead
if ::hFile == - 1
IF ::hFile == - 1
QOut( "DosFile:Read : No file open" )
elseif ::cMode != "R"
ELSEIF ::cMode != "R"
QOut( "File ", ::cFileName, " not open for reading" )
ELSEIF !::lEoF
@@ -230,7 +231,7 @@ FUNCTION READ()
ENDIF
IF !::lEoF
::nLine ++
::nLine++
nCRPos := At( Chr( 10 ), ::cBlock )
IF nCRPos != 0 // More than one line read
cRet := SubStr( ::cBlock, 1, nCRPos - 1 )
@@ -267,13 +268,13 @@ FUNCTION WriteLn( xTxt, lCRLF )
LOCAL self := QSelf()
LOCAL cBlock
if ::hFile == - 1
IF ::hFile == -1
QOut( "DosFile:Write : No file open" )
elseif ::cMode != 'W'
ELSEIF !( ::cMode == "W" )
QOut( "File ", ::cFileName, " not opened for writing" )
ELSE
cBlock := ToChar( xTxt ) // Convert to string
IF DEFAULT( lCRLF, .T. )
IF Default( lCRLF, .T. )
cBlock += Chr( 10 ) + Chr( 13 )
ENDIF
FWrite( ::hFile, cBlock, Len( cBlock ) )
@@ -289,11 +290,11 @@ FUNCTION Write( xTxt )
LOCAL self := QSelf()
return ::WriteLn( xTxt, .F. )
RETURN ::WriteLn( xTxt, .F. )
//
// Go to a specified line number
//
//
// Go to a specified line number
//
STATIC FUNCTION GOTO( nLine )
@@ -302,7 +303,7 @@ STATIC FUNCTION GOTO( nLine )
IF Empty( ::hFile )
QOut( "DosFile:Goto : No file open" )
elseif ::cMode != "R"
ELSEIF !( ::cMode == "R" )
QOut( "File ", ::cFileName, " not open for reading" )
ELSE
::lEoF := .F. // Clear (old) End of file
@@ -310,7 +311,7 @@ STATIC FUNCTION GOTO( nLine )
::cBlock := ""
FSeek( ::hFile, 0 ) // Go top
DO WHILE !::lEoF .AND. nWhere < nLine
nWhere ++
nWhere++
::Read()
ENDDO
ENDIF

35
harbour/tests/inifiles.prg
View File

@@ -101,9 +101,8 @@ STATIC FUNCTION New( cFileName )
cLine := SubStr( cLine, 2 )
ENDIF
AAdd( ::Contents, { cLine, { /* this will be CurrArray */
} } )
CurrArray := ::Contents[Len(::Contents)][ 2 ]
AAdd( ::Contents, { cLine, { /* this will be CurrArray */ } } )
CurrArray := ::Contents[ Len( ::Contents ) ][ 2 ]
ELSEIF Left( cLine, 1 ) == ";" // preserve comments
AAdd( CurrArray, { NIL, cLine } )
@@ -145,7 +144,7 @@ STATIC FUNCTION ReadString( cSection, cIdent, cDefault )
j := AScan( ::Contents, {| x | ValType( x[ 1 ] ) == "C" .AND. Lower( x[ 1 ] ) == cFind .AND. ValType( x[ 2 ] ) == "C" } )
IF j > 0
cResult := ::Contents[j][ 2 ]
cResult := ::Contents[ j ][ 2 ]
ENDIF
ELSE
@@ -157,7 +156,7 @@ STATIC FUNCTION ReadString( cSection, cIdent, cDefault )
j := AScan( ::Contents[ i ][ 2 ], {| x | ValType( x[ 1 ] ) == "C" .AND. Lower( x[ 1 ] ) == cFind } )
IF j > 0
cResult := ::Contents[ i ][ 2 ][j][ 2 ]
cResult := ::Contents[ i ][ 2 ][ j ][ 2 ]
ENDIF
ENDIF
ENDIF
@@ -177,7 +176,7 @@ STATIC PROCEDURE WriteString( cSection, cIdent, cString )
j := AScan( ::Contents, {| x | ValType( x[ 1 ] ) == "C" .AND. Lower( x[ 1 ] ) == cFind .AND. ValType( x[ 2 ] ) == "C" } )
IF j > 0
::Contents[j][ 2 ] := cString
::Contents[ j ][ 2 ] := cString
ELSE
AAdd( ::Contents, NIL )
@@ -187,19 +186,19 @@ STATIC PROCEDURE WriteString( cSection, cIdent, cString )
ELSE
cFind := Lower( cSection )
IF ( i := AScan( ::Contents, {| x | ValType(x[ 1 ] ) == "C" .AND. Lower(x[ 1 ] ) == cFind .AND. ValType(x[ 2 ] ) == "A" } ) ) > 0
IF ( i := AScan( ::Contents, {| x | ValType( x[ 1 ] ) == "C" .AND. Lower( x[ 1 ] ) == cFind .AND. ValType( x[ 2 ] ) == "A" } ) ) > 0
cFind := Lower( cIdent )
j := AScan( ::Contents[ i ][ 2 ], {| x | ValType( x[ 1 ] ) == "C" .AND. Lower( x[ 1 ] ) == cFind } )
IF j > 0
::Contents[ i ][ 2 ][j][ 2 ] := cString
::Contents[ i ][ 2 ][ j ][ 2 ] := cString
ELSE
AAdd( ::Contents[ i ][ 2 ], { cIdent, cString } )
ENDIF
ELSE
AAdd( ::Contents, { cSection, { {cIdent, cString} } } )
AAdd( ::Contents, { cSection, { { cIdent, cString } } } )
ENDIF
ENDIF
@@ -272,14 +271,14 @@ STATIC PROCEDURE EraseSection( cSection )
LOCAL i
IF Empty( cSection )
DO WHILE ( i := AScan( ::Contents, {| x | ValType(x[ 1 ] ) == "C" .AND. ValType(x[ 2 ] ) == "C" } ) ) > 0
DO WHILE ( i := AScan( ::Contents, {| x | ValType( x[ 1 ] ) == "C" .AND. ValType( x[ 2 ] ) == "C" } ) ) > 0
ADel( ::Contents, i )
ASize( ::Contents, Len( ::Contents ) - 1 )
ENDDO
ELSE
cSection := Lower( cSection )
IF ( i := AScan( ::Contents, {| x | ValType(x[ 1 ] ) == "C" .AND. Lower(x[ 1 ] ) == cSection .AND. ValType(x[ 2 ] ) == "A" } ) ) > 0
IF ( i := AScan( ::Contents, {| x | ValType( x[ 1 ] ) == "C" .AND. Lower( x[ 1 ] ) == cSection .AND. ValType( x[ 2 ] ) == "A" } ) ) > 0
ADel( ::Contents, i )
ASize( ::Contents, Len( ::Contents ) - 1 )
ENDIF
@@ -301,12 +300,12 @@ STATIC FUNCTION ReadSection( cSection )
ELSE
cSection := Lower( cSection )
IF ( i := AScan( ::Contents, {| x | ValType(x[ 1 ] ) == "C" .AND. x[ 1 ] == cSection .AND. ValType(x[ 2 ] ) == "A" } ) ) > 0
IF ( i := AScan( ::Contents, {| x | ValType(x[ 1 ] ) == "C" .AND. x[ 1 ] == cSection .AND. ValType( x[ 2 ] ) == "A" } ) ) > 0
FOR j := 1 TO Len( ::Contents[ i ][ 2 ] )
IF ::Contents[ i ][ 2 ][j][ 1 ] != NIL
AAdd( aSection, ::Contents[ i ][ 2 ][j][ 1 ] )
IF ::Contents[ i ][ 2 ][ j ][ 1 ] != NIL
AAdd( aSection, ::Contents[ i ][ 2 ][ j ][ 1 ] )
ENDIF
NEXT
ENDIF
@@ -343,12 +342,12 @@ STATIC PROCEDURE UpdateFile()
FWrite( hFile, "[" + ::Contents[ i ][ 1 ] + "]" + Chr( 13 ) + Chr( 10 ) )
FOR j := 1 TO Len( ::Contents[ i ][ 2 ] )
if ::Contents[ i ][ 2 ][j][ 1 ] == NIL
FWrite( hFile, ::Contents[ i ][ 2 ][j][ 2 ] + Chr( 13 ) + Chr( 10 ) )
IF ::Contents[ i ][ 2 ][ j ][ 1 ] == NIL
FWrite( hFile, ::Contents[ i ][ 2 ][ j ][ 2 ] + Chr( 13 ) + Chr( 10 ) )
ELSE
FWrite( hFile, ::Contents[ i ][ 2 ][j][ 1 ] + "=" + ::Contents[ i ][ 2 ][j][ 2 ] + Chr( 13 ) + Chr( 10 ) )
FWrite( hFile, ::Contents[ i ][ 2 ][ j ][ 1 ] + "=" + ::Contents[ i ][ 2 ][ j ][ 2 ] + Chr( 13 ) + Chr( 10 ) )
ENDIF
next
NEXT
FWrite( hFile, Chr( 13 ) + Chr( 10 ) )
ELSEIF ValType( ::Contents[ i ][ 2 ] ) == "C"

8
harbour/tests/initexit.prg
View File

@@ -28,7 +28,7 @@ INIT FUNCTION SecondOne()
static_var_accessed_in_INIT_function ++
QOut( "global static=", static_var_accessed_in_INIT_function )
RETURN nil
RETURN NIL
INIT FUNCTION Third()
STATIC static_var := "THIRD()"
@@ -37,7 +37,7 @@ INIT FUNCTION Third()
static_var_accessed_in_INIT_function ++
QOut( "global static=", static_var_accessed_in_INIT_function )
RETURN nil
RETURN NIL
EXIT FUNCTION Fifth()
STATIC static_var := "FIFTH()"
@@ -46,7 +46,7 @@ EXIT FUNCTION Fifth()
static_var_accessed_in_INIT_function --
QOut( "global static=", static_var_accessed_in_INIT_function )
RETURN nil
RETURN NIL
EXIT FUNCTION Sixth()
STATIC static_var := "SIXTH()"
@@ -55,7 +55,7 @@ EXIT FUNCTION Sixth()
static_var_accessed_in_INIT_function --
QOut( "global static=", static_var_accessed_in_INIT_function )
RETURN nil
RETURN NIL
INIT PROCEDURE _INITSTATICS()
PUBLIC _initStatics := "_INITSTATICS"

2
harbour/tests/inkeytst.prg
View File

@@ -200,7 +200,7 @@ PROCEDURE TEST6
PROCEDURE TEST7( cSkip, cRaw )
LOCAL nKey, nMask, cText
LOCAL nKey, nMask
CLS
? "For the last test, a loop is started and all keyboard and mouse"

2
harbour/tests/inline.prg
View File

@@ -21,7 +21,7 @@ FUNCTION TForm()
STATIC oClass
IF oClass == nil
IF oClass == NIL
oClass := HBClass():New( "TFORM" ) // starts a new class definition
oClass:AddData( "cText" ) // define this class objects datas

2
harbour/tests/iotest.prg
View File

@@ -6,7 +6,7 @@
PROCEDURE Main()
LOCAL h := 0
LOCAL h
LOCAL cstr := " "
LOCAL ntmp := 1

3
harbour/tests/iotest2.prg
View File

@@ -7,9 +7,8 @@
PROCEDURE Main()
LOCAL h := 0
LOCAL h
LOCAL cstr := " "
LOCAL ntmp := 0
h := FCreate( "test.txt" )
QOut( "create handle", h )

2
harbour/tests/longdev.prg
View File

@@ -11,7 +11,7 @@
PROCEDURE Main()
LOCAL cShort := "1234567890"
LOCAL i, j, cLong, cBuffer, nHandle
LOCAL i, cLong, cBuffer, nHandle
// Create an 80 KB string (Clipper is limited to 64 KB).
cLong := cShort

2
harbour/tests/longstr2.prg
View File

@@ -6,7 +6,7 @@
PROCEDURE Main()
LOCAL short := "1234567890"
LOCAL i, long, very_long, cNewLine
LOCAL i, long, very_long
long := short
FOR i := 1 TO 12

2
harbour/tests/memvar.prg
View File

@@ -33,6 +33,8 @@ PROCEDURE Main()
LOCAL main := 0
HB_SYMBOL_UNUSED( main )
Test1()
__Accept( "press Enter..." )
Test2()

13
harbour/tests/multiarg.prg
View File

@@ -22,6 +22,17 @@ PROCEDURE Main()
FUNCTION ShoutArg( nArg, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10 )
HB_SYMBOL_UNUSED( x1 )
HB_SYMBOL_UNUSED( x2 )
HB_SYMBOL_UNUSED( x3 )
HB_SYMBOL_UNUSED( x4 )
HB_SYMBOL_UNUSED( x5 )
HB_SYMBOL_UNUSED( x6 )
HB_SYMBOL_UNUSED( x7 )
HB_SYMBOL_UNUSED( x8 )
HB_SYMBOL_UNUSED( x9 )
HB_SYMBOL_UNUSED( x10 )
QOut( nArg, "==", hb_PValue( nArg ) )
RETURN nil
RETURN NIL

2
harbour/tests/newrdd.prg
View File

@@ -315,7 +315,7 @@ PROCEDURE Main()
CLS
nI := 1
NEWRDD->( __dbPack( {|| QOut( nI ), nI ++ } ) )
NEWRDD->( __dbPack( {|| QOut( nI ), nI++ } ) )
? "RecCount:", NEWRDD->( RecCount() )
? "Press any key to continue..."

1
harbour/tests/nums.prg
View File

@@ -18,5 +18,6 @@ PROCEDURE Main()
QOut( c )
QOut( d )
QOut( e )
QOut( f )
RETURN

4
harbour/tests/objasign.prg
View File

@@ -23,9 +23,9 @@ PROCEDURE Main()
o:x := 4
QOut( "Assign 4 : ", o:x )
QOut( "Post increment : ", o:x ++ )
QOut( "Post increment : ", o:x++ )
QOut( "After : ", o:x )
QOut( "Pre decrement : ", -- o:x )
QOut( "Pre decrement : ", --o:x )
QOut( "After : ", o:x )
o:x += 2

4
harbour/tests/objects.prg
View File

@@ -30,7 +30,7 @@ FUNCTION TAny() /* builds a class */
STATIC hClass
IF hClass == nil
IF hClass == NIL
hClass := __clsNew( "TANY", 3 ) // cClassName, nDatas
__clsAddMsg( hClass, "cName", 1, HB_OO_MSG_DATA ) // retrieve data
__clsAddMsg( hClass, "_cName", 1, HB_OO_MSG_DATA ) // assign data. Note the '_'
@@ -62,4 +62,4 @@ STATIC FUNCTION Test()
QOut( ::ClassName() ) // :: means Self: It is a Harbour built-in operator
RETURN nil
RETURN NIL

4
harbour/tests/overload.prg
View File

@@ -39,7 +39,7 @@ PROCEDURE Main()
QOut( "Array index[3] := 'X' :", oString[ 3 ] := 'X' )
QOut( oString:cValue )
RETURN nil
RETURN
CREATE CLASS tString
@@ -69,7 +69,7 @@ FUNCTION TString()
STATIC oClass
IF oClass == nil
IF oClass == NIL
oClass = HBClass():New( "TSTRING" ) // starts a new class definition
oClass:AddData( "cValue" ) // define this class objects datas

2
harbour/tests/passref.prg
View File

@@ -25,4 +25,4 @@ FUNCTION testfun( b, c )
QOut( 'a pointer+10 =', b )
QOut( 'b pointer := "A" =', c )
RETURN nil
RETURN NIL

8
harbour/tests/procname.prg
View File

@@ -14,19 +14,19 @@ FUNCTION Two()
Three()
RETURN nil
RETURN NIL
FUNCTION Three()
Four()
RETURN nil
RETURN NIL
FUNCTION Four()
Five()
RETURN nil
RETURN NIL
FUNCTION Five()
@@ -36,4 +36,4 @@ FUNCTION Five()
QQOut( "Called from: ", ProcName( n ), ProcLine( n++ ), hb_eol() )
ENDDO
RETURN nil
RETURN NIL

3
harbour/tests/readhrb.prg
View File

@@ -50,12 +50,11 @@ STATIC s_aScopes := { ;
PROCEDURE Main( cFrom )
LOCAL hFile
LOCAL cBlock := " "
LOCAL cBlock
LOCAL n, m
LOCAL nVal
LOCAL nSymbols
LOCAL nFuncs
LOCAL cMode := "SYMBOL"
LOCAL cScope
LOCAL nLenCount
LOCAL nIdx

6
harbour/tests/returns.prg
View File

@@ -23,13 +23,13 @@ FUNCTION Two( n )
DO CASE
CASE n == 1
QOut( "n == 1" )
RETURN nil
RETURN NIL
CASE n == 2
QOut( "n == 2" )
RETURN nil
RETURN NIL
ENDCASE
QOut( "This message should not been seen" )
RETURN nil
RETURN NIL

13
harbour/tests/rto_get.prg
View File

@@ -1585,19 +1585,6 @@ PROCEDURE LogGETVars( o, desc, xResult )
RETURN
STATIC FUNCTION ObjToList( o )
LOCAL cString := ""
LOCAL tmp
FOR tmp := 1 TO Len( o )
cString += XToStr( o[ tmp ] )
IF tmp < Len( o )
cString += ", "
ENDIF
NEXT
RETURN cString
FUNCTION XToStr( xValue )
LOCAL cType := ValType( xValue )

13
harbour/tests/rto_tb.prg
View File

@@ -584,19 +584,6 @@ PROCEDURE LogTBCVars( o, desc, xResult )
RETURN
STATIC FUNCTION ObjToList( o )
LOCAL cString := ""
LOCAL tmp
FOR tmp := 1 TO Len( o )
cString += XToStr( o[ tmp ] )
IF tmp < Len( o )
cString += ", "
ENDIF
NEXT
RETURN cString
FUNCTION XToStr( xValue )
LOCAL cType := ValType( xValue )

2
harbour/tests/sbartest.prg
View File

@@ -27,7 +27,7 @@ PROCEDURE Main()
FUNCTION InitScrlBar()
LOCAL tmpFileList := {}, i
LOCAL tmpFileList, i
MEMVAR aFileList, filesScroll
PRIVATE aFileList := {}, filesScroll

2
harbour/tests/setkeys.prg
View File

@@ -58,7 +58,7 @@
PROCEDURE Main()
LOCAL GetList := {}
LOCAL alpha, bravo, charlie, k, l
LOCAL alpha, bravo, charlie, k
LOCAL F8Active := .T.
CLS

2
harbour/tests/speed.prg
View File

@@ -7,7 +7,7 @@ PROCEDURE Main()
LOCAL Program := { , }, Condition := 1, body := 2, Counter := 1, TheEnd := 1000000, stop, start
Program[ condition ] := {|| Counter == TheEnd }
Program[ body ] := {|| Counter ++ }
Program[ body ] := {|| Counter++ }
? start := Second()
// in Clipper :

2
harbour/tests/statfun.prg
View File

@@ -18,4 +18,4 @@ STATIC FUNCTION SecondOne()
QOut( "From Second()" )
RETURN nil
RETURN NIL

2
harbour/tests/statics.prg
View File

@@ -53,6 +53,8 @@ PROCEDURE NumStat( a )
// STATIC m := s_n // uncomment it to see an error
// STATIC m := Time() // uncomment it to see an error
HB_SYMBOL_UNUSED( a )
cb := {| x | s_z + Str( x ) }
QOut( ++s_n )
QOut( Eval( cb, s_n ) )

21
harbour/tests/stripem.prg
View File

@@ -108,16 +108,16 @@ FUNCTION New( cFileName, cMode, nBlock )
::cFileName := cFileName
::cMode := Default( cMode, "R" )
if ::cMode == "R"
IF ::cMode == "R"
::hFile := FOpen( cFileName )
elseif ::cMode == "W"
ELSEIF ::cMode == "W"
::hFile := FCreate( cFileName )
ELSE
QOut( "DosFile Init: Unknown file mode:", ::cMode )
ENDIF
::nError := FError()
if ::nError != 0
IF ::nError != 0
::lEoF := .T.
QOut( "Error ", ::nError )
ENDIF
@@ -134,8 +134,8 @@ FUNCTION Dispose()
LOCAL self := QSelf()
::cBlock := NIL
if ::hFile != - 1
if ::cMode == "W" .AND. ::nError != 0
IF ::hFile != - 1
IF ::cMode == "W" .AND. ::nError != 0
::Write( Chr( 26 ) ) // Do not forget EOF marker
ENDIF
IF !FClose( ::hFile )
@@ -157,11 +157,10 @@ FUNCTION READ()
LOCAL cBlock
LOCAL nCrPos
LOCAL nEoFPos
LOCAL nRead
if ::hFile == - 1
IF ::hFile == - 1
QOut( "DosFile:Read : No file open" )
elseif ::cMode != "R"
ELSEIF ::cMode != "R"
QOut( "File ", ::cFileName, " not open for reading" )
ELSEIF !::lEoF
@@ -213,9 +212,9 @@ FUNCTION WriteLn( xTxt, lCRLF )
LOCAL self := QSelf()
LOCAL cBlock
if ::hFile == - 1
IF ::hFile == - 1
QOut( "DosFile:Write : No file open" )
elseif ::cMode != "W"
ELSEIF !( ::cMode == "W" )
QOut( "File ", ::cFileName, " not opened for writing" )
ELSE
cBlock := ToChar( xTxt ) // Convert to string
@@ -242,7 +241,7 @@ FUNCTION GOTO( nLine )
IF Empty( ::hFile )
QOut( "DosFile:Goto : No file open" )
elseif ::cMode != "R"
ELSEIF !( ::cMode == "R" )
QOut( "File ", ::cFileName, " not open for reading" )
ELSE
::lEoF := .F. // Clear (old) End of file

1
harbour/tests/switch.prg
View File

@@ -9,6 +9,7 @@
PROCEDURE Main()
LOCAL a := 1
MEMVAR b
PRIVATE b := "b"
#ifndef __XHARBOUR__

2
harbour/tests/tb1.prg
View File

@@ -70,7 +70,7 @@ PROCEDURE Main()
oCol1:footing := "position"
oCol1:colorBlock := {| val | { val % 5 + 1, val % 3 + 2 } }
oCol2 := TBColumnNew( "COL;2", {|| s_nCount ++ } )
oCol2 := TBColumnNew( "COL;2", {|| s_nCount++ } )
oCol2:defColor := { 3, 4, 5, 6 }
oCol2:footing := "counter"
oCol2:headSep := hb_UTF8ToStr( "┐ ┌─┤HIDE├─" )

2
harbour/tests/test_all.prg
View File

@@ -17,7 +17,7 @@
PROCEDURE Main( cOption, cCmd )
LOCAL aDir, f, n, o, p, cRead
LOCAL aDir, f, n, o, p
SET DATE ANSI
SET CENTURY ON

10
harbour/tests/testbrw.prg
View File

@@ -16,12 +16,14 @@ PROCEDURE Main()
LOCAL aTest2 := { Date(), Date() + 4, Date() + 56, Date() + 14, Date() + 5, Date() + 6, Date() + 7, Date() + 8, Date() + 10000, Date() - 1000, Date() - 54, Date() + 456342 }
LOCAL aTest3 := { .T. , .F. , .T. , .T. , .F. , .F. , .T. , .F. , .T. , .T. , .F. , .F. }
LOCAL n := 1
LOCAL nKey
LOCAL lEnd := .F.
LOCAL nCursor
LOCAL cColor
LOCAL nRow, nCol
#ifndef HB_COMPAT_C53
LOCAL nKey
LOCAL nTmpRow, nTmpCol
LOCAL lEnd := .F.
#endif
oBrowse:colorSpec := "W+/B, N/BG"
oBrowse:ColSep := hb_UTF8ToStr( "│" )
@@ -60,10 +62,10 @@ PROCEDURE Main()
nCol := Col()
@ 4, 4, 17, 31 BOX hb_UTF8ToStr( "┌─┐│┘─└│ " )
#ifdef HB_COMPAT_C53
oBrowse:SetKey( 0, {| ob, nkey | Defproc( ob,nKey ) } )
oBrowse:SetKey( 0, {| ob, nkey | Defproc( ob, nKey ) } )
WHILE .T.
oBrowse:ForceStable()
IF ( oBrowse:applykey( Inkey(0 ) ) == - 1 )
IF oBrowse:applykey( Inkey( 0 ) ) == -1
EXIT
ENDIF
ENDDO

2
harbour/tests/testcls.prg
View File

@@ -32,4 +32,4 @@ METHOD MyErrorManager( uParam1 ) CLASS Test
Alert( __GetMessage() ) // Shows the message that was sent to the object
RETURN nil
RETURN NIL

2
harbour/tests/testerro.prg
View File

@@ -12,4 +12,6 @@ PROCEDURE Main()
n++ // an error should raise here
HB_SYMBOL_UNUSED( n )
RETURN

2
harbour/tests/testfor.prg
View File

@@ -2,7 +2,7 @@
* $Id$
*/
PRCOEDURE Main()
PROCEDURE Main()
LOCAL i

3
harbour/tests/testmem.prg
View File

@@ -11,4 +11,7 @@ PROCEDURE Main()
a := "Hello"
b := 2
HB_SYMBOL_UNUSED( a )
HB_SYMBOL_UNUSED( b )
RETURN

2
harbour/tests/testntx.prg
View File

@@ -4,7 +4,7 @@
PROCEDURE Main()
LOCAL i := 0, block
LOCAL i := 0
FIELD Last, First
USE test

6
harbour/tests/testop.prg
View File

@@ -62,10 +62,12 @@
PROCEDURE Main()
LOCAL oCar := TCar():New( "red", 2 )
LOCAL oPetrol
LOCAL oPetrol := NIL
oCar := oCar + oPetrol
HB_SYMBOL_UNUSED( oCar )
RETURN
//----------------------------------------------------------------------------//
@@ -102,6 +104,8 @@ METHOD New( cColor, nDoors ) CLASS TCar
METHOD SUM( oObject ) CLASS TCar
HB_SYMBOL_UNUSED( oObject )
Alert( "+ has a special meaning and " + ;
"functionality for TCar Class objects!!!" )

3
harbour/tests/testpp.prg
View File

@@ -5,8 +5,9 @@
// Tests for stringify match markers
// Preproces and compile only
PROC MAIN()
LOCAL b
LOCAL b := ""
MEMVAR a
MEMVAR c
PRIVATE a
#command _REGULAR_(<z>) => ? <z> //REGULAR

16
harbour/tests/testrdd2.prg
View File

@@ -4,11 +4,11 @@
#include "ord.ch"
#define MAX_TEST_RECS 100
#define INDEX_KEY_CHAR CHAR + Str( NUM ) + DTOS( DATE )
#define INDEX_KEY_NUM NUM
#define INDEX_KEY_DATE DATE
#define INDEX_KEY_LOG LOG
#define MAX_TEST_RECS 100
#define INDEX_KEY_CHAR CHAR + Str( NUM ) + DToS( DATE )
#define INDEX_KEY_NUM NUM
#define INDEX_KEY_DATE DATE
#define INDEX_KEY_LOG LOG
EXTERNAL _ADS
EXTERNAL DBFNTX
@@ -351,7 +351,7 @@ PROCEDURE ErrorSys()
STATIC PROCEDURE MyError( e )
LOCAL cTrace := "", i := 1 /* Start are "real" error */, cErr
LOCAL i := 1 /* Start are "real" error */, cErr
cErr := "Runtime error" + hb_eol() + ;
hb_eol() + ;
@@ -362,7 +362,7 @@ STATIC PROCEDURE MyError( e )
"Call trace:" + hb_eol() + ;
hb_eol()
DO WHILE ! Empty( ProcName( ++ i ) )
DO WHILE ! Empty( ProcName( ++i ) )
cErr += RTrim( ProcName( i ) ) + "(" + LTrim( Str( ProcLine( i ) ) ) + ")" + hb_eol()
ENDDO
@@ -394,6 +394,8 @@ STATIC FUNCTION CompareArray( a1, a2 )
STATIC PROCEDURE NotifyUser( cErr, lNotError )
HB_SYMBOL_UNUSED( lNotError )
? cErr
QUIT // If remove this, will display all error without stopping

2
harbour/tests/teststr.prg
View File

@@ -2,7 +2,7 @@
* $Id$
*/
PROCEDURE Main( cParam )
PROCEDURE Main()
OutStd( hb_eol() )
OutStd( "Running with SET FIXED OFF (the default setting): " )

4
harbour/tests/testvars.prg
View File

@@ -15,6 +15,10 @@ PROCEDURE Main( Param1 )
QOut( j )
HB_SYMBOL_UNUSED( Param1 )
HB_SYMBOL_UNUSED( k )
HB_SYMBOL_UNUSED( i )
RETURN
FUNCTION Sub( j )

58
harbour/tests/testwarn.prg
View File

@@ -57,52 +57,52 @@ STATIC lGlobal AS LOGICAL
PROCEDURE Main( optional )
STATIC lStatic := 0, oMyObj As Class WrongClass
STATIC lStatic := 0, oMyObj As Class WrongClass
LOCAL cVar AS STRING := [declare function]
LOCAL cVar AS STRING := [declare function]
LOCAL a As STRING, oB AS Class MyClass, c AS STRING, oD AS Class OtherClass
LOCAL a As STRING, oB AS Class MyClass, c AS STRING, oD AS Class OtherClass
FIELD b AS NUMERIC
FIELD b AS NUMERIC
MEMVAR Var1 AS NUMERIC
MEMVAR Var1 AS NUMERIC
PRIVATE TEST AS STRING
PRIVATE TEST AS STRING
USE TEMP
USE TEMP
oMyObj:MyMethod( 2, 3, 4 )
oMyObj:MyMethod( 2, 3, 4 )
a := b:nMyFunc(2,3)
a := b:nMyFunc(2)
a := b:nMyFunc(2,3)
a := b:nMyFunc(2)
a := oB:oNext( 1 ):cMyData
a := oB:oNext( c ):cMyData2
a := oB:oNext( d ):cMyData
a := oB:oNext( oD ):cMyData
a := oB:oNext( 1 ):cMyData
a := oB:oNext( c ):cMyData2
a := oB:oNext( d ):cMyData
a := oB:oNext( oD ):cMyData
a := oB:aInstances[1]:oNext:cMyData2
a := oB:aInstances[1]:oNext:cMyData
a := oB:aInstances[1]:oNext:cMyData2
a := oB:aInstances[1]:oNext:cMyData
x := cOtherFunc( "A" )
x := cOtherFunc( @Test )
x := cOtherFunc( "A", "A", "A" )
x := cOtherFunc( "A" )
x := cOtherFunc( @Test )
x := cOtherFunc( "A", "A", "A" )
M->TEST := "TEST"
M->TEST := "TEST"
a := "A"
a := "A"
oB := "a"
oB := "a"
if lStatic
Var1 := .F.
endif
IF lStatic
Var1 := .F.
ENDIF
IF lGlobal
Var1 := .T.
ENDIF
IF lGlobal
Var1 := .T.
ENDIF
RETURN
RETURN
PROCEDURE SOMEPROC()

19
harbour/tests/tstasort.prg
View File

@@ -9,21 +9,20 @@ PROCEDURE Main()
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( a )
? "Asort.c......:", aDump( ASort( AClone( a ) ) )
? "Asort.c.block:", aDump( ASort( 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( b )
? "Asort.c......:", aDump( ASort( AClone( b ) ) )
? "Asort.c.block:", aDump( ASort( 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 ) } ) )
? "Original.....:", aDump( c )
? "Asort.c......:", aDump( ASort( AClone( c ) ) )
? "Asort.c.block:", aDump( ASort( AClone( c ), , , {| x, y | xToStr( x ) < xToStr( y ) } ) )
RETURN

2
harbour/tests/tstdbi.prg
View File

@@ -60,6 +60,6 @@ STATIC FUNCTION xToStr( xValue )
RETURN "A" + hb_ntos( Len( xValue ) )
CASE "U"
RETURN "NIL"
ENDCASE
ENDSWITCH
RETURN ""

4
harbour/tests/tstmacro.prg
View File

@@ -13,6 +13,10 @@ PROCEDURE Main()
PRIVATE cVar_1, cMainPrivate := "cVar_1", GlobalPrivate := "BornInRunTimeVar"
// to avoid unused STATIC FUNCTION warnings
UDF_STATIC()
UDF2_STATIC()
&cStr_1 := "Simple "
? M->cVar_1

2
harbour/tests/varparam.prg
View File

@@ -6,7 +6,7 @@
MEMVAR iLoop
PROCEDURE Main( p1, p2 )
PROCEDURE Main()
LOCAL l1 := 11, l2 := 22, l3 := 33, l4 := 44, l5 := 55, l6 := 66
PRIVATE iLoop

2
harbour/tests/vidtest.prg
View File

@@ -149,7 +149,7 @@ STATIC FUNCTION WindowBounce()
IF y[ i ] <= 0 .OR. y[ i ] + 12 >= MaxCol()
dy[ i ] := - dy[ i ]
ENDIF
next i
NEXT
++nFrames
ENDDO