diag.c
1 //! @file diag.c
2 //! @author J. Marcel van der Veer
3 //
4 //! @section Copyright
5 //
6 // This file is part of VIF - vintage FORTRAN compiler.
7 // Copyright 2020-2024 J. Marcel van der Veer <algol68g@xs4all.nl>.
8 //
9 //! @section License
10 //
11 // This program is free software; you can redistribute it and/or modify it
12 // under the terms of the GNU General Public License as published by the
13 // Free Software Foundation; either version 3 of the License, or
14 // (at your option) any later version.
15 //
16 // This program is distributed in the hope that it will be useful, but
17 // WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 // or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 // more details. You should have received a copy of the GNU General Public
20 // License along with this program. If not, see <http://www.gnu.org/licenses/>.
21
22 //! @section Synopsis
23 //!
24 //! Diagnostic routines.
25
26 #include <vif.h>
27
28 int_4 nerrors = 0, merrors = 0, nwarns = 0;
29
30 void diagnostic (int_4 proc, char *msg)
31 {
32 RECORD tmp;
33 fprintf (stderr, "%s\n", msg);
34 _srecordf (tmp, "// %s", msg);
35 code (proc, MESSAGES, tmp);
36 }
37
38 void message (FTN_LINE * flin, int_4 pos, char *sev, int num, char *pre, char *post)
39 {
40 if (EQUAL (sev, "error")) {
41 if (merrors++ > MAX_ERROR) {
42 return;
43 }
44 nerrors++;
45 if (flin != NULL && flin->diag > 0) {
46 flin->diag++;
47 return;
48 } else {
49 flin->diag++;
50 }
51 } else if (EQUAL (sev, "warning")) {
52 if (no_warnings) {
53 return;
54 }
55 if (nwarns++ > MAX_WARNS) {
56 return;
57 }
58 }
59 RECORD msg, tmp;
60 RECCLR (msg);
61 if (flin != NULL && flin->file != NULL) {
62 _srecordf (tmp, "** %-10s ** isn %d ", modnam, flin->isn);
63 bufcat (msg, tmp, RECLN);
64 }
65 if (sev != NULL) {
66 if (num > 0) {
67 if (strcmp (sev, "error") == 0) {
68 _srecordf (tmp, "e%d: %s", num, sev);
69 } else if (strcmp (sev, "warning") == 0) {
70 _srecordf (tmp, "w%d: %s", num, sev);
71 } else if (strcmp (sev, "fatal") == 0) {
72 _srecordf (tmp, "f%d: %s", num, sev);
73 } else if (strcmp (sev, "info") == 0) {
74 _srecordf (tmp, "i%d: %s", num, sev);
75 } else {
76 _srecordf (tmp, "d%d: %s", num, sev);
77 }
78 } else {
79 _srecordf (tmp, "%s", sev);
80 }
81 bufcat (msg, tmp, RECLN);
82 }
83 if (pre != NULL) {
84 _srecordf (tmp, ": %s", pre);
85 bufcat (msg, tmp, RECLN);
86 }
87 if (post != NULL) {
88 _srecordf (tmp, ": %s", post);
89 bufcat (msg, tmp, RECLN);
90 }
91 if (flin == NULL) {
92 diagnostic (0, msg);
93 } else {
94 if (flin->file != NULL && flin->file->text != NULL) {
95 _srecordf (tmp, "** %-10s ** isn %d %s", modnam, flin->isn, flin->text);
96 diagnostic (nprocs, tmp);
97 }
98 diagnostic (nprocs, msg);
99 }
100 }
© 2002-2024 J.M. van der Veer (jmvdveer@xs4all.nl)
|