Merge remote-tracking branch 'upstream/gnucobol-3.x' into gcos4gnucobol-3.x

Author: ddeclerck

NEWS

@@ -54,6 +54,9 @@ NEWS - user visible changes				-*- outline -*-
    calls to externals. The files are put into quotes, unless they start by
    '<'. Quoted files are expected to have absolute paths, as the C compiler
    is called in a temp directory instead of the project directory.
+   The directive >>IMP INCLUDE "file.h", >>IMP INCLUDE "<file.h>",
+   >>IMP INCLUDE <file.h> or >>IMP INCLUDE file.h can be used as an alternative
+   to this compiler option.
 
 ** output of unlimited errors may be requested by -fmax-errors=0,
    to stop compiliation at first error use -Wfatal-errors

cobc/ChangeLog

@@ -152,11 +152,21 @@
 	  internally disabling it for generation of libraries/executable after
 	  first program as we only need that code once, fixing Win32 build errors
 	  and duplication warnings in other environments
-	* flag.def: don't suppress the help of -fwinmain under Win32
+	* flag.def: don't suppress the help of -fwinmain under Win32 and Cygwin
 	* typeck.c (build_expr_finish): use fallback error position token, fixing
 	  compiler aborts on broken expressions, bugs #933, #938 and #966
 	* typeck.c: minor refactoring within functions
 
+2024-04-25  Boris Eng <boris.eng@ocamlpro.com>
+
+	FR #176: "Implementation of GC directive to include .h (c/c++) files"
+	* pplex.l, ppparse.y, cobc.h, codegen.c (output_gnucobol_defines):
+	  new >>IMP INCLUDE directive to include one or multiple header files in the
+	  generated C code (same behavior as the --include but with one directive per
+	  file)
+	* scanner.l: the leading space for all internal directives is removed in the
+	  lexer. Source previously preprocessed may need to be adjusted
+
 2024-04-24  Fabrice Le Fessant <fabrice.le_fessant@ocamlpro.com>
 
 	* replace.c: optimize speed and memory usage. For speed, we add two

cobc/cobc.h

