From a53bdd0cab44e8d7e2fa542d70b7e33610c6a7ac Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant Date: Sun, 15 Jan 2023 17:50:07 +0100 Subject: [PATCH] Fix COPY REPLACING and REPLACE Current implementation does not conform to standard (COPY REPLACING and REPLACE are supposed to be in two successive passes instead of applied together), and has various bugs. This version is probably less efficient, but better conforms to the standard. Limitations: * This first version only modify the replacements during preprocessing, not the ones during the listing printing. * Since REPLACE are interpreted *before* the COPY REPLACING, they cannot be modified by them. A conforming implementation would interpret REPLACE strictly after COPY REPLACING. --- cobc/ChangeLog | 10 + cobc/Makefile.am | 3 +- cobc/cobc.c | 56 ++- cobc/cobc.h | 5 + cobc/pplex.l | 271 ++----------- cobc/replace.c | 687 ++++++++++++++++++++++++++++++++ cobc/replace.h | 44 ++ tests/testsuite.src/syn_copy.at | 27 ++ 8 files changed, 857 insertions(+), 246 deletions(-) create mode 100644 cobc/replace.c create mode 100644 cobc/replace.h diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 385df1ef2..08d39c96c 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,14 @@ +2023-01-05 Fabrice Le Fessant + + * cobc.c.c: add `cobc_plex_stradd` and `cobc_plex_strsub` allocation + functions for the pplex phase. + * replace.c: new file containing the two-phase COPY-REPLACING and REPLACE + mechanism, conforming to COBOL standard. + * pplex.l: remove former `pplex_echo` and `pplex_replace` code. The + `alt_space` parameter is not used anymore, leading to different listing + code in some cases. + 2023-01-16 Simon Sobisch * parser.y (occurs_index): only set VALUE 1 for defaultbyte == INIT diff --git a/cobc/Makefile.am b/cobc/Makefile.am index 417af58aa..a96b7c3ab 100644 --- a/cobc/Makefile.am +++ b/cobc/Makefile.am @@ -22,7 +22,8 @@ bin_PROGRAMS = cobc cobc_SOURCES = cobc.c cobc.h ppparse.y pplex.c parser.y scanner.c config.c \ reserved.c error.c tree.c tree.h field.c typeck.c codegen.c help.c \ - config.def flag.def warning.def codeoptim.def ppparse.def codeoptim.c + config.def flag.def warning.def codeoptim.def ppparse.def \ + codeoptim.c replace.h replace.c #cobc_SOURCES = cobc.c cobc.h ppparse.y pplex.l parser.y scanner.l config.c diff --git a/cobc/cobc.c b/cobc/cobc.c index da4d181f7..d18e2ebf8 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -983,7 +983,7 @@ cobc_strdup (const char *dupstr) return p; } -#if defined (_WIN32) || defined (__CYGWIN__) +#if defined (_WIN32) || defined (__CYGWIN__) static char * cobc_stradd_dup (const char *str1, const char *str2) { @@ -1313,6 +1313,59 @@ cobc_plex_strdup (const char *dupstr) return p; } +char * +cobc_plex_stradd (const char *str1, const char *str2) +{ + char *p; + size_t m, n; + + /* LCOV_EXCL_START */ + if (unlikely (!str1 || !str2)) { + cobc_err_msg (_("call to %s with NULL pointer"), + "cobc_plex_stradd"); + cobc_abort_terminate (1); + } + /* LCOV_EXCL_STOP */ + m = strlen (str1); + n = strlen (str2); + p = cobc_plex_malloc (m + n + 1); + memcpy (p, str1, m); + memcpy (p + m, str2, n); + return p; +} + +void * +cobc_plex_strsub (const char *s, const int len) +{ + void *p; + int n; + +#ifdef COB_TREE_DEBUG + /* LCOV_EXCL_START */ + if (unlikely (!s)) { + cobc_err_msg (_("call to %s with NULL pointer"), + "cobc_plex_strsub"); + cobc_abort_terminate (1); + } + /* LCOV_EXCL_STOP */ +#endif + 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; +} + /* 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' */ @@ -5961,6 +6014,7 @@ print_program_trailer (void) /* Print file/symbol tables if requested */ if (cb_listing_symbols) { + if (cb_listing_with_header) { set_listing_header_symbols (); } diff --git a/cobc/cobc.h b/cobc/cobc.h index 9dcb38dc7..38a6fbb06 100644 --- a/cobc/cobc.h +++ b/cobc/cobc.h @@ -489,6 +489,8 @@ extern struct reserved_word_list *cob_user_res_list; extern void *cobc_malloc (const size_t); extern void cobc_free (void *); extern void *cobc_strdup (const char *); +extern char *cobc_stradd_dup (const char *str1, + const char *str2); extern void *cobc_realloc (void *, const size_t); extern void *cobc_main_malloc (const size_t); @@ -503,6 +505,9 @@ 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); +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/pplex.l b/cobc/pplex.l index fb9743bfc..1675f9714 100644 --- a/cobc/pplex.l +++ b/cobc/pplex.l @@ -92,6 +92,7 @@ static int ppwrap (void) { #include "cobc.h" #include "tree.h" #include "ppparse.h" +#include "replace.h" #ifdef _WIN32 #include /* for access */ @@ -106,6 +107,9 @@ static int ppwrap (void) { #define PLEX_COND_DEPTH 16 +// replace yytext by some simplified text in ppecho() +#define ALT_TEXT 1 + struct copy_info { struct copy_info *next; struct copy_info *prev; @@ -157,23 +161,14 @@ static int emit_area_a_tokens = 0; static char display_msg[PPLEX_BUFF_LEN]; -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; - -static struct cb_text_list *text_queue = NULL; -static size_t check_partial_match = 0; - static struct copy_info *copy_stack = NULL; static struct plex_stack plex_cond_stack[PLEX_COND_DEPTH]; /* Function declarations */ static int ppinput (char *, const size_t); -static void ppecho (const char *, const cob_u32_t, +static void ppecho (const char *, const int, const int); -static void ppecho_direct (const char *); -static int ppecho_replace (struct cb_replace_list *); static void switch_to_buffer (const int, const char *, const YY_BUFFER_STATE); static void check_listing (const char *, const unsigned int); @@ -183,9 +178,6 @@ static void display_finish (void); static void set_print_replace_list (struct cb_replace_list *); static void get_new_listing_file (void); -static struct cb_text_list *pp_text_list_add (struct cb_text_list *, - const char *, const size_t); - %} WORD [_0-9A-Z\x80-\xFF-]+ @@ -640,32 +632,32 @@ SUBSTITUTION_SECTION_STATE> } [,;]?\n { - ppecho ("\n", 0, 1); + ppecho ("\n", ALT_TEXT, 1); cb_source_line++; } [;]?[ ]+ { - ppecho (" ", 1U, 1); + ppecho (" ", ALT_TEXT, 1); } [,]?[ ]+ { if (inside_bracket) { - ppecho (", ", 0, 2); + ppecho (", ", ALT_TEXT, 2); } else { - ppecho (" ", 1U, 1); + ppecho (" ", ALT_TEXT, 1); } } "(" { - inside_bracket++; - ppecho ("(", 0, 1); + inside_bracket++; + ppecho (yytext, 0, (int)yyleng); } ")" { if (inside_bracket) { inside_bracket--; } - ppecho (")", 0, 1); + ppecho (yytext, 0, (int)yyleng); } {WORD} | @@ -1081,10 +1073,7 @@ ENDIF_DIRECTIVE_STATE>{ newline_count = 0; inside_bracket = 0; comment_allowed = 1; - current_replace_list = NULL; - base_replace_list = NULL; - save_current_replace = NULL; - text_queue = NULL; + free_replace (); copy_stack = NULL; quotation_mark = 0; consecutive_quotation = 0; @@ -1106,7 +1095,7 @@ ENDIF_DIRECTIVE_STATE>{ current_copy_info->buffer); /* Restore variables */ - current_replace_list = current_copy_info->replacing; + set_copy_replacing_list (current_copy_info->replacing); quotation_mark = current_copy_info->quotation_mark; cobc_set_source_format (current_copy_info->source_format); @@ -1123,26 +1112,8 @@ void pp_set_replace_list (struct cb_replace_list *list, const cob_u32_t is_pushpop) { /* Handle REPLACE verb */ - if (!list) { - /* REPLACE [LAST] OFF */ - if (!is_pushpop) { - base_replace_list = NULL; - return; - } - if (!base_replace_list) { - return; - } - base_replace_list = base_replace_list->prev; - return; - } - /* REPLACE [ALSO] ... */ - if (base_replace_list && is_pushpop) { - list->last->next = base_replace_list; - list->prev = base_replace_list; - } else { - list->prev = NULL; - } - base_replace_list = list; + + set_replace_list (list, is_pushpop); if (cb_src_list_file) { set_print_replace_list (list); } @@ -1155,6 +1126,7 @@ ppopen (const char *name, struct cb_replace_list *replacing_list) struct copy_info *current_copy_info; char *dname; cb_tree x = NULL; + struct cb_replace_list *current_replace_list; if (ppin) { for (; newline_count > 0; newline_count--) { @@ -1228,7 +1200,9 @@ ppopen (const char *name, struct cb_replace_list *replacing_list) cb_depend_list = pp_text_list_add (cb_depend_list, name, strlen (name)); } - /* Preserve the current buffer */ + current_replace_list = get_copy_replacing_list(); + + /* Preserve the current buffer */ current_copy_info = cobc_malloc (sizeof (struct copy_info)); current_copy_info->file = cb_source_file; current_copy_info->buffer = YY_CURRENT_BUFFER; @@ -1256,7 +1230,7 @@ ppopen (const char *name, struct cb_replace_list *replacing_list) replacing_list->last->next = current_replace_list; replacing_list->last = current_replace_list->last; } - current_replace_list = replacing_list; + set_copy_replacing_list (replacing_list); if (cb_src_list_file) { set_print_replace_list (replacing_list); } @@ -2447,7 +2421,7 @@ start: return (int)gotcr; } -static struct cb_text_list * +struct cb_text_list * pp_text_list_add (struct cb_text_list *list, const char *text, const size_t size) { @@ -2468,201 +2442,11 @@ pp_text_list_add (struct cb_text_list *list, const char *text, } static void -ppecho (const char *text, const cob_u32_t alt_space, const int textlen) +ppecho (const char *text, const int alt_space, const int textlen) { - /* performance note: 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; - const char *s; - struct cb_text_list *save_ptr_text_queue; - int status, save_status; - - /* ensure nothing is in the stream buffer */ - fflush (ppout); - - /* Check for replacement text before outputting */ - if (alt_space) { - s = yytext; - } else { - s = text; - } - - if (text_queue == NULL && (text[0] == ' ' || text[0] == '\n')) { - /* No replacement */ - fwrite (text, (size_t)textlen, (size_t)1, ppout); - /* TODO: instead of \n (empty line: set "needs source-loc" flag and - before first non-empty line output a #line directive, saving - quite some file io [keep 1 empty line]) */ - if (cb_listing_file) { - check_listing (s, 0); - } - return; - } - if (!current_replace_list && !base_replace_list) { - /* Output queue */ - for (; text_queue; text_queue = text_queue->next) { - fputs (text_queue->text, ppout); - } - fwrite (text, (size_t)textlen, (size_t)1, ppout); - if (cb_listing_file) { - check_listing (s, 0); - } - 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; - } - - /* Do replacement */ - text_queue = pp_text_list_add (text_queue, text, (size_t)textlen); - - 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 (text_queue->text[0] == ' ' - || text_queue->text[0] == '\n') { - ppecho_direct (text_queue->text); - text_queue = text_queue->next; - continue; - } - status = ppecho_replace (save_ptr); - if (status > save_status) { - save_status = status; - } - if (text_queue) { - /* Write text_queue if is not replaced */ - if (status != -1 && check_partial_match) { - ppecho_direct (text_queue->text); - } - 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; - } else { - save_ptr->next = NULL; - } - - /* No match */ - for (; text_queue; text_queue = text_queue->next) { - ppecho_direct (text_queue->text); - } -} - -static int -ppecho_replace (struct cb_replace_list *save_ptr) -{ - char *temp_ptr; - size_t size; - size_t size2; - struct cb_text_list *queue; - struct cb_text_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 (lno->text[0] == ' ' || lno->text[0] == '\n') { - continue; - } - while (queue && (queue->text[0] == ' ' || - queue->text[0] == '\n')) { - queue = queue->next; - } - if (queue == NULL) { - /* Partial match */ - if (!save_ptr) { - current_replace_list = NULL; - } else { - save_ptr->next = NULL; - } - return -1; - } - 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; - } - 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 */ - fprintf (ppout, "%*.*s", (int)size2, (int)size2, - save_queue->text); - if (cb_listing_file) { - temp_ptr = cobc_strdup (save_queue->text); - *(temp_ptr + size2) = 0; - check_listing (temp_ptr, 0); - cobc_free (temp_ptr); - } - } - for (lno = r->new_text; lno; lno = lno->next) { - ppecho_direct (lno->text); - } - if (r->src->lead_trail == CB_REPLACE_LEADING - && save_queue /* <- silence warnings */) { - /* Non-matched part of original text */ - ppecho_direct (save_queue->text + size); - } - check_partial_match = 0; - text_queue = queue; - continue; - } - } - return (save_ptr ? 1 : 0); + /* This new versoin does not use `alt_space`, so the output + will be different from the previous one. */ + ppecho_copy( text ); } static void @@ -2703,8 +2487,7 @@ display_finish (void) unput ('\n'); } -static void -ppecho_direct (const char *text) +void ppecho_direct (const char *text) { fputs (text, ppout); if (cb_listing_file) { diff --git a/cobc/replace.c b/cobc/replace.c new file mode 100644 index 000000000..a93218697 --- /dev/null +++ b/cobc/replace.c @@ -0,0 +1,687 @@ +/* + Copyright (C) 2003-2022 Free Software Foundation, Inc. + Written by Fabrice Le Fessant + + This file is part of GnuCOBOL. + + The GnuCOBOL compiler is free software: you can redistribute it + and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + GnuCOBOL is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GnuCOBOL. If not, see . +*/ + +#include "tarstamp.h" +#include "config.h" + +#include +#include +#include +#include +#include +#ifdef HAVE_STRINGS_H +#include +#endif +#include +#include +#include + + +#include "cobc.h" +#include "tree.h" +#include "replace.h" + +#define TRUE 1 +#define FALSE 0 + +// #define DEBUG_REPLACE_TRACE +// #define DEBUG_REPLACE + +#ifdef DEBUG_REPLACE_TRACE +#define DEBUG_REPLACE +#endif + +/* This is an implementation of the *two* phases of COPY-REPLACING and + REPLACE on a stream of token: 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 fully conform to the standard, as REPLACE are + parsed on the input stream *before* any COPY-REPLACING could have + been applied. + */ + + +/* 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. */ + /* not const */ struct cb_text_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 *token_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 + +#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){ + int 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 *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_text_list *tokens, + const struct cb_text_list *src, + const struct cb_replace_list *replace_list); + + + +/* This specific text_list_add function does a standard append on + list, without expecting `last` field to be correctly set. This is + important as `pp_text_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_text_list * +text_list_add (WITH_DEPTH struct cb_text_list *list, const char *text) +{ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%stext_list_add(%s,'%s')\n", + DEPTH, string_of_list(list), text); +#endif + struct cb_text_list *p; + void *tp; + int size = strlen(text); + + tp = cobc_plex_malloc (size + 1); + memcpy (tp, text, size); + + p = cobc_plex_malloc (sizeof (struct cb_text_list)); + p->text = tp; + p->next = NULL; + + if (list==NULL) { + return p; + } else { + struct cb_text_list *cursor = list; + for(;cursor->next != NULL; cursor = cursor->next); + cursor->next = p; + return list; + } +} + + +static +const char* pop_token (WITH_DEPTH struct cb_replacement_state *repls) +{ + const struct cb_text_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 + return q->text ; +} + +static +void ppecho_switch (WITH_DEPTH struct cb_replacement_state *repls, + const char* token) +{ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sppecho_switch(%s, '%s')\n", + DEPTH, repls->name, token); +#endif + switch( repls->ppecho ){ + case CB_PPECHO_DIRECT: +#ifdef DEBUG_REPLACE + fprintf(stderr, "%s ppecho_direct('%s')\n", DEPTH, token); +#endif + return ppecho_direct (token); + case CB_PPECHO_REPLACE: + return ppecho_replace (MORE_DEPTH token); + } +} + +static +void ppecho_switch_list (WITH_DEPTH struct cb_replacement_state *repls, + const struct cb_text_list *p) +{ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sppecho_switch_list(%s, %s)\n", + DEPTH, repls->name, string_of_list(p)); +#endif + + for (;p;p=p->next){ + ppecho_switch (MORE_DEPTH repls, p->text); + } +} + +static +int is_leading_or_trailing (WITH_DEPTH int leading, + const char* src_token, + const char* token, + int strict) +{ + + int src_len = strlen (src_token); + int token_len = strlen(token); + int result ; + if( token_len > src_len || ( !strict && token_len == src_len ) ){ + int pos = leading ? 0 : token_len - src_len ; + if( strncasecmp (src_token, token+pos, src_len) ){ + result = FALSE; + } else { + result = TRUE; + } + } else { + result = FALSE; + } +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, + "%sis_leading_or_trailing(%d, '%s', input='%s', %d) -> %d\n", + DEPTH, leading, src_token, token, strict, result); +#endif + return result; +} + +static +void ppecho_leading_or_trailing (WITH_DEPTH struct cb_replacement_state *repls, + int leading, + const char *src_token, + const char *token, + 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_token, token); +#endif + + int src_len = strlen (src_token); + int token_len = strlen (token); + + if (!leading && token_len > src_len) { + const char* remaining_token = + cobc_plex_strsub (token, + token_len - src_len); + ppecho_switch (MORE_DEPTH repls, remaining_token); + } + + ppecho_switch_list (MORE_DEPTH repls, new_text); + + if (leading && token_len > src_len) { + const char* remaining_token = + cobc_plex_strsub (token+src_len, + token_len - src_len); + ppecho_switch (MORE_DEPTH repls, remaining_token); + } +} + +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 */ + const char* token = pop_token (MORE_DEPTH repls); + ppecho_switch (MORE_DEPTH repls, token); + 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){ + int leading = (src->lead_trail == CB_REPLACE_LEADING); + unsigned int strict = src->strict; + const char *src_token = src->text_list->text; + const char *token = repls->token_queue->text; + + if (is_leading_or_trailing (MORE_DEPTH leading, + src_token,token,strict)){ + + /* MATCH */ + ppecho_leading_or_trailing (MORE_DEPTH repls, + leading, + src_token,token, + new_text) ; + pop_token (MORE_DEPTH repls); + check_replace_after_match (MORE_DEPTH repls); + } else { + check_replace (MORE_DEPTH repls,replace_list); + } + } else { + check_replace_all (MORE_DEPTH repls,new_text, + repls->token_queue, + src->text_list, + replace_list); + } + } +} + +static +void check_replace_all (WITH_DEPTH struct cb_replacement_state *repls, + const struct cb_text_list *new_text, + struct cb_text_list *tokens, + 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 tokens = %s,\n", DEPTH, + string_of_list(tokens)); + fprintf(stderr, "%s src = %s,\n", DEPTH, + string_of_list(src)); + fprintf(stderr, "%s)\n", DEPTH); +#endif + + if (src==NULL){ + /* MATCH */ + ppecho_switch_list (MORE_DEPTH repls, new_text) ; + repls->token_queue = tokens ; + check_replace_after_match (MORE_DEPTH repls); + } else { + const char* src_token = src->text; + if (src_token[0] == ' ' || src_token[0] == '\n'){ + check_replace_all (MORE_DEPTH repls,new_text,tokens, + src->next, replace_list); + } else { + if (tokens == NULL){ + /* PARTIAL MATCH, wait for next token */ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%s check_replace_all --> PARTIAL MATCH\n", DEPTH); +#endif + } else { + const char* token = tokens->text; + tokens = tokens->next; + if (token[0] == ' ' || token[0] == '\n'){ + check_replace_all (MORE_DEPTH repls, + new_text, + tokens, src, + replace_list); + } else { + if (!strcasecmp(src_token,token)){ + + check_replace_all( + MORE_DEPTH repls, + new_text, + tokens,src->next, + replace_list); + } else { + check_replace ( + MORE_DEPTH repls, + replace_list); + } + } + } + } + } +} + +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( repls->token_queue->text[0] == ' ' || + repls->token_queue->text[0] == '\n' ){ + ppecho_switch (MORE_DEPTH repls, + repls->token_queue->text); + 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_list (MORE_DEPTH repls, + repls->token_queue); + repls->token_queue = NULL; + } else { + check_replace (MORE_DEPTH repls, repls->replace_list); + } + } else { + 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; + int len = strlen (s); + + + 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; +} + +static void add_token_to_replace (WITH_DEPTH struct cb_replacement_state *repls, + int prequeue, + const char* token + ) +{ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sadd_token_to_replace(%s%s, '%s')\n", DEPTH, + repls->name, prequeue ? ", PREQUEUE" : "", token); +#endif + if( prequeue ){ + + if( is_word (MORE_DEPTH token) ) { + + if( repls->token_prequeue == NULL ){ + repls->token_prequeue = + cobc_plex_strdup (token); + } else { + repls->token_prequeue = + cobc_plex_stradd (repls->token_prequeue, + token); + } + } else { + + if( repls->token_prequeue == NULL ){ + add_token_to_replace(MORE_DEPTH repls, FALSE, token); + } else { + const char* pretoken = repls->token_prequeue; + repls->token_prequeue = NULL; + add_token_to_replace(MORE_DEPTH repls, + FALSE, pretoken); + add_token_to_replace(MORE_DEPTH repls, + FALSE, token); + } + } + } + else { + if( repls->token_queue == NULL && + ( token[0] == ' ' || token[0] == '\n') ) { + ppecho_switch (MORE_DEPTH repls, token); + } else { +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, + "%s add_token_to_replace() -> push_token()\n", + DEPTH); +#endif + repls->token_queue = + text_list_add(MORE_DEPTH repls->token_queue, + token); + + do_replace (MORE_DEPTH repls); + } + } +} + +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->token_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->token_prequeue = NULL; + s->token_queue = NULL; + s->replace_list = NULL ; + s->current_list = NULL ; +} + +static void ppecho_replace (WITH_DEPTH const char *token) +{ +#ifdef DEBUG_REPLACE + fprintf(stderr, "%sppecho_replace('%s')\n", DEPTH, token); +#endif + add_token_to_replace(MORE_DEPTH replace_repls, TRUE, token); +} + +void ppecho_copy (const char *token) +{ +#ifdef DEBUG_REPLACE + fprintf(stderr, "ppecho_copy('%s')\n", token); +#endif + add_token_to_replace(INIT_DEPTH copy_repls, FALSE, token); +} + +void init_replace( void ) +{ +#ifdef DEBUG_REPLACE_TRACE + for(int i=0; ireplace_list ; +} + +void set_copy_replacing_list (struct cb_replace_list *list) +{ + struct cb_replacement_state * repls = copy_repls ; + + repls->current_list = NULL; + 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 +} + +void +set_replace_list (struct cb_replace_list *list, const int is_pushpop) +{ +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "set_replace_list(...)\n"); +#endif + struct cb_replacement_state * repls = replace_repls ; + /* Do not reset current candidates as the REPLACE is not yet active + repls->current_list = NULL; + */ + + /* We changed the former behavior of GnuCOBOL, because the + `return` statements used to return from + `pp_set_replace_list` before calling + `set_print_replace_list`, whereas this function is not + always called. */ + if (!list) { + /* REPLACE [LAST] OFF */ + if (!is_pushpop) { + repls->replace_list = NULL; + return; + } + if (!repls->replace_list) { + return; + } + repls->replace_list = repls->replace_list->prev; + return; + } + /* REPLACE [ALSO] ... */ + if (repls->replace_list && is_pushpop) { + list->last->next = repls->replace_list; + list->prev = repls->replace_list; + } else { + list->prev = NULL; + } + repls->replace_list = list; +} diff --git a/cobc/replace.h b/cobc/replace.h new file mode 100644 index 000000000..9ae41ffaa --- /dev/null +++ b/cobc/replace.h @@ -0,0 +1,44 @@ +/* + Copyright (C) 2023-2023 Free Software Foundation, Inc. + Written by Fabrice Le Fessant + + This file is part of GnuCOBOL. + + The GnuCOBOL compiler is free software: you can redistribute it + and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + GnuCOBOL is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GnuCOBOL. If not, see . +*/ + +#ifndef CB_REPLACE_H +#define CB_REPLACE_H + +// defined in pplex.l +extern void ppecho_direct (const char *); +extern struct cb_text_list *pp_text_list_add (struct cb_text_list *, + const char *, const size_t); + +// defined in replace.c + +extern void init_replace (void); +extern void reset_replace (void); +extern void free_replace (void); +extern void ppecho_copy (const char *); + +/* For COPY-REPLACING */ +extern void set_copy_replacing_list (struct cb_replace_list *list); +extern struct cb_replace_list * get_copy_replacing_list (void); + +/* For REPLACE, called from yylex.l pp_set_replace_list */ +extern void +set_replace_list (struct cb_replace_list *list, const int is_pushpop); + +#endif // CB_REPLACE_H diff --git a/tests/testsuite.src/syn_copy.at b/tests/testsuite.src/syn_copy.at index 5daa5b3eb..207f1b4c6 100644 --- a/tests/testsuite.src/syn_copy.at +++ b/tests/testsuite.src/syn_copy.at @@ -902,3 +902,30 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE -F prog.cob], [0], [], []) AT_CLEANUP + + +AT_SETUP([COPY and REPLACE in same file]) +AT_KEYWORDS([copy replace]) + +AT_DATA([copy.inc], [ + 01 VAR-:TEST: PIC X(2) VALUE "OK". +]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + REPLACE ==VAR-COLON== BY ==VAR-COMMA==. + COPY "copy.inc" + REPLACING ==:TEST:== BY ==COLON==. + PROCEDURE DIVISION. + DISPLAY VAR-COLON NO ADVANCING + END-DISPLAY. + STOP RUN. + REPLACE OFF. +]) + +AT_CHECK([$COMPILE -F prog.cob], [0], [], []) + +AT_CLEANUP