diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 95122ee6fd..b7c5488fd2 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,21 @@ 2008-12-31 13:59 UTC+0100 Foo Bar */ +2008-04-18 00:01 UTC+0100 Viktor Szakats (harbour.01 syenar hu) + * tests/rto_tb.prg + + Added some C5.3 var tests. + + Added object as array info. + * Suppressed _eInstVar() difference by including + a strictly compatible copy of it for Harbour. + * Exclude incompatible binary array elements of the object. + + * tests/rto_get.prg + * Exclude incompatible binary array elements of the object. + + + bin/bld_os2.cmd + + Added OS/2 build command file. + ; Someone pls test and update the content if needed. + 2008-04-17 13:46 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * source/rtl/tget.prg * Formatting. diff --git a/harbour/bin/bld_os2.cmd b/harbour/bin/bld_os2.cmd new file mode 100644 index 0000000000..b3e600bb03 --- /dev/null +++ b/harbour/bin/bld_os2.cmd @@ -0,0 +1,81 @@ +@echo off +rem +rem $Id$ +rem + +rem --------------------------------------------------------------- +rem Template to build a final Harbour executable, using Harbour +rem with the C code generation feature, then calling the proper C +rem linker/compiler. +rem +rem Copyright 1999-2001 Viktor Szakats (viktor.szakats@syenar.hu) +rem See doc/license.txt for licensing terms. +rem --------------------------------------------------------------- + +if "%HB_COMPILER%" == "" set HB_COMPILER=gcc + +if "%HB_BIN_INSTALL%" == "" set HB_BIN_INSTALL=..\bin\ +if "%HB_LIB_INSTALL%" == "" set HB_LIB_INSTALL=..\lib\ +if "%HB_INC_INSTALL%" == "" set HB_INC_INSTALL=..\include\ + +:START + + if "%HB_COMPILER%" == "" goto NO_COMP + + if not "%1" == "" goto COMPILE + +:HELP + + echo. + echo Usage: bld filename + echo. + echo Notes: + echo. + echo - 'filename' is the .prg filename _without_ extension. + echo - Don't forget to make a MAIN() function for you application. + echo - This batch file assumes you are in some directory off the main + echo harbour directory. + echo - Environment variables HB_COMPILER, HB_GT_LIB should be set. + echo Setting HB_GT_LIB is optional. + echo The following values are currently supported: + echo. + echo HB_COMPILER: + echo - gcc (EMX GNU C, OS/2 32-bit) + echo - icc (IBM Visual Age C++ 3.0, OS/2 32-bit) + echo. + echo HB_GT_LIB: + echo - gtstd (Standard streaming) (for all architectures) + echo - gtos2 (OS/2 console) (for os2 architecture) + echo - gtpca (PC ANSI console) (for all architectures) + echo - gtcrs (Curses console) (for linux, w32 architectures) + echo - gtsln (Slang console) (for linux, w32 architectures) + goto END + +:NO_COMP + + echo Error: HB_COMPILER is not set. + goto HELP + +:BAD_COMP + + echo Error: HB_COMPILER value is unsupported. + goto HELP + +:COMPILE + + %HB_BIN_INSTALL%\harbour %1.prg -n -i%HB_INC_INSTALL% %2 %3 %HARBOURFLAGS% + +:A_DOS + + set _HB_GT_LIB=%HB_GT_LIB% + if "%_HB_GT_LIB%" == "" set _HB_GT_LIB=gtos2 + + if "%HB_COMPILER%" == "gcc" gcc %1.c %CFLAGS% -I%HB_INC_INSTALL% -L%HB_LIB_INSTALL% -ldebug -lvm -lrtl -l%_HB_GT_LIB% -llang -lrdd -lrtl -lvm -lmacro -lpp -ldbfntx -ldbfcdx -ldbffpt -lhbsix -lhsx -lcommon -lrtl -lvm + if "%HB_COMPILER%" == "icc" icc /Gs+ /W2 /Se /Sd+ /Ti+ /C- /Tp %CFLAGS% -I%HB_INC_INSTALL% %1.c %HB_LIB_INSTALL%\debug.lib %HB_LIB_INSTALL%\vm.lib %HB_LIB_INSTALL%\rtl.lib %HB_LIB_INSTALL%\%_HB_GT_LIB%.lib %HB_LIB_INSTALL%\lang.lib %HB_LIB_INSTALL%\rdd.lib %HB_LIB_INSTALL%\rtl.lib %HB_LIB_INSTALL%\vm.lib %HB_LIB_INSTALL%\macro.lib %HB_LIB_INSTALL%\pp.lib %HB_LIB_INSTALL%\dbfntx.lib %HB_LIB_INSTALL%\dbfcdx.lib %HB_LIB_INSTALL%\common.lib + goto END + +:CLEANUP + + del %1.c + +:END diff --git a/harbour/tests/rto_get.prg b/harbour/tests/rto_get.prg index 40a3f53cbd..29db1899b9 100644 --- a/harbour/tests/rto_get.prg +++ b/harbour/tests/rto_get.prg @@ -942,7 +942,11 @@ PROCEDURE LogGETVars( o, desc, xResult ) #else FOR tmp := 1 TO Len( o ) #endif - FWrite( s_fhnd, " [ " + Str( tmp, 3 ) + " ] " + XToStrX( o[ tmp ] ) + hb_OSNewLine() ) + /* Both indexes contain binary trash + (except the first char of [11] which is type. [vszakats] */ + IF tmp != 8 .AND. tmp != 11 + FWrite( s_fhnd, " [ " + Str( tmp, 3 ) + " ] " + XToStrX( o[ tmp ] ) + hb_OSNewLine() ) + ENDIF NEXT ENDIF FWrite( s_fhnd, "---------------------" + hb_OSNewLine() ) diff --git a/harbour/tests/rto_tb.prg b/harbour/tests/rto_tb.prg index e2d7511336..2614b8e81c 100644 --- a/harbour/tests/rto_tb.prg +++ b/harbour/tests/rto_tb.prg @@ -50,6 +50,17 @@ * */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2007 Przemyslaw Czerpak + * eInstVar() (from RTL) + * + * See doc/license.txt for licensing terms. + * + */ + /* NOTE: This source can be compiled with both Harbour and CA-Cl*pper. */ #include "common.ch" @@ -69,7 +80,7 @@ STATIC s_fhnd STATIC s_lCallBackStack STATIC s_lRTEDetails STATIC s_lIgnoreErrOp -STATIC s_lC5xDump +STATIC s_lObjectDump STATIC s_lCatchErr STATIC s_lCheckResult @@ -93,7 +104,7 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) s_lCallBackStack := "CALLBACKSTACK" $ Upper( cCommandLine ) s_lRTEDetails := "RTEDETAILS" $ Upper( cCommandLine ) s_lIgnoreErrOp := "IGNERROP" $ Upper( cCommandLine ) - s_lC5xDump := "C5XDUMP" $ Upper( cCommandLine ) + s_lObjectDump := "ODUMP" $ Upper( cCommandLine ) s_lCatchErr := .T. s_lCheckResult := .F. @@ -288,6 +299,10 @@ PROCEDURE TBRAssign( xVar ) o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:RowPos := xVar ) o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:SkipBlock := xVar ) o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:Stable := xVar ) +#ifdef HB_COMPAT_C53 + o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:border := xVar ) + o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:message := xVar ) +#endif RETURN @@ -309,6 +324,10 @@ PROCEDURE TBCAssign( xVar ) o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:HeadSep := xVar ) o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:Picture := xVar ) o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:Width := xVar ) +#ifdef HB_COMPAT_C53 + o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:preBlock := xVar ) + o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:postBlock := xVar ) +#endif RETURN @@ -444,11 +463,26 @@ PROCEDURE LogTBRVars( o, desc, xResult ) FWrite( s_fhnd, " RowPos " + XToStr( o:RowPos ) + hb_OSNewLine() ) FWrite( s_fhnd, " SkipBlock " + XToStr( o:SkipBlock ) + hb_OSNewLine() ) FWrite( s_fhnd, " Stable " + XToStr( o:Stable ) + hb_OSNewLine() ) -#ifndef __HARBOUR__ - IF s_lC5xDump - FWrite( s_fhnd, " _dump_ " + ObjToList( o ) + hb_OSNewLine() ) - ENDIF +#ifdef HB_COMPAT_C53 + FWrite( s_fhnd, " border " + XToStr( o:border ) + hb_OSNewLine() ) + FWrite( s_fhnd, " message " + XToStr( o:message ) + hb_OSNewLine() ) #endif + IF s_lObjectDump +#ifdef __HARBOUR__ +#ifdef HB_COMPAT_C53 + FOR tmp := 1 TO 18 +#else + FOR tmp := 1 TO 13 +#endif +#else + FOR tmp := 1 TO Len( o ) +#endif + /* [8] is binary data, not replicated in Harbour. */ + IF tmp != 8 + FWrite( s_fhnd, " [ " + Str( tmp, 3 ) + " ] " + XToStrX( o[ tmp ] ) + hb_OSNewLine() ) + ENDIF + NEXT + ENDIF FOR tmp := 1 TO o:colCount FWrite( s_fhnd, " Column: " + StrZero( tmp, 3 ) + hb_OSNewLine() ) col := o:GetColumn( tmp ) @@ -464,6 +498,10 @@ PROCEDURE LogTBRVars( o, desc, xResult ) FWrite( s_fhnd, " HeadSep " + XToStr( col:HeadSep ) + hb_OSNewLine() ) FWrite( s_fhnd, " Picture " + XToStr( col:Picture ) + hb_OSNewLine() ) FWrite( s_fhnd, " Width " + XToStr( col:Width ) + hb_OSNewLine() ) +#ifdef HB_COMPAT_C53 + FWrite( s_fhnd, " preBlock " + XToStr( col:preBlock ) + hb_OSNewLine() ) + FWrite( s_fhnd, " postBlock " + XToStr( col:postBlock ) + hb_OSNewLine() ) +#endif ELSE FWrite( s_fhnd, " Col: " + XToStr( col ) + hb_OSNewLine() ) ENDIF @@ -476,6 +514,8 @@ PROCEDURE LogTBCVars( o, desc, xResult ) LOCAL nLevel LOCAL cStack + LOCAL tmp + cStack := "" FOR nLevel := 2 TO 2 IF Empty( ProcName( nLevel ) ) @@ -505,11 +545,23 @@ PROCEDURE LogTBCVars( o, desc, xResult ) FWrite( s_fhnd, " HeadSep " + XToStr( o:HeadSep ) + hb_OSNewLine() ) FWrite( s_fhnd, " Picture " + XToStr( o:Picture ) + hb_OSNewLine() ) FWrite( s_fhnd, " Width " + XToStr( o:Width ) + hb_OSNewLine() ) -#ifndef __HARBOUR__ - IF s_lC5xDump - FWrite( s_fhnd, " _dump_ " + ObjToList( o ) + hb_OSNewLine() ) - ENDIF +#ifdef HB_COMPAT_C53 + FWrite( s_fhnd, " preBlock " + XToStr( o:preBlock ) + hb_OSNewLine() ) + FWrite( s_fhnd, " postBlock " + XToStr( o:postBlock ) + hb_OSNewLine() ) #endif + IF s_lObjectDump +#ifdef __HARBOUR__ +#ifdef HB_COMPAT_C53 + FOR tmp := 1 TO 14 +#else + FOR tmp := 1 TO 11 +#endif +#else + FOR tmp := 1 TO Len( o ) +#endif + FWrite( s_fhnd, " [ " + Str( tmp, 3 ) + " ] " + XToStrX( o[ tmp ] ) + hb_OSNewLine() ) + NEXT + ENDIF ELSE FWrite( s_fhnd, " o " + XToStr( o ) + hb_OSNewLine() ) ENDIF @@ -595,6 +647,47 @@ FUNCTION XToStrE( xValue ) RETURN "" +FUNCTION XToStrX( xValue ) + LOCAL cType := ValType( xValue ) + + LOCAL tmp + LOCAL cRetVal + + DO CASE + CASE cType == "C" + + xValue := StrTran( xValue, Chr(0), '"+Chr(0)+"' ) + xValue := StrTran( xValue, Chr(9), '"+Chr(9)+"' ) + xValue := StrTran( xValue, Chr(10), '"+Chr(10)+"' ) + xValue := StrTran( xValue, Chr(13), '"+Chr(13)+"' ) + xValue := StrTran( xValue, Chr(26), '"+Chr(26)+"' ) + + RETURN xValue + + CASE cType == "N" ; RETURN LTrim( Str( xValue ) ) + CASE cType == "D" ; RETURN DToS( xValue ) + CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." ) + CASE cType == "O" ; RETURN xValue:className() + " Object" + CASE cType == "U" ; RETURN "NIL" + CASE cType == "B" ; RETURN '{||...} -> ' + XToStrX( Eval( xValue ) ) + CASE cType == "A" + + cRetVal := '{ ' + + FOR tmp := 1 TO Len( xValue ) + cRetVal += XToStrX( xValue[ tmp ] ) + IF tmp < Len( xValue ) + cRetVal += ", " + ENDIF + NEXT + + RETURN cRetVal + ' }' + + CASE cType == "M" ; RETURN 'M:' + xValue + ENDCASE + + RETURN "" + FUNCTION ArrayToEList( a ) LOCAL tmp LOCAL cString := "" @@ -634,7 +727,8 @@ STATIC FUNCTION ErrorMessage( oError ) cMessage += oError:description + " " ENDIF IF !Empty( oError:operation ) .AND. !s_lIgnoreErrOp - cMessage += oError:operation + " " + /* NOTE: Clipping this to hide the difference in maximum symbol name length in error messages. [vszakats] */ + cMessage += Left( oError:operation, 9 ) + " " ENDIF IF !Empty( oError:filename ) cMessage += oError:filename + " " @@ -708,3 +802,32 @@ PROCEDURE OBJ_CREATE() // ; Dummy RETURN + +#ifdef __HARBOUR__ + +/* We use this to wash out a small incompatibility in Harbour's built-in _eInstVar(). */ + +FUNCTION _eInstVar( oVar, cMethod, xValue, cType, nSubCode, bValid ) + + LOCAL oError + + IF VALTYPE( xValue ) != cType .OR. ; + ( bValid != NIL .AND. !EVAL( bValid, oVar, xValue ) ) + oError := ErrorNew() + oError:description := HB_LANGERRMSG( 1 ) + oError:gencode := 1 + oError:severity := 2 + oError:cansubstitute := .T. + oError:subsystem := oVar:classname + HB_SYMBOL_UNUSED( cMethod ) + oError:subcode := nSubCode + oError:args := { xValue } + xValue := EVAL( ERRORBLOCK(), oError ) + IF VALTYPE( xValue ) != cType + __errInHandler() + ENDIF + ENDIF + + RETURN xValue + +#endif