json basic scripting language [update 7/18]

[AGS]

What about a grammar, rollie? You are creating a language and I'd
like to see what it looks like. Reading your source code I can find out
what language it is you are implementing (jsb_context tells tales).
But a grammar could tell me what a .jsb file is all about a lot faster.

A grammar for the json basic scripting language could look
something like this (it's far from complete)

Code: Select all

''Lexical grammar
''single character tokens
AMPERSAND ::= '&'
ASSIGN ::= '='
CARET ::= '^'
COLON ::= ':'
COMMA ::= ','
DIVIDE ::= '/'
DOT ::= '.'
DQUOTE ::= '"'
FSLASH ::= '\'
GT ::= '>'
LBRACK ::= '['
LCURLY ::= '{'
LPAREN ::= '('
LT ::= '<'
MINUS ::= '-'
MUL ::= '*'
PLUS ::= '+'
RBRACK ::= ']'
RCURLY ::= '}'
RPAREN ::= ')'
SEMI ::= ';'
SQUOTE ::= "'"
UNDERSCORE ::= '_'

''ranges of single character tokens
LOWER ::= 'a'
''many lines LOWER ::= 'b' UPPER ::= 'c' etc...
UPPER ::= 'A'
''many lines UPPER ::= 'B' UPPER ::= 'C' etc...

DIGIT ::= '0'
DIGIT ::= '1'
DIGIT ::= '2'
DIGIT ::= '3'
DIGIT ::= '4'
DIGIT ::= '5'
DIGIT ::= '6'
DIGIT ::= '7'
DIGIT ::= '8'
DIGIT ::= '9'

IDENTIFIER ::= UNDERSCORE IDENTIFIER1
IDENTIFIER ::= UPPER
IDENTIFIER ::= LOWER
IDENTIFIER ::= UPPER IDENTIFIER1
IDENTIFIER ::= LOWER IDENTIFIER1

IDENTIFIER1 ::= UPPER
IDENTIFIER! ::= LOWER
IDENTIFIER1 ::= DIGIT
IDENTIFIER1 ::= UNDERSCORE
IDENTIFIER1 ::= UPPER IDENTIFIER1
IDENTIFIER1 ::= LOWER IDENTIFIER1
IDENTIFIER1 ::= DIGIT IDENTIFIER1
IDENTIFIER1 ::= UNDERSCORE IDENTIFIER1

NUMBER ::= DIGIT
NUMBER ::= DIGIT NUMBER

''string definition
STRING ::= DQUOTE STRING_CHARS DQUOTE

STRING_CHARS ::= CHAR
STRING_CHARS ::= CHAR STRING_CHARS

''CHAR definition
CHAR ::= ESCAPED
CHAR ::= UNDERSCORE
CHAR ::= DIGIT
CHAR ::= UPPER
CHAR ::= LOWER

ESCAPED ::= FSLASH ESCAPED_CHARS

ESCAPED_CHARS ::= FSLASH
ESCAPED_CHARS ::= DIGIT
ESCAPED_CHARS ::= UPPER
ESCAPED_CHARS ::= LOWER
''many more alternatives



''combinations of assign and some other operator (many more entries needed)
ASSIGN_OP ::= '+='
ASSING_OP ::= '-='

''keywords
VAR ::= 'var'
FOR ::= 'for'
TO ::= 'to'
WHILE ::= 'while'

''context free(ish) grammar
program ::= statement_list

statement_list ::= statement
statement_list ::= statement_list statement

statement ::= expression
statement ::= declaration
statement ::= if_statement
statement ::= for_statement
statement ::= compound_statement
statement ::= while_statement

expression ::= expression COMMA expression
expression ::= expression ASSIGN expression
expression ::= expression PLUS expression
expression ::= expression MINUS expression
expression ::= expression MUL expression
expression ::= expression CARET expression
expression ::= expression DIVIDE expression
expression ::= expression LT expression
expression ::= expression GT expression
expression ::= expression LT ASSIGN expression
expression ::= expression GT ASSIGN expression
expression ::= expression LCURLY expression RCURLY
expression ::= expression LBRACK expression RBRACK
expression ::= expression LPAREN expression RPAREN
expression ::= expression ASSIGN_OP expression
expression ::= expression COLON expression
expression ::= expression LT expression
expression ::= expression GT expression
expression ::= expression LT GT expression
expression ::= expression AMPERSAND expression
expression ::= expression DOT expression
expression ::= PLUS expression
expression ::= MINUS expression
expression ::= NUMBER
expression ::= STRING
expression ::= IDENTIFIER

declaration ::= VAR IDENTIFIER ASSIGN expression SEMI
declaration ::= VAR IDENTIFIER SEMI

if_statement ::= IF expression statement
if_statement ::= IF expression statement ELSE statement

compound_statement ::= LCURLY statement RCURLY SEMI
for_statement ::= FOR IDENTIFIER ASSIGN expression TO expression statement
while_statement ::= WHILE expression statement



More productions and terminals are needed (lots more binary operators) to somewhat
complete the grammar.

I am not sure whether { statement }; is allowed at the top level.

Code: Select all

x = 55;
{
  var a = 4;
  var b = a + 8;
};


The above would introduce a scope outside the context of an if, while, for etc....
(same as scope... end scope in FB).

As json basic scripting uses the JSON format it could be worthwhile for users to
read the JSON grammar
http://tools.ietf.org/html/rfc7159

It is very nice to see a project dedicated to writing an interpreter in FreeBASIC.
I would not mind at all if there would be lots more projects dedicated to
writing an interpreter in FB.

As an aside (or a PS): having read your source code I am guessing that there is
room for improvement of the performance of the interpreter.

[rolliebollocks]

Thanks for taking a look. There is much room for improvement. Currently there is a problem with arrays that I am working with and it effects the utility of the language quite a bit.

As an example lets say you have

var Array = [1,2,3,[4,5,[6,7],8,9],10]

Array[3][0] is not currently parsable. However you can do this:

var Array2 = Array[3]

Array2[0] = 4

Likewise, objects in arrays must be copied. That sucks. And I cannot move forward without fixing it. And a couple of other things that aren't quite right. I may have to rewrite the part of the parser which handles variables entirely.

The other scripting language I wrote was must easier to deal with but had fewer features so I wanted to write a better one that I could use in multiple projects.

A grammar would be good, but until the parser works properly, I can't move forward with anything else, but I do plan on implementing dynamic scoping. I'm still working on it.

Thanks though.

[EDIT]

As of now I have the arrays and objects functioning properly. I need to do more tests on how well this works.

But something like

arr[1].somekey[0][1].anotherkey actually parser properly ( I think ). Or, if you like:

arr[1]["somekey"][0][1]["anotherkey"] also works

Also, it's worth noting that I'm bungling my way through this by trial and error. So this is maybe the third time I've had to rewrite major parts of the parser.

[jcfuller]

I have not investigated your code but was wondering if your json approach to an interpreter would work on the creation of a translator from basic syntax to c++

James

[rolliebollocks]

If I'm not mistaken FB has a C emitter. I don't think that a JSON approach would make a C translator any more or less effective. I don't know. I suppose it would allow you to handle variables easier, but I'm not certain they would be as effective or fast as either FreeBASIC or C's native types. Not only that, but since JSON objects are basically one size fits all they would be more memory greedy and slower. JSON/JS has no native integer type, and is basically composed of two pointers (for arrays and objects), a double, a bool (which in this case is an integer), an FB string, etc.. It seems implausible this would be a good angle to take for such a project.

I would think it would be #1: Very difficult since BASIC is among the most difficult languages to parse, and #2: A waste of time since FB benchmarks are comparable to C++ in speed.

Either way, I wouldn't have the know how or inclination to learn how, to work on a project like that.

[rolliebollocks]

Here are some examples of things that didn't work before but now do since I rewrote the parser.

Dereferencing an object stored inside an array:

Code: Select all

var obj = {
   "txt": "word",
   "def": "something like this"
};

var obj2 = obj;

print( obj2.def );

var arr = [];

arr.push_back( obj );
arr.push_back( obj2 );

print( arr[0]["txt"] );

Dereferencing with Assignment & Concatenation of Strings (which was totally screwed up too)

Code: Select all

var obj1 = {
   "this": "this",
   "that": "that"
};

var obj2 = {
   "this": "this2",
   "that": "that2"
};

var arr = [];

arr.push_back( obj1 );
arr.push_back( obj2 );

print( arr[0].this );
print( arr[1].that );
print( arr[0]["this"] );

sleep;
cls;

arr[0].this = "THIS!" + "THAT?";
print( arr[0].this );



Dereferncing an array within an array with assignment

Code: Select all

var arr = [0,[1,2],10,20,30];
arr[1][0] = 12+12;

print( arr[1][0] );

Dereferencing an array within an array with an ambiguous function call properly returning the expected data:

Code: Select all

var arr = [["one","two"],["three","four"]];
arr[0].push_back( "millions" );

print( arr[0][2].left( 3 ) );
print( arr[0][2].right( 3 ) );
print( arr[0][2].mid( 3, 3 ) );
print( arr[0][2].slice( 3, 6 ) );


Something that really sucks to try and parse correctly:

Code: Select all

var arr = [["one","two"],["three","four"]];
arr[0].push_back( "millions" );

var s = arr[0][0] + arr[0][1] + arr[0][2];
print( s );

I had to make sure this still was parsing properly:

Code: Select all

var arr = [["one","two"],["three","four"]];
arr[0].push_back( "millions" );

var s = arr[0][0];
s += arr[1][0];
print( s );

[AGS]

You might need a test suite real soon. Regression testing while writing a piece of software
like an interpreter is a must-have.

Perhaps a very rigid approach to testing might help: create a test suite with enough
test cases so that executing the test suite will execute every functions at least once.
Then expand the test suite with test cases so every statement gets executed at least once.
Expand the test suite again with test cases so every branch is taken at least once. At
this point the number of test cases should be quite large.

And using a grammar you could add test cases for every possible grammatical
construct ranging from the bare minimum (a = 0;) to the 'obscure'.

I'm not saying I want to help out with setting up a test suite (but I'm also not
saying I do not want to). It can help if the programmer doing the programming and the person
doing tests are not one and the same person (of course you test your own software and
'independent' testing is always a good thing).

