![[BACK]](/icons/back.gif){kind=icon}
Return to fortran.c CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [local] / src / usr.bin / ctags|
Return to fortran.c CVS log | Up to [local] / src / usr.bin / ctags |
1.6 ! deraadt 1: /* $OpenBSD: fortran.c,v 1.5 2003/06/03 02:56:07 millert Exp $ */
1.1 deraadt 2: /* $NetBSD: fortran.c,v 1.3 1995/03/26 20:14:08 glass Exp $ */
3:
4: /*
5: * Copyright (c) 1987, 1993, 1994
6: * The Regents of the University of California. All rights reserved.
7: *
8: * Redistribution and use in source and binary forms, with or without
9: * modification, are permitted provided that the following conditions
10: * are met:
11: * 1. Redistributions of source code must retain the above copyright
12: * notice, this list of conditions and the following disclaimer.
13: * 2. Redistributions in binary form must reproduce the above copyright
14: * notice, this list of conditions and the following disclaimer in the
15: * documentation and/or other materials provided with the distribution.
1.5 millert 16: * 3. Neither the name of the University nor the names of its contributors
1.1 deraadt 17: * may be used to endorse or promote products derived from this software
18: * without specific prior written permission.
19: *
20: * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
21: * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22: * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23: * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
24: * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25: * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
26: * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
27: * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
28: * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
29: * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
30: * SUCH DAMAGE.
31: */
32:
33: #ifndef lint
34: #if 0
35: static char sccsid[] = "@(#)fortran.c 8.3 (Berkeley) 4/2/94";
36: #else
1.6 ! deraadt 37: static char rcsid[] = "$OpenBSD: fortran.c,v 1.5 2003/06/03 02:56:07 millert Exp $";
1.1 deraadt 38: #endif
39: #endif /* not lint */
40:
41: #include <ctype.h>
42: #include <limits.h>
43: #include <stdio.h>
44: #include <string.h>
45:
46: #include "ctags.h"
47:
1.4 millert 48: static void takeprec(void);
1.1 deraadt 49:
50: char *lbp; /* line buffer pointer */
51:
52: int
1.6 ! deraadt 53: PF_funcs(void)
1.1 deraadt 54: {
55: bool pfcnt; /* pascal/fortran functions found */
56: char *cp;
57: char tok[MAXTOKEN];
58:
59: for (pfcnt = NO;;) {
60: lineftell = ftell(inf);
61: if (!fgets(lbuf, sizeof(lbuf), inf))
62: return (pfcnt);
63: ++lineno;
64: lbp = lbuf;
65: if (*lbp == '%') /* Ratfor escape to fortran */
66: ++lbp;
67: for (; isspace(*lbp); ++lbp)
68: continue;
69: if (!*lbp)
70: continue;
71: switch (*lbp | ' ') { /* convert to lower-case */
72: case 'c':
73: if (cicmp("complex") || cicmp("character"))
74: takeprec();
75: break;
76: case 'd':
77: if (cicmp("double")) {
78: for (; isspace(*lbp); ++lbp)
79: continue;
80: if (!*lbp)
81: continue;
82: if (cicmp("precision"))
83: break;
84: continue;
85: }
86: break;
87: case 'i':
88: if (cicmp("integer"))
89: takeprec();
90: break;
91: case 'l':
92: if (cicmp("logical"))
93: takeprec();
94: break;
95: case 'r':
96: if (cicmp("real"))
97: takeprec();
98: break;
99: }
100: for (; isspace(*lbp); ++lbp)
101: continue;
102: if (!*lbp)
103: continue;
104: switch (*lbp | ' ') {
105: case 'f':
106: if (cicmp("function"))
107: break;
108: continue;
109: case 'p':
110: if (cicmp("program") || cicmp("procedure"))
111: break;
112: continue;
113: case 's':
114: if (cicmp("subroutine"))
115: break;
116: default:
117: continue;
118: }
119: for (; isspace(*lbp); ++lbp)
120: continue;
121: if (!*lbp)
122: continue;
123: for (cp = lbp + 1; *cp && intoken(*cp); ++cp)
124: continue;
1.3 deraadt 125: if ((cp = lbp + 1))
1.1 deraadt 126: continue;
127: *cp = EOS;
1.3 deraadt 128: (void)strlcpy(tok, lbp, sizeof tok); /* possible trunc */
1.1 deraadt 129: getline(); /* process line for ex(1) */
130: pfnote(tok, lineno);
131: pfcnt = YES;
132: }
133: /*NOTREACHED*/
134: }
135:
136: /*
137: * cicmp --
138: * do case-independent strcmp
139: */
140: int
1.6 ! deraadt 141: cicmp(char *cp)
1.1 deraadt 142: {
143: int len;
144: char *bp;
145:
146: for (len = 0, bp = lbp; *cp && (*cp &~ ' ') == (*bp++ &~ ' ');
147: ++cp, ++len)
148: continue;
149: if (!*cp) {
150: lbp += len;
151: return (YES);
152: }
153: return (NO);
154: }
155:
156: static void
1.6 ! deraadt 157: takeprec(void)
1.1 deraadt 158: {
159: for (; isspace(*lbp); ++lbp)
160: continue;
161: if (*lbp == '*') {
162: for (++lbp; isspace(*lbp); ++lbp)
163: continue;
164: if (!isdigit(*lbp))
165: --lbp; /* force failure */
166: else
167: while (isdigit(*++lbp))
168: continue;
169: }
170: }