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

2012-11-30 15:09 UTC+0100 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/hbplist
  + contrib/hbtest
  + contrib/hbtest/core.prg
  + contrib/hbtest/corec.c
  + contrib/hbtest/hbtest.ch
  + contrib/hbtest/hbtest.hbc
  + contrib/hbtest/hbtest.hbp
  + contrib/hbtest/hbtest.hbx
  + contrib/hbtest/tests
  + contrib/hbtest/tests/hbmk.hbm
  + contrib/hbtest/tests/test.prg
    + added hbtest functionality as contrib

  - src/rtl/hbtestc.c
  * include/harbour.hbx
  * src/rtl/Makefile
    % deleted function not use in core
This commit is contained in:
Viktor Szakats
2012-11-30 14:11:29 +00:00
parent c415852281
commit 5bfad24ff1
12 changed files with 372 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
harbour/ChangeLog.txt
View File

@@ -10,6 +10,25 @@
* Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment
*/
2012-11-30 15:09 UTC+0100 Viktor Szakats (harbour syenar.net)
* contrib/hbplist
+ contrib/hbtest
+ contrib/hbtest/core.prg
+ contrib/hbtest/corec.c
+ contrib/hbtest/hbtest.ch
+ contrib/hbtest/hbtest.hbc
+ contrib/hbtest/hbtest.hbp
+ contrib/hbtest/hbtest.hbx
+ contrib/hbtest/tests
+ contrib/hbtest/tests/hbmk.hbm
+ contrib/hbtest/tests/test.prg
+ added hbtest functionality as contrib
- src/rtl/hbtestc.c
* include/harbour.hbx
* src/rtl/Makefile
% deleted function not use in core
2012-11-30 03:52 UTC+0100 Viktor Szakats (harbour syenar.net)
* src/rtl/hbtest.prg
! made another accidentally public function STATIC

1
harbour/contrib/hbplist
View File

@@ -46,6 +46,7 @@ hbssl/hbssl.hbp
hbtip/hbtip.hbp
hbtinymt/hbtinymt.hbp
hbtpathy/hbtpathy.hbp
hbtest/hbtest.hbp
hbunix/hbunix.hbp
hbwin/hbwin.hbp
hbxdiff/hbxdiff.hbp # uses: libxdiff (locally hosted)

215
harbour/contrib/hbtest/core.prg Normal file
View File

