Add support for b/f/d/t/m in cob_expand_env_string

libcob/ChangeLog

@@ -1,10 +1,13 @@
 2023-09-04  Fabrice Le Fessant <fabrice.le_fessant@ocamlpro.com> and Emilien Lemaire <emilien.lemaire@ocamlpro.com>
 
 	* Makefile.am: add `profiling.c` to sources
-	* profiling.c, cobprof.h: implement profiling functions (time spent in each
-	  procedure of the program)
-	* common.c: add 4 environments variables COB_PROF_FILE, COB_PROF_MAX_DEPTH,
-	  COB_PROF_ENABLE and COB_IS_RUNNING_IN_TESTMODE
+	* profiling.c: implement profiling functions
+	  (time spent in each procedure of the program)
+	* common.c: add 4 environments variables COB_PROF_FILE,
+	  COB_PROF_MAX_DEPTH,COB_PROF_ENABLE and COB_PROF_FORMAT
+	* common.c (cob_expand_env_string): add $b (executable basename),
+	  $f (executable filename), $m (last program-id),
+	  $d (date in yyyymmdd) and $t (time in hhmmss)
 
 2023-11-29  Fabrice Le Fessant <fabrice.le_fessant@ocamlpro.com>
 

libcob/common.c

@@ -7734,14 +7734,34 @@ var_print (const char *msg, const char *val, const char *default_val,
 
 }
 
+/* Returns a pointer to the last string following a /, \ or : */
+static const char *
+get_basename (const char *s)
+{
+	const char *str;
+	if (!s) return NULL;
+	str = s;
+	while (*s){
+		switch (*s++){
+		case '/':
+		case '\\':
+		case ':':
+			str = s; break;
+		default: ;
+		}
+	}
+	return str;
+}
+
+
 /*
  Expand a string with environment variable in it.
  Return malloced string.
  Variables should have the format ${var} or ${var:default}.
  $$ is used for the process ID
 */
 char *
-cob_expand_env_string (char *strval)
+cob_expand_env_string (const char *strval)
 {
 	unsigned int	i;
 	unsigned int	j = 0;
@@ -7806,17 +7826,48 @@ cob_expand_env_string (char *strval)
 				k++;
 			}
 			k--;
-		} else if (strval[k] == '$'
-		        && strval[k+1] == '$') {	/* Replace $$ with process-id */
-			j += sprintf (&env[j], "%d", cob_sys_getpid());
+		} else if (strval[k] == '$') {
+			struct cob_time time;
+			const char *s = NULL;
+		        switch ( strval[k+1] ){
+			case '$':	/* Replace $$ with process-id */
+				j += sprintf (&env[j], "%d", cob_sys_getpid());
+				k++;
+				continue;
+			case 'm': /* $m is the executable filename */
+				s = COB_MODULE_PTR->module_name;
+				break;
+			case 'f': /* $f is the executable filename */
+				s = cobglobptr->cob_main_argv0;
+				break;
+			case 'b': /* $b is the executable basename */
+				s = get_basename (cobglobptr->cob_main_argv0);
+				break;
+			case 'd': /* $d date as yyyymmdd */
+				time = cob_get_current_datetime (DTR_DATE);
+				j += sprintf (&env[j], "%04d%02d%02d",
+					      time.year, time.month,
+					      time.day_of_month);
+				k++;
+				continue;
+			case 't': /* $t time as hhmmss */
+				time = cob_get_current_datetime (DTR_TIME_NO_NANO);
+				j += sprintf (&env[j], "%02d%02d%02d",
+					      time.hour, time.minute, time.second);
+				k++;
+				continue;
+			default:
+				env[j++] = strval[k];
+				continue;
+			}
+			j += sprintf (&env[j], "%s", s ? s : "NULL");
 			k++;
-		/* CHECME: possibly add $f /$b as basename of executable [or, when passed to cob_init the first name] 
-		           along with $d date as yyyymmdd and $t as hhmmss */
 		} else if (!isspace ((unsigned char)strval[k])) {
 			env[j++] = strval[k];
 		} else {
 			env[j++] = ' ';
 		}