As a silly aside: at https://github.com/drh/lcc/tree/master/src you can find the code
for a handwritten C parser. It can parse expressions similar to the kind your interpreter has to
parse. It can produce bytecode which hints at the possibility of interpreting C code :) (don't
know if LCC can do that though).

And the return code at the end of function opCompare (jsb_parser_new.bas)

Code: Select all

    return -666


is sooo funny :)

[rolliebollocks]

A test suite is a great idea. I'm going to need to implement comments properly soon as well. Updates to the parser have made the current system useless.

I need to add dynamic scoping. That will be slightly more work than I anticipated.

I need to add self-parsing functions. That will be a bit of work but not complex.

I fixed the problem with arr[i]+=1. Check out jsb_parser.bas (the one posted to the boards, haven't updated ZIP on sourceforge yet. But if you copy and paste jsb_parser.bas in jsb's root directory, it should compile properly. Likewise there was a phantom error with select that is also now fixed.

And using a grammar you could add test cases for every possible grammatical
construct ranging from the bare minimum (a = 0;) to the 'obscure'.

This sounds ideal. I may need to do some research on setting it up. But on the other hand it could make error trapping more effective. I'll look into this later to day..

I'm not saying I want to help out with setting up a test suite (but I'm also not
saying I do not want to).

I see.. (no I don't.) I'll do a bit of research on setting up a grammar and see if I can streamline this process. I think I have some idea of what this is all about from your example. I should mention, I haven't stress tested JSB at all. All tests were done on ideal/proper conditions. Obviously, segfaulting, an array out of bounds, null pointer, illegal function calls etc.. Anything that would cause FB to abruptly stop running must be caught. Obviously, any help you can offer would be graciously appreciated.

I still want to implement macros too. But I really need to play with the language a little more in order to see what needs to be added or fiddled.

I actually need to still implement opCompare. It hasn't been a major priority. JSB renders all math operations left to right, but the innermost nested parentheticals are executed first.

I'll also look into producing byte code, though it may be a little over my head at the moment. Anyway, thanks for the suggestions!

[AGS]

I have used cutest in the past for creation of a test suite.
http://cutest.sourceforge.net/


It consists of two small. I translated the entire code of cutest to FreeBASIC

cutest.bi

Code: Select all

#IFNDEF CU_TEST_H
#DEFINE CU_TEST_H

#ifndef NULL
#define NULL 0
#endif

#ifdef __FB_UNIX__
  #define NEWLINE !"\r"
#else
  #define NEWLINE !"\r\n"
#endif


' #include <setjmp.h>
#INCLUDE ONCE "crt/setjmp.bi" '__HEADERS__: setjmp.h

' #include <stdarg.h>
#INCLUDE ONCE "crt/stdarg.bi" '__HEADERS__: stdarg.h

#DEFINE CUTEST_VERSION !"CuTest 1.5"

/' CuString '/
DECLARE FUNCTION CuStrAlloc ( _
   BYVAL size AS INTEGER) AS ZSTRING PTR

DECLARE FUNCTION CuStrCopy ( _
   BYVAL old AS CONST ZSTRING PTR) AS ZSTRING PTR

#DEFINE CU_ALLOC(TYPE_) (cast(TYPE_ ptr,malloc(SIZEOF(TYPE_))))

#DEFINE HUGE_STRING_LEN 8192

#DEFINE STRING_MAX 256

#DEFINE STRING_INC 256

TYPE CuString
   AS INTEGER length
   AS INTEGER size
   AS ZSTRING PTR buffer
END TYPE

DECLARE SUB CuStringInit ( _
   BYVAL str_TJF AS CuString PTR)

DECLARE FUNCTION CuStringNew () AS CuString PTR

DECLARE SUB CuStringRead ( _
   BYVAL str_TJF AS CuString PTR, _
   BYVAL path AS CONST ZSTRING PTR)

DECLARE SUB CuStringAppend ( _
   BYREF str_TJF AS CuString PTR, _
   BYVAL text AS CONST ZSTRING PTR)

DECLARE SUB CuStringAppendChar ( _
   BYVAL str_TJF AS CuString PTR, _
   BYVAL ch AS UBYTE)

DECLARE SUB CuStringInsert ( _
   BYVAL str_TJF AS CuString PTR, _
   BYVAL text AS CONST ZSTRING PTR, _
   BYVAL pos_TJF AS INTEGER)

DECLARE SUB CuStringResize ( _
   BYREF str_TJF AS CuString PTR, _
   BYVAL newSize AS INTEGER)

DECLARE SUB CuStringDelete ( _
   byref str_TJF AS CuString PTR)

TYPE CuTest_ as CuTest

TYPE TestFunction AS SUB (BYVAL _TJF AS CuTest_ PTR)

/' CuTest '/
TYPE CuTest
   AS ZSTRING PTR name
   AS TestFunction function
   AS INTEGER failed
   AS INTEGER ran
   AS CONST ZSTRING PTR message
   AS jmp_buf PTR jumpBuf
END TYPE

DECLARE SUB CuTestInit ( _
   BYVAL t AS CuTest PTR, _
   BYVAL name_TJF AS CONST ZSTRING PTR, _
   BYVAL function_TJF AS TestFunction)

DECLARE FUNCTION CuTestNew ( _
   BYVAL name_TJF AS CONST ZSTRING PTR, _
   BYVAL function_TJF AS TestFunction) AS CuTest PTR

DECLARE SUB CuTestRun ( _
   BYVAL tc AS CuTest PTR)

DECLARE SUB CuTestDelete ( _
   BYREF t AS CuTest PTR)

/' Internal versions of assert functions -- use the public versions '/
DECLARE SUB CuFail_Line ( _
   BYVAL tc AS CuTest PTR, _
   BYVAL file AS CONST ZSTRING PTR, _
   BYVAL line_TJF AS INTEGER, _
   BYVAL message2 AS CONST ZSTRING PTR, _
   BYVAL message AS CONST ZSTRING PTR)

DECLARE SUB CuAssert_Line ( _
   BYVAL tc AS CuTest PTR, _
   BYVAL file AS CONST ZSTRING PTR, _
   BYVAL line_TJF AS INTEGER, _
   BYVAL message AS CONST ZSTRING PTR, _
   BYVAL condition AS INTEGER)

DECLARE SUB CuAssertStrEquals_LineMsg ( _
   BYVAL tc AS CuTest PTR, _
   BYVAL file AS CONST ZSTRING PTR, _
   BYVAL line_TJF AS INTEGER, _
   BYVAL message AS CONST ZSTRING PTR, _
   BYVAL expected AS CONST ZSTRING PTR, _
   BYVAL actual AS CONST ZSTRING PTR)

DECLARE SUB CuAssertIntEquals_LineMsg ( _
   BYVAL tc AS CuTest PTR, _
   BYVAL file AS CONST ZSTRING PTR, _
   BYVAL line_TJF AS INTEGER, _
   BYVAL message AS CONST ZSTRING PTR, _
   BYVAL expected AS INTEGER, _
   BYVAL actual AS INTEGER)

DECLARE SUB CuAssertDblEquals_LineMsg ( _
   BYVAL tc AS CuTest PTR, _
   BYVAL file AS CONST ZSTRING PTR, _
   BYVAL line_TJF AS INTEGER, _
   BYVAL message AS CONST ZSTRING PTR, _
   BYVAL expected AS DOUBLE, _
   BYVAL actual AS DOUBLE, _
   BYVAL delta AS DOUBLE)

DECLARE SUB CuAssertPtrEquals_LineMsg ( _
   BYVAL tc AS CuTest PTR, _
   BYVAL file AS CONST ZSTRING PTR, _
   BYVAL line_TJF AS INTEGER, _
   BYVAL message AS CONST ZSTRING PTR, _
   BYVAL expected AS ANY PTR, _
   BYVAL actual AS ANY PTR)

/' public assert functions '/
#DEFINE CuFail(tc, ms) CuFail_Line( (tc), __FILE__, __LINE__, NULL, (ms))

#DEFINE CuAssert(tc, ms, cond) CuAssert_Line((tc), __FILE__, __LINE__, (ms), (cond))

#DEFINE CuAssertTrue(tc, cond) CuAssert_Line((tc), __FILE__, __LINE__, !"assert failed", (cond))

#DEFINE CuAssertStrEquals(tc,ex,ac) CuAssertStrEquals_LineMsg((tc),__FILE__,__LINE__,NULL,(ex),(ac))

#DEFINE CuAssertStrEquals_Msg(tc,ms,ex,ac) CuAssertStrEquals_LineMsg((tc),__FILE__,__LINE__,(ms),(ex),(ac))

#DEFINE CuAssertIntEquals(tc,ex,ac) CuAssertIntEquals_LineMsg((tc),__FILE__,__LINE__,NULL,(ex),(ac))

#DEFINE CuAssertIntEquals_Msg(tc,ms,ex,ac) CuAssertIntEquals_LineMsg((tc),__FILE__,__LINE__,(ms),(ex),(ac))

#DEFINE CuAssertDblEquals(tc,ex,ac,dl) CuAssertDblEquals_LineMsg((tc),__FILE__,__LINE__,NULL,(ex),(ac),(dl))

#DEFINE CuAssertDblEquals_Msg(tc,ms,ex,ac,dl) CuAssertDblEquals_LineMsg((tc),__FILE__,__LINE__,(ms),(ex),(ac),(dl))

#DEFINE CuAssertPtrEquals(tc,ex,ac) CuAssertPtrEquals_LineMsg((tc),__FILE__,__LINE__,NULL,(ex),(ac))

#DEFINE CuAssertPtrEquals_Msg(tc,ms,ex,ac) CuAssertPtrEquals_LineMsg((tc),__FILE__,__LINE__,(ms),(ex),(ac))

#DEFINE CuAssertPtrNotNull(tc,p) CuAssert_Line((tc),__FILE__,__LINE__,!"null pointer unexpected",(p <> NULL))

#DEFINE CuAssertPtrNotNullMsg(tc,msg,p) CuAssert_Line((tc),__FILE__,__LINE__,(msg),(p <> NULL))

/' CuSuite '/
#DEFINE MAX_TEST_CASES 1024

#DEFINE SUITE_ADD_TEST(SUITE,TEST) CuSuiteAdd(SUITE, CuTestNew(#TEST, TEST))

TYPE CuSuite
   AS INTEGER count
   AS CuTest PTR list(0 TO MAX_TEST_CASES-1)
   AS INTEGER failCount
END TYPE

DECLARE SUB CuSuiteInit ( _
   BYVAL testSuite AS CuSuite PTR)

DECLARE FUNCTION CuSuiteNew () AS CuSuite PTR

DECLARE SUB CuSuiteDelete ( _
   BYREF testSuite AS CuSuite PTR)

DECLARE SUB CuSuiteAdd ( _
   BYVAL testSuite AS CuSuite PTR, _
   BYVAL testCase AS CuTest PTR)

DECLARE SUB CuSuiteAddSuite ( _
   BYVAL testSuite AS CuSuite PTR, _
   BYVAL testSuite2 AS CuSuite PTR)

DECLARE SUB CuSuiteRun ( _
   BYVAL testSuite AS CuSuite PTR)

DECLARE SUB CuSuiteSummary ( _
   BYVAL testSuite AS CuSuite PTR, _
   BYVAL summary AS CuString PTR)

DECLARE SUB CuSuiteDetails ( _
   BYVAL testSuite AS CuSuite PTR, _
   BYVAL details AS CuString PTR)
/' CU_TEST_H '/
#ENDIF ' CU_TEST_H


cutest.bas

Code: Select all

#include "crt/setjmp.bi"
#include "crt/stdlib.bi"
#include "crt/stdio.bi"
#include "crt/string.bi"
#include "crt/math.bi"

#include "CuTest.bi"

/'-------------------------------------------------------------------------*
 * CuStr
 *-------------------------------------------------------------------------'/

function CuStrAlloc(byval size as integer) as zstring ptr

   dim newStr as zstring ptr = cast(zstring ptr,malloc( sizeof(zstring) * (size) ))
   return newStr

end function

function CuStrCopy(byval old as const zstring ptr) as zstring ptr

   
  dim len_ as integer = len(*old)
   dim newStr as zstring ptr = CuStrAlloc(len_ + 1)
   strcpy(newStr, cast(any ptr,strptr(*old)))
   return newStr

end function

/'-------------------------------------------------------------------------*
 * CuString
 *-------------------------------------------------------------------------'/

sub CuStringInit(byval str_ as CuString ptr)

   str_->length = 0
   str_->size = STRING_MAX
   str_->buffer = cast(zstring ptr,malloc(sizeof(zstring) * str_->size))
   str_->buffer[0] = asc(!"\0")

end sub

function CuStringNew() as CuString ptr

   dim str_ as CuString ptr = cast(CuString ptr,malloc(sizeof(CuString)))
   str_->length = 0
   str_->size = STRING_MAX
   str_->buffer = cast(zstring ptr,malloc(sizeof(zstring) * str_->size))
   str_->buffer[0] = asc(!"\0")
   return str_

end function

sub CuStringDelete(byref str_ as CuString ptr)

        if (str_ = 0) then return
        free(str_->buffer)
        free(str_)

end sub

sub CuStringResize(byref str_ as CuString ptr, byval newSize as integer)

   str_->buffer = cast(zstring ptr,realloc(str_->buffer, sizeof(zstring) * newSize))
   str_->size = newSize

end sub

sub CuStringAppend(byref str_ as CuString ptr, byval text as const zstring ptr)

   dim length as integer

   if (text = 0) then
      text = @"NULL"
   end if

   length = len(*text)
   if (str_->length + length + 1 >= str_->size) then
      CustringResize(str_, str_->length + length + 1 + STRING_INC)
  end if
   str_->length += length
   strcat(str_->buffer, cast(any ptr,text))

end sub

sub CustringAppendChar(byval str_ as Custring ptr, byval ch as ubyte)

   dim text as zstring * 2
   text[0] = ch
   text[1] = asc(!"\0")
   CustringAppend(str_, text)

end sub

sub CuStringInsert(byval str_ as CuString ptr, byval text as const zstring ptr, byval pos_ as integer)

   var length = len(*text)
   if (pos_ > str_->length) then
      pos_ = str_->length
  end if
   if (str_->length + length + 1 >= str_->size) then
      CustringResize(str_, str_->length + length + 1 + STRING_INC)
  end if
   memmove(str_->buffer + pos_ + length, str_->buffer + pos_, (str_->length - pos_) + 1)
   str_->length += length
   memcpy(str_->buffer + pos_, cast(any ptr,text), length)
end sub

/'-------------------------------------------------------------------------*
 * CuTest
 *-------------------------------------------------------------------------'/

sub CuTestInit(byval t as CuTest ptr, byval name_ as const zstring ptr, byval function_ as TestFunction)

   t->name = CuStrCopy(name_)
   t->failed = 0
   t->ran = 0
   t->message = NULL
   t->function = function_
   t->jumpBuf = NULL

end sub

function CuTestNew(byval name_ as const zstring ptr, byval function_ as TestFunction) as CuTest ptr

   dim tc as CuTest ptr = CU_ALLOC(CuTest)
   CuTestInit(tc, name_, function_)
   return tc

end function

sub CuTestDelete(byref t as CuTest ptr)

        if (t = 0) then return
        free(t->name)
        free(t)

end sub

sub CuTestRun(byval tc as CuTest ptr)

   dim buf as jmp_buf
   tc->jumpBuf = @buf
   var retval = setjmp(buf)
  if (retval = 0) then   
      tc->ran = 1
      (tc->function)(tc)
   end if
   tc->jumpBuf = 0

end sub

sub CuFailInternal(byval tc as CuTest ptr, byval file_ as const zstring ptr, _
                   byval line_ as integer, byval string_ as CuString ptr)

   dim buf(0 to HUGE_STRING_LEN) as ubyte

   sprintf(@buf(0), "%s:%d: ", file_, line_)
   CuStringInsert(string_, @buf(0), 0)

   tc->failed = 1
   tc->message = string_->buffer
   if (tc->jumpBuf <> 0) then longjmp(*(tc->jumpBuf), 0)

end sub

sub CuFail_Line(byval tc as CuTest ptr, byval file_ as const zstring ptr, _
                byval line_ as integer, byval message2 as const zstring ptr,_
                byval message as const zstring ptr)

   dim string_ as CuString

   CuStringInit(@string_)
   if (message2 <> NULL)  then   
      CuStringAppend(@string_, message2)
      CuStringAppend(@string_, @": ")
   end if
   CuStringAppend(@string_, message)
   CuFailInternal(tc, file_, line_, @string_)

end sub

sub CuAssert_Line(byval tc as CuTest ptr, byval file_ as const zstring ptr, _
                   byval line_ as integer, byval message as const zstring ptr, _
                   byval condition as integer)

   if (condition) then return
   CuFail_Line(tc, file_, line_, NULL, message)
 
end sub

sub CuAssertStrEquals_LineMsg(byval tc as CuTest ptr, byval file_ as const zstring ptr,_
                              byval line_ as integer, byval message as const zstring ptr,_
                              byval expected as const zstring ptr, _
                              byval actual as const zstring ptr)

   dim string_ as CuString
   
  if ((expected = NULL andalso actual = NULL) orelse _
       (expected <> NULL andalso actual <> NULL andalso _
       strcmp(cast(any ptr,expected), cast(any ptr,actual)) = 0)) then   
      return
   end if

   CuStringInit(@string_)
   if (message <> NULL) then   
      CuStringAppend(@string_, message)
      CuStringAppend(@string_, @": ")
   end if
   CuStringAppend(@string_, @"expected <")
   CuStringAppend(@string_, expected)
   CuStringAppend(@string_, @"> but was <")
   CuStringAppend(@string_, actual)
   CuStringAppend(@string_, @">")
   CuFailInternal(tc, file_, line_, @string_)

end sub

sub CuAssertIntEquals_LineMsg(byval tc as CuTest ptr, byval file_ as const zstring ptr,_
                              byval line_ as integer, byval message as const zstring ptr,_
                              byval expected as integer, _
                              byval actual as integer)

   dim buf as zstring * STRING_MAX
   if (expected = actual) then return
   sprintf(buf, "expected <%d> but was <%d>", expected, actual)
   CuFail_Line(tc, file_, line_, message, buf)

end sub

sub CuAssertDblEquals_LineMsg(byval tc as CuTest ptr, byval file_ as const zstring ptr, _
                              byval line_ as integer, byval message as const zstring ptr,_
                               byval expected as double , byval actual as double,_
                              byval delta as double)

   dim buf as zstring * STRING_MAX
   if (fabs(expected - actual) <= delta) then return
   sprintf(buf, "expected <%f> but was <%f>", expected, actual)

   CuFail_Line(tc, file_, line_, message, buf)

end sub

sub CuAssertPtrEquals_LineMsg(byval tc as CuTest ptr, byval file_ as const zstring ptr,_
                              byval line_ as integer, byval message as const zstring ptr,_
                              byval expected as any ptr, byval actual as any ptr)

   dim buf as zstring * STRING_MAX
   if (expected = actual) then return
   sprintf(buf, "expected pointer <0x%p> but was <0x%p>", expected, actual)
   CuFail_Line(tc, file_, line_, message, buf)

end sub


/'-------------------------------------------------------------------------*
 * CuSuite
 *-------------------------------------------------------------------------'/

sub CuSuiteInit(byval testSuite as CuSuite ptr)

   testSuite->count = 0
   testSuite->failCount = 0
  memset(@testSuite->list(0), 0, sizeof(testSuite->list))

end sub

function CuSuiteNew() as CuSuite ptr

   dim testSuite as CuSuite ptr = CU_ALLOC(CuSuite)
   CuSuiteInit(testSuite)
   return testSuite

end function

sub CuSuiteDelete(byref testSuite as CuSuite ptr)

  dim n as uinteger
  for n = 0 to MAX_TEST_CASES - 1
    if (testSuite->list(n)) then               
     CuTestDelete(testSuite->list(n))
    end if
  next n
  free(testSuite)

end sub

sub CuSuiteAdd(byval testSuite as CuSuite ptr, byval testCase as CuTest ptr)

   assert(testSuite->count < MAX_TEST_CASES)
   testSuite->list(testSuite->count) = testCase
   testSuite->count += 1

end sub

sub CuSuiteAddSuite(byval testSuite as CuSuite ptr, byval testSuite2 as CuSuite ptr)

   dim i as integer
   for i = 0 to testSuite2->count - 1   
      dim testCase as CuTest ptr = testSuite2->list(i)
      CuSuiteAdd(testSuite, testCase)
   next i

end sub

sub CuSuiteRun(byval testSuite as CuSuite ptr)

   dim i as integer
   for i = 0 to testSuite->count - 1   
      dim testCase as CuTest ptr = testSuite->list(i)
      CuTestRun(testCase)
      if (testCase->failed) then
      testSuite->failCount += 1
    end if
   next i

end sub

sub CuSuiteSummary(byval testSuite as CuSuite ptr, byval summary as CuString ptr)

   dim i as integer
   for i = 0 to testSuite->count -1   
      dim testCase as CuTest ptr = testSuite->list(i)
      CuStringAppend(summary, iif(testCase->failed,@"F",@"."))
   next i
   CuStringAppend(summary, @(NEWLINE & NEWLINE))

end sub

sub CuSuiteDetails(byval testSuite as CuSuite ptr, byval details as CuString ptr)

   dim i as integer
  ''s is used for formatted string concatenation
  dim s as string
   dim failcount as integer

   if (testSuite->failCount = 0) then
   
      dim passCount as integer = testSuite->count - testSuite->failCount
      dim testword as zstring ptr
    if (passcount = 1) then
      testword = @"test"
    else
      testword = @"tests"
    end if
      dim s as string
    s = "OK (" & passCount & " " & *testWord & NEWLINE
    CuStringAppend(details,strptr(s))
   else   
      if (testSuite->failCount = 1) then         
      s = !"There was 1 failure:" & NEWLINE
      CuStringAppend(details, strptr(s))
      else
         s = "There were " & testSuite->failCount & !" failures:" & NEWLINE
      CuStringAppend(details, strptr(s))
    end if

      for i as integer = 0 to testSuite->count - 1      
         dim testCase as CuTest ptr = testSuite->list(i)
         if (testCase->failed) then         
            failCount += 1
            s = failCount & ") " & *(testCase->name) & ": " & *(testCase->message) & NEWLINE
        CuStringAppend(details, strptr(s))
         end if
      next i
      s = NEWLINE & "!!!FAILURES!!!" & NEWLINE
   
    CuStringAppend(details, strptr(s))

      s = "Runs: " & testSuite->count
    CuStringAppend(details, strptr(s))
      s = "Passes: " & testSuite->count - testSuite->failCount
    CuStringAppend(details, strptr(s))
      s = "Fails: " & testSuite->failCount & NEWLINE
    CuStringAppend(details, strptr(s))
   end if

end sub


Code should be correct. It works much like the cunit testing framework as used by the
FreeBASIC developers.

Every test case is a sub. All subs get added to a suite. The test cases from one
suite can be added to those of some other suite. This allows for the creation of separate suites
(so you can break up testing into several suits) that can be joined.

The main suite (=join of all suites) is the one that will actually execute all of the tests.
During the run the test suite reports outcome of tests (including errors).

I am going to generate some test cases using cutest to see if that'll work out.
I will be using your source code as downloadable from sourceforge.net (possibly exchanging files
with files you posted verbatim on this forum).

I hope I will be able to come up with some good test cases. And hopefully find some bugs.

[rolliebollocks]

I appreciate that a great deal, thanks. There are plenty of bugs to find. I debugged (but did not update) problems with user funcs not lexing correctly last night. Now I have a problem with if-else conditionals that seems rather sporadic actually in occurrence. So that should be interesting. Anyways, thanks a bunch.

[rolliebollocks]

So.. As of 7/3.. All of my examples work properly. As of now, the code has never been as stable or as functional as it is now. The zip has been updated on sourceforge.. The pastes to the board have also been updated. Only the parser and lexer needed tweaking.

[rolliebollocks]

New Example demo'ing use of functions for object construction

Code: Select all

function newWordObject() {
   var res = {
      "txt": "",
      "tag_tkns": [],
      "phone_tag": "()",
      "accent": 0,
      "tags": []
   };
   return res;
};

var word1 = newWordObject();

print( word1.phone_tag );



[rolliebollocks]

There was a mistake in the zip which preventing compilation. I updated it.

[rolliebollocks]

Code: Select all

var s = "Hello World";

var s2 = s.right(5) + s.left(5) + s.slice(3,6) + s.mid(3,3);

print(s2);


There was basically one last major problem with the parser that I had to correct before moving forward with anything. It involved math-operators working in tandem with functions. The above code now parses properly. And I can move forward with other things. The zip has been updated on sourceforge as well as the jsb_parser.bas on the boards.

I have adapted but not tested how this would work with user funcs. It should work identically to regular funcs.

[rolliebollocks]

There was another problem. String concatenations were not working in tandem with function calls/math operators.. If you cut and paste jsb_parser.bas from the boards replacing the one from the zip. You should be able to run this:

Code: Select all

var s = "Hello World";

var s2 = s.right(5) + s.left(5) + "!!!!!!" + s.slice(3,6) + s.mid(3,3);

print(s2);


[rolliebollocks]

There was a problem with something. I fixed it. I forgot what it was. All examples now execute properly. I performed a couple optimizations. Shaved about .001-.002 seconds off execution time. Will be working more on that later. Brain hurts.

Updated paste jsb_parser.bas. Give it a go..