@@ -0,0 +1,215 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Regression tests for the runtime library (main)
*
* Copyright 1999-2012 Viktor Szakats (harbour syenar.net)
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "error.ch"
#define TEST_RESULT_COL1_WIDTH 1
#define TEST_RESULT_COL2_WIDTH 15
#define TEST_RESULT_COL3_WIDTH 40
#define TEST_RESULT_COL4_WIDTH 85
#define TEST_RESULT_COL5_WIDTH 85
THREAD STATIC t_hParams := { => }
PROCEDURE hbtest_Setup( cName, xValue )
IF HB_ISSTRING( cName ) .AND. ! Empty( cName )
IF PCount() > 1
t_hParams[ cName ] := xValue
ELSEIF cName $ t_hParams
hb_HDel( t_hParams, cName )
ENDIF
ENDIF
RETURN
PROCEDURE hbtest_Call( cBlock, bBlock, xResultExpected )
LOCAL xResult
LOCAL oError
LOCAL lPPError
LOCAL lFailed
LOCAL bOut
IF HB_ISSTRING( cBlock )
lPPError := .F.
ELSE
cBlock := "[Preprocessor error]"
lPPError := .T.
ENDIF
BEGIN SEQUENCE WITH ErrorBlock( {| oError | Break( oError ) } )
xResult := Eval( bBlock )
RECOVER USING oError
xResult := ErrorMessage( oError )
END SEQUENCE
IF !( ValType( xResult ) == ValType( xResultExpected ) )
IF HB_ISSTRING( xResultExpected ) .AND. ValType( xResult ) $ "ABOHPS"
lFailed := !( XToStr( xResult, .F. ) == xResultExpected )
ELSE
lFailed := .T.
ENDIF
ELSE
lFailed := !( xResult == xResultExpected )
ENDIF
IF lFailed .OR. lPPError .OR. hb_HGetDef( t_hParams, "showall", .T. )
bOut := hb_HGetDef( t_hParams, "output", {| cMsg | OutStd( cMsg ) } )
IF lFailed
Eval( bOut, PadR( iif( lFailed, "!", " " ), TEST_RESULT_COL1_WIDTH ) + " " +;
PadR( ProcName( 1 ) + "(" + hb_ntos( ProcLine( 1 ) ) + ")", TEST_RESULT_COL2_WIDTH ) + " " +;
PadR( cBlock, TEST_RESULT_COL3_WIDTH ) +;
hb_eol() +;
Space( 5 ) + " Result: " + XToStr( xResult, .F. ) +;
hb_eol() +;
Space( 5 ) + "Expected: " + XToStr( xResultExpected, .F. ) +;
hb_eol() )
ELSE
Eval( bOut, PadR( iif( lFailed, "!", " " ), TEST_RESULT_COL1_WIDTH ) + " " +;
PadR( ProcName( 1 ) + "(" + hb_ntos( ProcLine( 1 ) ) + ")", TEST_RESULT_COL2_WIDTH ) + " " +;
PadR( cBlock, TEST_RESULT_COL3_WIDTH ) + " -> " +;
PadR( XToStr( xResult, .F. ), TEST_RESULT_COL4_WIDTH ) + " | " +;
PadR( XToStr( xResultExpected, .F. ), TEST_RESULT_COL5_WIDTH ) +;
hb_eol() )
ENDIF
ENDIF
RETURN
STATIC FUNCTION ErrorMessage( oError )
LOCAL cMessage := ""
LOCAL tmp
IF HB_ISNUMERIC( oError:severity )
SWITCH oError:severity
CASE ES_WHOCARES ; cMessage += "M " ; EXIT
CASE ES_WARNING ; cMessage += "W " ; EXIT
CASE ES_ERROR ; cMessage += "E " ; EXIT
CASE ES_CATASTROPHIC ; cMessage += "C " ; EXIT
ENDSWITCH
ENDIF
IF HB_ISNUMERIC( oError:genCode )
cMessage += hb_ntos( oError:genCode ) + " "
ENDIF
IF HB_ISSTRING( oError:subsystem )
cMessage += oError:subsystem + " "
ENDIF
IF HB_ISNUMERIC( oError:subCode )
cMessage += hb_ntos( oError:subCode ) + " "
ENDIF
IF HB_ISSTRING( oError:description )
cMessage += oError:description + " "
ENDIF
IF ! Empty( oError:operation )
cMessage += "(" + oError:operation + ") "
ENDIF
IF ! Empty( oError:filename )
cMessage += "<" + oError:filename + "> "
ENDIF
IF HB_ISNUMERIC( oError:osCode )
cMessage += "OS:" + hb_ntos( oError:osCode ) + " "
ENDIF
IF HB_ISNUMERIC( oError:tries )
cMessage += "#:" + hb_ntos( oError:tries ) + " "
ENDIF
IF HB_ISARRAY( oError:Args )
cMessage += "A:" + hb_ntos( Len( oError:Args ) ) + ":"
FOR tmp := 1 TO Len( oError:Args )
cMessage += ValType( oError:Args[ tmp ] ) + ":" + XToStr( oError:Args[ tmp ], .T. )
IF tmp < Len( oError:Args )
cMessage += ";"
ENDIF
NEXT
cMessage += " "
ENDIF
IF oError:canDefault .OR. ;
oError:canRetry .OR. ;
oError:canSubstitute
cMessage += "F:"
IF oError:canDefault
cMessage += "D"
ENDIF
IF oError:canRetry
cMessage += "R"
ENDIF
IF oError:canSubstitute
cMessage += "S"
ENDIF
ENDIF
RETURN cMessage
STATIC FUNCTION XToStr( xValue, lInString )
SWITCH ValType( xValue )
CASE "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 iif( lInString, xValue, '"' + xValue + '"' )
CASE "N" ; RETURN hb_ntos( xValue )
CASE "D" ; RETURN iif( lInString, "0d" + iif( Empty( xValue ), "00000000", DToS( xValue ) ), 'hb_SToD("' + DToS( xValue ) + '")' )
CASE "U" ; RETURN "NIL"
CASE "M" ; RETURN "M:" + iif( lInString, xValue, '"' + xValue + '"' )
ENDSWITCH
RETURN hb_CStr( xValue )