+		/* nothing here, as we have 'continue' statements before */
 	}
 
 	env[j] = '\0';

libcob/common.h

@@ -1686,7 +1686,7 @@ COB_EXPIMP void	cob_set_locale			(cob_field *, const int);
 COB_EXPIMP int 	cob_setenv		(const char *, const char *, int);
 COB_EXPIMP int 	cob_unsetenv		(const char *);
 COB_EXPIMP char	*cob_getenv_direct		(const char *);
-COB_EXPIMP char *cob_expand_env_string	(char *);
+COB_EXPIMP char *cob_expand_env_string	(const char *);
 COB_EXPIMP char	*cob_getenv			(const char *);
 COB_EXPIMP int	cob_putenv			(char *);
 

libcob/profiling.c

@@ -533,16 +533,7 @@ cob_prof_end ()
 
 	prof_filename = cobsetptr->cob_prof_filename;
 	if (!prof_filename){
-		const char* program_id;
-
-		/* Do not use cob_sys_getpid() in case of fork() */
-		int pid = getpid();
-
-		for (l = prof_info_list ; l != NULL; l=l->next){
-			program_id = l->info->procedures[0].text;
-		}
-		sprintf(prof_file_buf, "cob-prof-%s-%d.csv", program_id, pid);
-		prof_filename = prof_file_buf;
+		prof_filename = cob_expand_env_string("cob-prof-$m-$$-$d-$t.csv");
 	}
 
 	file = fopen (prof_filename, !cobsetptr->cob_unix_lf ? "w" : "wb");
@@ -571,6 +562,7 @@ cob_prof_end ()
 			}
 		}
 		fclose (file);
+		fprintf(stderr, "File %s generated\n", prof_filename);
 	} else {
 		cob_runtime_warning (_("error '%s' opening COB_PROF_FILE '%s'"),
 				     cob_get_strerror (), prof_filename);

tests/testsuite.src/used_binaries.at

@@ -1105,7 +1105,9 @@ prog.cob: in paragraph 'PARA-0003':
 prog.cob:11: warning: GO TO SECTION '2ND'
 ])
 
-AT_CHECK([COB_PROF_ENABLE=1 COB_PROF_FILE=prof.csv ./prog])
+AT_CHECK([COB_PROF_ENABLE=1 COB_PROF_FILE=prof.csv ./prog], [0], [],
+[File prof.csv generated
+])
 
 #note: The time here is actually the number of times the procedure has been run, to avoid
 # any indeterminism in the running time of the procedure.
@@ -1142,6 +1144,8 @@ AT_CHECK([$COMPILE -fprof -x prog.cob])
 
 AT_CHECK([COB_PROF_ENABLE=1 COB_PROF_FILE=prof.csv ./prog], [0], [HELLO
 WORLD
+],
+[File prof.csv generated
 ])
 
 AT_CHECK([cat prof.csv], [0],
@@ -1171,6 +1175,8 @@ AT_CHECK([$COMPILE -fprof -x prog.cob])
 
 AT_CHECK([COB_PROF_ENABLE=1 COB_PROF_FILE=prof.csv ./prog], [0], [HELLO
 WORLD
+],
+[File prof.csv generated
 ])
 
 AT_CHECK([cat prof.csv], [0],
@@ -1220,6 +1226,8 @@ AT_CAPTURE_FILE([prof.csv])
 AT_CHECK([$COMPILE -fprof -x prog.cob])
 
 AT_CHECK([COB_PROF_ENABLE=1 COB_PROF_FILE=prof.csv ./prog], [0], [HELLO WORLD
+],
+[File prof.csv generated
 ])
 
 AT_CHECK([cat prof.csv], [0],