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

See ChangeLog entry 19990917-23:45 EDT David G. Holm <dholm@jsd-llc.com>

Browse Source
This commit is contained in:
David G. Holm
1999-09-18 04:00:30 +00:00
parent 74722fa1e4
commit 941f62a32b
23 changed files with 282 additions and 98 deletions
Download Patch File Download Diff File Expand all files Collapse all files

37
harbour/ChangeLog
View File

@@ -1,3 +1,40 @@
19990917-23:45 EDT David G. Holm <dholm@jsd-llc.com>
* source/tools/Makefile
+ source/tools/osnewlin.prg
+ New module simplifies deciding when to use CR/LF
or just LF when using OUTSTD() and/or OUTERR()
* tests/working/Makefile
+ tests/working/longdev.prg
+ I forgot to 'cvs add' this module with my earlier large string
changes, so it's a good thing that I left it out of the Makefile
* tests/working/rtl_test.prg
+ Added 3 tests for long strings (longer than 64 KB, Harbour only)
in a new function, Long_STRINGS()
* tests/working/adirtest.prg
* tests/working/cdow.prg
* tests/working/dates.prg
* tests/working/dates2.prg
* tests/working/dates3.prg
* tests/working/dates4.prg
* tests/working/dirtest.prg
* tests/working/harbour.ini
* tests/working/longstr2.prg
* tests/working/output.prg
* tests/working/readfile.prg
* tests/working/round.prg
* tests/working/rtl_test.prg
* tests/working/seconds.prg
* tests/working/set_num.prg
* tests/working/set_test.prg
* tests/working/testcgi.prg
* tests/working/testhtml.prg
% These test programs now use OS_NewLine()
instead of using 4 different methods.
19990917-04:58 GMT+1 Victor Szel <info@szelvesz.hu>
* source/vm/hvm.c

1
harbour/source/tools/Makefile
View File

@@ -35,6 +35,7 @@ PRG_SOURCES=\
nconvert.prg \
numtxthu.prg \
numtxten.prg \
osnewlin.prg \
stringp.prg \
LIB=tools

127
harbour/source/tools/osnewlin.prg Normal file
View File

@@ -0,0 +1,127 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Operating System related functions
*
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* www - http://www.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/* ------------------------------------------------------------------------- */
/*
* ChangeLog:
* V 1.1 David G. Holm Committed to CVS.
*
*/
/* ------------------------------------------------------------------------- */
/* $DOC$
* $FUNCNAME$
* OS_NewLine
* $CATEGORY$
* Operating System Specific
* $ONELINER$
* Returns the newline character(s) to use with the current OS
* $SYNTAX$
* OS_NewLine( aCrLf, aLf ) --> cString
* $ARGUMENTS$
* aCrLf can be used to add to the keyword list that is used to detect
* operating systems that require both CR and LF. The aCrLf list will
* be scanned before the default list is scanned.
* aLf can be used to force an OS that would normally be set up to
* require both CR and LF to use LF only.
* For both arguments, each element of the array must be a text string.
* Matches are made by using the $ operator with an array element as
* the left operand and the OS string as the right argument, after both
* strings have been converted to upper case.
* $RETURNS$
* A character string containing the character or characters required
* to move the screen cursor or print head to the start of a new line.
* The string will hold either CHR( 10 ) or CHR( 13 ) + CHR( 10 ).
* $DESCRIPTION$
* Returns a character string containing the character or characters
* required to move the screen cursor or print head to the start of a
* new line for the operating system that the program is running on
* (or thinks it is running on, if an OS emulator is being used).
* $EXAMPLES$
* // Get the newline character(s) for the current OS using defaults.
* STATIC s_cNewLine
* ...
* s_cNewLine := OS_NewLine()
* ...
* $TESTS$
* valtype( OS_NewLine() ) == "C"
* LEN( OS_NewLine( { "ANOTHERDOS" }, { "" } ) ) == 1
* $STATUS$
* C
* $COMPLIANCE$
* This is an add-on Operating System Tool function.
* $SEEALSO$
* OS()
* $END$
*/
STATIC aDefault
FUNCTION OS_NewLine( aCrLf, aLf )
LOCAL lCrLf, i, cOS := UPPER( OS() )
// Only create the default array once.
IF EMPTY( aDefault )
// NOTE: Don't use overly permissive strings like "DOS", "NT", or "WIN"
// All alpha characters must be in UPPER CASE only!
aDefault := { "OS/2", "MS-DOS", "PC DOS", "DR DOS", "DOS 5", ;
"WINDOWS 9", "WINDOWS NT", "WINDOWS 2", "CYGWIN" }
END IF
// First check the default CR/LF list.
lCrLf := ASCAN( aDefault, {|cEntry| cEntry $ cOS } ) > 0
IF ! lCrLf .AND. ! EMPTY( aCrLf )
// Only check the extra CR/LF list if the OS wasn't already
// identified as a CR/LF OS and an extra list was provided.
lCrLf := ASCAN( aCrLf, {|cEntry| UPPER( cEntry ) $ cOS } ) > 0
END IF
IF lCrLf .AND. ! EMPTY( aLf )
// Only check the force LF list if it was previously determined
// that the OS would normally use CR/LF.
lCrLf := ! ASCAN( aLf, {|cEntry| UPPER( cEntry ) $ cOS } ) > 0
END IF
// Finally, assign and return the appropriate newline string.
IF lCrLf
// It's an OS that requires both CR and LF.
cNewLine := CHR( 13 ) + CHR( 10 )
ELSE
// Everything else gets just LF.
cNewLine := CHR( 10 )
END IF
RETURN cNewLine