0
harbour/src/rtl/hbtestc.c → harbour/contrib/hbtest/corec.c
View File

60
harbour/contrib/hbtest/hbtest.ch Normal file
View File

@@ -0,0 +1,60 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Regression tests for the runtime library (header)
*
* Copyright 1999-2001 Viktor Szakats (harbour syenar.net)
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#ifndef HB_TEST_CH_
#define HB_TEST_CH_
#translate HBTEST <x> IS <result> => hbtest_Call( #<x>, {|| <x> }, <result> )
#pragma linenumber=on
#endif /* HB_TEST_CH_ */

11
harbour/contrib/hbtest/hbtest.hbc Normal file
View File

@@ -0,0 +1,11 @@
#
# $Id$
#
description=Regression test framework
incpaths=.
headers=hbtest.ch
libs=${_HB_DYNPREF}${hb_name}${_HB_DYNSUFF}

15
harbour/contrib/hbtest/hbtest.hbp Normal file
View File

@@ -0,0 +1,15 @@
#
# $Id$
#
-hblib
-inc
-o${hb_name}
-w3 -es2
${hb_name}.hbx
core.prg
corec.c

32
harbour/contrib/hbtest/hbtest.hbx Normal file
View File

@@ -0,0 +1,32 @@
/* --------------------------------------------------------------------
* NOTE: You can add manual override which functions to include or
* exclude from automatically generated EXTERNAL/DYNAMIC list.
* Syntax: // HB_FUNC_INCLUDE <func>
* // HB_FUNC_EXCLUDE <func>
*/
/* --------------------------------------------------------------------
* WARNING: Automatically generated code below. DO NOT EDIT!
* Regenerate using hbmk2 '-hbx=' option.
*/
#ifndef __HBEXTERN_CH__HBTEST__
#define __HBEXTERN_CH__HBTEST__
#if defined( __HBEXTREQ__ ) .OR. defined( __HBEXTERN__HBTEST__ANNOUNCE )
ANNOUNCE __HBEXTERN__HBTEST__
#endif
#if defined( __HBEXTREQ__ ) .OR. defined( __HBEXTERN__HBTEST__REQUEST )
#command DYNAMIC <fncs,...> => EXTERNAL <fncs>
#endif
DYNAMIC hbtest_Call
DYNAMIC hbtest_Setup
DYNAMIC __hbtest_NumGetDec
#if defined( __HBEXTREQ__ ) .OR. defined( __HBEXTERN__HBTEST__REQUEST )
#uncommand DYNAMIC <fncs,...> => EXTERNAL <fncs>
#endif
#endif

7
harbour/contrib/hbtest/tests/hbmk.hbm Normal file
View File

@@ -0,0 +1,7 @@
#
# $Id$
#
hbtest.hbc
-w3 -es2

12
harbour/contrib/hbtest/tests/test.prg Normal file
View File

@@ -0,0 +1,12 @@
/*
* $Id$
*/
#require "hbtest"
PROCEDURE Main()
HBTEST 2 + 2 IS 4
HBTEST 2 + 2 IS 5
RETURN

1
harbour/include/harbour.hbx
View File

@@ -1388,7 +1388,6 @@ DYNAMIC __hbdoc_LoadHBD
DYNAMIC __hbdoc_SaveHBD
DYNAMIC __hbdoc_ToSource
DYNAMIC __hbtest_Call
DYNAMIC __hbtest_NumGetDec
DYNAMIC __hbtest_Setup
DYNAMIC __HBHash
DYNAMIC __HBLogical

1
harbour/src/rtl/Makefile
View File

@@ -115,7 +115,6 @@ C_SOURCES := \
hbsockhb.c \
hbstrfmt.c \
hbstrsh.c \
hbtestc.c \
hbtoken.c \
hbzlib.c \
hbzlibgz.c \