1 /*
2 * gretl -- Gnu Regression, Econometrics and Time-series Library
3 * Copyright (C) 2001 Allin Cottrell and Riccardo "Jack" Lucchetti
4 *
5 * This program is free software: you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation, either version 3 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 *
18 */
19
20 #include "libgretl.h"
21 #include "gretl_func.h"
22 #include "libset.h"
23 #include "monte_carlo.h"
24
25 #include <errno.h>
26
27 #define EDEBUG 0
28
29 #define ERRLEN 2048
30
31 static char gretl_errmsg[ERRLEN];
32 static char gretl_warnmsg[ERRLEN];
33
34 static int gretl_errno;
35 static int gretl_warnnum;
36
37 static const char *gretl_error_messages[] = {
38 NULL,
39 NULL,
40 N_("Data error"), /* E_DATA = 2 */
41 N_("Exact or near collinearity encountered"), /* E_SINGULAR */
42 N_("Insufficient degrees of freedom for regression"), /* E_DF */
43 N_("Dependent variable is all zeros, aborting regression"), /* E_ZERO */
44 N_("Total sum of squares was not positive"), /* E_TSS */
45 N_("Sum of squared residuals negative!"), /* E_ESS */
46 N_("Sorry, command not available for this estimator"), /* E_NOTIMP */
47 N_("Unspecified error -- FIXME"), /* E_UNSPEC */
48 N_("This command won't work with the current periodicity"), /* E_PDWRONG */
49 N_("Error attempting to open file"), /* E_FOPEN */
50 N_("Out of memory!"), /* E_ALLOC */
51 N_("No formula supplied in genr"), /* E_EQN */
52 N_("Unknown variable name in command"), /* E_UNKVAR */
53 N_("Command has insufficient arguments"), /* E_ARGS */
54 N_("This command is implemented only for OLS models"), /* E_OLSONLY */
55 N_("Invalid argument"), /* E_INVARG */
56 N_("Syntax error"), /* E_PARSE */
57 N_("No independent variables left after omissions"), /* E_NOVARS */
58 N_("No independent variables were omitted"), /* E_NOOMIT */
59 N_("No new independent variables were added"), /* E_NOADD */
60 N_("One or more \"added\" vars were already present"), /* E_ADDDUP */
61 N_("Error generating logarithms"), /* E_LOGS */
62 N_("Error generating squares"), /* E_SQUARES */
63 N_("Error generating lagged variables"), /* E_LAGS */
64 N_("Attempting to take square root of negative number"), /* E_SQRT */
65 N_("Excessive exponent in genr formula"), /* E_HIGH */
66 N_("Need valid starting and ending observations"), /* E_OBS */
67 N_("You must include a constant in this sort of model"), /* E_NOCONST */
68 N_("The statistic you requested is not available"), /* E_BADSTAT */
69 N_("Missing sub-sample information; can't merge data"), /* E_NOMERGE */
70 N_("The convergence criterion was not met"), /* E_NOCONV */
71 N_("The operation was canceled"), /* E_CANCEL */
72 N_("Missing values encountered"), /* E_MISSDATA */
73 N_("Not a Number in calculation"), /* E_NAN */
74 N_("Matrices not conformable for operation"), /* E_NONCONF */
75 N_("Data types not conformable for operation"), /* E_TYPES */
76 N_("Incompatible options"), /* E_BADOPT */
77 N_("The restrictions do not identify the parameters"), /* E_NOIDENT */
78 N_("External command failed"), /* E_EXTERNAL */
79 N_("Maximum length of command line (65536 bytes) exceeded"), /* E_TOOLONG */
80 N_("No dataset is in place"), /* E_NODATA */
81 N_("Matrix is not positive definite"), /* E_NOTPD */
82 N_("Failed to calculate Jacobian"), /* E_JACOBIAN */
83 N_("Insufficient observations for this operation"), /* E_TOOFEW */
84 N_("You cannot define a function within a function"), /* E_FNEST */
85 N_("Error executing function"), /* E_FUNCERR */
86 N_("Execution aborted by request"), /* E_STOP */
87 N_("'catch' cannot be used in this context"), /* E_BADCATCH */
88 N_("complex arguments/operands not supported"), /* E_CMPLX */
89 N_("mixed complex/real arguments not supported"), /* E_MIXED */
90 NULL, /* E_DB_DUP */
91 NULL, /* E_OK */
92 NULL /* E_MAX */
93 };
94
95 static const char *gretl_warning_messages[] = {
96 NULL,
97 N_("gradient is not close to zero"), /* W_GRADIENT */
98 N_("generated missing values"), /* W_GENMISS */
99 N_("generated non-finite values"), /* W_GENNAN */
100 NULL /* W_MAX */
101 };
102
look_up_errmsg(int err)103 static const char *look_up_errmsg (int err)
104 {
105 if (err > 0 && err < E_MAX) {
106 return gretl_error_messages[err];
107 } else if (err == 0) {
108 return "";
109 } else {
110 fprintf(stderr, "look_up_errmsg: out of bounds code %d\n", err);
111 return "missing error message!";
112 }
113 }
114
look_up_warnmsg(int w)115 static const char *look_up_warnmsg (int w)
116 {
117 if (w > 0 && w < W_MAX) {
118 return gretl_warning_messages[w];
119 } else {
120 fprintf(stderr, "look_up_warnmsg: out of bounds code %d\n", w);
121 return "missing warning message!";
122 }
123 }
124
125 static int error_printed;
126 static int alarm_set;
127
128 /**
129 * errmsg_get_with_default:
130 * @err: gretl error code (see #gretl_error_codes).
131 *
132 * Returns: a specific error message if available,
133 * otherwise a generic error message corresponding to the
134 * given @err.
135 */
136
errmsg_get_with_default(int err)137 const char *errmsg_get_with_default (int err)
138 {
139 const char *ret = "";
140
141 #if EDEBUG
142 fprintf(stderr, "errmsg_get_with_default: msg='%s'\n",
143 gretl_errmsg);
144 #endif
145
146 if (err > 0 && err < E_MAX) {
147 if (*gretl_errmsg != '\0') {
148 ret = gretl_errmsg;
149 } else {
150 const char *deflt = look_up_errmsg(err);
151
152 if (deflt != NULL) {
153 ret = _(deflt);
154 }
155 }
156 }
157
158 return ret;
159 }
160
161 /**
162 * gretl_warnmsg_get:
163 *
164 * Returns: the current gretl warning message, or %NULL if no
165 * warning is currently in place.
166 */
167
gretl_warnmsg_get(void)168 const char *gretl_warnmsg_get (void)
169 {
170 const char *ret = NULL;
171
172 if (gretl_warnnum) {
173 if (*gretl_warnmsg != '\0') {
174 ret = gretl_warnmsg;
175 /* note; can't zero the message here! */
176 } else {
177 const char *deflt = look_up_warnmsg(gretl_warnnum);
178
179 if (deflt != NULL) {
180 ret = _(deflt);
181 }
182 }
183 gretl_warnnum = 0;
184 }
185
186 return ret;
187 }
188
189 /**
190 * errmsg:
191 * @err: gretl error code (see #error_codes).
192 * @prn: gretl printing struct.
193 *
194 * Prints to @prn a specific error message if available,
195 * otherwise a generic error message corresponding to the
196 * given @err.
197 */
198
errmsg(int err,PRN * prn)199 void errmsg (int err, PRN *prn)
200 {
201 #if EDEBUG
202 fprintf(stderr, "errmsg: err=%d, error_printed=%d\n",
203 err, error_printed);
204 #endif
205
206 if (!error_printed && prn != NULL) {
207 const char *msg = errmsg_get_with_default(err);
208
209 if (print_redirection_level(prn) > 0) {
210 /* FIXME can we get this message to appear at the
211 "top level" of @prn? */
212 const char *fname = print_redirection_filename(prn);
213
214 if (fname != NULL) {
215 fprintf(stderr, "error when 'outfile' (%s) active\n %s\n",
216 fname, msg);
217 } else {
218 fprintf(stderr, "error when 'outfile' active\n %s\n", msg);
219 }
220 }
221 pprintf(prn, "%s\n", msg);
222 error_printed = 1;
223 }
224 }
225
print_function_info(PRN * prn)226 static void print_function_info (PRN *prn)
227 {
228 if (gretl_function_depth() > 0) {
229 const char *fname = NULL;
230 const char *pname = NULL;
231
232 current_function_info(&fname, &pname);
233 if (fname != NULL && pname != NULL) {
234 pprintf(prn, "%s %s (%s %s):\n", _("In regard to function"),
235 fname, _("package"), pname);
236 } else if (fname != NULL) {
237 pprintf(prn, "%s %s:\n", _("In regard to function"), fname);
238 }
239 }
240 }
241
242 /**
243 * warnmsg:
244 * @prn: gretl printing struct.
245 *
246 * If a gretl warning is set, prints a message to @prn
247 * and zeros the warning signal.
248 */
249
warnmsg(PRN * prn)250 void warnmsg (PRN *prn)
251 {
252 if (prn == NULL || gretl_warnnum == 0) {
253 return;
254 }
255
256 if (!gretl_warnings_on()) {
257 *gretl_warnmsg = '\0';
258 gretl_warnnum = 0;
259 return;
260 }
261
262 if (*gretl_warnmsg != '\0') {
263 print_function_info(prn);
264 pprintf(prn, "%s: %s\n", _("Warning"), gretl_warnmsg);
265 *gretl_warnmsg = '\0';
266 } else {
267 const char *s = look_up_warnmsg(gretl_warnnum);
268
269 print_function_info(prn);
270 pprintf(prn, "%s: %s\n", _("Warning"), _(s));
271 }
272
273 gretl_warnnum = 0;
274 }
275
276 /**
277 * gretl_errmsg_get:
278 *
279 * Returns: a specific error message if available,
280 * otherwise an empty string.
281 */
282
gretl_errmsg_get(void)283 const char *gretl_errmsg_get (void)
284 {
285 return gretl_errmsg;
286 }
287
288 /**
289 * gretl_errmsg_set:
290 * @str: an error message.
291 *
292 * If %gretl_errmsg is currently blank, copy the given string into
293 * the message space; or if the error message is not blank but
294 * sufficient space remains, append @str to the message.
295 */
296
gretl_errmsg_set(const char * str)297 void gretl_errmsg_set (const char *str)
298 {
299 #if EDEBUG
300 fprintf(stderr, "gretl_errmsg_set: '%s'\n", str);
301 #endif
302
303 if (alarm_set && *gretl_errmsg != '\0') {
304 /* leave the current error message in place */
305 return;
306 }
307
308 if (*gretl_errmsg == '\0') {
309 strncat(gretl_errmsg, str, ERRLEN - 1);
310 } else if (strcmp(gretl_errmsg, str)) {
311 /* should we do the following? */
312 int n = strlen(gretl_errmsg);
313 int m = strlen(str);
314
315 if (n + m + 2 < ERRLEN) {
316 strcat(gretl_errmsg, "\n");
317 strcat(gretl_errmsg, str);
318 }
319 }
320
321 #if EDEBUG
322 fprintf(stderr, "gretl_errmsg now: '%s'\n", gretl_errmsg);
323 #endif
324 }
325
326 /**
327 * gretl_errmsg_append:
328 * @str: an error message.
329 * @err: the current error state, if any.
330 *
331 * Add @str to the current gretl error message, starting a
332 * new line, if space permits.
333 */
334
gretl_errmsg_append(const char * str,int err)335 void gretl_errmsg_append (const char *str, int err)
336 {
337 int n, m = strlen(str);
338
339 if (*gretl_errmsg == '\0' && err > 0 && err < E_MAX) {
340 const char *s = look_up_errmsg(err);
341
342 if (s != NULL) {
343 strcpy(gretl_errmsg, s);
344 }
345 }
346
347 n = strlen(gretl_errmsg);
348
349 if (n + m + 2 < ERRLEN) {
350 if (n > 0 && gretl_errmsg[n] != '\n') {
351 strcat(gretl_errmsg, "\n");
352 }
353 strcat(gretl_errmsg, str);
354 }
355 }
356
357 /**
358 * gretl_errmsg_ensure:
359 * @str: an error message.
360 *
361 * If %gretl_errmsg is currently blank, copy the given string into
362 * the message space.
363 */
364
gretl_errmsg_ensure(const char * str)365 void gretl_errmsg_ensure (const char *str)
366 {
367 if (*gretl_errmsg == '\0') {
368 strncat(gretl_errmsg, str, ERRLEN - 1);
369 }
370 }
371
372 /**
373 * gretl_warnmsg_set:
374 * @str: a warning message.
375 *
376 * Copy the given string into the warning message space.
377 */
378
gretl_warnmsg_set(const char * str)379 void gretl_warnmsg_set (const char *str)
380 {
381 *gretl_warnmsg = '\0';
382 strncat(gretl_warnmsg, str, ERRLEN - 1);
383 gretl_warnnum = W_MAX;
384 }
385
386 /**
387 * gretl_errmsg_sprintf:
388 * @fmt: format string.
389 * @...: arguments, as to sprintf.
390 *
391 * Append a formatted message to the current gretl
392 * error message.
393 */
394
gretl_errmsg_sprintf(const char * fmt,...)395 void gretl_errmsg_sprintf (const char *fmt, ...)
396 {
397 #if EDEBUG
398 fprintf(stderr, "gretl_errmsg_sprintf: fmt='%s'\n", fmt);
399 #endif
400
401 if (*gretl_errmsg == '\0') {
402 va_list ap;
403
404 va_start(ap, fmt);
405 vsnprintf(gretl_errmsg, ERRLEN, fmt, ap);
406 va_end(ap);
407 } else if (strstr(gretl_errmsg, "*** error in fun") &&
408 strstr(fmt, "*** error in fun")) {
409 /* don't print more than one "error in function"
410 message, as this gets confusing
411 */
412 ;
413 } else {
414 /* find the number of characters left */
415 int len0 = strlen(gretl_errmsg);
416 int n = ERRLEN - len0 - 2;
417
418 if (n > 31) {
419 char tmp[ERRLEN];
420 va_list ap;
421
422 *tmp = '\0';
423 va_start(ap, fmt);
424 vsnprintf(tmp, n, fmt, ap);
425 va_end(ap);
426
427 if (gretl_errmsg[len0 - 1] != '\n') {
428 strcat(gretl_errmsg, "\n");
429 }
430 strcat(gretl_errmsg, tmp);
431 }
432 }
433 }
434
gretl_errmsg_sprintf_replace(const char * fmt,...)435 void gretl_errmsg_sprintf_replace (const char *fmt, ...)
436 {
437 va_list ap;
438
439 gretl_errmsg[0] = '\0';
440 va_start(ap, fmt);
441 vsnprintf(gretl_errmsg, ERRLEN, fmt, ap);
442 va_end(ap);
443 }
444
445 /**
446 * gretl_warnmsg_sprintf:
447 * @fmt: format string.
448 * @...: arguments, as to sprintf.
449 *
450 * Write a formatted message to the current gretl
451 * warning message space.
452 */
453
gretl_warnmsg_sprintf(const char * fmt,...)454 void gretl_warnmsg_sprintf (const char *fmt, ...)
455 {
456 va_list ap;
457
458 *gretl_warnmsg = '\0';
459
460 va_start(ap, fmt);
461 vsnprintf(gretl_warnmsg, ERRLEN, fmt, ap);
462 va_end(ap);
463
464 gretl_warnnum = W_MAX;
465 }
466
gretl_strerror(int errnum)467 char *gretl_strerror (int errnum)
468 {
469 #if 0 /* doesn't work, AND not cross-platform */
470 static locale_t loc = (locale_t) 0;
471
472 if (loc == (locale_t) 0) {
473 loc = newlocale(LC_ALL_MASK, "", loc);
474 }
475
476 if (loc != (locale_t) 0) {
477 uselocale(loc);
478 return strerror_l(errnum, loc);
479 } else {
480 return strerror(errnum);
481 }
482 #else
483 return strerror(errnum);
484 #endif
485 }
486
487 /**
488 * gretl_errmsg_set_from_errno:
489 * @s: string to prepend to error message, or %NULL.
490 *
491 * If %gretl_errmsg is currently blank, copy the string
492 * returned by %strerror into the message space; or if the
493 * error message is not blank but sufficient space remains,
494 * append the new error info to the message.
495 */
496
gretl_errmsg_set_from_errno(const char * s,int errnum)497 void gretl_errmsg_set_from_errno (const char *s, int errnum)
498 {
499 char *msg = NULL;
500
501 if (errnum) {
502 msg = gretl_strerror(errnum);
503 errno = 0;
504 }
505
506 if (msg != NULL) {
507 if (s != NULL) {
508 gretl_errmsg_sprintf("%s: %s", s, msg);
509 } else {
510 gretl_errmsg_set(msg);
511 }
512 }
513 }
514
515 /**
516 * gretl_error_clear:
517 *
518 * Blank out any previously recorded error message.
519 */
520
gretl_error_clear(void)521 int gretl_error_clear (void)
522 {
523 #if EDEBUG
524 fprintf(stderr, "gretl_error_clear\n");
525 #endif
526 if (!alarm_set) {
527 *gretl_errmsg = '\0';
528 }
529 error_printed = 0;
530 errno = 0;
531 #if 0 /* 2015-11-18: with the following activated, warning
532 messages will rarely, if ever, get printed?
533 */
534 gretl_warnnum = 0;
535 *gretl_warnmsg = '\0';
536 #endif
537
538 return 0;
539 }
540
541 /**
542 * gretl_errmsg_is_set:
543 *
544 * Returns: 1 if the gretl error message is currently
545 * set (not blank), otherwise 0.
546 */
547
gretl_errmsg_is_set(void)548 int gretl_errmsg_is_set (void)
549 {
550 return (*gretl_errmsg != '\0');
551 }
552
553 /**
554 * maybe_save_gretl_errmsg:
555 *
556 * Returns: An allocated copy of the current gretl error
557 * message, or NULL if @err is zero or the current message
558 * is blank.
559 */
560
maybe_save_gretl_errmsg(int err)561 char *maybe_save_gretl_errmsg (int err)
562 {
563 if (err && *gretl_errmsg != '\0') {
564 return gretl_strdup(gretl_errmsg);
565 } else {
566 return NULL;
567 }
568 }
569
570 /* setting the "alarm" prevents gretl_errmsg from being
571 overwritten
572 */
573
set_gretl_alarm(int val)574 void set_gretl_alarm (int val)
575 {
576 alarm_set = val;
577 }
578
set_gretl_errno(int err)579 void set_gretl_errno (int err)
580 {
581 gretl_errno = err;
582 }
583
set_gretl_warning(int w)584 void set_gretl_warning (int w)
585 {
586 gretl_warnnum = w;
587 }
588
get_gretl_errno(void)589 int get_gretl_errno (void)
590 {
591 int err = gretl_errno;
592
593 gretl_errno = 0;
594 return err;
595 }
596
check_gretl_errno(void)597 int check_gretl_errno (void)
598 {
599 return gretl_errno;
600 }
601
check_gretl_warning(void)602 int check_gretl_warning (void)
603 {
604 return gretl_warnnum;
605 }
606
gretl_error_is_fatal(void)607 int gretl_error_is_fatal (void)
608 {
609 if (gretl_compiling_function()) {
610 return 1;
611 } else if (gretl_compiling_loop()) {
612 return 1;
613 } else {
614 return gretl_in_batch_mode();
615 }
616 }
617
invalid_field_error(const char * s)618 int invalid_field_error (const char *s)
619 {
620 gretl_errmsg_sprintf(_("field '%s' in command is invalid"), s);
621 return E_DATA;
622 }
623