1
harbour/tests/working/Makefile
View File

@@ -78,6 +78,7 @@ PRG_SOURCES=\
instr.prg \
iotest.prg \
iotest2.prg \
longdev.prg \
longstr.prg \
longstr2.prg \
mankala.prg \

11
harbour/tests/working/adirtest.prg
View File

@@ -20,16 +20,7 @@ STATIC FUNCTION TestIt( cSpec )
LOCAL a4
LOCAL a5
LOCAL cNewLine
cOs := OS()
IF "OS/2" $ OS() .OR. ;
"DOS" $ OS()
cNewLine := Chr( 13 ) + Chr( 10 )
ELSE
cNewLine := Chr( 10 )
ENDIF
LOCAL cNewLine := OS_NewLine()
SET DATE ANSI
SET CENTURY ON

3
harbour/tests/working/cdow.prg
View File

@@ -3,7 +3,8 @@
//
function main()
local cNewLine := chr (13)+chr (10)
local cNewLine := OS_NewLine()
OutStd( cMonth( date() ) + cNewLine )
OutStd( cMonth( date() + 31 ) + cNewLine )
OutStd( cMonth( date() + 60 ) + cNewLine )

2
harbour/tests/working/dates.prg
View File

@@ -7,7 +7,7 @@
#include "set.ch"
function Main()
local cNewLine := CHR( 13 ) + CHR( 10 )
local cNewLine := OS_NewLine()
local dDate, dDate2, cMask, cDate

3
harbour/tests/working/dates2.prg
View File

@@ -4,8 +4,9 @@
#include "set.ch"
function main()
local newline := CHR(13) + CHR(10)
local newline := OS_NewLine()
local dDate := CTOD ("04/30/99")
outstd (SET (_SET_DATEFORMAT), dDate, newline)
set (_SET_DATEFORMAT, "yyy/mm/ddd")
outstd (SET (_SET_DATEFORMAT), dDate, newline)

2
harbour/tests/working/dates3.prg
View File

@@ -8,7 +8,7 @@
function main()
LOCAL dDate, i, cNewLine := chr( 13 ) + chr( 10 )
LOCAL dDate, i, cNewLine := OS_NewLine()
set( _SET_DATEFORMAT, "dd/mm/yyyy" )
dDate := cToD( "25/05/1999" )

24
harbour/tests/working/dates4.prg
View File

@@ -5,11 +5,14 @@
// Testing Harbour dates management.
#include "set.ch"
function main()
STATIC s_cNewLine
function main()
LOCAL i
LOCAL dDate := date()
s_cNewLine := OS_NewLine()
set( _SET_DATEFORMAT, "dd/mm/yyyy" )
for i := 7 to 49 step 7
@@ -20,16 +23,15 @@ function main()
return nil
function CheckDate( dDate )
local cNewLine := chr( 13 ) + chr( 10 )
OutStd( "Testing date:", dDate , cNewLine )
OutStd( "Days in month..:", daysinmonth( dDate ), cNewLine )
OutStd( "Day of year....:", doy( dDate ), cNewLine )
OutStd( "Begin of month.:", bom( dDate ), cNewLine )
OutStd( "End of month...:", eom( dDate ), cNewLine )
OutStd( "Week of month..:", wom( dDate ), cNewLine )
OutStd( "Week of year...:", woy( dDate ), cNewLine )
OutStd( "Begin of year..:", boy( dDate ), cNewLine )
OutStd( "End of year....:", eoy( dDate ), cNewLine )
OutStd( "Testing date:", dDate , s_cNewLine )
OutStd( "Days in month..:", daysinmonth( dDate ), s_cNewLine )
OutStd( "Day of year....:", doy( dDate ), s_cNewLine )
OutStd( "Begin of month.:", bom( dDate ), s_cNewLine )
OutStd( "End of month...:", eom( dDate ), s_cNewLine )
OutStd( "Week of month..:", wom( dDate ), s_cNewLine )
OutStd( "Week of year...:", woy( dDate ), s_cNewLine )
OutStd( "Begin of year..:", boy( dDate ), s_cNewLine )
OutStd( "End of year....:", eoy( dDate ), s_cNewLine )
__Accept( "Press ENTER to continue..." )
OutStd( chr( 10 ), chr( 10 ) )

