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

see changelog

Browse Source
This commit is contained in:
Eddie Runia
1999-07-21 07:05:57 +00:00
parent b3cefd96b0
commit 7b2ce3a143
4 changed files with 195 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
harbour/ChangeLog
View File

@@ -1,3 +1,17 @@
19990721-09:00 CET Jose Lalin
* source/vm/hvm.c
+ added support for concatenation operator "-"
+ added support to generate correct runtime errors in functions:
And(), Equal(), Greater(), GreaterEqual(),
Inc(), Instring(), Less(), LessEqual(), Not(),
NotEqual(), Minus(), Or(), Plus(), HB_LEN()
+ tests/working/strsub.prg
tests for operator "-" on strings
19990721-09:00 CET Matthew Hamilton
* tests/working/inifiles.prg
* Case sensitive & Speed improvement
19990720-09:38 Alexander Kresin
* source\hbpp\hbpp.c
* Fixed bugs related to nested #ifdef, #ifndef

87
harbour/source/vm/hvm.c
View File

@@ -615,8 +615,7 @@ void And( void )
{
PHB_ITEM pItem2 = stack.pPos - 1;
PHB_ITEM pItem1 = stack.pPos - 2;
PHB_ITEM pError;
int iResult;
int iResult;
HB_DEBUG( "And\n" );
@@ -629,10 +628,7 @@ void And( void )
}
else
{
pError = hb_errNew();
hb_errPutDescription( pError, "Argument error: conditional" );
hb_errLaunch( pError );
hb_errRelease( pError );
hb_errorRT_BASE(EG_ARG, 1066, "Argument error", "conditional");
}
}
@@ -882,8 +878,7 @@ void Equal( BOOL bExact )
else if( pItem1->type != pItem2->type )
{
printf( "types do not match on equal operation\n" );
exit( 1 );
hb_errorRT_BASE(EG_ARG, 1070, "Argument error", "==");
}
else
@@ -1016,8 +1011,7 @@ void Greater( void )
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
{
printf( "types do not match on greater operation %d, %d\n", (stack.pPos - 2)->type, (stack.pPos - 1)->type );
exit( 1 );
hb_errorRT_BASE(EG_ARG, 1075, "Argument error", ">");
}
}
@@ -1063,8 +1057,7 @@ void GreaterEqual( void )
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
{
printf( "types do not match on greaterequal operation\n" );
exit( 1 );
hb_errorRT_BASE(EG_ARG, 1076, "Argument error", ">=");
}
}
@@ -1087,10 +1080,7 @@ void Inc( void )
}
else
{
pError = hb_errNew();
hb_errPutDescription( pError, "Error BASE/1086 Argument error: ++" );
hb_errLaunch( pError );
hb_errRelease( pError );
hb_errorRT_BASE(EG_ARG, 1086, "Argument error", "++");
}
}
@@ -1136,11 +1126,7 @@ void Instring( void )
}
else
{
PHB_ITEM pError = hb_errNew();
hb_errPutDescription( pError, "Error BASE/1109 Argument error: $" );
hb_errLaunch( pError );
hb_errRelease( pError );
hb_errorRT_BASE(EG_ARG, 1109, "Argument error", "$");
}
}
@@ -1252,8 +1238,7 @@ void Less( void )
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
{
printf( "types do not match on less operation\n" );
exit( 1 );
hb_errorRT_BASE(EG_ARG, 1073, "Argument error", "<");
}
}
@@ -1299,8 +1284,7 @@ void LessEqual( void )
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
{
printf( "types do not match on lessequal operation\n" );
exit( 1 );
hb_errorRT_BASE(EG_ARG, 1074, "Argument error", "<=");
}
}
@@ -1340,7 +1324,7 @@ void Not( void )
if( IS_LOGICAL( pItem ) )
pItem->item.asLogical.value = ! pItem->item.asLogical.value;
else
; /* TODO: Raise an error here ? */
hb_errorRT_BASE(EG_ARG, 1077, "Argument error", ".NOT.");
}
void NotEqual( void )
@@ -1383,8 +1367,7 @@ void NotEqual( void )
else if( pItem1->type != pItem2->type )
{
printf( "types do not match on equal operation\n" );
exit( 1 );
hb_errorRT_BASE(EG_ARG, 1072, "Argument error", "<>");
}
else
@@ -1415,11 +1398,45 @@ void Minus( void )
lDate1 = PopDate();
PushDate( lDate1 - dNumber2 );
}
else if( IS_STRING( pItem1 ) && IS_STRING( pItem2 ) )
{
ULONG lLen = pItem1->item.asString.length;
ULONG lInc = 0;
ULONG i;
pItem1->item.asString.value = (char*)hb_xrealloc( pItem1->item.asString.value, pItem1->item.asString.length + pItem2->item.asString.length + 1 );
while( lLen && pItem1->item.asString.value[lLen - 1] == ' ' )
{
lLen--;
lInc++;
}
pItem1->item.asString.length = lLen;
lLen = pItem2->item.asString.length;
pItem2->item.asString.length += lInc;
for( i = 0; i < lInc; i++)
pItem2->item.asString.value[lLen + i] = ' ';
memcpy( pItem1->item.asString.value+ pItem1->item.asString.length,
pItem2->item.asString.value, pItem2->item.asString.length );
pItem1->item.asString.length += pItem2->item.asString.length;
pItem1->item.asString.value[ pItem1->item.asString.length ] = 0;
if( pItem2->item.asString.value )
{
hb_xfree( pItem2->item.asString.value );
pItem2->item.asString.value = NULL;
}
StackPop();
return;
}
else if( IS_OBJECT( stack.pPos - 2 ) && hb_isMessage( stack.pPos - 2, "-" ) )
OperatorCall( stack.pPos - 2, stack.pPos - 1, "-" );
else
hb_errorRT_BASE(EG_ARG, 1082, "Argument error", "-");
/* TODO: We should substract strings also ? and generate an error it types
don't match */
}
void Modulus( void )
@@ -1464,10 +1481,7 @@ void Or( void )
}
else
{
pError = hb_errNew();
hb_errPutDescription( pError, "Argument error: conditional" );
hb_errLaunch( pError );
hb_errRelease( pError );
hb_errorRT_BASE(EG_ARG, 1066, "Argument error", "conditional");
}
}
@@ -1522,9 +1536,8 @@ void Plus( void )
OperatorCall( pItem1, pItem2, "+" );
else
hb_errorRT_BASE( 1081, 1081, "Types of arguments do not match", "+" );
hb_errorRT_BASE( EG_ARG, 1081, "Types of arguments do not match", "+" );
/* TODO: Generate an error if types don't match */
HB_DEBUG( "Plus\n" );
}
@@ -2157,7 +2170,7 @@ HARBOUR HB_LEN( void )
break;
default:
hb_retni( 0 ); /* QUESTION: Should we raise an error here ? */
hb_errorRT_BASE(EG_ARG, 1111, "Argument error", "LEN");
break;
}
}

