From 7995d2e7a67936d27ea653762f077b047ac8c14f Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant Date: Tue, 6 Jun 2023 11:31:45 +0200 Subject: [PATCH 1/4] Cleaner replacement for alt_space in ppecho --- cobc/ChangeLog | 5 ++ cobc/pplex.l | 134 ++++++++++++++++++-------------- tests/testsuite.src/syn_copy.at | 9 +-- 3 files changed, 86 insertions(+), 62 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 431806723..f08d3eaf7 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,9 @@ +2023-07-05 Fabrice Le Fessant + + * pplex.l (ppecho, ppecho_direct): replace alt_space by passing a + second equivalent token + 2023-07-05 Fabrice Le Fessant * flag.def/cobc.c: new flags -fno-ttimestamp to suppress timestamp diff --git a/cobc/pplex.l b/cobc/pplex.l index a17b215a4..e737a328b 100644 --- a/cobc/pplex.l +++ b/cobc/pplex.l @@ -160,7 +160,14 @@ 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; +struct cb_token_list { + struct cb_token_list *next; /* next pointer */ + struct cb_token_list *last; + const char *text; + const char *token; +}; + +static struct cb_token_list *text_queue = NULL; static size_t check_partial_match = 0; static struct copy_info *copy_stack = NULL; @@ -169,10 +176,10 @@ 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, - const int); -static void ppecho_direct (const char *); -static int ppecho_replace (struct cb_replace_list *); +static void ppecho (const char *text, const char *token); +static void ppecho_direct (const char *text, const char *token); +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); @@ -225,7 +232,7 @@ MAYBE_AREA_A [ ]?#? /* 2002+: inline comment */ #if 0 /* RXWRXW - Directive state */ if (YY_START != DIRECTIVE_STATE && YY_START != SET_DIRECTIVE_STATE) { - ppecho (" ", 0, 1); + ppecho (" ", NULL); } #endif } @@ -515,7 +522,7 @@ MAYBE_AREA_A [ ]?#? DEFAULT SECTION where compile-time defaults are specified. */ /* cf `ppparse.y`, grammar entry `program_with_control_division`, along with `parser.y`, entry `_control_division`. */ - ppecho (yytext, 0, (int)yyleng); + ppecho (yytext, NULL); yy_push_state (CONTROL_DIVISION_STATE); return CONTROL_DIVISION; } @@ -527,7 +534,7 @@ MAYBE_AREA_A [ ]?#? } \. { /* Pass dots to the parser to handle DEFAULT SECTION. */ - ppecho (yytext, 0, (int)yyleng); + ppecho (yytext, NULL); return DOT; } } @@ -553,7 +560,7 @@ SUBSTITUTION_SECTION_STATE>{ while (YY_START == CONTROL_DIVISION_STATE || YY_START == SUBSTITUTION_SECTION_STATE) yy_pop_state (); - ppecho (yytext, 0, (int)yyleng); + ppecho (yytext, NULL); } [,;]?\n { ECHO; @@ -573,25 +580,25 @@ SUBSTITUTION_SECTION_STATE> yy_pop_state (); /* Allow comment sentences/paragraphs */ comment_allowed = 1; - ppecho (yytext, 0, (int)yyleng); + ppecho (yytext, NULL); } "PROGRAM-ID"/[ .,;\n] { /* Allow comment sentences/paragraphs */ comment_allowed = 1; - ppecho (yytext, 0, (int)yyleng); + ppecho (yytext, NULL); } "DIVISION"/[ .,;\n] { /* Disallow comment sentences/paragraphs */ comment_allowed = 0; - ppecho (yytext, 0, (int)yyleng); + ppecho (yytext, NULL); } "SECTION"/[ .,;\n] { /* Disallow comment sentences/paragraphs */ comment_allowed = 0; - ppecho (yytext, 0, (int)yyleng); + ppecho (yytext, NULL); } ^{MAYBE_AREA_A}[ ]*"EJECT"([ ]*\.)? | @@ -640,43 +647,43 @@ SUBSTITUTION_SECTION_STATE> /* Pick up early - Also activates debugging lines */ cb_verify (cb_debugging_mode, "DEBUGGING MODE"); cb_flag_debugging_line = 1; - ppecho (yytext, 0, (int)yyleng); + ppecho (yytext, NULL); } [,;]?\n { - ppecho ("\n", 0, 1); + ppecho ("\n", NULL); cb_source_line++; } [;]?[ ]+ { - ppecho (" ", 1U, 1); + ppecho (" ", yytext); } [,]?[ ]+ { if (inside_bracket) { - ppecho (", ", 0, 2); + ppecho (", ", NULL); } else { - ppecho (" ", 1U, 1); + ppecho (" ", yytext); } } "(" { - inside_bracket++; - ppecho ("(", 0, 1); + inside_bracket++; + ppecho (yytext, NULL); } ")" { if (inside_bracket) { inside_bracket--; } - ppecho (")", 0, 1); + ppecho (yytext, NULL); } {WORD} | {NUMRIC_LITERAL} | {ALNUM_LITERAL} | . { - ppecho (yytext, 0, (int)yyleng); + ppecho (yytext, NULL); } 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; + } + memcpy (tp, text, text_size); + p->text = tp; + if (!list) { + p->last = p; + return p; + } + list->last->next = p; + list->last = p; + return list; +} + static void -ppecho (const char *text, const cob_u32_t alt_space, const int textlen) +ppecho (const char *text, const char *token) { /* performance note (last verified with GnuCOBOL 2.2): while this function used 5% (according to callgrind) @@ -2601,8 +2638,7 @@ ppecho (const char *text, const cob_u32_t alt_space, const int textlen) for optimization */ struct cb_replace_list *save_ptr; - const char *s; - struct cb_text_list *save_ptr_text_queue; + 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 @@ -2611,33 +2647,16 @@ ppecho (const char *text, const cob_u32_t alt_space, const int textlen) fflush (ppout); #endif - /* 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); - } + ppecho_direct (text, token); 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); + ppecho_direct(text_queue->text, text_queue->token); } + ppecho_direct(text, token); return; } if (!current_replace_list) { @@ -2649,7 +2668,7 @@ ppecho (const char *text, const cob_u32_t alt_space, const int textlen) } /* Do replacement */ - text_queue = pp_text_list_add (text_queue, text, (size_t)textlen); + text_queue = pp_token_list_add (text_queue, text, token); save_ptr_text_queue = text_queue; status = ppecho_replace (save_ptr); @@ -2659,7 +2678,8 @@ ppecho (const char *text, const cob_u32_t alt_space, const int textlen) text_queue = save_ptr_text_queue; while (text_queue && check_partial_match) { if (is_space_or_nl (text_queue->text[0])) { - ppecho_direct (text_queue->text); + ppecho_direct (text_queue->text, + text_queue->token); text_queue = text_queue->next; continue; } @@ -2670,7 +2690,8 @@ ppecho (const char *text, const cob_u32_t alt_space, const int textlen) if (text_queue) { /* Write text_queue if is not replaced */ if (status != -1 && check_partial_match) { - ppecho_direct (text_queue->text); + ppecho_direct (text_queue->text, + text_queue->token); } text_queue = text_queue->next; } @@ -2690,7 +2711,7 @@ ppecho (const char *text, const cob_u32_t alt_space, const int textlen) /* No match */ for (; text_queue; text_queue = text_queue->next) { - ppecho_direct (text_queue->text); + ppecho_direct (text_queue->text, text_queue->token); } } @@ -2701,8 +2722,8 @@ 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; + struct cb_token_list *queue; + struct cb_token_list *save_queue; const struct cb_text_list *lno; struct cb_replace_list *r; @@ -2776,12 +2797,12 @@ ppecho_replace (struct cb_replace_list *save_ptr) } } for (lno = r->new_text; lno; lno = lno->next) { - ppecho_direct (lno->text); + ppecho_direct (lno->text, NULL); } if (r->src->lead_trail == CB_REPLACE_LEADING && save_queue /* <- silence warnings */) { /* Non-matched part of original text */ - ppecho_direct (save_queue->text + size); + ppecho_direct (save_queue->text + size, NULL); } check_partial_match = 0; text_queue = queue; @@ -2829,12 +2850,11 @@ display_finish (void) unput ('\n'); } -static void -ppecho_direct (const char *text) +void ppecho_direct (const char *text, const char *token ) { fputs (text, ppout); if (cb_listing_file) { - check_listing (text, 0); + check_listing (token != NULL ? token : text, 0); } } diff --git a/tests/testsuite.src/syn_copy.at b/tests/testsuite.src/syn_copy.at index 9fbb52f4c..aeb6b9dec 100644 --- a/tests/testsuite.src/syn_copy.at +++ b/tests/testsuite.src/syn_copy.at @@ -933,12 +933,9 @@ AT_KEYWORDS([copy]) # continue the loop with the - potential partially replaced - # new content. -AT_XFAIL_IF([true]) - AT_DATA([copy.inc], [ 01 VAR-:TEST: PIC X(2) VALUE "OK". ]) - AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog. @@ -954,6 +951,8 @@ AT_DATA([prog.cob], [ REPLACE OFF. ]) -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) +AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], +[prog.cob:10: error: 'VAR-COMMA' is not defined +]) -AT_CLEANUP \ No newline at end of file +AT_CLEANUP From 3f61cf11682f69d74e7032c8e3860b2a61dbf853 Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant Date: Tue, 6 Jun 2023 14:48:26 +0200 Subject: [PATCH 2/4] move ppecho() to replace.c --- cobc/ChangeLog | 5 + cobc/Makefile.am | 3 +- cobc/pplex.l | 285 ++---------------------------------------- cobc/ppparse.y | 4 +- cobc/replace.c | 316 +++++++++++++++++++++++++++++++++++++++++++++++ cobc/replace.h | 45 +++++++ cobc/tree.h | 4 +- 7 files changed, 384 insertions(+), 278 deletions(-) create mode 100644 cobc/replace.c create mode 100644 cobc/replace.h diff --git a/cobc/ChangeLog b/cobc/ChangeLog index f08d3eaf7..378315035 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,6 +1,11 @@ 2023-07-05 Fabrice Le Fessant + * pplex.l/replace.c: move the preprocessing code performing + COPY REPLACING and REPLACE from pplex.l to replace.c + +2023-07-02 Fabrice Le Fessant + * pplex.l (ppecho, ppecho_direct): replace alt_space by passing a second equivalent token 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/pplex.l b/cobc/pplex.l index e737a328b..52206e82c 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 */ @@ -156,29 +157,13 @@ 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; - -struct cb_token_list { - struct cb_token_list *next; /* next pointer */ - struct cb_token_list *last; - const char *text; - const char *token; -}; - -static struct cb_token_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 *text, const char *token); -static void ppecho_direct (const char *text, const char *token); -static int ppecho_replace (struct cb_replace_list *); +static void ppecho (const char *text, const char *token ); static void switch_to_buffer (const int, const char *, const YY_BUFFER_STATE); @@ -186,7 +171,6 @@ static void check_listing (const char *, const unsigned int); static void skip_to_eol (void); static void count_newlines (const char *); 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 *, @@ -1091,10 +1075,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; + cb_free_replace (); copy_stack = NULL; quotation_mark = 0; consecutive_quotation = 0; @@ -1116,7 +1097,7 @@ ENDIF_DIRECTIVE_STATE>{ current_copy_info->buffer); /* Restore variables */ - current_replace_list = current_copy_info->replacing; + cb_set_copy_replacing_list (current_copy_info->replacing); quotation_mark = current_copy_info->quotation_mark; cobc_set_source_format (current_copy_info->source_format); @@ -1129,35 +1110,6 @@ ENDIF_DIRECTIVE_STATE>{ /* Global functions */ -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; - if (cb_src_list_file) { - set_print_replace_list (list); - } -} - static int is_fixed_indicator (char c){ switch (c){ /* same indicators as in ppinput() */ @@ -1294,6 +1246,7 @@ ppopen (const char *name, struct cb_replace_list *replacing_list) { struct copy_info *current_copy_info; char *dname; + struct cb_replace_list *current_replace_list; if (ppin) { for (; newline_count > 0; newline_count--) { @@ -1329,6 +1282,7 @@ ppopen (const char *name, struct cb_replace_list *replacing_list) } /* preserve the current buffer */ + current_replace_list = cb_get_copy_replacing_list(); current_copy_info = cobc_malloc (sizeof (struct copy_info)); current_copy_info->file = cb_source_file; current_copy_info->buffer = YY_CURRENT_BUFFER; @@ -1352,9 +1306,9 @@ 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; + cb_set_copy_replacing_list (replacing_list); if (cb_src_list_file) { - set_print_replace_list (replacing_list); + cb_set_print_replace_list (replacing_list); } } @@ -1876,8 +1830,8 @@ get_new_listing_file (void) cb_current_file = newfile; } -static void -set_print_replace_list (struct cb_replace_list *list) +void +cb_set_print_replace_list (struct cb_replace_list *list) { struct cb_replace_list *r; const struct cb_text_list *l; @@ -1929,12 +1883,6 @@ switch_to_buffer (const int line, const char *file, const YY_BUFFER_STATE buffer yy_switch_to_buffer (buffer); } -static COB_INLINE COB_A_INLINE int -is_space_or_nl (const char c) -{ - return c == ' ' || c == '\n'; -} - static COB_INLINE COB_A_INLINE int is_cobol_word_char (const char c) { @@ -2597,219 +2545,10 @@ pp_text_list_add (struct cb_text_list *list, const char *text, return list; } -static struct cb_token_list * -pp_token_list_add (struct cb_token_list *list, - const char *text, - const char *token) -{ - struct cb_token_list *p; - void *tp; - int text_size = strlen (text); - - p = cobc_plex_malloc (sizeof (struct cb_token_list)); - 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; - } - memcpy (tp, text, text_size); - p->text = tp; - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - static void ppecho (const char *text, const char *token) { - /* 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); -#endif - - if (text_queue == NULL && (text[0] == ' ' || text[0] == '\n')) { - ppecho_direct (text, token); - return; - } - if (!current_replace_list && !base_replace_list) { - /* Output queue */ - for (; text_queue; text_queue = text_queue->next) { - ppecho_direct(text_queue->text, text_queue->token); - } - 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; - } - - /* 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])) { - 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; - } - if (text_queue) { - /* Write text_queue if is not replaced */ - if (status != -1 && check_partial_match) { - ppecho_direct (text_queue->text, - text_queue->token); - } - 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, text_queue->token); - } -} - -/* handle all kinds of COPY REPLACING and REPLACE */ -static int -ppecho_replace (struct cb_replace_list *save_ptr) -{ - 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; - } - 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, NULL); - } - if (r->src->lead_trail == CB_REPLACE_LEADING - && save_queue /* <- silence warnings */) { - /* Non-matched part of original text */ - ppecho_direct (save_queue->text + size, NULL); - } - check_partial_match = 0; - text_queue = queue; - continue; - } - } - return (save_ptr ? 1 : 0); + cb_ppecho_copy_replace (text, token); } static void @@ -2850,7 +2589,7 @@ display_finish (void) unput ('\n'); } -void ppecho_direct (const char *text, const char *token ) +void cb_ppecho_direct (const char *text, const char *token ) { fputs (text, ppout); if (cb_listing_file) { diff --git a/cobc/ppparse.y b/cobc/ppparse.y index a5d351176..ab0356f09 100644 --- a/cobc/ppparse.y +++ b/cobc/ppparse.y @@ -1633,11 +1633,11 @@ copy_replacing: replace_statement: REPLACE _also replacing_list { - pp_set_replace_list ($3, $2); + cb_set_replace_list ($3, $2); } | REPLACE _last OFF { - pp_set_replace_list (NULL, $2); + cb_set_replace_list (NULL, $2); } ; diff --git a/cobc/replace.c b/cobc/replace.c new file mode 100644 index 000000000..7439f6114 --- /dev/null +++ b/cobc/replace.c @@ -0,0 +1,316 @@ +/* + Copyright (C) 2003-2022 Free Software Foundation, Inc. + + Authors: + Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, Brian Tiffin, + Edward Hart, Dave Pitts + + 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" + +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; + +struct cb_token_list { + struct cb_token_list *next; /* next pointer */ + struct cb_token_list *last; + const char *text; + const char *token; +}; + +static struct cb_token_list *text_queue = NULL; +static size_t check_partial_match = 0; + +static int ppecho_replace (struct cb_replace_list *); + +static struct cb_token_list * +pp_token_list_add (struct cb_token_list *list, + const char *text, + const char *token) +{ + struct cb_token_list *p; + void *tp; + int text_size = strlen (text); + + p = cobc_plex_malloc (sizeof (struct cb_token_list)); + 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; + } + memcpy (tp, text, text_size); + p->text = tp; + if (!list) { + p->last = p; + return p; + } + list->last->next = p; + list->last = p; + return list; +} + +void cb_free_replace( void ) +{ + current_replace_list = NULL; + base_replace_list = NULL; + save_current_replace = NULL; + text_queue = NULL; +} + +struct cb_replace_list *cb_get_copy_replacing_list (void) +{ + return current_replace_list; +} + +void cb_set_copy_replacing_list (struct cb_replace_list *list) +{ + current_replace_list = list; +} + +void +cb_ppecho_copy_replace (const char *text, const char *token) +{ + /* 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); +#endif + + if (text_queue == NULL && (text[0] == ' ' || text[0] == '\n')) { + cb_ppecho_direct (text, token); + return; + } + 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); + } + 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; + } + + /* 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; + } + 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); + } + 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) { + cb_ppecho_direct (text_queue->text, text_queue->token); + } +} + +/* handle all kinds of COPY REPLACING and REPLACE */ +static int +ppecho_replace (struct cb_replace_list *save_ptr) +{ + 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; + } + 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 */ + 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; + } + } + return (save_ptr ? 1 : 0); +} + + +void +cb_set_replace_list (struct cb_replace_list *list, const int 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; + if (cb_src_list_file) { + cb_set_print_replace_list (list); + } +} diff --git a/cobc/replace.h b/cobc/replace.h new file mode 100644 index 000000000..25d02c78d --- /dev/null +++ b/cobc/replace.h @@ -0,0 +1,45 @@ +/* + 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 cb_ppecho_direct (const char *text, const char *token ); +extern struct cb_text_list *cb_pp_text_list_add (struct cb_text_list *, + const char *, const size_t); + +extern void cb_ppecho_copy_replace (const char *text, const char *token ); +extern void cb_free_replace (void); + +/* For COPY-REPLACING */ +extern void cb_set_copy_replacing_list (struct cb_replace_list *list); +extern struct cb_replace_list * cb_get_copy_replacing_list (void); + +extern void +cb_set_print_replace_list (struct cb_replace_list *); + +static COB_INLINE COB_A_INLINE int +is_space_or_nl (const char c) +{ + return c == ' ' || c == '\n'; +} + +#endif // CB_REPLACE_H diff --git a/cobc/tree.h b/cobc/tree.h index df31751a5..829726890 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1643,8 +1643,8 @@ struct cb_replace_list { const struct cb_text_list *new_text; }; -extern void pp_set_replace_list (struct cb_replace_list *, - const cob_u32_t); +extern void cb_set_replace_list (struct cb_replace_list *, + const int); /* List of error messages */ struct list_error { From 8bdc60fc7af8b9cd575cd75052a28dca471a4d62 Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant Date: Tue, 13 Jun 2023 16:44:43 +0200 Subject: [PATCH 3/4] Use a two-pass algorithm for COPY-REPLACING and then REPLACE --- cobc/ChangeLog | 16 +- cobc/Makefile.am | 2 +- cobc/cobc.c | 44 ++ cobc/cobc.h | 2 + cobc/pplex.l | 6 +- cobc/replace.c | 930 +++++++++++++++++++++++++------- cobc/replace.h | 45 -- cobc/tree.h | 15 + tests/testsuite.src/listings.at | 20 +- tests/testsuite.src/syn_copy.at | 56 +- 10 files changed, 863 insertions(+), 273 deletions(-) delete mode 100644 cobc/replace.h diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 378315035..ab7a0dd9a 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,13 +1,21 @@ 2023-07-05 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 - COPY REPLACING and REPLACE from pplex.l to replace.c + COPY REPLACING and REPLACE from pplex.l to replace.c 2023-07-02 Fabrice Le Fessant * pplex.l (ppecho, ppecho_direct): replace alt_space by passing a - second equivalent token + second equivalent token 2023-07-05 Fabrice Le Fessant @@ -89,8 +97,8 @@ * typeck.c (cb_build_expr): remove cb_ prefix from static functions and comment algorithm - Bugs #875 V IS ZERO AND, #880 error compiling abbreviated conditions - and #887 error compiling parenthesized relation + Bugs #875 V IS ZERO AND, #880 error compiling abbreviated conditions + and #887 error compiling parenthesized relation * typeck.c (cb_build_expr): additional generate 'invalid conditional expression' error", translate NOT comparison to inversed comparison * typeck.c (cb_build_expr), tree.c (cb_build_binary_op): give more diff --git a/cobc/Makefile.am b/cobc/Makefile.am index a96b7c3ab..444987fc6 100644 --- a/cobc/Makefile.am +++ b/cobc/Makefile.am @@ -23,7 +23,7 @@ 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 replace.h replace.c + codeoptim.c 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 93980c2bc..8b15430f3 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -1337,6 +1337,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/pplex.l b/cobc/pplex.l index 52206e82c..d966a90ad 100644 --- a/cobc/pplex.l +++ b/cobc/pplex.l @@ -92,7 +92,6 @@ static int ppwrap (void) { #include "cobc.h" #include "tree.h" #include "ppparse.h" -#include "replace.h" #ifdef _WIN32 #include /* for access */ @@ -1970,6 +1969,11 @@ next_word_is_comment_paragraph_name (const char *buff) return 1; } +static COB_INLINE COB_A_INLINE int +is_space_or_nl (const char c) +{ + return c == ' ' || c == '\n'; +} /* FIXME: try to optimize as this function used 25-10% (according to callgrind) of the complete time spent in a sample run with diff --git a/cobc/replace.c b/cobc/replace.c index 7439f6114..42e44f80a 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. @@ -38,278 +38,814 @@ #include "cobc.h" #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; +/* 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 1 if the + token should not be treated immediately (because it may be merged + with other following tokens if they are of the same kind), 0 + 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 +}; + -static int ppecho_replace (struct cb_replace_list *); +#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]; + +/* In debugging mode only, stores a list of text/tokens into a + preallocated string for easy display */ +#define STRING_OF_LIST(kind) \ +static \ +char * string_of_##kind##_list(const struct cb_##kind##_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; \ +} + +/* string_of_token_list (...) */ +STRING_OF_LIST(token) +/* string_of_text_list (...) */ +STRING_OF_LIST(text) + +#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_token_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_text_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_token_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) +{ + + const size_t src_len = strlen (src_text); + const 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 = 0; + } else { + result = 1; } - 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 = 0; } +#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); + } + } +} + +static COB_INLINE COB_A_INLINE int +is_space_or_nl (const char c) +{ + return c == ' ' || c == '\n'; +} + +/* `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_text_list(new_text)); + fprintf(stderr, "%s texts = %s,\n", DEPTH, + string_of_token_list(texts)); + fprintf(stderr, "%s src = %s,\n", DEPTH, + string_of_text_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') -> 0\n", DEPTH, s); +#endif + return 0; + } } +#ifdef DEBUG_REPLACE_TRACE + fprintf(stderr, "%sis_word('%s') -> 1\n", DEPTH, s); +#endif + return 1; } -/* 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, 0, 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, + 0, pretext, NULL); + add_text_to_replace(MORE_DEPTH repls, + 0, 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 = 1 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, 1, text, token); +} + +/* pass a text to the copy-replacing stream (called from ppecho() in + pplex.l). Use prequeue = 0 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, 0, 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_text_list(list->src->text_list)); + fprintf(stderr, " leading = %d\n", + list->src->lead_trail); + fprintf(stderr, " new_text = %s\n", + string_of_text_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/cobc/replace.h b/cobc/replace.h deleted file mode 100644 index 25d02c78d..000000000 --- a/cobc/replace.h +++ /dev/null @@ -1,45 +0,0 @@ -/* - 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 cb_ppecho_direct (const char *text, const char *token ); -extern struct cb_text_list *cb_pp_text_list_add (struct cb_text_list *, - const char *, const size_t); - -extern void cb_ppecho_copy_replace (const char *text, const char *token ); -extern void cb_free_replace (void); - -/* For COPY-REPLACING */ -extern void cb_set_copy_replacing_list (struct cb_replace_list *list); -extern struct cb_replace_list * cb_get_copy_replacing_list (void); - -extern void -cb_set_print_replace_list (struct cb_replace_list *); - -static COB_INLINE COB_A_INLINE int -is_space_or_nl (const char c) -{ - return c == ' ' || c == '\n'; -} - -#endif // CB_REPLACE_H diff --git a/cobc/tree.h b/cobc/tree.h index 829726890..5edbbe317 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -2572,6 +2572,21 @@ extern cb_tree cobc_tree_cast_check (const cb_tree, const char *, const int, const enum cb_tag); #endif +/* pplex.l */ +extern void cb_ppecho_direct (const char *text, const char *token ); +extern struct cb_text_list *cb_pp_text_list_add (struct cb_text_list *, + const char *, const size_t); +/* replace.c */ +extern void cb_ppecho_copy_replace (const char *text, const char *token ); +extern void cb_free_replace (void); + +/* For COPY-REPLACING */ +extern void cb_set_copy_replacing_list (struct cb_replace_list *list); +extern struct cb_replace_list * cb_get_copy_replacing_list (void); + +extern void +cb_set_print_replace_list (struct cb_replace_list *); + /* codeoptim.c */ extern void cob_gen_optim (const enum cb_optim); diff --git a/tests/testsuite.src/listings.at b/tests/testsuite.src/listings.at index cabda9b9f..29cc75aed 100644 --- a/tests/testsuite.src/listings.at +++ b/tests/testsuite.src/listings.at @@ -95,9 +95,7 @@ AT_DATA([prog.cob], [ STOP RUN. ]) -AT_CHECK([$COMPILE_LISTING0 -t prog.lst prog.cob], [0], [], []) - -AT_DATA([expected.lst], +AT_CHECK([$COMPILE_LISTING0 -t- prog.cob], [0], [GnuCOBOL V.R.P prog.cob LINE PG/LN A...B............................................................ @@ -116,12 +114,6 @@ LINE PG/LN A...B............................................................ 0 errors in compilation group ]) -# TODO: add an AT_CHECK to compare prog.lst and expected.lst. There is -# a problem with the Eject character here that makes the comparison fail, -# need more time to investigate. - -AT_CHECK([diff expected.lst prog.lst], [0], [], []) - AT_DATA([prog2.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog2. @@ -2060,9 +2052,7 @@ AT_DATA([prog.cob], [ END FUNCTION WITHPAR. ]) -AT_CHECK([$COBC $LISTING_FLAGS -q -fsyntax-only -t prog.lst -fno-theader -ftcmd prog.cob], [0], [], []) - -AT_DATA([reference.lst], +AT_CHECK([$COBC $LISTING_FLAGS -q -fsyntax-only -t- -fno-theader -ftcmd prog.cob], [0], [ 000001 000002 IDENTIFICATION DIVISION. @@ -2075,16 +2065,14 @@ AT_DATA([reference.lst], 000009 ADD 1 TO PAR-IN GIVING PAR-OUT END-ADD. 000010 GOBACK. 000011 END FUNCTION WITHPAR. - + @&t@ command line: cobc -fdiagnostics-plain-output -fttitle=GnuCOBOL_V.R.P -fno-ttimestamp -q -+ -fsyntax-only -t prog.lst -fno-theader -ftcmd prog.cob ++ -fsyntax-only -t- -fno-theader -ftcmd prog.cob 0 warnings in compilation group 0 errors in compilation group ]) -# TODO: we don't perform any comparison here between prog.lst and reference.lst. Why ? - AT_CHECK([$COBC $LISTING_FLAGS -q -std=default -Wall -fno-tmessages -fsyntax-only -t- -fno-tsymbols -ftcmd prog.cob], [0], [GnuCOBOL V.R.P prog.cob Page 0001 diff --git a/tests/testsuite.src/syn_copy.at b/tests/testsuite.src/syn_copy.at index aeb6b9dec..c10562233 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,51 @@ 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]) + +AT_CHECK([cat preproc.lst], [0], +[ 1 @&t@ + 2 IDENTIFICATION DIVISION. + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 @&t@ + 7 @&t@ + 8 @&t@ + 9 01 VAR-COMMA PIC X(2) VALUE "OK". + 10 @&t@ + 11 PROCEDURE DIVISION. + 12 DISPLAY VAR-COMMA NO ADVANCING + 13 END-DISPLAY. + 14 STOP RUN. + 15 @&t@ + +]) + +AT_CHECK([$COMPILE_LISTING -t- prog.cob], [0], +[GnuCOBOL V.R.P prog.cob 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_CLEANUP From f1d06129a32ec9cd070674f8558d03f3b865b5a1 Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant Date: Thu, 6 Jul 2023 00:16:18 +0200 Subject: [PATCH 4/4] Add - as stdout for -P flag --- NEWS | 12 +++++++++++- cobc/ChangeLog | 5 +++-- cobc/cobc.c | 10 ++++++++-- tests/testsuite.src/syn_copy.at | 4 +--- 4 files changed, 23 insertions(+), 8 deletions(-) diff --git a/NEWS b/NEWS index 812927dcf..573d9e8b2 100644 --- a/NEWS +++ b/NEWS @@ -185,6 +185,12 @@ NEWS - user visible changes -*- outline -*- callee modules that use BY VALUE must be compiled with the same version of GnuCOBOL, either prior this release, or since. +** cobc now uses a two-pass preprocessing algorithm, where replacements for + COPY-REPLACING are done in a first pass, and the replacements for + REPLACE are done in a second pass. Note that, however, both + statements are parsed before the first replacement pass, so + COPY-REPLACING cannot impact a REPLACE statement itself. + * Changes to the COBOL compiler (cobc) options: ** new -fformat dialect option, and extended SOURCE FORMAT directives, @@ -321,7 +327,9 @@ NEWS - user visible changes -*- outline -*- and fatality `cobc --list-exceptions` ** new compiler command line option -ftcmd to enable printing of the command - line in the source listing + line in the source listing, -fno-timestamp to suppress printing of the time + and -ftittle to set a title instead of GnuCOBOL and version (_ chars are + replaced by spaces in the title) ** new compiler command line option --coverage to instrument binaries for coverage checks @@ -349,6 +357,8 @@ NEWS - user visible changes -*- outline -*- the option -fdiagnostics-plain-output was added to request that diagnostic output look as plain as possible and stay more stable over time +** the -P flag accepts - as argument for stdout + * Important Bugfixes: ** for dialects other than the GnuCOBOL default different reserved "alias" words diff --git a/cobc/ChangeLog b/cobc/ChangeLog index ab7a0dd9a..0f9f781d6 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -6,6 +6,7 @@ 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. + * cobc.c: flag -P now accepts - as argument to mean stdout 2023-07-02 Fabrice Le Fessant @@ -97,8 +98,8 @@ * typeck.c (cb_build_expr): remove cb_ prefix from static functions and comment algorithm - Bugs #875 V IS ZERO AND, #880 error compiling abbreviated conditions - and #887 error compiling parenthesized relation + Bugs #875 V IS ZERO AND, #880 error compiling abbreviated conditions + and #887 error compiling parenthesized relation * typeck.c (cb_build_expr): additional generate 'invalid conditional expression' error", translate NOT comparison to inversed comparison * typeck.c (cb_build_expr), tree.c (cb_build_binary_op): give more diff --git a/cobc/cobc.c b/cobc/cobc.c index 8b15430f3..3c1ceb401 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -567,7 +567,7 @@ static const char *const cob_csyns[] = { #define COB_NUM_CSYNS sizeof(cob_csyns) / sizeof(cob_csyns[0]) -static const char short_options[] = "hVivqECScbmxjdFOPgwo:t:T:I:L:l:D:K:k:"; +static const char short_options[] = "hVivqECScbmxjdFOgwo:P:t:T:I:L:l:D:K:k:"; #define CB_NO_ARG no_argument #define CB_RQ_ARG required_argument @@ -9184,6 +9184,9 @@ main (int argc, char **argv) memset (cb_listing_header, 0, sizeof (cb_listing_header)); /* If -P=file specified, all lists go to this file */ if (cobc_list_file) { + if (strcmp (cobc_list_file, COB_DASH) == 0) { + cb_listing_file = stdout; + } else if (cb_unix_lf) { cb_listing_file = fopen (cobc_list_file, "wb"); } else { @@ -9269,7 +9272,10 @@ main (int argc, char **argv) } if (cobc_list_file) { - fclose (cb_listing_file); + if (cb_listing_file != stdout) + fclose (cb_listing_file); + else + fflush (stdout); cb_listing_file = NULL; } diff --git a/tests/testsuite.src/syn_copy.at b/tests/testsuite.src/syn_copy.at index c10562233..f6a64b5f5 100644 --- a/tests/testsuite.src/syn_copy.at +++ b/tests/testsuite.src/syn_copy.at @@ -946,9 +946,7 @@ AT_DATA([prog.cob], [ REPLACE OFF. ]) -AT_CHECK([$COMPILE_ONLY -P=preproc.lst prog.cob]) - -AT_CHECK([cat preproc.lst], [0], +AT_CHECK([$COMPILE_ONLY -P- prog.cob], [0], [ 1 @&t@ 2 IDENTIFICATION DIVISION. 3 PROGRAM-ID. prog.