9
harbour/tests/working/dirtest.prg
View File

@@ -6,19 +6,12 @@
function main(filespec,attribs,cshort)
local adir := {}
local x := 0, lShort := .f.
local cOs := OS(), cNewLine
local x := 0, lShort := .f., cNewLine := OS_NewLine()
IF !cshort == NIL .and. (Upper( cShort ) == "TRUE" .or. Upper( cShort ) == ".T.")
lShort := .t.
ENDIF
IF "OS/2" $ cOs .OR. "WIN" $ cOs .OR. "DOS" $ cOs
cNewLine := CHR( 13 ) + CHR( 10 )
ELSE
cNewLine := CHR( 10 )
END IF
//adir := asort( directory(filespec,attribs,lShort),,, {|x,y|upper(x[1]) < upper(y[1])} )
adir := directory(filespec,attribs,lShort)

2
harbour/tests/working/harbour.ini
View File

@@ -8,7 +8,7 @@ so there!!!=
another=section
[Date Test]
Today=19990718
Today=19990917
[Bool Test]
True=.t.

43
harbour/tests/working/longdev.prg Normal file
View File

@@ -0,0 +1,43 @@
//
// $Id$
//
// Testing Harbour long string handling with device output.
/* Harbour Project source code
http://www.Harbour-Project.org/
Copyright 1999 David G. Holm <dholm@jsd-llc.com>
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
FUNCTION Main()
LOCAL cShort := "1234567890"
LOCAL i, j, cLong, cBuffer, nHandle
// Create an 80 KB string (Clipper is limited to 64 KB).
cLong := cShort
FOR i := 1 TO 13
cLong += cLong
NEXT
// Write the long string to file long_str.prn
SET PRINTER TO long_str
SET DEVICE TO PRINTER
DEVOUT( cLong )
SET PRINTER OFF
SET DEVICE TO SCREEN
// Confirm the string length and that a copy is exactly identical.
? "The length of the long string is", IF( LEN( cLong ) == 80 * 1024, "correct", "wrong" )
cBuffer := cLong
? "The length of a copy of the long string is", IF( LEN( cLong ) == 80 * 1024, "correct", "wrong" )
? "The copy of the long string is", IF( cLong == cBuffer, "equal", "not equal" ), "to the long string"
// Read the string back in and compare it to the original.
nHandle := FOPEN( "long_str.prn" )
cBuffer := FREADSTR( nHandle, 90000 )
? "Original:", LEN( cLong )
? "From file:", LEN( cBuffer )
? "The strings are", IF( cLong == cBuffer, "equal", "not equal" )
return nil

8
harbour/tests/working/longstr2.prg
View File

@@ -6,14 +6,10 @@
function Main()
local short := "1234567890", cOs := OS()
local short := "1234567890"
local i, long, very_long, cNewLine
IF "OS/2" $ cOs .OR. "WIN" $ cOs .OR. "DOS" $cOs
cNewLine := CHR( 13 ) + CHR( 10 )
ELSE
cNewLine := CHR( 10 )
END IF
cNewLine := OS_NewLine()
long := short
for i := 1 TO 12

2
harbour/tests/working/output.prg
View File

@@ -10,9 +10,9 @@
*/
#include "set.ch"
#define cNewLine CHR( 13 ) + CHR( 10 )
function Main()
local cNewLine := OS_NewLine()
OUTSTD (cNewLine, "Testing Harbour device management on", DATE())
SET ALTERNATE TO OUTPUT_A ADDITIVE

8
harbour/tests/working/readfile.prg
View File

