fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
aed2388134151a9d7dfd83fa874f13d64ec00c71
harbour-core/harbour/utils/hbtest/hbtest.prg
Viktor Szakats 2b523b361b 2010-06-03 16:33 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) 
* INSTALL
    * Minor typo.

  * package/mpkg_win.nsi
  * package/winuni/mpkg_win_uni.nsi
    + Added user's mailing list link.
    - Deleted user forum link.
    * Updated developers' mailing list link.

  * utils/hbformat/hbformac.c
  * utils/hbformat/hbformat.prg
  * utils/hbmk2/hbmk2.prg
  * utils/hbi18n/hbi18n.prg
  * utils/hbtest/rt_main.h
  * utils/hbtest/hbtest.prg
  * utils/hbtest/rt_main.ch
  * utils/hbtest/rt_trans.prg
  * utils/hbtest/rt_miscc.c
  * utils/hbtest/rt_math.prg
  * utils/hbtest/rt_hvm.prg
  * utils/hbtest/rt_misc.prg
  * utils/hbtest/rt_hvma.prg
  * utils/hbtest/rt_init.ch
  * utils/hbtest/rt_class.prg
  * utils/hbtest/rt_str.prg
  * utils/hbtest/rt_stra.prg
  * utils/hbtest/rt_date.prg
  * utils/hbtest/rt_vars.ch
  * utils/hbtest/rt_array.prg
  * utils/hbtest/rt_file.prg
  * utils/hbtest/rt_mt.prg
  * utils/hbrun/hbrun.prg
    * Deleted 'www.' from harbour-project.org website name.
      (www.harbour-project.org -> harbour-project.org)
2010-06-03 14:34:42 +00:00

659 lines
20 KiB
Plaintext
Raw Blame History