@@ -276,7 +276,7 @@ enum cb_sub_check {
 struct cb_text_list {
 	struct cb_text_list	*next;			/* next pointer */
 	struct cb_text_list	*last;
-	const char		*text;
+	char			*text;
 };
 
 /* Structure for extended filenames */
@@ -478,7 +478,8 @@ extern int			cb_depend_keep_missing;
 extern int			cb_flag_copybook_deps;
 extern struct cb_text_list	*cb_depend_list;
 extern struct cb_text_list	*cb_copy_list;
-extern struct cb_text_list	*cb_include_file_list;
+extern struct cb_text_list	*cb_include_file_list; /* global */
+extern struct cb_text_list	*cb_include_file_list_directive; /* temporary */
 extern struct cb_text_list	*cb_include_list;
 extern struct cb_text_list	*cb_intrinsic_list;
 extern struct cb_text_list	*cb_extension_list;

cobc/codegen.c

@@ -1801,6 +1801,7 @@ static void
 output_gnucobol_defines (const char *formatted_date)
 {
 	int	i;
+	struct cb_text_list *l;
 
 	if (!strrchr (cb_source_file, '\\')
 	 && !strrchr (cb_source_file, '"')) {
@@ -1832,17 +1833,23 @@ output_gnucobol_defines (const char *formatted_date)
 		current_compile_tm.tm_sec;
 	output_line ("#define  COB_MODULE_TIME\t\t%d", i);
 
-	{
-		struct cb_text_list *l = cb_include_file_list ;
-		for (;l;l=l->next){
-			if (l->text[0] == '<'){
-				output_line ("#include %s", l->text);
-			} else {
-				output_line ("#include \"%s\"", l->text);
-			}
+	for (l = cb_include_file_list; l; l = l->next) {
+		if (l->text[0] == '<') {
+			output_line ("#include %s", l->text);
+		} else {
+			output_line ("#include \"%s\"", l->text);
+		}
+	}
+
+	for (l = cb_include_file_list_directive; l; l = l->next) {
+		if (l->text[0] == '<') {
+			output_line ("#include %s", l->text);
+		} else {
+			output_line ("#include \"%s\"", l->text);
 		}
 	}
 
+	cb_include_file_list_directive = NULL;
 }
 
 /* CALL cache */

cobc/flag.def

@@ -109,7 +109,7 @@ CB_FLAG_NQ (1, "default-file-colseq", CB_FLAG_GETOPT_DEFAULT_FILE_COLSEQ,
 	  "                        * default: NATIVE"))
 
 /* Binary flags, partially with suppressed help */
-#ifdef _WIN32
+#if defined (_WIN32) || defined (__CYGWIN__)
 #define COB_SHOW 1
 #else
 #define COB_SHOW 0

cobc/pplex.l

@@ -201,6 +201,7 @@ ALNUM_LITERAL_A	"\'"([^''\n]|("\'"[0-9][0-9, ]+"\'"))*"\'"
 ALNUM_LITERAL	{ALNUM_LITERAL_Q}|{ALNUM_LITERAL_A}
 SET_PAREN_LIT	\([^()\n]*\)
 DEFNUM_LITERAL	[+-]?[0-9]*[\.]*[0-9]+
+RAW_SEQ		[^ \n]+
 
 AREA_A		[ ]?#
 MAYBE_AREA_A	[ ]?#?
@@ -224,6 +225,7 @@ MAYBE_AREA_A	[ ]?#?
 %x ALNUM_LITERAL_STATE
 %x CONTROL_STATEMENT_STATE
 %x DISPLAY_DIRECTIVE_STATE
+%x IMP_DIRECTIVE_STATE
 
 %%
 
@@ -357,6 +359,11 @@ MAYBE_AREA_A	[ ]?#?
 	return CALL_DIRECTIVE;
 }
 
+^{MAYBE_AREA_A}[ ]*">>"[ ]?"IMP"	{
+	BEGIN IMP_DIRECTIVE_STATE;
+	return IMP_DIRECTIVE;
+}
+
 ^{MAYBE_AREA_A}[ ]*">>"[ ]*\n		{
 	/* empty 2002+ style directive */
 	cb_plex_warning (COBC_WARN_FILLER, newline_count,
@@ -721,6 +728,7 @@ ELSE_DIRECTIVE_STATE,
 ENDIF_DIRECTIVE_STATE,
 ALNUM_LITERAL_STATE,
 CONTROL_STATEMENT_STATE,
+IMP_DIRECTIVE_STATE,
 COBOL_WORDS_DIRECTIVE_STATE>{
   \n			{
 	BEGIN INITIAL;
@@ -990,6 +998,14 @@ ENDIF_DIRECTIVE_STATE>{
   }
 }
 
+<IMP_DIRECTIVE_STATE>{
+  "INCLUDE"		{ return INCLUDE; }		/* GnuCOBOL 3.3 extension */
+  {RAW_SEQ}		{
+	pplval.s = cobc_plex_strdup (yytext);
+	return TOKEN;
+	}
+}
+
 <IF_DIRECTIVE_STATE>{
   "IS"			{ return IS; }
   "NOT"			{ return NOT; }

cobc/ppparse.y

@@ -741,6 +741,9 @@ ppparse_clear_vars (const struct cb_define_struct *p)
 %token WITH
 %token LOCATION
 
+%token IMP_DIRECTIVE
+%token INCLUDE
+
 %token TERMINATOR	"end of line"
 
 %token <s> TOKEN		"Word or Literal"
@@ -768,6 +771,7 @@ ppparse_clear_vars (const struct cb_define_struct *p)
 %type <l>	alnum_equality_list
 %type <l>	ec_list
 %type <s>	unquoted_literal
+%type <l>	imp_include_sources
 
 %type <r>	_copy_replacing
 %type <r>	replacing_list
@@ -838,6 +842,7 @@ directive:
 | TURN_DIRECTIVE turn_directive
 | LISTING_DIRECTIVE listing_directive
 | LEAP_SECOND_DIRECTIVE leap_second_directive
+| IMP_DIRECTIVE imp_directive
 | IF_DIRECTIVE
   {
 	current_cmd = PLEX_ACT_IF;
@@ -1368,6 +1373,34 @@ leap_second_directive:
 | OFF
 ;
 
+imp_directive:
+  /* GnuCOBOL 3.3 extension */
+  INCLUDE
+  {
+	cb_error (_("invalid %s directive"), "IMP INCLUDE");
+	yyerrok;
+  }
+| INCLUDE imp_include_sources
+  {
+	struct cb_text_list *p = $2;
+	while (p != NULL) {
+		fprintf (ppout, "#INCLUDE %s\n", p->text);
+		p = p->next;
+	}
+  }
+;
+
+imp_include_sources:
+  TOKEN
+  {
+	$$ = ppp_list_add (NULL, fix_filename ($1));
+  }
+| imp_include_sources TOKEN
+  {
+	$$ = ppp_list_add ($1, fix_filename ($2));
+  }
+;
+
 turn_directive:
   ec_list CHECKING on_or_off
   {

cobc/scanner.l

@@ -172,6 +172,8 @@ static size_t			pic2_size;
 static unsigned int		inside_bracket = 0;
 static char			err_msg[COB_MINI_BUFF];
 
+struct cb_text_list	*cb_include_file_list_directive = NULL;
+
 /* Function declarations */
 static void	read_literal (const char, const enum cb_literal_type);
 static int	scan_x (const char *, const char *);
@@ -189,6 +191,7 @@ static void	copy_two_words_in_quotes (char ** const, char ** const);
 static void	add_synonym (const int, const int);
 static void	make_synonym (void);
 static void clear_constants (void);
+static struct cb_text_list *scan_list_add (struct cb_text_list *, const char *);
 
 %}
 
@@ -217,7 +220,7 @@ AREA_A		"#AREA_A"\n
 	cobc_in_area_a = 0;
 %}
 
-<*>^[ ]?"#CALLFH".*\n {
+<*>^"#CALLFH".*\n {
 	if (current_program) {
 		const char	*p1;
 		char		*p2;
@@ -240,37 +243,37 @@ AREA_A		"#AREA_A"\n
 }
 
 
-<*>^[ ]?"#DEFLIT".*\n {
+<*>^"#DEFLIT".*\n {
 	scan_define_options (yytext);
 }
 
-<*>^[ ]?"#ADDRSV".*\n {
+<*>^"#ADDRSV".*\n {
 	char	*word;
 
 	copy_word_in_quotes (&word);
 	add_reserved_word_now (word, NULL);
 	cobc_free (word);
 }
 
-<*>^[ ]?"#ADDSYN-STD".*\n {
+<*>^"#ADDSYN-STD".*\n {
 	add_synonym (1, 0);
 }
-<*>^[ ]?"#ADDSYN".*\n {
+<*>^"#ADDSYN".*\n {
 	add_synonym (0, 0);
 }
 
-<*>^[ ]?"#MAKESYN".*\n {
+<*>^"#MAKESYN".*\n {
 	make_synonym ();
  }
 
-<*>^[ ]?"#OVERRIDE-STD".*\n {
+<*>^"#OVERRIDE-STD".*\n {
 	add_synonym (1, 1);
 }
-<*>^[ ]?"#OVERRIDE".*\n {
+<*>^"#OVERRIDE".*\n {
 	add_synonym (0, 1);
 }
 
-<*>^[ ]?"#REMOVE-STD".*\n {
+<*>^"#REMOVE-STD".*\n {
 	char	*word;
 
 	copy_word_in_quotes (&word);
@@ -283,27 +286,27 @@ AREA_A		"#AREA_A"\n
 	cobc_free (word);
 }
 
-<*>^[ ]?"#REMOVE".*\n {
+<*>^"#REMOVE".*\n {
 	char	*word;
 
 	copy_word_in_quotes (&word);
 	remove_reserved_word_now (word);
 	cobc_free (word);
 }
 
-<*>^[ ]?"#REFMOD_ZERO "[0-9]\n {
+<*>^"#REFMOD_ZERO "[0-9]\n {
 	cb_ref_mod_zero_length = (yytext[13] - '0');
 }
 
-<*>^[ ]?"#ODOSLIDE "[0-1]\n {
+<*>^"#ODOSLIDE "[0-1]\n {
 	cb_odoslide = (yytext[10] - '0');
 }
 
-<*>^[ ]?"#ASSIGN "[0-9]\n {
+<*>^"#ASSIGN "[0-9]\n {
 	cb_assign_type_default = (enum cb_assign_type)(yytext[8] - '0');
 }
 
-<*>^[ ]?"#TURN".*\n {
+<*>^"#TURN".*\n {
 	struct cb_turn_list	*l;
 
 	for (l = cb_turn_list; l && l->line != -1; l = l->next);
@@ -312,14 +315,21 @@ AREA_A		"#AREA_A"\n
 	}
 }
 
-<*>^[ ]?"#AREACHECK"\n {
+<*>^"#AREACHECK"\n {
 	cobc_areacheck = 1;
 }
 
-<*>^[ ]?"#NOAREACHECK"\n {
+<*>^"#NOAREACHECK"\n {
 	cobc_areacheck = 0;
 }
 
+<*>^"#INCLUDE".*/\n {
+	cb_include_file_list_directive = scan_list_add (
+		cb_include_file_list_directive,
+		yytext + 9
+	);
+}
+
 <*>^{AREA_A}[ ]*/"." {
 	count_lines (yytext + 9); /* skip "\n#area_a\n" */
 	if (cobc_in_procedure && cobc_areacheck) {
@@ -2580,6 +2590,22 @@ clear_constants (void)
 	top_78_ptr = NULL;
 }
 
+static struct cb_text_list *
+scan_list_add (struct cb_text_list *list, const char *text)
+{
+	struct cb_text_list	*p;
+
+	p = cobc_parse_malloc (sizeof (struct cb_text_list));
+	p->text = cobc_parse_strdup (text);
+	if (!list) {
+		p->last = p;
+		return p;
+	}
+	list->last->next = p;
+	list->last = p;
+	return list;
+}
+
 /* Global functions */
 
 void

doc/gnucobol.texi

@@ -386,6 +386,8 @@ Add a @code{#include} @file{file.h} at the beginning of the generated
 C source file. The file name is put into quotes, unless it starts by
 @code{<}. Quoted files should be absolute paths, since C files are compiled
 in temporary directories.
+The directive @code{>>IMP INCLUDE "FILE.h"} or @code{>>IMP INCLUDE <FILE.h>}
+can be used as an alternative to this compiler option.
 The option also implies @option{-fno-gen-c-decl-static-call}.
 This option can be used to check function prototypes when
 static calls are used. When this option is used, the source file is