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

2006-07-24 13:50 UTC+0100 Ryszard Glab <rglab//imid.med.pl>

Browse Source 
* source/pp/ppcore.c
   * source/pp/pptable.c
   * utils/hbpptest/pp_test.prg
      * fixed to be more Clipper compatible
      * fixed access to unallocated memory
      * added more test cases
This commit is contained in:
Ryszard Glab
2006-07-24 11:43:24 +00:00
parent 9d78bdc98d
commit a943d9579d
4 changed files with 156 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
harbour/ChangeLog
View File

@@ -8,6 +8,15 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
! fixed access to first stack item in hb_vmIsLocalRef()
* harbour/TODO
- removed note about hb_objGetMethod() - it's already addressed
* fixed to be more Clipper compatible
2006-07-24 13:50 UTC+0100 Ryszard Glab <rglab//imid.med.pl>
* source/pp/ppcore.c
* source/pp/pptable.c
* utils/hbpptest/pp_test.prg
* fixed to be more Clipper compatible
* fixed access to unallocated memory
* added more test cases

17
harbour/source/pp/ppcore.c
View File

@@ -3409,9 +3409,8 @@ static void SearnRep( char *exppatt, char *expreal, int lenreal, char *ptro, int
}
else if( lastchar == '0' )
{
*lenres += ReplacePattern( exppatt[2], expreal, lenreal, ptrOut + ifou - 1, *lenres - isdvig - ifou + 1 );
*lenres += ReplacePattern( (exppatt[1]?exppatt[2]:exppatt[1]), expreal, lenreal, ptrOut + ifou - 1, *lenres - isdvig - ifou + 1 );
isdvig += ifou - 1;
}
else
{
@@ -3632,9 +3631,9 @@ static int ReplacePattern( char patttype, char *expreal, int lenreal, char *ptro
{
int i;
i = ( ifou ) ? 5 : 4;
hb_pp_Stuff( "{||},", ptro, i, 0, lenres );
hb_pp_Stuff( expreal, ptro + 3, lenitem, 0, lenres + i );
i = ( ifou ) ? 6 : 5;
hb_pp_Stuff( "{|| },", ptro, i, 0, lenres );
hb_pp_Stuff( expreal, ptro + 4, lenitem, 0, lenres + i );
ptro += i + lenitem;
rmlen += i + lenitem;
}
@@ -3649,9 +3648,9 @@ static int ReplacePattern( char patttype, char *expreal, int lenreal, char *ptro
}
else
{
hb_pp_Stuff( "{||}", ptro, 4, 4, lenres );
hb_pp_Stuff( expreal, ptro + 3, lenreal, 0, lenres );
rmlen = lenreal + 4;
hb_pp_Stuff( "{|| }", ptro, 5, 4, lenres );
hb_pp_Stuff( expreal, ptro + 4, lenreal, 0, lenres );
rmlen = lenreal + 5;
}
break;
@@ -4526,7 +4525,7 @@ static int NextName( char **sSource, char *sDest )
State = STATE_QUOTE2;
}
/* Ron Pinkas added 2000-11-08 */
else if( **sSource == '[' && s_bArray == FALSE && strchr( ")]}.", cLastChar ) == NULL && !ISNAME( ( BYTE ) cLastChar ) )
else if( **sSource == '[' && s_bArray == FALSE && strchr( ")]}.\"\'", cLastChar ) == NULL && !ISNAME( ( BYTE ) cLastChar ) )
{
/* Ron Pinkas added 2000-11-08 */
pString = *sSource;

22
harbour/source/pp/pptable.c
View File

@@ -251,7 +251,7 @@ void hb_pp_Table( void )
static COMMANDS sC___108 = {0,"SET",3,"WRAP (\1A00)","Set( _SET_WRAP, \1A00 )",&sC___107 };
static COMMANDS sC___109 = {0,"SET",3,"MESSAGE TO \1A00 \2\1B20 CENTER, CENTRE>\3",
"Set( _SET_MESSAGE, \1A00 ) ; Set( _SET_MCENTER, \1B50 )",&sC___108 };
static COMMANDS sC___110 = {0,"SET",3,"MESSAGE TO","Set( _SET_MESSAGE, 0 ) ; Set( _SET_MCENTER, .f. )",&sC___109 };
static COMMANDS sC___110 = {0,"SET",3,"MESSAGE TO","Set( _SET_MESSAGE, 0 ) ; Set( _SET_MCENTER, .F. )",&sC___109 };
static COMMANDS sC___111 = {0,"@",1,"\1A00, \1B00 PROMPT \1C00 \2MESSAGE \1D00\3 \2COLOR \1E00\3",
"__AtPrompt( \1A00, \1B00, \1C00 , \1D00 , \1E00 )",&sC___110 };
static COMMANDS sC___112 = {0,"MENU",4,"TO \1A00","\1A00 := __MenuTo( {|_1| if(PCount() == 0, \1A00, \1A00 := _1)}, \1A10 )",&sC___111 };
@@ -275,15 +275,15 @@ void hb_pp_Table( void )
static COMMANDS sC___128 = {0,"SET",3,"FUNCTION \1A00 \2TO\3 \2\1B00\3","__SetFunction( \1A00, \1B00 )",&sC___127 };
static COMMANDS sC___129 = {0,"CLEAR",5,"MEMORY","__MVClear()",&sC___128 };
static COMMANDS sC___130 = {0,"RELEASE",7," \1A10","__MVXRelease( \1A30 )",&sC___129 };
static COMMANDS sC___131 = {0,"RELEASE",7,"ALL","__MVRelease('*', .t.)",&sC___130 };
static COMMANDS sC___132 = {0,"RELEASE",7,"ALL LIKE \1A00","__MVRelease( \1A10, .t. )",&sC___131 };
static COMMANDS sC___133 = {0,"RELEASE",7,"ALL EXCEPT \1A00","__MVRelease( \1A10, .f. )",&sC___132 };
static COMMANDS sC___131 = {0,"RELEASE",7,"ALL","__MVRelease('*', .T.)",&sC___130 };
static COMMANDS sC___132 = {0,"RELEASE",7,"ALL LIKE \1A00","__MVRelease( \1A10, .T. )",&sC___131 };
static COMMANDS sC___133 = {0,"RELEASE",7,"ALL EXCEPT \1A00","__MVRelease( \1A10, .F. )",&sC___132 };
static COMMANDS sC___134 = {0,"RESTORE",7,"\2FROM \1A40\3 \2\1B20 ADDITIVE>\3","__MVRestore( \1A30, \1B50 )",&sC___133 };
static COMMANDS sC___135 = {0,"SAVE",4,"ALL LIKE \1A00 TO \1B40","__MVSave( \1B30, \1A30, .t. )",&sC___134 };
static COMMANDS sC___136 = {0,"SAVE",4,"TO \1A40 ALL LIKE \1B00","__MVSave( \1A30, \1B30, .t. )",&sC___135 };
static COMMANDS sC___137 = {0,"SAVE",4,"ALL EXCEPT \1A00 TO \1B40","__MVSave( \1B30, \1A30, .f. )",&sC___136 };
static COMMANDS sC___138 = {0,"SAVE",4,"TO \1A40 ALL EXCEPT \1B00","__MVSave( \1A30, \1B30, .f. )",&sC___137 };
static COMMANDS sC___139 = {0,"SAVE",4,"\2TO \1A40\3 \2ALL\3","__MVSave( \1A30, '*', .t. )",&sC___138 };
static COMMANDS sC___135 = {0,"SAVE",4,"ALL LIKE \1A00 TO \1B40","__MVSave( \1B30, \1A30, .T. )",&sC___134 };
static COMMANDS sC___136 = {0,"SAVE",4,"TO \1A40 ALL LIKE \1B00","__MVSave( \1A30, \1B30, .T. )",&sC___135 };
static COMMANDS sC___137 = {0,"SAVE",4,"ALL EXCEPT \1A00 TO \1B40","__MVSave( \1B30, \1A30, .F. )",&sC___136 };
static COMMANDS sC___138 = {0,"SAVE",4,"TO \1A40 ALL EXCEPT \1B00","__MVSave( \1A30, \1B30, .F. )",&sC___137 };
static COMMANDS sC___139 = {0,"SAVE",4,"\2TO \1A40\3 \2ALL\3","__MVSave( \1A30, '*', .T. )",&sC___138 };
static COMMANDS sC___140 = {0,"ERASE",5,"\1A40","FErase( \1A30 )",&sC___139 };
static COMMANDS sC___141 = {0,"DELETE",6,"FILE \1A40","FErase( \1A30 )",&sC___140 };
static COMMANDS sC___142 = {0,"RENAME",6,"\1A40 TO \1B40","FRename( \1A30, \1B30 )",&sC___141 };
@@ -384,7 +384,7 @@ void hb_pp_Table( void )
static COMMANDS sC___215 = {0,"AVERAGE",7,"\2 \1A00 \2, \1B00\3 TO \1C00 \2, \1D00\3 \3 \2FOR \1E00\3 \2WHILE \1F00\3 \2NEXT \1G00\3 \2RECORD \1H00\3 \2\1I20REST>\3 \2ALL\3",
"M->__Avg := \1C00 := \2 \1D00 := \3 0 ; DBEval( {|| M->__Avg := M->__Avg + 1, \1C00 := \1C00 + \1A00 \2, \1D00 := \1D00 + \1B00\3 }, \1E40, \1F40, \1G00, \1H00, \1I50 ) ; \1C00 := \1C00 / M->__Avg \2; \1D00 := \1D00 / M->__Avg \3",&sC___214 };
static COMMANDS sC___216 = {0,"LIST",4,"\2\1A10\3 \2\1B20OFF>\3 \2\1C20 TO PRINTER>\3 \2TO FILE \1D40\3 \2FOR \1E00\3 \2WHILE \1F00\3 \2NEXT \1G00\3 \2RECORD \1H00\3 \2\1I20REST>\3 \2ALL\3",
"__dbList( \1B50, { \1A40 }, .t., \1E40, \1F40, \1G00, \1H00, \1I50, \1C50, \1D30 )",&sC___215 };
"__dbList( \1B50, { \1A40 }, .T., \1E40, \1F40, \1G00, \1H00, \1I50, \1C50, \1D30 )",&sC___215 };
static COMMANDS sC___217 = {0,"DISPLAY",7,"\2\1A10\3 \2\1B20OFF>\3 \2\1C20 TO PRINTER>\3 \2TO FILE \1D40\3 \2FOR \1E00\3 \2WHILE \1F00\3 \2NEXT \1G00\3 \2RECORD \1H00\3 \2\1I20REST>\3 \2\1J20ALL>\3",
"__DBList( \1B50, { \1A40 }, \1J50, \1E40, \1F40, \1G00, \1H00, \1I50, \1C50, \1D30 )",&sC___216 };
static COMMANDS sC___218 = {0,"REPORT",6,"FORM \1A00 \2HEADING \1B00\3 \2\1C20 PLAIN>\3 \2\1D20 NOEJECT>\3 \2\1E20 SUMMARY>\3 \2\1F20 NOCONSOLE>\3 \2\1G20 TO PRINTER>\3 \2TO FILE \1H40\3 \2FOR \1I00\3 \2WHILE \1J00\3 \2NEXT \1K00\3 \2RECORD \1L00\3 \2\1M20REST>\3 \2ALL\3",
@@ -414,7 +414,7 @@ void hb_pp_Table( void )
"ordCondSet( \1D20, \1D40, \2\1E50\3, \1F40, \1J40, \1K00, RECNO(), \1G00, \1H00, \2\1I50\3, \2\1N50\3,, \2\1P50\3, \2\1O50\3, \2\1R50\3, \2\1S50\3, \1F20 ) ; ordCreate(\1C30, \1B30, \1A20, \1A40, \2\1L50\3 )",&sC___230 };
#endif
static COMMANDS sC___232 = {0,"INDEX",5,"ON \1A00 TO \1B40 \2\1C20 UNIQUE>\3",
"dbCreateIndex( \1B30, \1A20, \1A40, if( \1C50, .t., NIL ) )",&sC___231 };
"dbCreateIndex( \1B30, \1A20, \1A40, if( \1C50, .T., NIL ) )",&sC___231 };
static COMMANDS sC___233 = {0,"DELETE",6,"TAG \1A40 \2 IN \1B40 \3 \2, \1C40 \2 IN \1D40 \3 \3",
"ordDestroy( \1A30, \1B30 ) \2; ordDestroy( \1C30, \1D30 ) \3",&sC___232 };
static COMMANDS sC___234 = {0,"REINDEX",7,"\2EVAL \1A00\3 \2EVERY \1B00\3",

150
harbour/utils/hbpptest/pp_test.prg
View File

@@ -33,8 +33,11 @@ CCCC c
#define RED {255,0,0}
#ifdef __HARBOUR__
/* ---------------------------------------------------------------------*/
/* obligatory clause on left side used as optional clause on right side
* Clipper doesn't allow for it
*/
#xcommand SET COOLTIP TO <color> OF <form> => ;
SM( TTH (<"form">), 1, RGB(<color>[1], ;
SM( TTH (<"form">), 1, RGB(<color>\[1\], ;
<color>\[2\], ;
<color>[, <color>[ 3 ] ]), 0)
@@ -42,31 +45,50 @@ CCCC c
#endif
#xcommand SET TOOLTIP TO <color> OF <form> => ;
SM( TTH (<"form">), 1, RGB(<color>[1], ;
SM( TTH (<"form">), 1, RGB(<color>\[1\], ;
<color>\[2\], ;
<color>\[ 3 \]), 0)
SET TOOLTIP TO RED OF form1
/* ---------------------------------------------------------------------*/
/* simple optional clause */
#command ZZZ [<v>] => QOUT( [ <v>\[1\] ] )
ZZZ a
ZZZ
ZZZ a[1]+2
ZZZ 1
ZZZ 'z'
ZZZ "z"
#translate TZZZ [<v>] => QOUT( [ <v>\[1\] ] )
TZZZ a
TZZZ
TZZZ a[1]+2
TZZZ 1
TZZZ 'z'
TZZZ "z"
/* ---------------------------------------------------------------------*/
#xtranslate _HMG_a => _HMG\[137\]
? _bro[ a( _HMG_a [i] ) ]
/* ---------------------------------------------------------------------*/
#ifdef __HARBOUR__
#define clas( x ) (x)
#ifdef __HARBOUR__
/* <!name!> is harbour extension match marker used to allow identifiers
* only
*/
#xtranslate ( <!name!>{ [<p,...>] } => (<name>():New(<p>)
a :=clas( TesT{ 1,2,3} )
a :=clas( a+3{ 11,2,3} )
a :=clas( a(){ 11,2,3} )
#endif
#define clas( x ) (x)
#xtranslate ( <name>{ [<p,...>] } => (<name>():New(<p>)
a :=clas( TEST{ 1,2,3} )
a :=clas( a+3{ 11,2,3} )
a :=clas( a(){ 11,2,3} )
/* ---------------------------------------------------------------------*/
#define DATENEW 1
@@ -76,6 +98,7 @@ CCCC c
? datediff( x, y )
/* ---------------------------------------------------------------------*/
/* test for regular match marker */
#command _REGULAR_(<z>) => rm( <z> )
_REGULAR_(a)
_REGULAR_("a")
@@ -90,6 +113,7 @@ CCCC c
_REGULAR_("['']")
//NORMAL
/* test for normal match marker */
#command _NORMAL_M(<z>) => nm( <"z"> )
_NORMAL_M(a)
_NORMAL_M("a")
@@ -104,6 +128,7 @@ CCCC c
_NORMAL_M("['']")
//SMART
/* test for smart match marker */
#command _SMART_M(<z>) => sm( <(z)> )
_SMART_M(a)
_SMART_M("a")
@@ -118,6 +143,7 @@ CCCC c
_SMART_M("['']")
//DUMB
/* test for dumb match marker */
#command _DUMB_M(<z>) => dm( #<z> )
_DUMB_M(a)
_DUMB_M("a")
@@ -133,30 +159,34 @@ CCCC c
/* ---------------------------------------------------------------------*/
// REGULAR list
/* test for regular match marker */
#command _REGULAR_L(<z,...>) => rl( <z> )
_REGULAR_L(a,"a",'a',["'a'"],"['a']",'["a"]',&a.1,&a,&a.,&a. ,&(a),&a[1],&a.[1],&a. [2],&a&a, &a.a, a, a)
// NORMAL list
/* test for normal match marker */
#command _NORMAL_L(<z,...>) => nl( <"z"> )
_NORMAL_L(n,"n",'a',["'a'"],"['a']",'["a"]',&a.1,&a,&a.,&a. ,&(a),&a[1],&a.[1],&a. [2],&a&a, &.a, &a.a, a, a)
// SMART list
/* test for smart match marker */
#command _SMART_L(<z,...>) => sl( <(z)> )
_SMART_L(a,"a",'a',["'a'"],"['a']",'["a"]',&a.1,&a,&a.,&a. ,&(a),&a[1],&a.[1],&a. [2],&a&a, &.a, &a.a, a, a)
// DUMB list
/* test for dumb match marker */
#command _DUMB_L(<z,...>) => dl( #<z> )
_DUMB_L(a,"a",'a',["'a'"],"['a']",'["a"]',&a.1,&a,&a.,&a. ,&(a),&a[1],&a.[1],&a. [2],&a&a, &.a, &a.a, a, a)
/* ---------------------------------------------------------------------*/
index on LEFT( f1 , 10 ) to _tst
/* ---------------------------------------------------------------------*/
#xcommand SET <var1> [, <varN>] WITH <val> => <var1>:=<val>[; <varN>:=<val>]
SET v1, v2, v3 WITH 0
/* test of preserving spaces in expressions */
/* Notice that Clipper and Harbour doesn't remove spaces from
* expressions passed for stingify
*/
index on LEFT( f1 , 10 ) to _tst
/* ---------------------------------------------------------------------*/
/* repeated optinal clauses */
#xcommand INSERT INTO <table> ( <uField1> [, <uFieldN> ] ) VALUES ( <uVal1>
[, <uValN> ] ) => ;
if <table>->( dbappend() ) ;;
@@ -179,6 +209,7 @@ endif
values ( "first", "last", "street" )
/* ---------------------------------------------------------------------*/
/* test for case sensitivity in define */
#define F1( n ) F2( n, N )
F1( 1 )
@@ -186,6 +217,7 @@ endif
F3( 1, 2 )
/* ---------------------------------------------------------------------*/
/* test for different order of optional clauses */
#command MYCOMMAND [<mylist,...>] [MYCLAUSE <myval>] => ;
MyFunction( {<mylist>} [, <myval>] )
MYCOMMAND MYCLAUSE 321 "HELLO"
@@ -193,37 +225,40 @@ endif
MYCOMMAND "HELLO","all" MYCLAUSE 321
#command MYCOMMAND2 [<mylist,...>] [MYCLAUSE <myval>] [ALL] => ;
MyFunction( {<mylist>} [, <myval>] )
MyFunction2( {<mylist>} [, <myval>] )
MYCOMMAND2 MYCLAUSE 321 "HELLO"
MYCOMMAND2 MYCLAUSE 321 "HELLO" ALL
MYCOMMAND2 ALL MYCLAUSE 321 "HELLO"
MYCOMMAND2 MYCLAUSE 321 "HELLO" ALL
MYCOMMAND2 MYCLAUSE 321 ALL "HELLO"
/*
in := 'MYCOMMAND3 ALL MYCLAUSE 321 "HELLO","WORLD"'
in := 'MYCOMMAND3 MYCLAUSE 321 ALL "HELLO"'
in := 'MYCOMMAND3 MYCLAUSE 321 "HELLO" ALL'
in := 'MYCOMMAND3 MYCLAUSE 321 "HELLO"'
*/
#xcommand MYCOMMAND3 [<myList,...>] ;
[MYCLAUSE <myVal>] [MYOTHER <myOther>] => MyFunction3( {<myList>}, <myVal>, <myOther> )
#xcommand MYCOMMAND4 [<myList,...>] ;
[MYCLAUSE <myVal>] [MYOTHER <myOther>] => MyFunction4( {<myList>}, <myVal>, <myOther> )
MYCOMMAND3 MYCLAUSE 322 "Hello" MYOTHER 1
MYCOMMAND3 MYOTHER 1 MYCLAUSE 322 "Hello"
MYCOMMAND3 "Hello" MYOTHER 1 MYCLAUSE 322
MYCOMMAND3 MYOTHER 1 "Hello" MYCLAUSE 322
/* ---------------------------------------------------------------------*/
/* Special restricted macro match marker (used in SET FILTER TO command */
/* <x:&> is matched when &variable or &(expression) are used
*/
SET FILTER TO &cVar.
SET FILTER TO &(cVar .AND. &cVar)
SET FILTER TO &cVar. .AND. cVar
/* ---------------------------------------------------------------------*/
#xtranslate XTRANS(<x>( => normal( <(x)> )
#xtranslate XTRANS(<x:&>( => macro( <(x)> )
#xtranslate XTRANS(<x>( => normal_match( <(x)> )
#xtranslate XTRANS(<x:&>( => macro_match( <(x)> )
XTRANS( cVar (
XTRANS( &cVar (
XTRANS( &cVar+1 (
XTRANS( &cVar. (
XTRANS( &cVar&cVar (
XTRANS( &cVar.&cVar (
XTRANS( &cVar.&cVar. (
XTRANS( (&cVar.) (
XTRANS( &(cVar) (
XTRANS( &cVar[3] (
@@ -334,7 +369,7 @@ endif
MCOMMAND &cVar.&(cVar)
/* ---------------------------------------------------------------------*/
/* repeated optional clauses */
/* repeated optional clauses */
#xcommand SET <var1> [, <varN>] WITH <val> => <var1>:=<val> [; <varN>:=<val>]
SET v1 WITH 0
SET v1, v2 WITH 0
@@ -467,5 +502,76 @@ DEFINE CLIPBOARD oC OF oD FORMAT TEXT
DEFINE WINDOW &oW ON INIT oW.Title:= "My title"
&oW.Title := "title"
&oW.f9 := 9
/* statndard Clipper commands */
RELEASE ALL
RELEASE ALL LIKE A
RELEASE ALL EXCEPT A
SAVE ALL LIKE A TO A
SAVE TO A ALL LIKE A
SAVE TO A ALL
SAVE ALL EXCEPT A TO A
SAVE TO A ALL EXCEPT A
LIST
LIST TO PRINTER
LIST TO FILE a
LIST OFF
LIST OFF TO PRINTER
LIST OFF TO FILE a
LIST a
LIST a,b
LIST a,b,(seek(a+b),c)
LIST a TO PRINTER
LIST a TO FILE a
LIST a,b TO PRINTER
LIST a,b,(seek(a+b),c) TO FILE a
LIST a OFF TO PRINTER
LIST a OFF TO FILE a
LIST a,b OFF TO PRINTER
LIST a,b,(seek(a+b),c) OFF TO FILE a
LIST a TO PRINTER OFF
LIST a TO FILE a OFF
LIST a,b TO PRINTER OFF
LIST a,b,(seek(a+b),c) TO FILE a OFF
LIST TO PRINTER a,b,c
LIST TO FILE a a,b,c
LIST REST
LIST REST TO PRINTER
LIST REST TO FILE a
LIST REST OFF
LIST OFF REST
LIST REST ALL
LIST ALL
LIST ALL REST
LIST ALL OFF
LIST ALL TO PRINTER
LIST ALL ALL
LIST REST REST
LIST OFF OFF
LIST ALL ALL TO PRINTER
LIST REST REST TO PRINTER
LIST OFF OFF TO PRINTER
LIST (ALL) ALL
LIST (REST) REST
LIST (OFF) OFF
LIST ALL+ALL
LIST REST+REST
LIST OFF+OFF
LIST ALL+ALL ALL
LIST REST+REST REST
LIST OFF+OFF OFF
LIST ALL+ALL REST
LIST REST+REST OFF
LIST OFF+OFF ALL
RETURN