/*
* $Id$
*/
/*
* Harbour Project source code:
* Regression tests for the runtime library (main)
*
* Copyright 1999-2010 Viktor Szakats (harbour.01 syenar.hu)
* 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.
*
*/
/* TRANSFORM() tests mostly written by Eddie Runia <eddie@runia.com> */
/* EMPTY() tests written by Eddie Runia <eddie@runia.com> */
/* :class* tests written by Dave Pearson <davep@hagbard.demon.co.uk> */
/* NOTE: Always compile with /n switch */
/* NOTE: It's worth to make tests with and without the /z switch */
/* NOTE: Guard all Harbour extensions with __HARBOUR__ #ifdefs */
/* NOTE: Use ":className()" instead of ":className" to make your code work
with Xbase++. Xbase++ seem to take differenciate between the
object method and object variable form. In CA-Cl*pper and Harbour
both syntax is accepted. Same goes for ":Eval()" */
/* TODO: Add checks for string parameters with embedded NUL character */
/* TODO: Add test cases for other string functions */
/* TODO: Incorporate tests from test/working/string*.prg */
/* TODO: String overflow on + and - tests */
/* TODO: Tests with MEMO type ? */
/* TODO: Tests with Log(0) type of invalid values */
#include "rt_main.ch"
#include "error.ch"
#include "fileio.ch"
/* Don't change the position of this #include. */
#include "rt_vars.ch"
#ifndef __HARBOUR__
#xtranslate HB_OSNewLine() => ( Chr( 13 ) + Chr( 10 ) )
#endif
STATIC s_nPass
STATIC s_nFail
STATIC s_nFhnd
STATIC s_nCount
STATIC s_lShowAll
STATIC s_lShortcut
STATIC s_aSkipList
STATIC s_nStartTime
STATIC s_nEndTime
#ifdef __HARBOUR__
REQUEST HB_LANG_EN
#endif
PROCEDURE Main( cPar1, cPar2 )
OutStd( "Harbour Regression Test Suite" + HB_OSNewLine() +;
"Copyright (c) 1999-2010, http://harbour-project.org/" + HB_OSNewLine() )
IF cPar1 == NIL
cPar1 := ""
ENDIF
IF cPar2 == NIL
cPar2 := ""
ENDIF
IF "/?" $ Upper( cPar1 ) .OR. ;
"/H" $ Upper( cPar1 ) .OR. ;
"-?" $ Upper( cPar1 ) .OR. ;
"-H" $ Upper( cPar1 )
OutStd( HB_OSNewLine() +;
"Syntax: hbtest [options]" + HB_OSNewLine() +;
HB_OSNewLine() +;
"Options: -h, -? Display this help." + HB_OSNewLine() +;
" -all Display all tests, not only the failures." + HB_OSNewLine() +;
" -skip:<list> Skip the listed test numbers." + HB_OSNewLine() )
RETURN
ENDIF
/* Initialize test */
TEST_BEGIN( cPar1 + " " + cPar2 )
Main_HVM()
Main_HVMA()
Main_MATH()
Main_DATE()
Main_STR()
Main_STRA()
Main_TRANS()
Comp_Str()
Exact_Str()
New_STRINGS()
#ifdef __HARBOUR__
Long_STRINGS()
#endif
#ifdef __XPP__
Long_STRINGS()
#endif
Main_ARRAY()
Main_FILE()
Main_MISC()
#ifdef __HARBOUR__
Main_OPOVERL()
Main_CLASS()
Main_MT()
#endif
Main_LAST()
/* Show results, return ERRORLEVEL and exit */
TEST_END()
RETURN
/* NOTE: These should always be called last, since they can mess up the test
environment.
Right now the failing __MRestore() will clear all memory variables,
which is absolutely normal otherwise. */
STATIC PROCEDURE Main_LAST()
TEST_LINE( MEMVARBLOCK( "mcString" ) , "{||...}" )
#ifndef __XPP__
TEST_LINE( __MRestore() , "E 1 BASE 2007 Argument error (__MRESTORE) OS:0 #:0 " )
#endif
TEST_LINE( MEMVARBLOCK( "mcString" ) , "{||...}" )
#ifndef __XPP__
TEST_LINE( __MSave() , "E 1 BASE 2008 Argument error (__MSAVE) OS:0 #:0 " )
TEST_LINE( __MRestore( "$NOTHERE.MEM", .F. ) , "E 21 BASE 2005 Open error <$NOTHERE.MEM> OS:2 #:1 F:DR" )
#endif
TEST_LINE( MEMVARBLOCK( "mcString" ) , NIL )
#ifndef __XPP__
TEST_LINE( __MSave( BADFNAME(), "*", .T. ) , "E 20 BASE 2006 Create error <" + BADFNAME() + "> OS:2 #:1 F:DR" )
#endif
RETURN
STATIC PROCEDURE TEST_BEGIN( cParam )
s_nStartTime := Seconds()
s_lShowAll := "/ALL" $ Upper( cParam ) .OR. ;
"-ALL" $ Upper( cParam )
s_aSkipList := ListToNArray( CMDLGetValue( Upper( cParam ), "/SKIP:", "" ) )
IF Empty( s_aSkipList )
s_aSkipList := ListToNArray( CMDLGetValue( Upper( cParam ), "-SKIP:", "" ) )
ENDIF
/* Detect presence of shortcutting optimization */
s_lShortcut := .T.
IF .T. .OR. Eval( {|| s_lShortcut := .F. } )
/* Do nothing */
ENDIF
s_nFhnd := 1 /* FHND_STDOUT */
s_nCount := 0
s_nPass := 0
s_nFail := 0
/* Set up the initial state */
#ifdef __HARBOUR__
hb_langSelect( "EN" )
#endif
SET DATE ANSI
SET CENTURY ON
SET EXACT OFF
FErase( "NOT_HERE.$$$" )
/* Feedback */
OutMsg( s_nFhnd, "---------------------------------------------------------------------------" + HB_OSNewLine() +;
" Version: " + Version() + HB_OSNewLine() )
#ifdef __HARBOUR__
OutMsg( s_nFhnd, " Compiler: " + HB_Compiler() + HB_OSNewLine() )
#endif
OutMsg( s_nFhnd, " OS: " + OS() + HB_OSNewLine() +;
" Date, Time: " + DToC( Date() ) + " " + Time() + HB_OSNewLine() +;
"Shortcut opt.: " + iif( s_lShortcut, "ON", "OFF" ) + HB_OSNewLine() +;
" Switches: " + cParam + HB_OSNewLine() +;
"===========================================================================" + HB_OSNewLine() )
OutMsg( s_nFhnd, PadR( "R", TEST_RESULT_COL1_WIDTH ) + " " +;
PadR( "No. Line", TEST_RESULT_COL2_WIDTH ) + " " +;
PadR( "TestCall()", TEST_RESULT_COL3_WIDTH ) + " -> " +;
PadR( "Result", TEST_RESULT_COL4_WIDTH ) + " | " +;
PadR( "Expected", TEST_RESULT_COL5_WIDTH ) + HB_OSNewLine() +;
"---------------------------------------------------------------------------" + HB_OSNewLine() )
/* NOTE: mxNotHere intentionally not declared */
PUBLIC mcLongerNameThen10Chars := "Long String Name!"
PUBLIC mcString := scString
PUBLIC mcStringE := scStringE
PUBLIC mcStringZ := scStringZ
PUBLIC mcStringW := scStringW
PUBLIC mnIntZ := snIntZ
PUBLIC mnDoubleZ := snDoubleZ
PUBLIC mnIntP := snIntP
PUBLIC mnLongP := snLongP
PUBLIC mnDoubleP := snDoubleP
PUBLIC mnIntN := snIntN
PUBLIC mnLongN := snLongN
PUBLIC mnDoubleN := snDoubleN
PUBLIC mnDoubleI := snDoubleI
PUBLIC mdDate := sdDate
PUBLIC mdDateE := sdDateE
PUBLIC mlFalse := slFalse
PUBLIC mlTrue := slTrue
PUBLIC moObject := ErrorNew()
PUBLIC muNIL := suNIL
PUBLIC mbBlock := sbBlock
PUBLIC mbBlockC := sbBlockC
PUBLIC maArray := { 9898 }
#ifndef __XPP__
//rddSetDefault( "DBFCDX" )
#endif
dbCreate( "_hbtmp_.dbf",;
{ { "TYPE_C" , "C", 15, 0 } ,;
{ "TYPE_C_E" , "C", 15, 0 } ,;
{ "TYPE_D" , "D", 8, 0 } ,;
{ "TYPE_D_E" , "D", 8, 0 } ,;
{ "TYPE_M" , "M", 10, 0 } ,;
{ "TYPE_M_E" , "M", 10, 0 } ,;
{ "TYPE_N_I" , "N", 11, 0 } ,;
{ "TYPE_N_IE", "N", 11, 0 } ,;
{ "TYPE_N_D" , "N", 11, 3 } ,;
{ "TYPE_N_DE", "N", 11, 3 } ,;
{ "TYPE_L" , "L", 1, 0 } ,;
{ "TYPE_L_E" , "L", 1, 0 } } )
USE ( "_hbtmp_.dbf" ) NEW ALIAS w_TEST EXCLUSIVE
dbAppend()
w_TEST->TYPE_C := "<FieldValue>"
w_TEST->TYPE_C_E := ""
w_TEST->TYPE_D := sdDate
w_TEST->TYPE_D_E := sdDateE
w_TEST->TYPE_M := "<MemoValue>"
w_TEST->TYPE_M_E := ""
w_TEST->TYPE_N_I := 100
w_TEST->TYPE_N_IE := 0
w_TEST->TYPE_N_D := 101.127
w_TEST->TYPE_N_DE := 0
w_TEST->TYPE_L := .T.
w_TEST->TYPE_L_E := .F.
RETURN
PROCEDURE TEST_CALL( cBlock, bBlock, xResultExpected )
LOCAL xResult
LOCAL oError
LOCAL bOldError
LOCAL lPPError
LOCAL lFailed
LOCAL lSkipped
s_nCount++
IF ValType( cBlock ) == "C"
lPPError := .F.
ELSE
cBlock := "!! Preprocessor error !!"
lPPError := .T.
ENDIF
lSkipped := AScan( s_aSkipList, s_nCount ) > 0
IF lSkipped
lFailed := .F.
xResult := "!! Skipped !!"
ELSE
bOldError := ErrorBlock( {|oError| Break( oError ) } )
BEGIN SEQUENCE
xResult := Eval( bBlock )
RECOVER USING oError
xResult := ErrorMessage( oError )
END SEQUENCE
ErrorBlock( bOldError )
IF !( ValType( xResult ) == ValType( xResultExpected ) )
IF ValType( xResultExpected ) == "C" .AND. ValType( xResult ) $ "ABMO"
lFailed := !( XToStr( xResult ) == xResultExpected )
ELSE
lFailed := .T.
ENDIF
ELSE
lFailed := !( xResult == xResultExpected )
ENDIF
ENDIF
IF s_lShowAll .OR. lFailed .OR. lSkipped .OR. lPPError
IF lFailed
OutMsg( s_nFhnd, PadR( iif( lFailed, "!", iif( lSkipped, "S", " " ) ), TEST_RESULT_COL1_WIDTH ) + " " +;
PadR( Str( s_nCount, 4 ) + " " + ProcName( 1 ) + "(" + LTrim( Str( ProcLine( 1 ), 5 ) ) + ")", TEST_RESULT_COL2_WIDTH ) + " " +;
PadR( cBlock, TEST_RESULT_COL3_WIDTH ) +;
HB_OSNewLine() +;
Space( 5 ) + " Result: " + XToStr( xResult ) +;
HB_OSNewLine() +;
Space( 5 ) + "Expected: " + XToStr( xResultExpected ) +;
HB_OSNewLine() )
ELSE
OutMsg( s_nFhnd, PadR( iif( lFailed, "!", iif( lSkipped, "S", " " ) ), TEST_RESULT_COL1_WIDTH ) + " " +;
PadR( Str( s_nCount, 4 ) + " " + ProcName( 1 ) + "(" + LTrim( Str( ProcLine( 1 ), 5 ) ) + ")", TEST_RESULT_COL2_WIDTH ) + " " +;
PadR( cBlock, TEST_RESULT_COL3_WIDTH ) + " -> " +;
PadR( XToStr( xResult ), TEST_RESULT_COL4_WIDTH ) + " | " +;
PadR( XToStr( xResultExpected ), TEST_RESULT_COL5_WIDTH ) +;
HB_OSNewLine() )
ENDIF
ENDIF
IF lFailed
s_nFail++
ELSE
s_nPass++
ENDIF
RETURN
FUNCTION TEST_OPT_Z()
RETURN s_lShortCut
STATIC PROCEDURE TEST_END()
dbSelectArea( "w_TEST" )
dbCloseArea()
FErase( "_hbtmp_.dbf" )
FErase( "_hbtmp_.dbt" )
s_nEndTime := Seconds()
OutMsg( s_nFhnd, "===========================================================================" + HB_OSNewLine() +;
"Test calls passed: " + Str( s_nPass ) + " ( " + LTrim( Str( ( 1 - ( s_nFail / s_nPass ) ) * 100, 6, 2 ) ) + " % )" + HB_OSNewLine() +;
"Test calls failed: " + Str( s_nFail ) + " ( " + LTrim( Str( ( s_nFail / s_nPass ) * 100, 6, 2 ) ) + " % )" + HB_OSNewLine() +;
" ----------" + HB_OSNewLine() +;
" Total: " + Str( s_nPass + s_nFail ) +;
" ( Time elapsed: " + LTrim( Str( s_nEndTime - s_nStartTime ) ) + " seconds )" + HB_OSNewLine() +;
HB_OSNewLine() )
IF s_nFail != 0
IF "CLIPPER (R)" $ Upper( Version() )
OutMsg( s_nFhnd, "WARNING ! Failures detected using CA-Cl*pper." + HB_OSNewLine() +;
"Please fix those expected results which are not bugs in CA-Cl*pper itself." + HB_OSNewLine() )
ELSE
OutMsg( s_nFhnd, "WARNING ! Failures detected" + HB_OSNewLine() )
ENDIF
ENDIF
#ifdef __XPP__
FClose( s_nFhnd )
#endif
ErrorLevel( iif( s_nFail != 0, 1, 0 ) )
RETURN
FUNCTION XToStr( xValue )
LOCAL cType := ValType( xValue )
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 'HB_SToD("' + 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 '{||...}'
CASE cType == "A" ; RETURN '{.[' + LTrim( Str( Len( xValue ) ) ) + '].}'
CASE cType == "M" ; RETURN 'M:"' + xValue + '"'
ENDCASE
RETURN ""
FUNCTION XToStrE( xValue )
LOCAL cType := ValType( xValue )
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 '{||...}'
CASE cType == "A" ; RETURN '{.[' + LTrim( Str( Len( xValue ) ) ) + '].}'
CASE cType == "M" ; RETURN 'M:' + xValue
ENDCASE
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 ""
STATIC FUNCTION ErrorMessage( oError )
LOCAL cMessage := ""
LOCAL tmp
IF ValType( oError:severity ) == "N"
DO CASE
CASE oError:severity == ES_WHOCARES ; cMessage += "M "
CASE oError:severity == ES_WARNING ; cMessage += "W "
CASE oError:severity == ES_ERROR ; cMessage += "E "
CASE oError:severity == ES_CATASTROPHIC ; cMessage += "C "
ENDCASE
ENDIF
IF ValType( oError:genCode ) == "N"
cMessage += LTrim( Str( oError:genCode ) ) + " "
ENDIF
IF ValType( oError:subsystem ) == "C"
cMessage += oError:subsystem + " "
ENDIF
IF ValType( oError:subCode ) == "N"
cMessage += LTrim( Str( oError:subCode ) ) + " "
ENDIF
IF ValType( oError:description ) == "C"
cMessage += oError:description + " "
ENDIF
IF !Empty( oError:operation )
cMessage += "(" + oError:operation + ") "
ENDIF
IF !Empty( oError:filename )
cMessage += "<" + oError:filename + "> "
ENDIF
IF ValType( oError:osCode ) == "N"
cMessage += "OS:" + LTrim( Str( oError:osCode ) ) + " "
ENDIF
IF ValType( oError:tries ) == "N"
cMessage += "#:" + LTrim( Str( oError:tries ) ) + " "
ENDIF
IF ValType( oError:Args ) == "A"
cMessage += "A:" + LTrim( Str( Len( oError:Args ) ) ) + ":"
FOR tmp := 1 TO Len( oError:Args )
cMessage += ValType( oError:Args[ tmp ] ) + ":" + XToStrE( oError:Args[ tmp ] )
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 ListToNArray( cString )
LOCAL aArray := {}
LOCAL nPos
IF !Empty( cString )
DO WHILE ( nPos := At( ",", cString ) ) > 0
AAdd( aArray, Val( AllTrim( Left( cString, nPos - 1 ) ) ) )
cString := SubStr( cString, nPos + 1 )
ENDDO
AAdd( aArray, Val( AllTrim( cString ) ) )
ENDIF
RETURN aArray
STATIC FUNCTION CMDLGetValue( cCommandLine, cName, cRetVal )
LOCAL tmp, tmp1
IF ( tmp := At( cName, cCommandLine ) ) > 0
IF ( tmp1 := At( " ", tmp := SubStr( cCommandLine, tmp + Len( cName ) ) ) ) > 0
tmp := Left( tmp, tmp1 - 1 )
ENDIF
cRetVal := tmp
ENDIF
RETURN cRetVal
#ifdef __XPP__
FUNCTION HB_SToD( cDate )
RETURN SToD( cDate )
#endif
#ifdef RT_NO_C
#ifndef __HARBOUR__
#ifndef __XPP__
FUNCTION HB_SToD( cDate )
LOCAL cOldDateFormat
LOCAL dDate
IF ValType( cDate ) == "C" .AND. !Empty( cDate )
cOldDateFormat := Set( _SET_DATEFORMAT, "yyyy/mm/dd" )
dDate := CToD( SubStr( cDate, 1, 4 ) + "/" +;
SubStr( cDate, 5, 2 ) + "/" +;
SubStr( cDate, 7, 2 ) )
Set( _SET_DATEFORMAT, cOldDateFormat )
ELSE
dDate := CToD( "" )
ENDIF
RETURN dDate
#endif
#endif
#endif
STATIC FUNCTION BADFNAME()
#ifdef __PLATFORM__UNIX
RETURN "*BADNAM/*.MEM"
#else
RETURN "*BADNAM*.MEM"
#endif
STATIC PROCEDURE OutMsg( hFile, cMsg )
IF hFile == 1
OutStd( cMsg )
ELSEIF hFile == 2
OutErr( cMsg )
ELSE
FWrite( hFile, cMsg )
ENDIF
RETURN
/* Don't change the position of this #include. */
#include "rt_init.ch"
Reference in New Issue View Git Blame Copy Permalink