181
harbour/tests/working/inifiles.prg
View File

@@ -2,7 +2,7 @@
// $Id$
//
#define IF_BUFFER 65535
#define CRLF (Chr(13) + Chr(10))
function Main(cFilename, cSection)
local oIni := TIniFile():New(Default( cFilename, "harbour.ini" ) )
@@ -75,48 +75,55 @@ static function New(cFileName)
hFile := fcreate(cFilename)
endif
cLine := ''
Done := .f.
cFile := space(1)
while !Done
cLine := ''
cFile := space(256)
Done := (fread(hFile, cFile, 256) <= 0)
while !Done
Done := (fread(hFile, @cFile, 1) <= 0)
cFile := strtran(cFile, chr(10), '') // so we can just search for CHR(13)
if !cFile $ chr(10) + chr(13)
cLine += cFile
// prepend last read
cFile := cLine + cFile
while !empty(cFile)
if (nPos := at(chr(13), cFile)) > 0
cLine := left(cFile, nPos - 1)
cFile := substr(cFile, nPos + 1)
if !empty(cLine)
if Left(cLine, 1) == '[' // new section
if (nPos := At(']', cLine)) > 1
cLine := substr(cLine, 2, nPos - 2);
else
cLine := substr(cLine, 2)
endif
AAdd(::Contents, { cLine, { /* this will be CurrArray */ } } )
CurrArray := ::Contents[Len(::Contents)][2]
elseif Left(cLine, 1) == ';' // preserve comments
AAdd( CurrArray, { NIL, cLine } )
else
if (nPos := At('=', cLine)) > 0
cIdent := Left(cLine, nPos - 1)
cLine := SubStr(cLine, nPos + 1)
AAdd( CurrArray, { cIdent, cLine } )
else
AAdd( CurrArray, { cLine, '' } )
endif
endif
cLine := '' // to stop prepend later on
endif
else
exit
cLine := cFile
cFile := ''
endif
end
if !empty(cLine)
if Left(cLine, 1) == '[' // new section
if (nPos := At(']', cLine)) > 1
cLine := substr(cLine, 2, nPos - 2)
else
cLine := substr(cLine, 2)
endif
AAdd(::Contents, { cLine, { /* this will be CurrArray */ } } )
CurrArray := ::Contents[Len(::Contents)][2]
elseif Left(cLine, 1) == ';' // preserve comments
AAdd( CurrArray, { NIL, cLine } )
else
if (nPos := At('=', cLine)) > 0
cIdent := Left(cLine, nPos - 1)
cLine := SubStr(cLine, nPos + 1)
AAdd( CurrArray, { cIdent, cLine } )
else
AAdd( CurrArray, { cLine, '' } )
endif
endif
endif
end
fclose(hFile)
@@ -126,26 +133,41 @@ return Self
static function ReadString(cSection, cIdent, cDefault)
local Self := QSelf()
local cResult := cDefault
local j, i := AScan( ::Contents, {|x| x[1] == cSection} )
local i, j, cFind
if i > 0
j := AScan( ::Contents[i][2], {|x| x[1] == cIdent} )
if Empty(cSection)
cFind := lower(cIdent)
j := AScan( ::Contents, {|x| lower(x[1]) == cFind .and. ValType(x[2]) == 'C'} )
if j > 0
cResult := ::Contents[i][2][j][2]
cResult := ::Contents[j][2]
endif
else
cFind := lower(cSection)
i := AScan( ::Contents, {|x| lower(x[1]) == cFind} )
if i > 0
cFind := lower(cIdent)
j := AScan( ::Contents[i][2], {|x| lower(x[1]) == cFind} )
if j > 0
cResult := ::Contents[i][2][j][2]
endif
endif
endif
return cResult
static procedure WriteString(cSection, cIdent, cString)
local Self := QSelf()
local j, i
local i, j, cFind
if Empty(cIdent)
outerr('Must specify an identifier')
elseif Empty(cSection)
j := AScan( ::Contents, {|x| x[1] == cIdent .and. ValType(x[2]) == 'C'} )
cFind := lower(cIdent)
j := AScan( ::Contents, {|x| lower(x[1]) == cFind .and. ValType(x[2]) == 'C'} )
if j > 0
::Contents[j][2] := cString
@@ -156,21 +178,24 @@ static procedure WriteString(cSection, cIdent, cString)
::Contents[1] := {cIdent, cString}
endif
elseif (i := AScan( ::Contents, ;
{|x| x[1] == cSection .and. ValType(x[2]) == 'A'})) > 0
j := AScan( ::Contents[i][2], {|x| x[1] == cIdent} )
else
cFind := lower(cSection)
if (i := AScan( ::Contents, {|x| lower(x[1]) == cFind .and. ValType(x[2]) == 'A'})) > 0
cFind := lower(cIdent)
j := AScan( ::Contents[i][2], {|x| lower(x[1]) == cFind} )
if j > 0
::Contents[i][2][j][2] := cString
if j > 0
::Contents[i][2][j][2] := cString
else
AAdd( ::Contents[i][2], {cIdent, cString} )
endif
else
AAdd( ::Contents[i][2], {cIdent, cString} )
AAdd( ::Contents, {cSection, {{cIdent, cString}}} )
endif
else
AAdd( ::Contents, {cSection, {{cIdent, cString}}} )
endif
return
return
static function ReadNumber(cSection, cIdent, nDefault)
local Self := QSelf()
@@ -206,10 +231,14 @@ return
static procedure DeleteKey(cSection, cIdent)
local Self := QSelf()
local j, i := AScan( ::Contents, {|x| x[1] == cSection} )
local i, j
cSection := lower(cSection)
i := AScan( ::Contents, {|x| lower(x[1]) == cSection} )
if i > 0
j := AScan( ::Contents[i][2], {|x| x[1] == cIdent} )
cIdent := lower(cIdent)
j := AScan( ::Contents[i][2], {|x| lower(x[1]) == cIdent} )
ADel( ::Contents[i][2], j )
ASize( ::Contents[i][2], Len(::Contents[i][2]) - 1 )
@@ -221,12 +250,17 @@ static procedure EraseSection(cSection)
local i
if Empty(cSection)
outerr('Must specify a section')
while (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. ValType(x[2]) == 'C'})) > 0
ADel( ::Contents, i )
ASize( ::Contents, len(::Contents) - 1 )
end
elseif (i := AScan( ::Contents,;
{|x| x[1] == cSection .and. ValType(x[2]) == 'A'})) > 0
ADel( ::Contents, i )
ASize( ::Contents, Len(::Contents) - 1 )
else
cSection := lower(cSection)
if (i := AScan( ::Contents, {|x| lower(x[1]) == cSection .and. ValType(x[2]) == 'A'})) > 0
ADel( ::Contents, i )
ASize( ::Contents, Len(::Contents) - 1 )
endif
endif
return
@@ -235,17 +269,23 @@ static function ReadSection(cSection)
local i, j, aSection := {}
if Empty(cSection)
outerr('Must specify a section')
elseif (i := AScan( ::Contents, ;
{|x| x[1] == cSection .and. ValType(x[2]) == 'A'})) > 0
for j := 1 to Len(::Contents[i][2])
if ::Contents[i][2][j][1] <> NIL
AAdd(aSection, ::Contents[i][2][j][1])
for i := 1 to len(::Contents)
if valtype(::Contents[i][1]) == 'C' .and. valtype(::Contents[i][2]) == 'C'
aadd(aSection, ::Contents[i][1])
endif
next
else
cSection := lower(cSection)
if (i := AScan( ::Contents, {|x| x[1] == cSection .and. ValType(x[2]) == 'A'})) > 0
for j := 1 to Len(::Contents[i][2])
if ::Contents[i][2][j][1] <> NIL
AAdd(aSection, ::Contents[i][2][j][1])
endif
next
endif
endif
return aSection
@@ -279,18 +319,15 @@ static procedure UpdateFile()
fwrite(hFile, ::Contents[i][2][j][2] + Chr(13) + Chr(10))
else
fwrite(hFile, ::Contents[i][2][j][1] + '=' + ;
::Contents[i][2][j][2] + Chr(13) + Chr(10))
fwrite(hFile, ::Contents[i][2][j][1] + '=' + ::Contents[i][2][j][2] + Chr(13) + Chr(10))
endif
next
fwrite(hFile, Chr(13) + Chr(10))
elseif ValType(::Contents[i][2]) == 'C'
fwrite(hFile, ::Contents[i][1] + '=' + ::Contents[i][2] + ;
Chr(13) + Chr(10))
fwrite(hFile, ::Contents[i][1] + '=' + ::Contents[i][2] + Chr(13) + Chr(10))
endif
next
fclose(hFile)
return

22
harbour/tests/working/strsub.prg Normal file
View File

@@ -0,0 +1,22 @@
// Testing strings concat
function main()
LOCAL a := "STRINGS "
LOCAL b := "CONCAT"
LOCAL c
LOCAL i
for i := 1 to 3
a += " "
c := a
c -= b
QOut( "[" + c + "]" )
next
QOut()
__Accept( "Press a key to raise an error!" )
QOut( a - i )
return nil