From: glyn Date: Fri, 25 Sep 2015 14:18:45 +0000 (+0100) Subject: Add missing new files X-Git-Url: https://git.8kb.co.uk/?p=dataflex%2Fdf32func;a=commitdiff_plain;h=21b727fd491be6f9953f1675b18385296cab0955 Add missing new files --- diff --git a/src/c/gnuregex.c b/src/c/gnuregex.c new file mode 100644 index 0000000..f0f2dea --- /dev/null +++ b/src/c/gnuregex.c @@ -0,0 +1,464 @@ +/*------------------------------------------------------------------------- + * gnuregex.c + * posix regex extensions + * + * Copyright (c) 2007-2015, glyn@8kb.co.uk + * Author: Glyn Astill + * + *------------------------------------------------------------------------- + */ + +#include +#include +#include +#include +#include "memman.h" + +#define MAX_ERROR_MSG 0x1000 + +/* + * Return a properly escaped / quoted string + */ +static char * quote_output(char *str) { + char *result; + char *result_return; + int len; + int do_quote = 0; + char *ptr; + + len = strlen(str); + + /* Check for characters that need quoting */ + for (ptr = str; *ptr; ptr++) { + char ch = *ptr; + if (ch == '\"' || ch =='\\' || ch == '\{' || ch == ',') { + do_quote = 1; + break; + } + } + + /* If we find no characters that need quoting just return the input */ + if (do_quote != 1) + return str; + + /* Do the quoting, here the allocation is wasteful */ + result = (char *) wmalloc((len * 2 + 3) * sizeof(char)); + result_return = result; + + /* + * Starting address of result is incremented as we modify it's contents here + * with result_return keeping the starting address + */ + *result++ = '"'; + while (len-- > 0) { + /* Escape double quotes and backslash with backslash */ + if (*str == '"') { + *result++ = '\\'; + } + if (*str == '\\') { + *result++ = '\\'; + } + *result++ = *str++; + } + *result++ = '"'; + *result++ = '\0'; + + return result_return; +} + +/* + * Count open parenthesis to evaluate the number of subexpressions in the regex + */ +static int count_subexpressions(const char *str){ + int result = 0; + int last_was_backslash = 0; + const char *ptr; + + for(ptr=str; *ptr; ptr++){ + if (*ptr == '\\' && !last_was_backslash){ + last_was_backslash = 1; + continue; + } + if (*ptr == ')' && !last_was_backslash) + result++; + last_was_backslash = 0; + } + return result; +} + +/* + * Check to see if string contains any escape chars + * these could of course just be escaped backslashes + * themselvs. + */ +static int has_escapes(const char *str){ + const char *ptr; + + for(ptr=str; *ptr; ptr++){ + if (*ptr == '\\') + return 1; + } + return 0; +} + +/* + * Compile the regex pattern + */ +static int compile_regex(regex_t *re, const char *pattern, const char *flags, int errors) +{ + int status; + int cflags = REG_EXTENDED; + + if (strchr(flags, 'i')) { + cflags = cflags|REG_ICASE; + } + if (strchr(flags, 'n')) { + cflags = cflags|REG_NEWLINE; + } + + status = regcomp(re, pattern, cflags); + if (status != REG_NOERROR) { + if (errors == 1) { + char error_message[MAX_ERROR_MSG]; + regerror (status, re, error_message, MAX_ERROR_MSG); + fprintf (stderr, "Regex error compiling '%s': %s\n", pattern, error_message); + } + } + return status; +} + +/* + * Returns a pointer to a malloced array of regmatch_t containing match offsets + * in the input string. (As opposed to offests from each match) + * + * The regmatch struct info: + * regmatch_t.rm_so (regoff_t) = byte offset from start of string to start of substring + * regmatch_t.rm_eo (regoff_t) = byte offset from start of string to first character after the end of substring + */ +static int find_regex_matches(regex_t *re, const char *str, const int nsub, const char *flags, regmatch_t **result) +{ + /* Each individual match and it's subexpression matches stored in m */ + regmatch_t m[nsub+1]; + + /* A pointer into the string at the end of the previous match */ + const char *prev_match_eo = str; + + /* + * We return a count of matches and pass back an array of regmatch_t in + * matches containing match offsets in the original string + */ + int array_len = strchr(flags, 'g') ? 256 : 32; + int match_count = 0; + regmatch_t *matches; + + matches = (regmatch_t *) wmalloc(sizeof(regmatch_t) * array_len); + + while (!regexec(re, prev_match_eo, nsub+1, m, 0)) { + int i = 0; + + /* resize the matches array; when more space is required double current size */ + while (match_count + (nsub * 2) > array_len) { + array_len *= 2; + matches = (regmatch_t *) wrealloc(matches, sizeof(regmatch_t) * array_len); + } + + /* when we have subexpressions, we're only interested in their match offsets */ + if (nsub > 0) { + for (i = 1; i <= nsub; i++) { + if (m[i].rm_so < 0 || m[i].rm_eo < 0) { + matches[match_count].rm_so = -1; + matches[match_count++].rm_eo = -1; + } + else { + matches[match_count].rm_so = (prev_match_eo - str) + m[i].rm_so; + matches[match_count++].rm_eo = (prev_match_eo - str) + m[i].rm_eo; + } + } + } + /* else we want the original match offsets*/ + else { + matches[match_count].rm_so = (prev_match_eo - str) + m[0].rm_so; + matches[match_count++].rm_eo = (prev_match_eo - str) + m[0].rm_eo; + } + + /* + * If we have matched on a blank expression or we were + * not flagged to do greedy matching then break + */ + if (!m[0].rm_eo || !strchr(flags, 'g')) + break; + + /* + * Advance the search position to the end of the current match + * If the match happens to be zero length, advance search position + * by one? + */ + if (m[0].rm_eo == m[0].rm_so) + prev_match_eo++; + else + prev_match_eo += m[0].rm_eo; + } + *result = matches; + + return match_count; +} + +/* + * Takes regmatch_t array returned by find_regex_matches and returns a malloced + * string representing the captured substrings. + */ +static char * regex_matches_to_string(const char *str, int nsub, int match_count, regmatch_t *matches) { + int j; + int i; + char *unquoted = NULL; + char *quoted = NULL; + int quoted_len; + char *result; + + int str_len = strlen(str); + int allocated_sz = str_len+1; + result = wmalloc(allocated_sz * sizeof(char)); + int result_sz = 0; + + j = 0; + while (j < match_count) { + + if (j > 0) { + result_sz += 2; + result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len); + result[result_sz-2] = ','; + result[result_sz-1] = '{'; + } + else { + result_sz++; + result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len); + result[result_sz-1] = '{'; + } + + for (i = 0; i <= nsub; i++) { + if ((nsub > 0) && (i == 0)) + continue; + + if (i > 1) { + result_sz++; + result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len); + result[result_sz-1] = ','; + } + + int so = matches[j].rm_so; + int eo = matches[j].rm_eo; + + if (so == -1 || eo == -1) { + result = reallocate_block(result, &allocated_sz, (result_sz+4) * sizeof(char), str_len); + strncpy(result+result_sz, "NULL", 4); + result_sz += 4; + } + else { + unquoted = wmalloc((eo-so)+1 * sizeof(char)); + strncpy(unquoted, str+so, eo-so); + unquoted[eo-so] = '\0'; + quoted = quote_output(unquoted); + quoted_len = strlen(quoted); + + result = reallocate_block(result, &allocated_sz, (result_sz+quoted_len) * sizeof(char), str_len); + strncpy(result+result_sz, quoted, quoted_len); + result_sz += quoted_len; + + if (quoted != unquoted) + wfree(unquoted); + wfree(quoted); + } + j++; + } + + result_sz++; + result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len); + result[result_sz-1] = '}'; + } + + result_sz++; + result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len); + result[result_sz-1] = '\0'; + + return result; +} + +/* + * Purely check for a match in the regex + */ +int regexp_match(const char *str, const char *pattern, const char *flags, int errors) +{ + regex_t re; + int result; + int status; + + status = compile_regex(&re, pattern, flags, errors); + if (status == REG_NOERROR) { + result = regexec(&re, str, (size_t) 0, NULL, 0); + regfree(&re); + + if (!result) /* match */ + return 1; + else /* no match */ + return 0; + } + else /* error condition, but still: no match */ + return 0; +} + +/* + * Return all matches in the regex as a string by first calling find_regex_matches + * and then regex_matches_to_string. Arguably this could all be one function + * however separation will make future multiple output formats easier. + */ +char * regexp_matches(const char *str, const char *pattern, const char *flags, int errors) +{ + regex_t re; + regmatch_t *matches_p = NULL; + int nsub; + int match_count; + int status; + char *result = NULL; + + /* Compile the regex */ + status = compile_regex(&re, pattern, flags, errors); + if (status == REG_NOERROR) { + /* Count our subexpressions to size our regmatch_t array */ + nsub = count_subexpressions(pattern); + /* Find all the matches relative to the input string */ + match_count = find_regex_matches(&re, str, nsub, flags, &matches_p); + /* Turn the matches into an output string */ + result = regex_matches_to_string(str, nsub, match_count, matches_p); + /* Free up the regmatch_t malloced by find_regex_matches */ + wfree(matches_p); + regfree(&re); + } + + return result; +} + +/* + * Substitutes matches with the regex pattern in the string with the replacement + * pattern/string. + */ +char * regexp_replace(const char *str, const char *pattern, const char *replacement, const char *flags, int errors) +{ + regex_t re; + int nsub; + char *result = NULL; + char *match_str; + int status; + const char *prev_match_eo = str; + int str_len = strlen(str); + int replacement_len = strlen(replacement); + int allocated_sz = str_len+1; + int result_sz = 0; + + status = compile_regex(&re, pattern, flags, errors); + if (status == REG_NOERROR) { + + result = wmalloc(allocated_sz * sizeof(char)); + + /* Count our subexpressions to size our regmatch_t array */ + nsub = count_subexpressions(pattern); + regmatch_t m[nsub+1]; + + while (!regexec(&re, prev_match_eo, nsub+1, m, 0)) { + + /* Copy everything to the left of the first match */ + if (m[0].rm_so > 0) { + result = reallocate_block(result, &allocated_sz, (result_sz+m[0].rm_so) * sizeof(char), str_len); + strncpy(result+result_sz, prev_match_eo, m[0].rm_so); + result_sz += m[0].rm_so; + } + + /* If there are no backreferences in the replacement, copy in the replacement */ + if (!has_escapes(replacement)) { + result = reallocate_block(result, &allocated_sz, (result_sz+replacement_len) * sizeof(char), str_len); + strncpy(result+result_sz, replacement, replacement_len); + result_sz += replacement_len; + } + /* Otherwise process the backreferences and copy in subcaptures */ + else { + /* find the next escape char */ + const char *start = replacement; + const char *ptr; + + for(ptr = replacement; *ptr; ptr++) { + if (*ptr != '\\') + continue; + + /* append everything to the left of the current escape */ + result = reallocate_block(result, &allocated_sz, (result_sz+(ptr-start)) * sizeof(char), str_len); + strncpy(result+result_sz, start, (ptr-start)); + result_sz += (ptr-start); + + ptr++; + + if ((*ptr >= '1' && *ptr <= '9') || (*ptr == '&')) + { + /* Use the back reference of regexp. */ + int sub; + if (*ptr == '&') + sub = 0; + else + sub = *ptr - '0'; + + if (m[sub].rm_so != -1 && m[sub].rm_eo != -1 && sub <= nsub) { + result = reallocate_block(result, &allocated_sz, (result_sz+(m[sub].rm_eo-m[sub].rm_so)) * sizeof(char), str_len); + strncpy(result+result_sz, prev_match_eo+m[sub].rm_so, (m[sub].rm_eo-m[sub].rm_so)); + result_sz += (m[sub].rm_eo-m[sub].rm_so); + } + ptr++; + } + else if (*ptr == '\\') + { + /* append backsalsh */ + result_sz++; + result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len); + result[result_sz-1] = '\\'; + ptr++; + } + else { + /* append backsalsh */ + result_sz++; + result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len); + result[result_sz-1] = '\\'; + } + start = ptr; + } + /* + * Append right trailing replacement, except in the instance + * when it starts with character zero, which can happen when the + * last part of the replace string is escaped. + */ + if (*start) { + result = reallocate_block(result, &allocated_sz, (result_sz+(ptr-start)) * sizeof(char), str_len); + strncpy(result+result_sz, start, (ptr-start)); + result_sz += (ptr-start); + } + + } + prev_match_eo += m[0].rm_eo; + + /* + * If we have matched on a blank expression or we were + * not flagged to do greedy matching then break + */ + if (!m[0].rm_eo || !strchr(flags, 'g')) + break; + } + + /* Copy everything to the right of the last match */ + result = reallocate_block(result, &allocated_sz, (result_sz+(str_len-(prev_match_eo-str))) * sizeof(char), str_len); + strncpy(result+result_sz, prev_match_eo, str_len-(prev_match_eo-str)); + result_sz += str_len-(prev_match_eo-str); + + regfree(&re); + + result_sz++; + result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len); + result[result_sz-1] = '\0'; + } + return result; +} diff --git a/src/c/gnuregex.h b/src/c/gnuregex.h new file mode 100644 index 0000000..e493712 --- /dev/null +++ b/src/c/gnuregex.h @@ -0,0 +1,18 @@ +/*------------------------------------------------------------------------- + * gnuregex.h + * posix regex extension definitions + * + * Copyright (c) 2007-2015, glyn@8kb.co.uk + * Author: Glyn Astill + * + *-------------------------------------------------------------------------- + */ + +#ifndef __GNUREGEX_H__ +#define __GNUREGEX_H__ + +extern int regexp_match(const char *str, const char *pattern, const char *flags, int errors); +extern char * regexp_matches(const char *str, const char *pattern, const char *flags, int errors); +extern char * regexp_replace(const char *str, const char *pattern, const char *replacement, const char *flags, int errors); + +#endif diff --git a/src/c/memman.c b/src/c/memman.c new file mode 100644 index 0000000..2497fc4 --- /dev/null +++ b/src/c/memman.c @@ -0,0 +1,66 @@ +/*------------------------------------------------------------------------- + * memman.c + * wrappers around malloc/realloc/free + * + * Copyright (c) 2007-2015, glyn@8kb.co.uk + * Author: Glyn Astill + * + *------------------------------------------------------------------------- + */ + + +#include +#include +#include + +/* + * Wrappers around malloc/realloc/free + */ +void * wmalloc(unsigned int size) { + char *result; + + if ((result = malloc(size)) == NULL) { + fprintf(stderr, "Failed to malloc %d bytes\n", size); + exit(1); + } + return result; +} + +void * wrealloc(void *iptr, unsigned int size) { + char *result; + + assert(iptr != NULL); + + if ((result = realloc(iptr, size)) == NULL) { + fprintf(stderr, "Failed to realloc %d bytes\n", size); + exit(1); + } + return result; +} + +void wfree(void *iptr){ + assert(iptr != NULL); + + if (iptr) { + free(iptr); + } + iptr = NULL; +} + +/* + * Reallocate memory block pointed to by iptr in chunks of chunk_size when + * required_size is greater than value pointed to be allocated_size. + * Sets value of allocated_size to current allocation. + */ +void * reallocate_block(void *iptr, int *allocated_size, int required_size, int chunk_size) { + void *result; + + if (*allocated_size >= required_size) + return iptr; + + *allocated_size += (((required_size-*allocated_size)/chunk_size)+1)*chunk_size; + + result = wrealloc(iptr, *allocated_size); + + return result; +} diff --git a/src/c/memman.h b/src/c/memman.h new file mode 100644 index 0000000..dd03cbc --- /dev/null +++ b/src/c/memman.h @@ -0,0 +1,19 @@ +/*------------------------------------------------------------------------- + * memman.h + * definitions for wrappers around malloc/realloc/free + * + * Copyright (c) 2007-2015, glyn@8kb.co.uk + * Author: Glyn Astill + * + *------------------------------------------------------------------------- + */ + +#ifndef __MEMMAN_H__ +#define __MEMMAN_H__ + +extern void * wmalloc(unsigned int size); +extern void * wrealloc(void *iptr, unsigned int size); +extern void wfree(void *iptr); +extern void * reallocate_block(void *iptr, int *allocated_size, int required_size, int chunk_size); + +#endif diff --git a/src/depends/mingw-libgnurx-2.5.1-src.tar.gz b/src/depends/mingw-libgnurx-2.5.1-src.tar.gz new file mode 100644 index 0000000..620cf36 Binary files /dev/null and b/src/depends/mingw-libgnurx-2.5.1-src.tar.gz differ diff --git a/src/df32/df32func.h b/src/df32/df32func.h new file mode 100644 index 0000000..0940c0a --- /dev/null +++ b/src/df32/df32func.h @@ -0,0 +1,30 @@ +//------------------------------------------------------------------------- +// df32func.h +// This file contains definitions of "Win32" api functions provided by +// the df32func.dll dynamic link library. +// +// This file is to be included when using socket networking in df32func.mk +// +// Copyright (c) 2006-2015, glyn@8kb.co.uk +// +// df32func/df32func.h +//------------------------------------------------------------------------- + +Define __df32func_h__ + +//------------------------------------------------------------------------- +// External functions +//------------------------------------------------------------------------- + +external_function ClientSocket "ClientSocket" df32func.dll dword port string host returns integer +external_function ServerSocket "ServerSocket" df32func.dll dword port returns integer +external_function AcceptClient "AcceptClient" df32func.dll returns integer +external_function Send "Send" df32func.dll dword socket string data returns integer +external_function Receive "Receive" df32func.dll dword socket pointer dataOut returns integer +external_function CloseConnection "CloseConnection" df32func.dll dword socket returns integer +external_function PseudoRand "PseudoRand" df32func.dll dword w returns integer +external_function RdtscRand "RdtscRand" df32func.dll returns integer +external_function GetTzi "GetTzi" df32func.dll pointer lpTimeZone pointer lpResult returns integer +external_function RegexpMatch "RegexpMatch" df32func.dll pointer str pointer pattern pointer flags integer errors returns integer +external_function RegexpMatches "RegexpMatches" df32func.dll pointer str pointer pattern pointer flags pointer out pointer out_len integer errors returns integer +external_function RegexpReplace "RegexpReplace" df32func.dll pointer str pointer pattern pointer replacement pointer flags pointer out pointer out_len integer errors returns integer \ No newline at end of file diff --git a/src/df32/regex.inc b/src/df32/regex.inc new file mode 100644 index 0000000..a0f9b5c --- /dev/null +++ b/src/df32/regex.inc @@ -0,0 +1,165 @@ +//------------------------------------------------------------------------- +// regex.inc +// This file contains DataFlex functions to provide basic regex +// functionality based on the GNU POSIX regex library, and accessed +// via Win32 API calls to df32func.dll. +// See df32func.h for external function definitions. +// +// This file is to be included when using Win32 capabilities in df32func.mk +// +// Copyright (c) 2006-2015, glyn@8kb.co.uk +// +// df32func/regex.inc +//------------------------------------------------------------------------- + +#IFDEF __df32func_h__ +#ELSE + #INCLUDE df32func.h +#ENDIF + +//------------------------------------------------------------------------- +// Functions +//------------------------------------------------------------------------- + +// All the regex function accept a set of flags, this can be one or more of: +// g = Perform match against each substring rather than just the first (greedy) +// n = Perform newline-sensitive matching +// i = Perform cases insensitive matching + +//Purely check if a regex expression produces match in the input string +// Returns 1 on match, 0 on no match +// E.g +// move (regexp_match('the quick brown fox jumps over the lazy dog.', 'fox', 'g')) +function regexp_match global string str string pattern string flags returns integer + local integer l_iReturn + local pointer l_pStr l_pPattern l_pFlags + + getaddress of str to l_pStr + getaddress of pattern to l_pPattern + getaddress of flags to l_pFlags + + move (RegexpMatch(l_pStr, l_pPattern, l_pFlags, ERRORS_TO_STDERR)) to l_iReturn + + function_return l_iReturn +end_function + +//Return a string containing all regex matches in the input string +// E.g +// move (regexp_matches('the quick brown fox jumps over the la\{zy d"og.', 'fox|(the)|brown|(la\\\{zy)|(d"og)', 'g')) to myString +function regexp_matches global string str string pattern string flags returns string + local integer l_iReturn + local pointer l_pStr l_pPattern l_pFlags l_pOut + local string l_sOut l_sReturn + + move "" to l_sReturn + getaddress of str to l_pStr + getaddress of pattern to l_pPattern + getaddress of flags to l_pFlags + zerostring MAX_DFREGEX_BUFFER to l_sOut + getaddress of l_sOut to l_pOut + + move (RegexpMatches(l_pStr, l_pPattern, l_pFlags, l_pOut, MAX_DFREGEX_BUFFER, ERRORS_TO_STDERR)) to l_iReturn + + if (l_iReturn = 0); + move (cstring(l_sOut)) To l_sReturn + else begin + if (l_iReturn = -1); + custom_error ERROR_CODE_REGEX_BUFFER_OVERFLOW$ ERROR_MSG_REGEX_BUFFER_OVERFLOW MAX_DFREGEX_BUFFER + if (l_iReturn = -2); + custom_error ERROR_CODE_REGEX_COMPILE_FAILURE$ ERROR_MSG_REGEX_COMPILE_FAILURE + move "" to l_sReturn + end + + function_return l_sReturn +end_function + +//Perform a replacement on the input string all matches with the given pattern +// E.g. +// move (regexp_replace('22 quick brown foxes jump over the 44 lazy dogs.', '([0-9]*).* (foxes) .* ([0-9]*) .* (dogs).*', 'SELECT build_data(\1,\2), build_data(\3,\4);', 'g')) to myString +function regexp_replace global string str string pattern string replacement string flags returns string + local integer l_iReturn + local pointer l_pStr l_pPattern l_pFlags l_pReplacement l_pOut + local string l_sOut l_sReturn + + move "" to l_sReturn + getaddress of str to l_pStr + getaddress of pattern to l_pPattern + getaddress of flags to l_pFlags + getaddress of replacement to l_pReplacement + zerostring MAX_DFREGEX_BUFFER to l_sOut + getaddress of l_sOut to l_pOut + + move (RegexpReplace(l_pStr, l_pPattern, l_pReplacement, l_pFlags, l_pOut, MAX_DFREGEX_BUFFER, ERRORS_TO_STDERR)) to l_iReturn + + if (l_iReturn = 0); + move (cstring(l_sOut)) To l_sReturn + else begin + if (l_iReturn = -1); + custom_error ERROR_CODE_REGEX_BUFFER_OVERFLOW$ ERROR_MSG_REGEX_BUFFER_OVERFLOW MAX_DFREGEX_BUFFER + if (l_iReturn = -2); + custom_error ERROR_CODE_REGEX_COMPILE_FAILURE$ ERROR_MSG_REGEX_COMPILE_FAILURE + move "" to l_sReturn + end + + function_return l_sReturn +end_function + +// Parse an output string from regexp_matches to get the result count +// E.g +// move (regexp_matches_count(myRegexMatchesOutput)) to myInt +function regexp_matches_count global string argv returns integer + local integer l_iCount l_i + local string l_sChar l_sLast + + move "" to l_sChar + move "" to l_sLast + for l_i from 0 to (length(argv)) + move (mid(argv,1,l_i)) to l_sChar + if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount + move l_sChar to l_sLast + loop + + function_return l_iCount +end_function + +// Parse an output string from regexp_matches to get the result at an index +// E.g +// move (regexp_matches_item(myRegexMatchesOutput,muInt)) to myString +function regexp_matches_item global string argv integer argv2 returns string + local integer l_iCount l_i l_iOpen l_iQuot + local string l_sChar l_sLast l_sNext l_sBuf + + move 0 to l_iCount + move 0 to l_iOpen + move 0 to l_iQuot + move "" to l_sLast + for l_i from 0 to (length(argv)) + move (mid(argv,1,l_i)) to l_sChar + move (mid(argv,1,l_i-1)) to l_sLast + + if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount + if (l_iCount <> argv2) break begin + + move (mid(argv,1,l_i+1)) to l_sNext + + if ((l_sChar = '{') and not (l_iQuot)) begin + move 1 to l_iOpen + move "" to l_sBuf + end + else if ((l_sChar = '}') and not (l_iQuot)) begin + move 0 to l_iOpen + end + else if ((l_sChar = '"') and (l_sLast <> '\')) begin + if (l_iQuot) move 0 to l_iQuot + else move 1 to l_iQuot + end + if ((l_sChar = ',') and not (l_iOpen)) break begin + if (((l_sChar = '{') or (l_sChar = '}')) and not (l_iQuot)) break begin + if ((l_sChar = '"') and (l_sLast <> '\')) break begin + if ((l_iQuot) and (l_sChar = '\') and ((l_sNext = '"') or (l_sNext = '\'))) break begin + + append l_sBuf l_sChar + loop + + function_return l_sBuf +end_function \ No newline at end of file diff --git a/src/df32/tap.inc b/src/df32/tap.inc new file mode 100644 index 0000000..51eda43 --- /dev/null +++ b/src/df32/tap.inc @@ -0,0 +1,304 @@ +//------------------------------------------------------------------------- +// tap.inc +// This file contains some DataFlex 3.2 Console Mode classes +// to provide some test anything protocol functionality. +// See: http://testanything.org/ +// +// This file is to be included in df32func.mk +// +// Copyright (c) 2006-2015, glyn@8kb.co.uk +// +// df32func/tap.inc +//------------------------------------------------------------------------- + +//------------------------------------------------------------------------- +// Classes +//------------------------------------------------------------------------- + +// TAP class - impliments the vet basic of the Test Anything Protocol +// +// Get methods: +// plan - Gets the "plan" or expected number of tests +// tests - Gets the number of tests executed so far +// +// Set methods: (All of the following methods are intended to be private) +// plan - Sets the "plan" or expected number of tests +// +// Send message methods: +// ok - Fundamental test, to check binary outcome of an expression +// is - Test values are equivaent +// isnt - Test values are not equivaent +// cmp_ok - Test values are not equivaent +// finish - Complete the set of tests (also alias "done_testing") +// +// Notes +// If a plan has been set, and the program aborts without calling finish, finish is called +// automatically, and results will be output. Piping test output to a file or creating a +// "wrapper" around the program with a simple "chain wait" allows test results to always be +// seen. +// +// Example usage: +// +// object myTest is a TAP +// end_object +// +// set plan of myTest to 8 +// +// send ok to myTest (1=1) "One is equal to one" +// send ok to myTest (2=1) "Two is equal to one" +// send ok to myTest (3=3) "Three is equal to three" +// send is to myTest "pie" 100 "Pie is numeric" +// send isnt to myTest "pie" "pie" "Both should be pie" +// send cmp_ok to myTest "pie" "pie" "=" "Pie equals pie" +// send cmp_ok to myTest 1 2 "=" "One equals two" +// send cmp_ok to myTest 1 2 ">" "One is greater than two" +// send cmp_ok to myTest "pankcake" "cake" "~~" "Pankace contains cake" +// +// send finish to myTest +// +class TAP is an array + procedure construct_object integer argc + forward send construct_object + property integer c_iPlan public argc + property integer c_iTest + set c_iPlan to -1 + set c_iTest to 0 + end_procedure + + procedure set plan integer argv + set c_iPlan to argv + end_procedure + + function plan + local integer l_iPlan + get c_iPlan to l_iPlan + function_return l_iPlan + end_procedure + + function tests + local integer l_iTest + get c_iTest to l_iTest + function_return l_iTest + end_procedure + + procedure is string argv string argv2 string argv3 + local integer l_iTest + local string l_sTestResult + + get c_iTest to l_iTest + increment l_iTest + + move (ternary((argv = argv2),"1","0")+string(l_iTest)+" - "+argv3) to l_sTestResult + + forward set array_value item l_iTest to l_sTestResult + set c_iTest to l_iTest + end_procedure + + procedure isnt string argv string argv2 string argv3 + local integer l_iTest + local string l_sTestResult + + get c_iTest to l_iTest + increment l_iTest + + move (ternary((argv <> argv2),"1","0")+string(l_iTest)+" - "+argv3) to l_sTestResult + + forward set array_value item l_iTest to l_sTestResult + set c_iTest to l_iTest + end_procedure + + procedure cmp_ok string argv string argv2 string argv3 string argv4 + local integer l_iTest + local string l_sTestResult + + get c_iTest to l_iTest + increment l_iTest + + case begin + case ((argv3 = "=") or (argv3 = "eq") or (argv3 = "==")) move (ternary((argv = argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult + case break + case ((argv3 = "<>") or (argv3 = "ne") or (argv3 = "!=") or (argv3 = "!")) move (ternary((argv <> argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult + case break + case ((argv3 = ">") or (argv3 = "gt")) move (ternary((argv > argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult + case break + case ((argv3 = ">=") or (argv3 = "ge")) move (ternary((argv >= argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult + case break + case ((argv3 = "<") or (argv3 = "lt")) move (ternary((argv < argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult + case break + case ((argv3 = "<=") or (argv3 = "le")) move (ternary((argv <= argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult + case break + case ((argv3 = "~") or (argv3 = "~~") or (argv3 = "contains")) move (ternary(((argv contains argv2) > 0),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult + case break + case else custom_error ERROR_CODE_COMPARISON_OPERATOR$ ERROR_MSG_COMPARISON_OPERATOR argv3 + case end + + forward set array_value item l_iTest to l_sTestResult + set c_iTest to l_iTest + end_procedure + + procedure ok integer argv string argv2 + local integer l_iTest + local string l_sTestResult + + get c_iTest to l_iTest + increment l_iTest + + if ((argv <= 1) and (argv >= 0)) begin + move (string(argv)+string(l_iTest)+" - "+argv2) to l_sTestResult + end + else begin + custom_error ERROR_CODE_INVALID_BOOLEAN$ ERROR_MSG_INVALID_BOOLEAN ERROR_DETAIL_INVALID_BOOLEAN argv + end + + forward set array_value item l_iTest to l_sTestResult + set c_iTest to l_iTest + end_procedure + + procedure finish + local integer l_iPlan l_iTest l_i l_iStatus + local string l_sBuf l_sMsg + + get c_iPlan to l_iPlan + get c_iTest to l_iTest + + + if (l_iPlan <> -1) showln "1.." l_iPlan + for l_i from 1 to l_iTest + forward get string_value item l_i to l_sBuf + move (left(l_sBuf,1)) to l_iStatus + move (right(l_sBuf,length(l_sBuf)-1)) to l_sMsg + + if (l_iStatus = 1) begin + showln "ok " l_sMsg + end + else begin + showln "not ok " l_sMsg + end + loop + + if (l_iPlan <> -1) begin + set c_iPlan to -1 + end + else showln "1.." l_iTest + + forward send delete_data + set c_iTest to 0 + end_procedure + + procedure done_testing + send finish + end_procedure + + procedure destroy_object + local integer l_iPlan + get c_iPlan to l_iPlan + if (l_iPlan <> -1) send finish + //forward send destroy_object + send destroy_object + end_procedure + +end_class + +// TAP_harness class - overrides finish method of TAP class to provide a +// basic harness +// +// Inherits all methods from TAP +// +// Set methods: (extra methods) +// timing_on - Turns on test timing +// timing_off - Turns off test timing +// notices_on - Turns on test notices +// notices_off - Turns off test notices +// +class TAP_harness is a TAP + procedure construct_object integer argc + forward send construct_object argc + property integer c_iNotices + property integer c_iTiming + property integer c_nStart + set c_iNotices to 0 + set c_iTiming to 0 + end_procedure + + function get_timer_seconds returns number + local date l_dDate + local number l_nHr l_nMin l_nSec + + sysdate l_dDate l_nHr l_nMin l_nSec + function_return ((integer(l_dDate)-integer(date("01/01/1970"))*86400)+(((l_nHr*60)+l_nMin)*60)+l_nSec) + end_procedure + + procedure notices_on + set c_iNotices to 1 + end_procedure + + procedure notices_off + set c_iNotices to 0 + end_procedure + + procedure timing_on + local number l_iSecs + set c_iTiming to 1 + get get_timer_seconds to l_iSecs + set c_nStart to l_iSecs + end_procedure + + procedure timing_off + set c_iTiming to 0 + end_procedure + + procedure finish + local integer l_iPlan l_iTest l_i l_iStatus l_iFailed l_iNotices l_iTiming + local string l_sBuf l_sMsg l_sFailed + local number l_nStart l_nSecs + + forward get c_iPlan to l_iPlan + forward get c_iTest to l_iTest + get c_iNotices to l_iNotices + get c_iTiming to l_iTiming + + move 0 to l_iFailed + move "" to l_sFailed + + if (l_iPlan <> -1) showln "1.." l_iPlan + for l_i from 1 to l_iTest + forward get string_value item l_i to l_sBuf + move (left(l_sBuf,1)) to l_iStatus + move (right(l_sBuf,length(l_sBuf)-1)) to l_sMsg + + if (l_iStatus = 1) begin + showln "ok " l_sMsg + end + else begin + showln "not ok " l_sMsg + if (l_iFailed > 0) append l_sFailed ", " + append l_sFailed l_i + increment l_iFailed + end + loop + + if (l_iPlan <> -1) begin + if (l_iNotices) begin + if (l_iTest < l_iPlan); + showln "Notice: Only ran " l_iTest " of " l_iPlan " tests" + if (l_iTest > l_iPlan); + showln "Notice: Ran " l_iTest " tests, but only expected " l_iPlan + end + + if (l_iFailed > 0) begin + showln "FAILED test" (ternary((l_iFailed > 1),"s "," ")) l_sFailed + showln "Failed " l_iFailed "/" l_iTest " tests, " (decround(1-(number(l_iFailed)/number(l_iTest))*100,2)) "% ok" + end + + forward set c_iPlan to -1 + end + else showln "1.." l_iTest + + if (l_iTiming) begin + get get_timer_seconds to l_nSecs + get c_nStart to l_nStart + showln "Timing: " (l_nSecs-l_nStart) " seconds" + end + end_procedure + +end_class