@@ -13,13 +13,7 @@
PROCEDURE Main( cFile )
LOCAL oFile := TFileRead():New( cFile )
LOCAL cOs := UPPER( OS() ), cNewLine
IF "OS/2" $ cOs .OR. "WIN" $ cOS .OR. "DOS" $cOS
cNewLine := CHR( 13 ) + CHR( 10 )
ELSE
cNewLine := CHR( 10 )
END IF
LOCAL cNewLine := OS_NewLine()
oFile:Open()
IF oFile:Error()

8
harbour/tests/working/round.prg
View File

@@ -11,13 +11,7 @@
function main()
local n, value := -5
local cOs := OS(), cNewLine
IF "OS/2" $ cOs .OR. "WIN" $ cOs .OR. "DOS" $cOs
cNewLine := CHR( 13 ) + CHR( 10 )
ELSE
cNewLine := CHR( 10 )
END IF
local cNewLine := OS_NewLine()
for n := 1 to 100
OUTSTD(cNewLine)

24
harbour/tests/working/rtl_test.prg
View File

@@ -135,6 +135,9 @@ FUNCTION Main( cPar1, cPar2 )
Main_HVM()
Main_MATH()
Main_STRINGS()
#ifdef __HARBOUR__
Long_STRINGS()
#endif
Main_MISC()
#ifdef __HARBOUR__
Main_OPOVERL()
@@ -1507,6 +1510,16 @@ STATIC FUNCTION Main_STRINGS()
RETURN NIL
#ifdef __HARBOUR__
STATIC FUNCTION Long_STRINGS()
TEST_LINE( RIGHT( SPACE( 64 * 1024 - 5 ) + "12345 7890", 10 ), "12345 7890" )
TEST_LINE( LEN( SPACE( 81910 ) + "1234567890" ), 81920 )
TEST_LINE( ( "1234567890" + SPACE( 810910 ) ) - ( "1234567890" + SPACE( 810910 ) ), "12345678901234567890" + SPACE( 810910 * 2 ) )
RETURN NIL
#endif
STATIC FUNCTION Main_MISC()
/* EVAL(), :EVAL */
@@ -2046,18 +2059,10 @@ STATIC FUNCTION Main_LAST()
RETURN NIL
STATIC FUNCTION TEST_BEGIN( cParam )
LOCAL cOs
s_nStartTime := Seconds()
cOs := OS()
IF "OS/2" $ cOs .OR. ;
"DOS" $ cOs
s_cNewLine := Chr( 13 ) + Chr( 10 )
ELSE
s_cNewLine := Chr( 10 )
ENDIF
s_cNewLine := OS_NewLine()
s_lShowAll := "/ALL" $ Upper( cParam )
s_aSkipList := ListToNArray( CMDLGetValue( Upper( cParam ), "/SKIP:", "" ) )
@@ -2485,4 +2490,3 @@ STATIC FUNCTION SToD( cDate )
#endif
#endif

8
harbour/tests/working/seconds.prg
View File

@@ -11,13 +11,7 @@
function Main( cParam )
local n, limit := 10
local cOs := OS(), cNewLine
IF "OS/2" $ cOs .OR. "WIN" $ cOs .OR. "DOS" $ cOs
cNewLine := CHR( 13 ) + CHR( 10 )
ELSE
cNewLine := CHR( 10 )
END IF
local cNewLine := OS_NewLine()
IF( ! EMPTY( cParam ) )
limit := VAL( cParam )

4
harbour/tests/working/set_num.prg
View File

@@ -5,10 +5,10 @@
// Testing SET
function Main()
local n, NEWLINE := CHR (10) + CHR(13)
local n, cNewLine := OS_NewLine()
for n := 1 to 39
outstd (NEWLINE)
outstd (cNewLine)
outstd (set (n))
next

8
harbour/tests/working/set_test.prg
View File

@@ -4,11 +4,16 @@
// Testing SET
STATIC s_cNewLine
#include "set.ch"
request dbfntx
function Main()
// for Clipper, this drags in the terminal driver
@ Row(), col() say ""
s_cNewLine := OS_NewLine()
TestLine( "_SET_EXACT", 1)
TestLine( "_SET_FIXED", 2)
TestLine( "_SET_DECIMALS", 3)
@@ -60,8 +65,7 @@ function Main()
return nil
proc testline( c, n )
local NEWLINE := CHR (13) + CHR (10)
outstd( NEWLINE )
outstd( s_cNewLine )
outstd( str( n, 3 ) )
outstd( " "+Padr( c, 17 ) )
outstd( Set( n ) )

25
harbour/tests/working/testcgi.prg
View File

