diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 35d8066d1..3fef618eb 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,12 @@ +2023-07-02 Fabrice Le Fessant + + * replace.c: rewrite the code for preprocessing with a two-phase + algorithm. The first phase performs COPY REPLACING on the stream + of tokens, while the second phase perform REPLACE on the resulting + stream of tokens. This rewriting is closer to the COBOL standard + and fixes bug #831 partially. + 2023-07-02 Fabrice Le Fessant * pplex.l/replace.c: move the preprocessing code performing diff --git a/cobc/cobc.c b/cobc/cobc.c index fe9095025..c0cb8514c 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -1316,6 +1316,50 @@ cobc_plex_strdup (const char *dupstr) return p; } +/* Return a newly allocated zero-terminated string with only the first + * len chars of the first argument */ +void * +cobc_plex_strsub (const char *s, const int len) +{ + void *p; + int n; + + n = strlen (s); + +#ifdef COB_TREE_DEBUG + /* LCOV_EXCL_START */ + if ( len>n ) { + cobc_err_msg ("call to %s with bad argument len=%d>%d=strlen(s)", + "cobc_plex_strsub", len, n); + cobc_abort_terminate (1); + } + /* LCOV_EXCL_STOP */ +#endif + + p = cobc_plex_malloc (len + 1); + memcpy (p, s, len); + return p; +} + +/* Returns a newly allocated zero-terminated string containing the + * concatenation of str1 and str2. str1 and str2 may be freed + * afterwards. + */ +char * +cobc_plex_stradd (const char *str1, const char *str2) +{ + char *p; + size_t m, n; + + m = strlen (str1); + n = strlen (str2); + p = cobc_plex_malloc (m + n + 1); + memcpy (p, str1, m); + memcpy (p + m, str2, n); + return p; +} + + /* variant of strcpy which copies max 'max_size' bytes from 'src' to 'dest', if the size of 'src' is too long only its last/last bytes are copied and an eliding "..." is placed in front or at end depending on 'elide_at_end' */ diff --git a/cobc/cobc.h b/cobc/cobc.h index 21d2bcc4b..73f3d7a23 100644 --- a/cobc/cobc.h +++ b/cobc/cobc.h @@ -513,6 +513,8 @@ extern void cobc_parse_free (void *); extern void *cobc_plex_malloc (const size_t); extern void *cobc_plex_strdup (const char *); +extern void *cobc_plex_strsub (const char *, const int len); +extern char *cobc_plex_stradd (const char *str1, const char *str2); extern void *cobc_check_string (const char *); extern void cobc_err_msg (const char *, ...) COB_A_FORMAT12; diff --git a/cobc/replace.c b/cobc/replace.c index 7439f6114..4d7bd5f89 100644 --- a/cobc/replace.c +++ b/cobc/replace.c @@ -1,9 +1,9 @@ /* - Copyright (C) 2003-2022 Free Software Foundation, Inc. + Copyright (C) 2001-2023 Free Software Foundation, Inc. Authors: Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, Brian Tiffin, - Edward Hart, Dave Pitts + Edward Hart, Dave Pitts, Fabrice Le Fessant This file is part of GnuCOBOL. @@ -40,276 +40,801 @@ #include "tree.h" #include "replace.h" -static struct cb_replace_list *current_replace_list = NULL; -static struct cb_replace_list *save_current_replace = NULL; -static struct cb_replace_list *base_replace_list = NULL; +#define TRUE 1 +#define FALSE 0 + +/* This is an implementation of the *two* phases of COPY-REPLACING and + REPLACE on a stream of tokens: the stream of tokens generated by the + pplex.l/parser.y goes first through COPY-REPLACING replacements, + and then through REPLACE replacements, as expected by the COBOL + standard. + + However, it does not fully conform to the standard, as REPLACE are + parsed on the input stream *before* any COPY-REPLACING could have + been applied. + + The general entry point is `add_text_to_replace(stream, prequeue, + token)`, it adds `token` to `stream`, `prequeue` is TRUE if the + token should not be treated immediately (because it may be merged + with other following tokens if they are of the same kind), FALSE + otherwise. + + Initially, `pp_echo()` in `pplex.l` will use + `cb_ppecho_copy_replace()` to add tokens to the first stream + `copy_repls` (using `add_text_to_replace`), i.e. the stream of + copy-replacing. + + Once copy-replacing operations have been performed in this stream, + `ppecho_replace()` is used to add tokens to the second stream + `replace_repls` (using again `add_text_to_replace`), i.e. the + stream of `replace`. + + Once replace operations have been performed on this second stream, + `cb_ppecho_direct()` (in pplex.l) is used to output the final + tokens. + + The states of both streams are stored in a struct + `cb_replacement_state`, and `add_text_to_replace` calls the + function `do_replace()` to perform the replacement on a given + stream. + */ + +/* Uncomment the following lines to have a trace of replacements. + It uses macros WITH_DEPTH that adds an additional argument to every + function to keep the depth of the recursion. */ + +/* #define DEBUG_REPLACE_TRACE */ +/* #define DEBUG_REPLACE */ + +#ifdef DEBUG_REPLACE_TRACE +#define DEBUG_REPLACE +#endif struct cb_token_list { struct cb_token_list *next; /* next pointer */ struct cb_token_list *last; + + /* The text in the source to be matched. Most of the time, it + * directly what appears in the source file, but it may also + * be a simplified version, typically for spaces, in which + * case the exact text is stored in the `token` field (to be + * used if no replacement is performed) */ const char *text; + + /* NULL most of the time, non-NULL only if the `text` was + * replaced by a simplified version, i.e. space to easy + * testing. */ const char *token; }; -static struct cb_token_list *text_queue = NULL; -static size_t check_partial_match = 0; +/* types */ +enum cb_ppecho { + CB_PPECHO_DIRECT = 0, /* direct output */ + CB_PPECHO_REPLACE = 1, /* output to REPLACE */ +}; + +struct cb_replacement_state { + + /* The list of tokens that are currently being checked for + * replacements. Empty, unless a partial match occurred. */ + struct cb_token_list *token_queue ; + + /* We don't queue WORD tokens immediately, because + * preprocessing could create larger words. Instead, we buffer + * WORD tokens (and merge them) until another kind of token + * (SPACE,DELIM,etc.) is received. */ + const char *text_prequeue ; + + /* Current list of replacements specified in COPY-REPLACING or + * REPLACE */ + struct cb_replace_list *replace_list ; + + /* List of replacements after a partial match that still need + * to be tested. */ + const struct cb_replace_list *current_list ; + + /* The next pass to which generated tokens should be passed + * (either REPLACE pass or direct output */ + enum cb_ppecho ppecho ; + +#ifdef DEBUG_REPLACE + const char* name ; +#endif +}; + + +#ifdef DEBUG_REPLACE_TRACE + +#define WITH_DEPTH int depth, +#define INIT_DEPTH 1, +#define MORE_DEPTH depth+1, + +#define MAX_DEPTH 100 +char depth_buffer[MAX_DEPTH+1]; +#define DEPTH depth_buffer + ( MAX_DEPTH-depth ) + +#else // DEBUG_REPLACE_TRACE + +#define WITH_DEPTH +#define DEPTH +#define INIT_DEPTH +#define MORE_DEPTH -static int ppecho_replace (struct cb_replace_list *); +#endif // DEBUG_REPLACE_TRACE + + +#ifdef DEBUG_REPLACE + +#define MAX_TEXT_LIST_STRING 10000 +char text_list_string[MAX_TEXT_LIST_STRING]; + +static +char * string_of_list(const struct cb_text_list *list) +{ + int pos = 1; + text_list_string[0] = '['; + + for(; list != NULL; list = list->next){ + size_t len = strlen(list->text); + text_list_string[pos++] = '"'; + memcpy( text_list_string + pos, list->text, len ); + pos += len; + text_list_string[pos++] = '"'; + text_list_string[pos++] = ','; + text_list_string[pos++] = ' '; + } + + text_list_string[pos] = ']'; + text_list_string[pos+1]=0; + return text_list_string; +} +#endif // DEBUG_REPLACE + +/* global state */ +static struct cb_replacement_state * replace_repls; +static struct cb_replacement_state * copy_repls; + +/* forward definitions */ +static void ppecho_replace (WITH_DEPTH const char *text, const char* token); +static void do_replace (WITH_DEPTH struct cb_replacement_state* repls); +static void check_replace_after_match (WITH_DEPTH struct cb_replacement_state *repls); +static void check_replace_all (WITH_DEPTH struct cb_replacement_state *repls, + const struct cb_text_list *new_text, + struct cb_token_list *texts, + const struct cb_text_list *src, + const struct cb_replace_list *replace_list); static struct cb_token_list * -pp_token_list_add (struct cb_token_list *list, - const char *text, - const char *token) +token_list_add (WITH_DEPTH struct cb_token_list *list, + const char *text, + const char *token); + +/* This specific token_list_add function does a standard append on + list, without expecting `last` field to be correctly set. This is + important as `pp_token_list_add` only correctly works when always + adding on the same head, other `last` fields in the middle of the + list not being correctly updated... + */ +static +struct cb_token_list * +token_list_add (WITH_DEPTH struct cb_token_list *list, + const char *text, const char *token) { +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%stoken_list_add(%s,'%s')\n", + DEPTH, string_of_list(list), text); +#endif struct cb_token_list *p; - void *tp; - int text_size = strlen (text); p = cobc_plex_malloc (sizeof (struct cb_token_list)); + p->text = cobc_plex_strdup (text); if (token == NULL) { - tp = cobc_plex_malloc (text_size + 1); p->token = NULL; } else { - int token_size = strlen (token); - tp = cobc_plex_malloc( text_size + token_size + 2); - memcpy (tp+text_size+1, token, token_size); - p->token = tp+text_size+1; + p->token = cobc_plex_strdup (token); } - memcpy (tp, text, text_size); - p->text = tp; - if (!list) { - p->last = p; + + p->next = NULL; + if (list==NULL) { return p; + } else { + struct cb_token_list *cursor = list; + for(;cursor->next != NULL; cursor = cursor->next); + cursor->next = p; + return list; } - list->last->next = p; - list->last = p; - return list; } -void cb_free_replace( void ) + + +static +const void pop_token (WITH_DEPTH struct cb_replacement_state *repls, + const char **text, const char **token) { - current_replace_list = NULL; - base_replace_list = NULL; - save_current_replace = NULL; - text_queue = NULL; + const struct cb_token_list *q = repls->token_queue ; + repls->token_queue = q->next ; +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%spop_token(%s) -> '%s'\n", + DEPTH, repls->name, q->text); +#endif + if (text) *text = q->text ; + if (token) *token = q->token ; } -struct cb_replace_list *cb_get_copy_replacing_list (void) +static +void ppecho_switch (WITH_DEPTH struct cb_replacement_state *repls, + const char* text, const char* token) { - return current_replace_list; +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sppecho_switch(%s, '%s')\n", + DEPTH, repls->name, text); +#endif + switch( repls->ppecho ){ + case CB_PPECHO_DIRECT: +#ifdef DEBUG_REPLACE + fprintf(stderr, "%s ppecho_direct('%s')\n", DEPTH, text); +#endif + return cb_ppecho_direct (text, token); + case CB_PPECHO_REPLACE: + return ppecho_replace (MORE_DEPTH text, token); + } } -void cb_set_copy_replacing_list (struct cb_replace_list *list) +static +void ppecho_switch_text_list (WITH_DEPTH struct cb_replacement_state *repls, + const struct cb_text_list *p) { - current_replace_list = list; +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sppecho_switch_text_list(%s, %s)\n", + DEPTH, repls->name, string_of_list(p)); +#endif + + for (;p;p=p->next){ + ppecho_switch (MORE_DEPTH repls, p->text, NULL); + } } -void -cb_ppecho_copy_replace (const char *text, const char *token) + +static +void ppecho_switch_token_list (WITH_DEPTH struct cb_replacement_state *repls, + const struct cb_token_list *p) { - /* performance note (last verified with GnuCOBOL 2.2): - while this function used 5% (according to callgrind) - of the complete time spent in a sample run with - -fsyntax-only on 880 production code files (2,500,000 LOC), - 3.8% of this time is spent in fwrite, therefore not much potential - for optimization */ - - struct cb_replace_list *save_ptr; - struct cb_token_list *save_ptr_text_queue; - int status, save_status; - -#if 0 /* Simon: disabled until found necessary, as this takes together with frwite - a big part of the parsing phase of cobc, increasing the IO cost by numbers */ - /* ensure nothing is in the stream buffer */ - fflush (ppout); +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sppecho_switch_token_list(%s, %s)\n", + DEPTH, repls->name, string_of_list(p)); #endif - if (text_queue == NULL && (text[0] == ' ' || text[0] == '\n')) { - cb_ppecho_direct (text, token); - return; + for (;p;p=p->next){ + ppecho_switch (MORE_DEPTH repls, p->text, p->token); } - if (!current_replace_list && !base_replace_list) { - /* Output queue */ - for (; text_queue; text_queue = text_queue->next) { - cb_ppecho_direct(text_queue->text, text_queue->token); +} + +static +int is_leading_or_trailing (WITH_DEPTH int leading, + const char* src_text, + const char* text, + int strict) +{ + + size_t src_len = strlen (src_text); + size_t text_len = strlen(text); + int result ; + if( text_len > src_len || ( !strict && text_len == src_len ) ){ + int pos = leading ? 0 : text_len - src_len ; + if( strncasecmp (src_text, text+pos, src_len) ){ + result = FALSE; + } else { + result = TRUE; } - cb_ppecho_direct(text, token); - return; - } - if (!current_replace_list) { - current_replace_list = base_replace_list; - save_ptr = NULL; } else { - current_replace_list->last->next = base_replace_list; - save_ptr = current_replace_list->last; + result = FALSE; } +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, + "%sis_leading_or_trailing(%d, '%s', input='%s', %d) -> %d\n", + DEPTH, leading, src_text, text, strict, result); +#endif + return result; +} - /* Do replacement */ - text_queue = pp_token_list_add (text_queue, text, token); - - save_ptr_text_queue = text_queue; - status = ppecho_replace (save_ptr); - /* Search another replacement when have a Partial Match in the last ppecho call */ - if (check_partial_match && status != -1) { - save_status = status; - text_queue = save_ptr_text_queue; - while (text_queue && check_partial_match) { - if (is_space_or_nl (text_queue->text[0])) { - cb_ppecho_direct (text_queue->text, - text_queue->token); - text_queue = text_queue->next; - continue; - } - status = ppecho_replace (save_ptr); - if (status > save_status) { - save_status = status; +/* after a LEADING or TRAILING match, perform the replacement within + the text, and pass the resulting new text to the next stream */ +static +void ppecho_leading_or_trailing (WITH_DEPTH struct cb_replacement_state *repls, + int leading, + const char *src_text, + const char *text, + const struct cb_text_list * new_text) +{ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, + "%sppecho_leading_or_trailing(%s, %d, '%s', input='%s', ...)\n", + DEPTH, repls->name, leading, src_text, text); +#endif + + size_t src_len = strlen (src_text); + size_t text_len = strlen (text); + + if (!leading && text_len > src_len) { + /* For TRAILING, we have to keep only the non-matched + * prefix part of the matching text */ + const char* remaining_text = + cobc_plex_strsub (text, + text_len - src_len); + ppecho_switch (MORE_DEPTH repls, remaining_text, NULL); + } + + ppecho_switch_text_list (MORE_DEPTH repls, new_text); + + if (leading && text_len > src_len) { + const char* remaining_text = + cobc_plex_strsub (text+src_len, + text_len - src_len); + ppecho_switch (MORE_DEPTH repls, remaining_text, NULL); + } +} + +/* `check_replace( repls, replace_list )`: check if one of the + * replacements in the list `replace_list` applies on the stream + * `repls`. + * * `repls`: the current stream + * * `replace_list`: the current list of possible replacements on check + */ + +static +void check_replace (WITH_DEPTH struct cb_replacement_state* repls, + const struct cb_replace_list *replace_list) +{ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%scheck_replace(%s, ...)\n", DEPTH, + repls->name); +#endif + repls->current_list = replace_list; + + if (replace_list == NULL){ + + /* NO MATCH: no possible replacement on this text */ + + /* remove the text from the current stream */ + const char* text; + const char* token; + pop_token (MORE_DEPTH repls, &text, &token); + + /* pass it to the next stream */ + ppecho_switch (MORE_DEPTH repls, text, token); + + /* restart replacements on this stream */ + check_replace_after_match (MORE_DEPTH repls); + + } else { + const struct cb_replace_src *src = replace_list->src; + const struct cb_text_list *new_text = replace_list->new_text; + replace_list = replace_list->next; + + if (src->lead_trail == CB_REPLACE_LEADING + || src->lead_trail == CB_REPLACE_TRAILING){ + /* LEADING and TRAILING replacements are + * different: they match only on one text, so + * we just need one test to decide if it is a + * match or a failure */ + int leading = (src->lead_trail == CB_REPLACE_LEADING); + unsigned int strict = src->strict; + const char *src_text = src->text_list->text; + const char *text = repls->token_queue->text; + + if (is_leading_or_trailing (MORE_DEPTH leading, + src_text,text,strict)){ + + /* MATCH */ + /* remove the text from the current stream */ + pop_token (MORE_DEPTH repls, NULL, NULL); + + /* perform a partial replacement on the text, + and pass it to the next stream */ + ppecho_leading_or_trailing (MORE_DEPTH repls, + leading, + src_text,text, + new_text) ; + + /* restart replacements on this stream */ + check_replace_after_match (MORE_DEPTH repls); + } else { + check_replace (MORE_DEPTH repls,replace_list); } - if (text_queue) { - /* Write text_queue if is not replaced */ - if (status != -1 && check_partial_match) { - cb_ppecho_direct (text_queue->text, - text_queue->token); + } else { + /* we need to compare a list of texts from + * this stream with a list of texts from the + * replacement */ + check_replace_all (MORE_DEPTH repls,new_text, + repls->token_queue, + src->text_list, + replace_list); + } + } +} + +/* `check_replace_all( repls, new_text, texts, src, replace_list )`: + * checks whether a particular replacement is possible on the current + * list of texts. + * * `repls` is the current stream state + * * `new_text` is the text by which the texts should be replace in case of match + * * `texts` is the list of texts found in the source that remains to be matched + * * `src` is the list of texts from the replacement to be matched + * * `replace_list` is the next replacements to try in case of failure + */ +static +void check_replace_all (WITH_DEPTH + struct cb_replacement_state *repls, + const struct cb_text_list *new_text, + struct cb_token_list *texts, + const struct cb_text_list *src, + const struct cb_replace_list *replace_list) +{ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%scheck_replace_all(%s,", + DEPTH, repls->name); + fprintf(stderr, "%s new_text = %s,\n", DEPTH, + string_of_list(new_text)); + fprintf(stderr, "%s texts = %s,\n", DEPTH, + string_of_list(texts)); + fprintf(stderr, "%s src = %s,\n", DEPTH, + string_of_list(src)); + fprintf(stderr, "%s)\n", DEPTH); +#endif + + if (src==NULL){ + /* MATCH */ + /* pass the new text to the next stream */ + ppecho_switch_text_list (MORE_DEPTH repls, new_text) ; + /* keep only in this stream the remaining texts that have not been matched */ + repls->token_queue = texts ; + /* restart replacements on the stream */ + check_replace_after_match (MORE_DEPTH repls); + } else { + const char* src_text = src->text; + if ( is_space_or_nl(src_text[0]) ){ + /* skip spaces in replacement */ + check_replace_all (MORE_DEPTH repls,new_text,texts, + src->next, replace_list); + } else { + if (texts == NULL){ + /* PARTIAL MATCH, we have emptied the + * list of texts, but there are still + * texts in the replacement, so wait + * for more texts to be added on the + * stream */ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%s check_replace_all --> PARTIAL MATCH\n", DEPTH); +#endif + } else { + const char* text = texts->text; + texts = texts->next; + if ( is_space_or_nl(text[0]) ){ + /* skip spaces in texts */ + check_replace_all (MORE_DEPTH repls, + new_text, + texts, src, + replace_list); + } else { + if (!strcasecmp(src_text,text)){ + /* We could match one + * text from the + * stream with a text + * from the + * replacement, so + * move on to the next + * text */ + check_replace_all( + MORE_DEPTH repls, + new_text, + texts,src->next, + replace_list); + } else { + /* match failed, move + * on to the next + * potential + * replacement */ + check_replace ( + MORE_DEPTH repls, + replace_list); + } } - text_queue = text_queue->next; } } - status = save_status; } - /* Manage Partial Match */ - if (status == -1) { - check_partial_match = save_ptr_text_queue != NULL; - return; - } - if (!status) { - current_replace_list = NULL; +} + +static +void check_replace_after_match (WITH_DEPTH struct cb_replacement_state *repls) +{ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%scheck_replace_after_match(%s)\n", + DEPTH, repls->name); +#endif + repls->current_list = NULL; + if (repls->token_queue != NULL){ + if( is_space_or_nl (repls->token_queue->text[0]) ){ + ppecho_switch (MORE_DEPTH repls, + repls->token_queue->text, + repls->token_queue->token); + repls->token_queue = repls->token_queue->next; + check_replace_after_match (MORE_DEPTH repls); + } else { + do_replace (MORE_DEPTH repls); + } + } +} + +static +void do_replace (WITH_DEPTH struct cb_replacement_state* repls) +{ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sdo_replace(%s)\n",DEPTH, repls->name); +#endif + if (repls->current_list == NULL){ + if (repls->replace_list == NULL){ + + /* Beware: this is incorrect if a REPLACE is + * withing the queue, as it has already been + * parsed before any COPY-REPLACING + * substitution. */ + ppecho_switch_token_list (MORE_DEPTH repls, + repls->token_queue); + repls->token_queue = NULL; + } else { + check_replace (MORE_DEPTH repls, repls->replace_list); + } } else { - save_ptr->next = NULL; + check_replace (MORE_DEPTH repls, repls->current_list); } +} + +/* Whether a word matches the definition of WORD in pplex.l */ +static +int is_word (WITH_DEPTH const char* s){ + int i; + size_t len = strlen (s); - /* No match */ - for (; text_queue; text_queue = text_queue->next) { - cb_ppecho_direct (text_queue->text, text_queue->token); + + for( i = 0; i= '0' && c <= '9' ) + || ( c >= 'A' && c <= 'Z' ) + || ( c >= 'a' && c <= 'z' ) + || ( c >= 128 && c <= 255 ) + ){ + + } else { +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sis_word('%s') -> FALSE\n", DEPTH, s); +#endif + return FALSE; + } } +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sis_word('%s') -> TRUE\n", DEPTH, s); +#endif + return TRUE; } -/* handle all kinds of COPY REPLACING and REPLACE */ -static int -ppecho_replace (struct cb_replace_list *save_ptr) +static void add_text_to_replace (WITH_DEPTH struct cb_replacement_state *repls, + int prequeue, + const char* text, + const char* token + ) { - char *temp_ptr; - size_t size; - size_t size2; - struct cb_token_list *queue; - struct cb_token_list *save_queue; - const struct cb_text_list *lno; - struct cb_replace_list *r; - - save_queue = NULL; - size = 0; - size2 = 0; - for (r = current_replace_list; r; r = r->next) { - queue = text_queue; - /* The LEADING/TRAILING code looks peculiar as we use */ - /* variables after breaking out of the loop BUT */ - /* ppparse.y guarantees that we have only one token */ - /* and therefore only one iteration of this loop */ - for (lno = r->src->text_list; lno; lno = lno->next) { - if (is_space_or_nl (lno->text[0])) { - continue; - } - while (queue && is_space_or_nl (queue->text[0])) { - queue = queue->next; - } - if (queue == NULL) { - /* Partial match */ - if (!save_ptr) { - current_replace_list = NULL; - } else { - save_ptr->next = NULL; - } - return -1; +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sadd_text_to_replace(%s%s, '%s')\n", DEPTH, + repls->name, prequeue ? ", PREQUEUE" : "", text); +#endif + if( prequeue ){ + + if( is_word (MORE_DEPTH text) ) { + + if( repls->text_prequeue == NULL ){ + /* a word should be kept in the prequeue */ + repls->text_prequeue = + cobc_plex_strdup (text); + } else { + /* two following words should be + * merged, and keep waiting in the + * prequeue */ + repls->text_prequeue = + cobc_plex_stradd (repls->text_prequeue, + text); } - if (r->src->lead_trail == CB_REPLACE_LEADING) { - /* Check leading text */ - size = strlen (lno->text); - if ((r->src->strict && strlen (queue->text) == size) - || strncasecmp (lno->text, queue->text, size)) { - /* No match */ - break; - } - save_queue = queue; - } else if (r->src->lead_trail == CB_REPLACE_TRAILING) { - /* Check trailing text */ - size = strlen (lno->text); - size2 = strlen (queue->text); - if (size2 < size - || (r->src->strict && size2 == size)) { - /* No match */ - break; - } - size2 -= size; - if (strncasecmp (lno->text, queue->text + size2, size)) { - /* No match */ - break; - } - save_queue = queue; - } else if (strcasecmp (lno->text, queue->text)) { - /* No match */ - break; + } else { + if( repls->text_prequeue == NULL ){ + /* not a word, and empty prequeue, + * just perform replacements */ + add_text_to_replace(MORE_DEPTH repls, FALSE, text, token); + } else { + /* not a word, one word in the + * prequeue, flush the word from the + * prequeue and pass the current text + * to the replacements */ + const char* pretext = repls->text_prequeue; + repls->text_prequeue = NULL; + add_text_to_replace(MORE_DEPTH repls, + FALSE, pretext, NULL); + add_text_to_replace(MORE_DEPTH repls, + FALSE, text, token); } - queue = queue->next; } - if (lno == NULL) { - /* Match */ - if (r->src->lead_trail == CB_REPLACE_TRAILING - && save_queue /* <- silence warnings */) { - /* Non-matched part of original text */ - temp_ptr = cobc_strdup (save_queue->text); - *(temp_ptr + size2) = 0; - cb_ppecho_direct (temp_ptr, NULL); - cobc_free (temp_ptr); - } - for (lno = r->new_text; lno; lno = lno->next) { - cb_ppecho_direct (lno->text, NULL); - } - if (r->src->lead_trail == CB_REPLACE_LEADING - && save_queue /* <- silence warnings */) { - /* Non-matched part of original text */ - cb_ppecho_direct (save_queue->text + size, NULL); - } - check_partial_match = 0; - text_queue = queue; - continue; + } + else { + if( repls->token_queue == NULL && + ( is_space_or_nl (text[0])) ) { + ppecho_switch (MORE_DEPTH repls, text, token); + } else { +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, + "%s add_text_to_replace() -> push_text()\n", + DEPTH); +#endif + repls->token_queue = + token_list_add(MORE_DEPTH repls->token_queue, + text, token); + + do_replace (MORE_DEPTH repls); } } - return (save_ptr ? 1 : 0); } +/* pass a text to the replace stream (called from the copy-replacing + stream). Use prequeue = TRUE so that texts of the same kind are + merged into a single text. + */ +static void ppecho_replace (WITH_DEPTH const char *text, const char *token) +{ +#ifdef DEBUG_REPLACE + fprintf(stderr, "%sppecho_replace('%s')\n", DEPTH, text); +#endif + add_text_to_replace(MORE_DEPTH replace_repls, TRUE, text, token); +} + +/* pass a text to the copy-replacing stream (called from ppecho() in + pplex.l). Use prequeue = FALSE as texts of the same kind from the + source file should not be merged. + */ +void cb_ppecho_copy_replace (const char *text, const char *token) +{ +#ifdef DEBUG_REPLACE + fprintf(stderr, "cb_ppecho_copy_replace('%s')\n", text); +#endif + add_text_to_replace(INIT_DEPTH copy_repls, FALSE, text, token); +} + + +static +struct cb_replacement_state * create_replacements( enum cb_ppecho ppecho ) +{ + struct cb_replacement_state * s; + + s = cobc_malloc (sizeof(struct cb_replacement_state)); + + s->text_prequeue = NULL; + s->token_queue = NULL; + s->replace_list = NULL ; + s->current_list = NULL ; + s->ppecho = ppecho; + +#ifdef DEBUG_REPLACE + if( ppecho == CB_PPECHO_REPLACE ){ + s->name = "COPY-REPLACING"; + } else { + s->name = "REPLACE"; + } +#endif + + return s; +} + +static void reset_replacements( struct cb_replacement_state * s ) +{ + s->text_prequeue = NULL; + s->token_queue = NULL; + s->replace_list = NULL ; + s->current_list = NULL ; +} + +static +void init_replace( void ) +{ +#ifdef DEBUG_REPLACE_TRACE + for(int i=0; ireplace_list ; +} + +/* Called by pplex.l, either at the end of a file to restore the +previous stack of active copy-replacing, or when a new file is open to +set additional copy replacing */ +void cb_set_copy_replacing_list (struct cb_replace_list *list) +{ + copy_repls->current_list = NULL; + copy_repls->replace_list = list ; +#ifdef DEBUG_REPLACE + fprintf(stderr, "set_copy_replacing_list(\n"); + for(;list != NULL; list=list->next){ + fprintf(stderr, " repl = {\n"); + fprintf(stderr, " src = %s\n", + string_of_list(list->src->text_list)); + fprintf(stderr, " leading = %d\n", + list->src->lead_trail); + fprintf(stderr, " new_text = %s\n", + string_of_list(list->new_text)); + fprintf(stderr, " };\n"); + } + fprintf(stderr, " )\n"); +#endif +} +/* Called by pplex.l from pp_set_replace_list() after a REPLACE statement: + + list is_pushpop + REPLACE . <> NULL false + REPLACE ALSO . <> NULL true + REPLACE LAST OFF. NULL true + REPLACE OFF. NULL false + */ void cb_set_replace_list (struct cb_replace_list *list, const int is_pushpop) { - /* Handle REPLACE verb */ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "set_replace_list(...)\n"); +#endif if (!list) { /* REPLACE [LAST] OFF */ if (!is_pushpop) { - base_replace_list = NULL; + replace_repls->replace_list = NULL; return; } - if (!base_replace_list) { + if (!replace_repls->replace_list) { return; } - base_replace_list = base_replace_list->prev; + replace_repls->replace_list = replace_repls->replace_list->prev; return; } /* REPLACE [ALSO] ... */ - if (base_replace_list && is_pushpop) { - list->last->next = base_replace_list; - list->prev = base_replace_list; + if (replace_repls->replace_list && is_pushpop) { + list->last->next = replace_repls->replace_list; + list->prev = replace_repls->replace_list; } else { list->prev = NULL; } - base_replace_list = list; + replace_repls->replace_list = list; if (cb_src_list_file) { cb_set_print_replace_list (list); } diff --git a/tests/testsuite.src/syn_copy.at b/tests/testsuite.src/syn_copy.at index aeb6b9dec..5b8f5f821 100644 --- a/tests/testsuite.src/syn_copy.at +++ b/tests/testsuite.src/syn_copy.at @@ -921,17 +921,12 @@ AT_CLEANUP AT_SETUP([COPY and REPLACE in same file]) -AT_KEYWORDS([copy]) +AT_KEYWORDS([replacing preprocess]) -# see Bug #868 +# See Bug #831 # the issue with this example is that the outer REPLACE # _could_ only see the result of the inner REPLACING: # "COLON", but needs to see "VAR-COLON". -# To even enable it to see the replaced data in the outer -# replacings pplex.l (ppecho_replace) must be changed to not -# output the results with a call to (ppecho_direct) but has to -# continue the loop with the - potential partially replaced - -# new content. AT_DATA([copy.inc], [ 01 VAR-:TEST: PIC X(2) VALUE "OK". @@ -951,8 +946,39 @@ AT_DATA([prog.cob], [ REPLACE OFF. ]) -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'VAR-COMMA' is not defined +#AT_CHECK([$COMPILE_ONLY -P=preproc.lst prog.cob], [0], [], []) +#AT_CHECK([cat preproc.lst], [0], +#[ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +#],[]) + +AT_CHECK([$COMPILE_ONLY -t preproc.lst prog.cob], [0], [], []) +AT_DATA([expected.lst], +[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 + +LINE PG/LN A...B............................................................ + +000001 +000002 IDENTIFICATION DIVISION. +000003 PROGRAM-ID. prog. +000004 DATA DIVISION. +000005 WORKING-STORAGE SECTION. +000006 REPLACE ==VAR-COLON== BY ==VAR-COMMA==. +000007 COPY "copy.inc" +000001C +000002C 01 VAR-:TEST: PIC X(2) VALUE "OK". +000007 REPLACING ==:TEST:== BY ==COLON==. +000008 PROCEDURE DIVISION. +000009 DISPLAY VAR-COMMA NO ADVANCING +000010 END-DISPLAY. +000011 STOP RUN. +000012 REPLACE OFF. + + +0 warnings in compilation group +0 errors in compilation group ]) +AT_CHECK([$UNIFY_LISTING preproc.lst preproc.lis], [0], [], []) +AT_CHECK([diff expected.lst preproc.lis], [0], [], []) + AT_CLEANUP