diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 9727ccc264..6cfdc6d89f 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,41 @@ +19990909-21:30 GMT+1 Victor Szel + * source/rtl/arrays.c + ! hb_arrayCopy() fixed. Now it has two methods, one strictly compatible, + and one which fixes buggy behaviour on extreme parameters. Clipper will + copy one item, even it an out-of-range start, or target position is + passed, I've considered that buggy. You can choose with the + HARBOUR_STRICT_CLIPPER_COMPATIBILITY switch anyway. + * tests/working/rtl_test.prg + + ACOPY() tests added. + * source/rtl/tgetlist.prg + + Using getexit.ch include file, instead of repeating its content. + * source/debug/tbrwtext.prg + + CVS header added. + * include/extend.h + ! Some Clipper compatibility include files moved to the bottom, it's + better now, but it still doesn't work when + HARBOUR_STRICT_CLIPPER_COMPATIBILITY is defined. + * source/rtl/tget.prg + source/debug/debugger.prg + + Using common.ch include file, instead of repeating its content. + DEFAULT := form changed to the standard DEFAULT TO form, which is a + bit more efficient anyway, since it only assigns when needed. + * source/tools/fileread.prg + source/tools/dates2.c + source/tools/hb_f.c + source/vm/dynsym.c + source/hbpp/table.c + source/hbpp/hbppint.c + source/hbpp/hbpp.c + source/compiler/fixflex.c + source/rtl/*.c + * Standardization in header format. Note that we should also standardize + the *text* of the copyright message. + * source/vm/hvm.c + * Small formatting correction. + * source/rtl/xsavescr.prg + + Reformatted. + 19990909-18:22 GMT+1 Victor Szel * source/rtl/arrays.c ! ARRAY() fixed to parse the dimension list in the right order. @@ -6,7 +44,7 @@ * tests/working/rtl_test.prg + Some new ARRAY() tests added. * tests/working/extend2.c - ; Compiled/linked successfully with Cygwin. There's still incompatibility + ; Compiled/linked successfully with Cygwin. There's still incompatibility since Harbour needs all the C functions to be prefixed with "HB_". * Changed HARBOUR function types to CLIPPER. * include/clipdefs.h @@ -28,8 +66,8 @@ * source/rtl/arrays.c include/extend.h ! hb_arraySize() - Fixed a memory related bug. Now when an array is - resized to zero length, it will free (and not reallocate) the memory - allocated for the item pointer table. ASIZE({ "A", "B" }, 0) could + resized to zero length, it will free (and not reallocate) the memory + allocated for the item pointer table. ASIZE({ "A", "B" }, 0) could show the problem. + ARRAY() now supprt multiple dimensions. Code based on hb_vmArrayNew(). ! Array functions error handling behaviour made completely CA-Clipper @@ -47,12 +85,12 @@ ! __RUN() now checks for the parameter type, not the number, + __RUN() funtionality enabled for __CYGWIN__ + __RUN() will now throw an "operation not supported" runtime error on - platforms where it's not supported, this is IMO better than silently - doing nothing. The error has a Default case, so the use can continue + platforms where it's not supported, this is IMO better than silently + doing nothing. The error has a Default case, so the use can continue running the program. ! __RUN() Standardized the doc header. * source/rtl/copyfile.c - + Made completely compatible in order to pass the tests. A small file + + Made completely compatible in order to pass the tests. A small file name forming difference is still there. * tests/working/rtl_test.prg + __COPYFILE() tests added. @@ -73,37 +111,37 @@ 19990909-16:05 GMT+2 Ryszard Glab *source/rtl/memvarbl.prg - + corrected to allow setings of NIL value - + + corrected to allow setings of NIL value + 19990909-13:00 GMT+2 Ryszard Glab *source/runner/stdalone/external.prg - + added __MVGET, __MVPUT, MEMVARBLOCK - + + added __MVGET, __MVPUT, MEMVARBLOCK + *include/init.h - + added 'static' declaration for functions used to initialize - symbols table - + + added 'static' declaration for functions used to initialize + symbols table + 19990909-12:45 GMT+2 Ryszard Glab *source/rtl/memvars.c - * removed unused variables - + * removed unused variables + *source/rtl/memvarbl.prg - + added new file with MEMVARBLOCK() function - + + added new file with MEMVARBLOCK() function + *source/trl/Makefile - + added memvarbl.prg to PRG_SOURCES - + + added memvarbl.prg to PRG_SOURCES + 19990909-12:00 GMT+2 Ryszard Glab *source/rtl/memvars.c - + added __mvGET and __mvPUT functions to set/get the value of - private and public variables - + + added __mvGET and __mvPUT functions to set/get the value of + private and public variables + *doc/subcodes.txt - * updated info for 3009 and 3010 subcodes used in __mvGET/__mvPUT - + * updated info for 3009 and 3010 subcodes used in __mvGET/__mvPUT + 19990908-21:35 EDT David G. Holm * include/extend.h * include/hbdefs.h diff --git a/harbour/include/extend.h b/harbour/include/extend.h index 05b07d193d..9f6368d5bf 100644 --- a/harbour/include/extend.h +++ b/harbour/include/extend.h @@ -30,12 +30,6 @@ #include "hbdefs.h" #include "hb_vmpub.h" -#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY - /* Clipper includes these from extend.h */ - #include "extend.api" - #include "fm.api" -#endif - /* items types and type checking macros */ #define IT_NIL ( ( WORD ) 0x0000 ) #define IT_INTEGER ( ( WORD ) 0x0002 ) @@ -369,5 +363,13 @@ extern char * hb_consoleGetNewLine( void ); extern char * hb_setColor( char * ); +/* Please leave these at the bottom of this file */ + +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY + /* Clipper includes these from extend.h */ + #include "extend.api" + #include "fm.api" +#endif + #endif /* HB_EXTEND_H_ */ diff --git a/harbour/source/compiler/fixflex.c b/harbour/source/compiler/fixflex.c index 6b50c24abb..2af80fd573 100644 --- a/harbour/source/compiler/fixflex.c +++ b/harbour/source/compiler/fixflex.c @@ -1,5 +1,8 @@ -/* $Id$ +/* + * $Id$ + */ +/* Harbour Project source code This file contains an external program that splits the Harbour Flex and diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index 166ba5fc8c..f299ff1733 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -26,11 +26,7 @@ #include "classes.ch" #include "inkey.ch" #include "memvars.ch" - -#xcommand DEFAULT := ; - [, := ] => ; - := If( == nil, , ) ;; - [ := If( == nil, , ); ] +#include "common.ch" #xcommand MENU [] => [ := ] TDbMenu():New() #xcommand MENUITEM [ ACTION ] => ; @@ -583,7 +579,7 @@ return nil METHOD Show( lFocused ) CLASS TDbWindow - DEFAULT lFocused := .f. + DEFAULT lFocused TO .f. ::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom, ::nRight ) SetColor( ::cColor ) diff --git a/harbour/source/debug/tbrwtext.prg b/harbour/source/debug/tbrwtext.prg index 7427691ab3..759269d2a8 100644 --- a/harbour/source/debug/tbrwtext.prg +++ b/harbour/source/debug/tbrwtext.prg @@ -1,3 +1,7 @@ +/* + * $Id$ + */ + // Browses a text file #include "classes.ch" diff --git a/harbour/source/hbpp/hbpp.c b/harbour/source/hbpp/hbpp.c index 213bbc0ce8..35463c22a5 100644 --- a/harbour/source/hbpp/hbpp.c +++ b/harbour/source/hbpp/hbpp.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Harbour Project source code This file contains the main part of preprocessor implementation. diff --git a/harbour/source/hbpp/hbppint.c b/harbour/source/hbpp/hbppint.c index 9b35e082f0..7c9608bc13 100644 --- a/harbour/source/hbpp/hbppint.c +++ b/harbour/source/hbpp/hbppint.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Harbour Project source code This file contains some functions of preprocessor, which provides diff --git a/harbour/source/hbpp/table.c b/harbour/source/hbpp/table.c index 8429c7c5a3..7ad854e11d 100644 --- a/harbour/source/hbpp/table.c +++ b/harbour/source/hbpp/table.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Harbour Project source code This file contains the tables of predefined #define and #command diff --git a/harbour/source/rtl/alert.prg b/harbour/source/rtl/alert.prg index a99ec8a780..9325cc1ab6 100644 --- a/harbour/source/rtl/alert.prg +++ b/harbour/source/rtl/alert.prg @@ -1,5 +1,8 @@ -/* $Id$ +/* + * $Id$ + */ +/* Harbour Project source code www - http://www.Harbour-Project.org @@ -23,7 +26,7 @@ // This is fixed. // ; nDelay parameter is a Harbour addition. -FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay) +FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay ) LOCAL nChoice LOCAL aSay, nPos, nWidth, nOpWidth, nInitRow, nInitCol, iEval LOCAL nKey, aPos, nCurrent, aHotkey, aOptionsOK @@ -44,7 +47,7 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay) #ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY // TODO: Enable this when we have a function for querying the command line // parameters. -// IF "//NOALERT" $ /* Upper(cCommandLine) */ +// IF "//NOALERT" $ /* Upper( cCommandLine ) */ // QUIT // ENDIF #endif @@ -53,58 +56,58 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay) #ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY - IF !(ValType(xMessage) == "C") + IF !( ValType( xMessage ) == "C" ) RETURN NIL ENDIF - DO WHILE (nPos := At(';', xMessage)) != 0 - AAdd(aSay, Left(xMessage, nPos - 1)) - xMessage := SubStr(xMessage, nPos + 1) + DO WHILE ( nPos := At( ';', xMessage ) ) != 0 + AAdd( aSay, Left( xMessage, nPos - 1 ) ) + xMessage := SubStr( xMessage, nPos + 1 ) ENDDO - AAdd(aSay, xMessage) + AAdd( aSay, xMessage ) #else - IF ValType(xMessage) == "A" + IF ValType( xMessage ) == "A" - FOR iEval := 1 TO Len(xMessage) + FOR iEval := 1 TO Len( xMessage ) IF ValType( xMessage[ iEval ] ) == "C" - AAdd(aSay, xMessage[ iEval ] ) + AAdd( aSay, xMessage[ iEval ] ) ENDIF NEXT ELSE DO CASE - CASE ValType(xMessage) $ "CM" /* Do nothing, just speed up things */ - CASE ValType(xMessage) == "N" ; xMessage := LTrim( Str( xMessage ) ) - CASE ValType(xMessage) == "D" ; xMessage := DToC( xMessage ) - CASE ValType(xMessage) == "L" ; xMessage := iif( xMessage, ".T.", ".F." ) - CASE ValType(xMessage) == "O" ; xMessage := xMessage:className + " Object" - CASE ValType(xMessage) == "B" ; xMessage := "{||...}" - OTHERWISE ; xMessage := "NIL" + CASE ValType( xMessage ) $ "CM" /* Do nothing, just speed up things */ + CASE ValType( xMessage ) == "N" ; xMessage := LTrim( Str( xMessage ) ) + CASE ValType( xMessage ) == "D" ; xMessage := DToC( xMessage ) + CASE ValType( xMessage ) == "L" ; xMessage := iif( xMessage, ".T.", ".F." ) + CASE ValType( xMessage ) == "O" ; xMessage := xMessage:className + " Object" + CASE ValType( xMessage ) == "B" ; xMessage := "{||...}" + OTHERWISE ; xMessage := "NIL" ENDCASE - DO WHILE (nPos := At(';', xMessage)) != 0 - AAdd(aSay, Left(xMessage, nPos - 1)) - xMessage := SubStr(xMessage, nPos + 1) + DO WHILE ( nPos := At( ';', xMessage ) ) != 0 + AAdd( aSay, Left( xMessage, nPos - 1 ) ) + xMessage := SubStr( xMessage, nPos + 1 ) ENDDO - AAdd(aSay, xMessage) + AAdd( aSay, xMessage ) ENDIF #endif - IF !(ValType(aOptions) == "A") + IF !( ValType( aOptions ) == "A" ) aOptions := {} ENDIF - IF !(ValType(cColorNorm) == "C") - cColorNorm := 'w+/r' - cColorHigh := 'w+/b' + IF !( ValType( cColorNorm ) == "C" ) + cColorNorm := "W+/R" + cColorHigh := "W+/B" ELSE - cColorHigh := StrTran(StrTran(iif(At("/", cColorNorm) == 0, "N", SubStr(cColorNorm, At("/", cColorNorm) + 1)) + "/" +; - iif(At("/", cColorNorm) == 0, cColorNorm, Left(cColorNorm, At("/", cColorNorm) - 1)), "+", ""), "*", "") + cColorHigh := StrTran( StrTran( iif( At( "/", cColorNorm ) == 0, "N", SubStr( cColorNorm, At( "/", cColorNorm ) + 1 ) ) + "/" +; + iif( At( "/", cColorNorm ) == 0, cColorNorm, Left( cColorNorm, At( "/", cColorNorm ) - 1 ) ), "+", "" ), "*", "" ) ENDIF IF nDelay == NIL @@ -113,59 +116,59 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay) /* The longest line */ nWidth := 0 - AEval(aSay, { |x| nWidth := Max(Len(x), nWidth) }) + AEval( aSay, {| x | nWidth := Max( Len( x ), nWidth ) } ) /* Cleanup the button array */ aOptionsOK := {} - FOR iEval := 1 TO Len(aOptions) - IF ValType(aOptions[iEval]) == "C" .AND. !Empty(aOptions[iEval]) - AAdd(aOptionsOK, aOptions[iEval]) + FOR iEval := 1 TO Len( aOptions ) + IF ValType( aOptions[ iEval ] ) == "C" .AND. !Empty( aOptions[ iEval ] ) + AAdd( aOptionsOK, aOptions[ iEval ] ) ENDIF NEXT - IF Len(aOptionsOK) == 0 + IF Len( aOptionsOK ) == 0 aOptionsOK := { 'Ok' } #ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY // ; Clipper allows only four options - ELSEIF Len(aOptionsOK) > 4 - aSize(aOptionsOK, 4) + ELSEIF Len( aOptionsOK ) > 4 + aSize( aOptionsOK, 4 ) #endif ENDIF /* Total width of the botton line (the one with choices) */ nOpWidth := 0 - AEval(aOptionsOK, { |x| nOpWidth += Len(x) + 4 }) + AEval( aOptionsOK, {| x | nOpWidth += Len( x ) + 4 } ) /* what's wider ? */ - nWidth := Max(nWidth + 2 + iif(Len(aSay) == 1, 4, 0), nOpWidth + 2) + nWidth := Max( nWidth + 2 + iif( Len( aSay ) == 1, 4, 0 ), nOpWidth + 2 ) /* box coordinates */ - nInitRow := Int(((MaxRow() - (Len(aSay) + 4)) / 2) + .5) - nInitCol := Int(((MaxCol() - (nWidth + 2)) / 2) + .5) + nInitRow := Int( ( ( MaxRow() - ( Len( aSay ) + 4 ) ) / 2 ) + .5 ) + nInitCol := Int( ( ( MaxCol() - ( nWidth + 2 ) ) / 2 ) + .5 ) /* detect prompts positions */ aPos := {} aHotkey := {} - nCurrent := nInitCol + Int((nWidth - nOpWidth) / 2) + 2 - AEval(aOptionsOK, { |x| AAdd(aPos, nCurrent), AAdd(aHotKey, Upper(Left(x, 1))), nCurrent += Len(x) + 4 }) + nCurrent := nInitCol + Int( ( nWidth - nOpWidth ) / 2 ) + 2 + AEval( aOptionsOK, {| x | AAdd( aPos, nCurrent ), AAdd( aHotKey, Upper( Left( x, 1 ) ) ), nCurrent += Len( x ) + 4 } ) IF lConsole - FOR iEval := 1 TO Len(aSay) - OutStd(aSay[iEval]) - IF iEval < Len(aSay) - OutStd(Chr(13) + Chr(10)) + FOR iEval := 1 TO Len( aSay ) + OutStd( aSay[ iEval ] ) + IF iEval < Len( aSay ) + OutStd( Chr( 13 ) + Chr( 10 ) ) ENDIF NEXT - OutStd(" (") - FOR iEval := 1 TO Len(aOptionsOK) - OutStd(aOptionsOK[iEval]) - IF iEval < Len(aOptionsOK) - OutStd(", ") + OutStd( " (" ) + FOR iEval := 1 TO Len( aOptionsOK ) + OutStd( aOptionsOK[ iEval ] ) + IF iEval < Len( aOptionsOK ) + OutStd( ", " ) ENDIF NEXT - OutStd(") ") + OutStd( ") " ) ELSE @@ -179,15 +182,15 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay) /* save status */ nOldRow := Row() nOldCol := Col() - nOldCursor := SetCursor(0) - cOldScreen := SaveScreen( nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1 ) + nOldCursor := SetCursor( 0 ) + cOldScreen := SaveScreen( nInitRow, nInitCol, nInitRow + Len( aSay ) + 3, nInitCol + nWidth + 1 ) /* draw box */ - @ nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1 ; + @ nInitRow, nInitCol, nInitRow + Len( aSay ) + 3, nInitCol + nWidth + 1 ; BOX B_SINGLE + ' ' COLOR cColorNorm - FOR iEval := 1 TO Len(aSay) - @ nInitRow + iEval, nInitCol + 1 + Int(((nWidth - Len(aSay[iEval])) / 2) + .5) SAY aSay[iEval] ; + FOR iEval := 1 TO Len( aSay ) + @ nInitRow + iEval, nInitCol + 1 + Int( ( ( nWidth - Len( aSay[ iEval ] ) ) / 2 ) + .5 ) SAY aSay[ iEval ] ; COLOR cColorNorm NEXT @@ -199,13 +202,13 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay) DO WHILE .T. IF !lConsole - FOR iEval := 1 TO Len(aOptionsOK) - @ nInitRow + Len(aSay) + 2, aPos[iEval] SAY " " + aOptionsOK[iEval] + " " ; - COLOR If(iEval == nChoice, cColorHigh, cColorNorm) + FOR iEval := 1 TO Len( aOptionsOK ) + @ nInitRow + Len( aSay ) + 2, aPos[ iEval ] SAY " " + aOptionsOK[ iEval ] + " " ; + COLOR iif( iEval == nChoice, cColorHigh, cColorNorm ) NEXT ENDIF - nKey := Inkey(nDelay) + nKey := Inkey( nDelay ) DO CASE CASE nKey == K_ENTER .OR. nKey == 0 @@ -217,23 +220,23 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay) nChoice := 0 EXIT - CASE (nKey == K_LEFT .OR. nKey == K_SH_TAB) .AND. Len(aOptionsOK) > 1 + CASE ( nKey == K_LEFT .OR. nKey == K_SH_TAB ) .AND. Len( aOptionsOK ) > 1 nChoice-- IF nChoice == 0 - nChoice := Len(aOptionsOK) + nChoice := Len( aOptionsOK ) ENDIF - CASE (nKey == K_RIGHT .OR. nKey == K_TAB) .AND. Len(aOptionsOK) > 1 + CASE ( nKey == K_RIGHT .OR. nKey == K_TAB ) .AND. Len( aOptionsOK ) > 1 nChoice++ - IF nChoice > Len(aOptionsOK) + IF nChoice > Len( aOptionsOK ) nChoice := 1 ENDIF - CASE aScan(aHotkey, {|x| x == Upper(Chr(nKey)) }) > 0 + CASE aScan( aHotkey, {| x | x == Upper( Chr( nKey ) ) } ) > 0 - nChoice := aScan(aHotkey, {|x| x == Upper(Chr(nKey)) }) + nChoice := aScan( aHotkey, {| x | x == Upper( Chr( nKey ) ) } ) EXIT ENDCASE @@ -242,14 +245,14 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay) IF lConsole - OutStd(Chr(nKey)) + OutStd( Chr( nKey ) ) ELSE /* Restore status */ - RestScreen( nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1, cOldScreen ) - SetCursor(nOldCursor) - SetPos(nOldRow, nOldCol) + RestScreen( nInitRow, nInitCol, nInitRow + Len( aSay ) + 3, nInitCol + nWidth + 1, cOldScreen ) + SetCursor( nOldCursor ) + SetPos( nOldRow, nOldCol ) /* PostExt */ DO WHILE nOldDispCount-- != 0 diff --git a/harbour/source/rtl/arrays.c b/harbour/source/rtl/arrays.c index b3c684228c..18d87e8b98 100644 --- a/harbour/source/rtl/arrays.c +++ b/harbour/source/rtl/arrays.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Antonio Linares. This program is free software; you can redistribute it and/or modify @@ -114,6 +116,7 @@ BOOL hb_arraySize( PHB_ITEM pArray, ULONG ulLen ) if( ! pBaseArray->ulLen ) { pBaseArray->pItems = ( PHB_ITEM ) hb_xgrab( ulLen * sizeof( HB_ITEM ) ); + for( ulPos = 0; ulPos < ulLen; ulPos++ ) ( pBaseArray->pItems + ulPos )->type = IT_NIL; } @@ -142,6 +145,7 @@ BOOL hb_arraySize( PHB_ITEM pArray, ULONG ulLen ) pBaseArray->pItems = ( PHB_ITEM ) hb_xrealloc( pBaseArray->pItems, sizeof( HB_ITEM ) * ulLen ); } } + pBaseArray->ulLen = ulLen; return TRUE; @@ -610,20 +614,36 @@ BOOL hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG * pulStart, else ulTarget = 1; +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY + if( ulSrcLen > 0 ) +#else if( ulStart <= ulSrcLen ) +#endif { +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY + if( ulStart > ulSrcLen ) + ulStart = ulSrcLen; +#endif if( pulCount && ( *pulCount <= ulSrcLen - ulStart ) ) ulCount = *pulCount; else ulCount = ulSrcLen - ulStart + 1; +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY + if( ulDstLen > 0 ) +#else if( ulTarget <= ulDstLen ) +#endif { +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY + if( ulTarget > ulDstLen ) + ulTarget = ulDstLen; +#endif if( ulCount > ulDstLen - ulTarget ) - ulCount = ulDstLen - ulTarget; + ulCount = ulDstLen - ulTarget + 1; - for( ulTarget--, ulStart--; ulCount > 0; ulCount--, ulStart++ ) - hb_itemCopy( pDstBaseArray->pItems + ( ulTarget + ulStart ), pSrcBaseArray->pItems + ulStart ); + for( ulTarget--, ulStart--; ulCount > 0; ulCount--, ulStart++, ulTarget++ ) + hb_itemCopy( pDstBaseArray->pItems + ulTarget, pSrcBaseArray->pItems + ulStart ); } } diff --git a/harbour/source/rtl/codebloc.c b/harbour/source/rtl/codebloc.c index 350e94cbca..7884c912c7 100644 --- a/harbour/source/rtl/codebloc.c +++ b/harbour/source/rtl/codebloc.c @@ -1,6 +1,8 @@ /* * $Id$ - * + */ + +/* Harbour Project source code This file is a part of Harbour Runtime Library and it contains code diff --git a/harbour/source/rtl/copyfile.c b/harbour/source/rtl/copyfile.c index bc17261255..f3bb95f372 100644 --- a/harbour/source/rtl/copyfile.c +++ b/harbour/source/rtl/copyfile.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Andi Jahja This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/rtl/descend.c b/harbour/source/rtl/descend.c index cb1af187dd..5185ef48df 100644 --- a/harbour/source/rtl/descend.c +++ b/harbour/source/rtl/descend.c @@ -1,6 +1,8 @@ /* * $Id$ - * + */ + +/* Harbour Project source code Copyright(C) 1999 by Jose Lalin. diff --git a/harbour/source/rtl/devoutp.prg b/harbour/source/rtl/devoutp.prg index 71590930b8..60a3964e42 100644 --- a/harbour/source/rtl/devoutp.prg +++ b/harbour/source/rtl/devoutp.prg @@ -1,5 +1,8 @@ -/* $Id$ +/* + * $Id$ + */ +/* Harbour Project source code This file contains the Harbour function that outputs expressions @@ -75,6 +78,8 @@ * $END$ */ -FUNCTION DEVOUTPICT( xValue, cPicture, cColor ) - DEVOUT( TRANSFORM( xValue, cPicture ), cColor ) -RETURN NIL +FUNCTION DevOutPict( xValue, cPicture, cColor ) + + DevOut( Transform( xValue, cPicture ), cColor ) + + RETURN NIL diff --git a/harbour/source/rtl/do.c b/harbour/source/rtl/do.c index 99106bb9a5..e9f993fd5f 100644 --- a/harbour/source/rtl/do.c +++ b/harbour/source/rtl/do.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Harbour Project source code This file is a part of Harbour Runtime Library and it contains code diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index d4ca6e5daa..67db9704ad 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Antonio Linares. This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/rtl/errorsys.prg b/harbour/source/rtl/errorsys.prg index d1fb3fdbea..a24df97054 100644 --- a/harbour/source/rtl/errorsys.prg +++ b/harbour/source/rtl/errorsys.prg @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Antonio Linares. This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/rtl/extend.c b/harbour/source/rtl/extend.c index b6db679ae9..6ec9f99aa3 100644 --- a/harbour/source/rtl/extend.c +++ b/harbour/source/rtl/extend.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Antonio Linares. This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/rtl/fm.c b/harbour/source/rtl/fm.c index d7e750f0b5..267b84a136 100644 --- a/harbour/source/rtl/fm.c +++ b/harbour/source/rtl/fm.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Antonio Linares. This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/rtl/hardcr.c b/harbour/source/rtl/hardcr.c index 2e31be319c..b8187ad499 100644 --- a/harbour/source/rtl/hardcr.c +++ b/harbour/source/rtl/hardcr.c @@ -1,6 +1,8 @@ /* * $Id$ - * + */ + +/* Harbour Project source code Copyright(C) 1999 by Jose Lalin. diff --git a/harbour/source/rtl/inkey.c b/harbour/source/rtl/inkey.c index 67128338a8..15b2235402 100644 --- a/harbour/source/rtl/inkey.c +++ b/harbour/source/rtl/inkey.c @@ -1,5 +1,8 @@ -/* $Id$ +/* + * $Id$ + */ +/* Harbour Project source code This module contains the Harbour functions for INKEY management. diff --git a/harbour/source/rtl/itemapi.c b/harbour/source/rtl/itemapi.c index 3721d89aeb..92251c8343 100644 --- a/harbour/source/rtl/itemapi.c +++ b/harbour/source/rtl/itemapi.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Antonio Linares. This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index 3dd91d400b..e5d9dcd4c4 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -1,6 +1,7 @@ /* * $Id$ */ + /* Harbour Project source code http://www.Harbour-Project.org/ The following function is Copyright 1999 David G. Holm: diff --git a/harbour/source/rtl/memvarbl.prg b/harbour/source/rtl/memvarbl.prg index bffa681edb..e229d527f5 100644 --- a/harbour/source/rtl/memvarbl.prg +++ b/harbour/source/rtl/memvarbl.prg @@ -1,6 +1,7 @@ /* * $Id$ */ + /* Harbour Project source code diff --git a/harbour/source/rtl/memvars.c b/harbour/source/rtl/memvars.c index d2e4ec2653..ddb8a9bd75 100644 --- a/harbour/source/rtl/memvars.c +++ b/harbour/source/rtl/memvars.c @@ -1,6 +1,8 @@ /* * $Id$ - * + */ + +/* Harbour Project source code This file is a part of Harbour Runtime Library and it contains code diff --git a/harbour/source/rtl/mtran.c b/harbour/source/rtl/mtran.c index ff68e60d8f..2e081d16af 100644 --- a/harbour/source/rtl/mtran.c +++ b/harbour/source/rtl/mtran.c @@ -1,5 +1,8 @@ /* * $Id$ + */ + +/* Harbour Project source code Copyright(C) 1999 by Jose Lalin. diff --git a/harbour/source/rtl/readvar.prg b/harbour/source/rtl/readvar.prg index 0af301723b..3625dfad28 100644 --- a/harbour/source/rtl/readvar.prg +++ b/harbour/source/rtl/readvar.prg @@ -34,12 +34,12 @@ */ FUNCTION ReadVar( cVarName ) - STATIC scVarName := "" + STATIC s_cVarName := "" - LOCAL cOldVarName := scVarName + LOCAL cOldVarName := s_cVarName IF ValType( cVarName ) == "C" - scVarName := cVarName + s_cVarName := cVarName ENDIF RETURN cOldVarName diff --git a/harbour/source/rtl/set.c b/harbour/source/rtl/set.c index cc881adc38..8cecd86ee7 100644 --- a/harbour/source/rtl/set.c +++ b/harbour/source/rtl/set.c @@ -1,5 +1,8 @@ -/* $Id$ +/* + * $Id$ + */ +/* Harbour Project source code This module contains the Harbour functions for SET management. diff --git a/harbour/source/rtl/setcolor.c b/harbour/source/rtl/setcolor.c index ba253546e1..50f9b93b78 100644 --- a/harbour/source/rtl/setcolor.c +++ b/harbour/source/rtl/setcolor.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Paul Tucker This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/rtl/setkey.prg b/harbour/source/rtl/setkey.prg index d822ae3d13..47cf39b492 100644 --- a/harbour/source/rtl/setkey.prg +++ b/harbour/source/rtl/setkey.prg @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Harbour Project source code - http://www.Harbour-Project.org By: A White - awhite@user.rose.com diff --git a/harbour/source/rtl/strings.c b/harbour/source/rtl/strings.c index 570b45f478..5a8f46bc91 100644 --- a/harbour/source/rtl/strings.c +++ b/harbour/source/rtl/strings.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Antonio Linares. This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index 0a17b7062a..c1557c0bbb 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -2,8 +2,6 @@ * $Id$ */ -// Harbour Class TClass to build classes - /* Copyright(C) 1999 by Antonio Linares. @@ -31,6 +29,8 @@ * Support for default DATA values */ +// Harbour Class TClass to build classes + #include "hboo.ch" //----------------------------------------------------------------------------// diff --git a/harbour/source/rtl/terror.prg b/harbour/source/rtl/terror.prg index de80576be5..01008fa05c 100644 --- a/harbour/source/rtl/terror.prg +++ b/harbour/source/rtl/terror.prg @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Antonio Linares. This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index f59715bfad..0a68968e5c 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -26,11 +26,7 @@ #include "classes.ch" #include "color.ch" - -#xcommand DEFAULT := ; - [, := ] => ; - := If( == nil, , ) ;; - [ := If( == nil, , ); ] +#include "common.ch" //----------------------------------------------------------------------------// @@ -93,11 +89,11 @@ METHOD New(nRow, nCol, bVarBlock, cVarName, cPicture, cColor) CLASS TGet local cChar local nAt, nFor - DEFAULT nRow := Row() ,; - nCol := Col() ,; - cVarName := "" ,; - cPicture := "" ,; - cColor := "" + DEFAULT nRow TO Row() + DEFAULT nCol TO Col() + DEFAULT cVarName TO "" + DEFAULT cPicture TO "" + DEFAULT cColor TO "" ::badDate := .f. ::block := bVarBlock @@ -313,7 +309,7 @@ METHOD Untransform(cBuffer) CLASS TGet local cChar local nFor - DEFAULT cBuffer := ::buffer + DEFAULT cBuffer TO ::buffer do case case ::type == "C" @@ -671,8 +667,8 @@ METHOD PutMask(xValue, lEdit) CLASS TGet local cChar, cBuffer local nFor, nLen, nAt - DEFAULT xValue := ::VarGet() ,; - lEdit := ::hasfocus + DEFAULT xValue TO ::VarGet() + DEFAULT lEdit TO ::hasfocus cBuffer := Transform(xValue, Alltrim(::cPicFunc+" "+::cPicMask)) diff --git a/harbour/source/rtl/tgetlist.prg b/harbour/source/rtl/tgetlist.prg index a9d62a4943..8c3e4992d6 100644 --- a/harbour/source/rtl/tgetlist.prg +++ b/harbour/source/rtl/tgetlist.prg @@ -25,19 +25,10 @@ */ #include "classes.ch" +#include "getexit.ch" #include "inkey.ch" #include "set.ch" -#define GE_NOEXIT 0 -#define GE_UP 1 -#define GE_DOWN 2 -#define GE_TOP 3 -#define GE_BOTTOM 4 -#define GE_ENTER 5 -#define GE_WRITE 6 -#define GE_ESCAPE 7 -#define GE_WHEN 8 - #define SCORE_ROW 0 #define SCORE_COL 60 diff --git a/harbour/source/rtl/xsavescr.prg b/harbour/source/rtl/xsavescr.prg index 80e166d33e..20457461c6 100644 --- a/harbour/source/rtl/xsavescr.prg +++ b/harbour/source/rtl/xsavescr.prg @@ -1,15 +1,21 @@ -/* $Id$ - * +/* + * $Id$ */ -STATIC cScrn +STATIC s_cScrn -Procedure __XSAVESCREEN() -cScrn := {Row(), Col(), SaveScreen()} +PROCEDURE __XSAVESCREEN() -procedure __XRESTSCREEN() -IF cScrn <> NIL - RestScreen( ,,,,cScrn[3] ) - SetPos( cScrn[1], cScrn[2] ) -ENDIF -cScrn := NIL + s_cScrn := { Row(), Col(), SaveScreen() } + + RETURN + +PROCEDURE __XRESTSCREEN() + + IF s_cScrn != NIL + RestScreen( , , , , s_cScrn[ 3 ] ) + SetPos( s_cScrn[ 1 ], s_cScrn[ 2 ] ) + s_cScrn := NIL + ENDIF + + RETURN diff --git a/harbour/source/tools/dates2.c b/harbour/source/tools/dates2.c index 5ffb42876e..1509b8b50f 100644 --- a/harbour/source/tools/dates2.c +++ b/harbour/source/tools/dates2.c @@ -1,6 +1,8 @@ /* * $Id$ - * + */ + +/* Harbour Project source code Copyright(C) 1999 by Jose Lalin. diff --git a/harbour/source/tools/fileread.prg b/harbour/source/tools/fileread.prg index 7fa6d34fa5..289be3c48c 100644 --- a/harbour/source/tools/fileread.prg +++ b/harbour/source/tools/fileread.prg @@ -1,5 +1,8 @@ -/* $Id$ +/* + * $Id$ + */ +/* Harbour Project source code A class that reads a file one line at a time diff --git a/harbour/source/tools/hb_f.c b/harbour/source/tools/hb_f.c index 1a0c39c1b2..bfdb1c23ee 100644 --- a/harbour/source/tools/hb_f.c +++ b/harbour/source/tools/hb_f.c @@ -1,6 +1,8 @@ /* * $Id$ + */ +/* Copyright(C) 1999 by Andi Jahja This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/vm/dynsym.c b/harbour/source/vm/dynsym.c index 6232006fec..ef18c76e95 100644 --- a/harbour/source/vm/dynsym.c +++ b/harbour/source/vm/dynsym.c @@ -2,8 +2,8 @@ * $Id$ */ -/* Harbour dynamic symbol table management - * +/* + * Harbour dynamic symbol table management * Copyright(C) 1999 by Antonio Linares. * * This program is free software; you can redistribute it and/or modify diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 14a39ed47f..296fd668b2 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -67,7 +67,7 @@ static void hb_vmReleaseLocalSymbols( void ); /* releases the memory of the static void hb_vmDebuggerShowLine( WORD wLine ); /* makes the debugger shows a specific source code line */ static void hb_vmDebuggerEndProc( void ); /* notifies the debugger for an endproc */ -static void hb_vmArrayNew( HB_ITEM_PTR, WORD ); /* creates array */ +static void hb_vmArrayNew( HB_ITEM_PTR, WORD ); /* creates array */ #ifdef HARBOUR_OBJ_GENERATION static void hb_vmProcessObjSymbols ( void ); /* process Harbour generated OBJ symbols */ diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index b5932cc7d3..4c64c005c6 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -52,6 +52,12 @@ #translate TEST_LINE( , ) => TEST_CALL( <(x)>, {|| }, ) +#define TEST_RESULT_COL1_WIDTH 1 +#define TEST_RESULT_COL2_WIDTH 4 +#define TEST_RESULT_COL3_WIDTH 40 +#define TEST_RESULT_COL4_WIDTH 55 +#define TEST_RESULT_COL5_WIDTH 40 + STATIC s_nPass STATIC s_nFail STATIC s_cFileName @@ -1653,6 +1659,7 @@ STATIC FUNCTION Main_MISC() TEST_LINE( aSize( NIL, -1 ) , NIL ) TEST_LINE( aSize( {}, -1 ) , "{.[0].}" ) TEST_LINE( aSize( { 1 }, -1 ) , "{.[0].}" ) + TEST_LINE( aSize( { 1 }, 5000 ) , "{.[1].}" ) TEST_LINE( aSize( ErrorNew(), -1 ) , "ERROR Object" ) TEST_LINE( aSize( ErrorNew(), 100 ) , "ERROR Object" ) TEST_LINE( aAdd( NIL, NIL ) , "E BASE 1123 Argument error AADD F:S" ) @@ -1708,6 +1715,42 @@ STATIC FUNCTION Main_MISC() TEST_LINE( TAStr(aFill(TANew(),"X", 21, 3)) , ".........." ) TEST_LINE( TAStr(aFill(TANew(),"X", 21,20)) , ".........." ) + /* ACOPY() */ + + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1 )) , "ABCDEFGHIJ" ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 0 )) , ".........." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 3 )) , "ABC......." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 20 )) , "ABCDEFGHIJ" ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3 )) , "CDEFGHIJ.." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 0 )) , ".........." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 3 )) , "CDE......." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 20 )) , "CDEFGHIJ.." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21 )) , ".........." ) /* Bug in CA-Cl*pper, it returns: "J........." */ + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 0 )) , ".........." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3 )) , ".........." ) /* Bug in CA-Cl*pper, it returns: "J........." */ + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 20 )) , ".........." ) /* Bug in CA-Cl*pper, it returns: "J........." */ + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1,NIL, 1)) , "ABCDEFGHIJ" ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 0, 1)) , ".........." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 3, 0)) , "ABC......." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 3, 2)) , ".ABC......" ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 3, 8)) , ".......ABC" ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 3, 20)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".........A" */ + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 20, 1)) , "ABCDEFGHIJ" ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3,NIL, 3)) , "..CDEFGHIJ" ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 0, 3)) , ".........." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 3, 0)) , "CDE......." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 3, 2)) , ".CDE......" ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 3, 8)) , ".......CDE" ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 3, 20)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".........C" */ + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 20, 3)) , "..CDEFGHIJ" ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21,NIL, 21)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".........J" */ + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 0, 21)) , ".........." ) + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 0)) , ".........." ) /* Bug in CA-Cl*pper, it returns: "J........." */ + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 2)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".J........" */ + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 8)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".......J.." */ + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 20)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".........J" */ + TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 20, 21)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".........J" */ + /* ASCAN() */ TEST_LINE( aScan() , 0 ) @@ -1756,12 +1799,6 @@ STATIC FUNCTION Main_MISC() RETURN NIL -#define TEST_RESULT_COL1_WIDTH 1 -#define TEST_RESULT_COL2_WIDTH 4 -#define TEST_RESULT_COL3_WIDTH 30 -#define TEST_RESULT_COL4_WIDTH 55 -#define TEST_RESULT_COL5_WIDTH 40 - STATIC FUNCTION TEST_BEGIN( cParam ) LOCAL cOs @@ -2070,7 +2107,7 @@ STATIC FUNCTION ListToNArray( cString ) RETURN aArray -STATIC FUNCTION TANew( nLen, cChar ) +STATIC FUNCTION TANew( cChar, nLen ) LOCAL aArray LOCAL tmp @@ -2087,7 +2124,23 @@ STATIC FUNCTION TANew( nLen, cChar ) /* Intentionally not using aFill() here, since this function is involved in testing aFill() itself. */ FOR tmp := 1 TO nLen - aArray[ tmp ] := "." + aArray[ tmp ] := cChar + NEXT + + RETURN aArray + +STATIC FUNCTION TARng( nLen ) + LOCAL aArray + LOCAL tmp + + IF nLen == NIL + nLen := 10 + ENDIF + + aArray := Array( nLen ) + + FOR tmp := 1 TO nLen + aArray[ tmp ] := Chr( Asc( "A" ) + tmp - 1 ) NEXT RETURN aArray