@@ -27,17 +27,16 @@
#include "cgi.ch"
#define IF_BUFFER 65535
#ifdef __HARBOUR__
#define NewLine chr(10)
#else
#define NewLine chr(13)
#endif
STATIC s_cNewLine
FUNCTION Main()
LOCAL oHTML := THTML():New()
LOCAL hFile, nPos, cString, cBuf, i, cTable, cLine
s_cNewLine := OS_NewLine()
oHTML:SetHTMLFile( "function.cfm" )
hFile := fOpen( "list.txt", 0 )
@@ -247,8 +246,8 @@ STATIC FUNCTION AddPara( cPara, cAlign )
LOCAL Self := QSelf()
::cBody := ::cBody + ;
"<P ALIGN='" + cAlign + "'>" + NewLine + ;
cPara + NewLine + ;
"<P ALIGN='" + cAlign + "'>" + s_cNewLine + ;
cPara + s_cNewLine + ;
"</P>"
RETURN( Self )
@@ -262,11 +261,11 @@ STATIC FUNCTION Generate()
// Is this a meta file or hand generated script?
IF empty( ::cHTMLFile )
::cContent := ;
"<HTML><HEAD>" + NewLine + ;
"<TITLE>" + ::cTitle + "</TITLE>" + NewLine + ;
"<HTML><HEAD>" + s_cNewLine + ;
"<TITLE>" + ::cTitle + "</TITLE>" + s_cNewLine + ;
"<BODY link='" + ::cLinkColor + "' " + ;
"vlink='" + ::cvLinkColor + "'>" + + NewLine + ;
::cBody + NewLine + ;
"vlink='" + ::cvLinkColor + "'>" + + s_cNewLine + ;
::cBody + s_cNewLine + ;
"</BODY></HTML>"
ELSE
::cContent := ""
@@ -326,8 +325,8 @@ STATIC FUNCTION ShowResult()
LOCAL Self := QSelf()
OutStd( ;
"HTTP/1.0 200 OK" + NewLine + ;
"CONTENT-TYPE: TEXT/HTML" + NewLine + NewLine + ;
"HTTP/1.0 200 OK" + s_cNewLine + ;
"CONTENT-TYPE: TEXT/HTML" + s_cNewLine + s_cNewLine + ;
::cContent )
RETURN( Self )

20
harbour/tests/working/testhtml.prg
View File

@@ -15,12 +15,14 @@
*
**/
#define NewLine chr(10)+chr(13)
STATIC s_cNewLine
FUNCTION Main()
LOCAL oHTML := THTML():New()
s_cNewLine := OS_NewLine()
oHTML:SetTitle( "Harbour Power Demonstration" )
oHTML:AddHead( "Harbour Project" )
oHTML:AddPara( "<B>Harbour</B> is xBase at its best. Have a taste today!", "LEFT" )
@@ -119,8 +121,8 @@ STATIC FUNCTION AddPara( cPara, cAlign )
Default( cAlign, "Left" )
::cBody := ::cBody + ;
"<P ALIGN='" + cAlign + "'>" + NewLine + ;
cPara + NewLine + ;
"<P ALIGN='" + cAlign + "'>" + s_cNewLine + ;
cPara + s_cNewLine + ;
"</P>"
RETURN( Self )
@@ -130,11 +132,11 @@ STATIC FUNCTION Generate()
LOCAL Self := QSelf()
::cContent := ;
"<HTML><HEAD>" + NewLine + ;
"<TITLE>" + ::cTitle + "</TITLE>" + NewLine + ;
"<HTML><HEAD>" + s_cNewLine + ;
"<TITLE>" + ::cTitle + "</TITLE>" + s_cNewLine + ;
"<BODY link='" + ::cLinkColor + "' " + ;
"vlink='" + ::cvLinkColor + "'>" + + NewLine + ;
::cBody + NewLine + ;
"vlink='" + ::cvLinkColor + "'>" + + s_cNewLine + ;
::cBody + s_cNewLine + ;
"</BODY></HTML>"
RETURN( Self )
@@ -144,8 +146,8 @@ STATIC FUNCTION ShowResult()
LOCAL Self := QSelf()
qqOut( ;
"HTTP/1.0 200 OK" + NewLine + ;
"CONTENT-TYPE: TEXT/HTML" + NewLine + NewLine + ;
"HTTP/1.0 200 OK" + s_cNewLine + ;
"CONTENT-TYPE: TEXT/HTML" + s_cNewLine + s_cNewLine + ;
::cContent )
RETURN( Self )