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

2008-04-18 00:01 UTC+0100 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* 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.
This commit is contained in:
Viktor Szakats
2008-04-17 22:03:40 +00:00
parent 531f06a928
commit 4d2778e296
4 changed files with 235 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
harbour/ChangeLog
View File

@@ -8,6 +8,21 @@
2008-12-31 13:59 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
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.

81
harbour/bin/bld_os2.cmd Normal file
View File

@@ -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

6
harbour/tests/rto_get.prg
View File

@@ -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() )

145
harbour/tests/rto_tb.prg
View File

@@ -50,6 +50,17 @@
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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