![[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.8 ! fgsch 1: /* $OpenBSD: fortran.c,v 1.7 2009/10/27 23:59:37 deraadt 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: #include <ctype.h>
34: #include <limits.h>
35: #include <stdio.h>
36: #include <string.h>
37:
38: #include "ctags.h"
39:
1.4 millert 40: static void takeprec(void);
1.1 deraadt 41:
42: char *lbp; /* line buffer pointer */
43:
44: int
1.6 deraadt 45: PF_funcs(void)
1.1 deraadt 46: {
47: bool pfcnt; /* pascal/fortran functions found */
48: char *cp;
49: char tok[MAXTOKEN];
50:
51: for (pfcnt = NO;;) {
52: lineftell = ftell(inf);
53: if (!fgets(lbuf, sizeof(lbuf), inf))
54: return (pfcnt);
55: ++lineno;
56: lbp = lbuf;
57: if (*lbp == '%') /* Ratfor escape to fortran */
58: ++lbp;
59: for (; isspace(*lbp); ++lbp)
60: continue;
61: if (!*lbp)
62: continue;
63: switch (*lbp | ' ') { /* convert to lower-case */
64: case 'c':
65: if (cicmp("complex") || cicmp("character"))
66: takeprec();
67: break;
68: case 'd':
69: if (cicmp("double")) {
70: for (; isspace(*lbp); ++lbp)
71: continue;
72: if (!*lbp)
73: continue;
74: if (cicmp("precision"))
75: break;
76: continue;
77: }
78: break;
79: case 'i':
80: if (cicmp("integer"))
81: takeprec();
82: break;
83: case 'l':
84: if (cicmp("logical"))
85: takeprec();
86: break;
87: case 'r':
88: if (cicmp("real"))
89: takeprec();
90: break;
91: }
92: for (; isspace(*lbp); ++lbp)
93: continue;
94: if (!*lbp)
95: continue;
96: switch (*lbp | ' ') {
97: case 'f':
98: if (cicmp("function"))
99: break;
100: continue;
101: case 'p':
102: if (cicmp("program") || cicmp("procedure"))
103: break;
104: continue;
105: case 's':
106: if (cicmp("subroutine"))
107: break;
108: default:
109: continue;
110: }
111: for (; isspace(*lbp); ++lbp)
112: continue;
113: if (!*lbp)
114: continue;
115: for (cp = lbp + 1; *cp && intoken(*cp); ++cp)
116: continue;
1.3 deraadt 117: if ((cp = lbp + 1))
1.1 deraadt 118: continue;
119: *cp = EOS;
1.3 deraadt 120: (void)strlcpy(tok, lbp, sizeof tok); /* possible trunc */
1.8 ! fgsch 121: get_line(); /* process line for ex(1) */
1.1 deraadt 122: pfnote(tok, lineno);
123: pfcnt = YES;
124: }
125: /*NOTREACHED*/
126: }
127:
128: /*
129: * cicmp --
130: * do case-independent strcmp
131: */
132: int
1.6 deraadt 133: cicmp(char *cp)
1.1 deraadt 134: {
135: int len;
136: char *bp;
137:
138: for (len = 0, bp = lbp; *cp && (*cp &~ ' ') == (*bp++ &~ ' ');
139: ++cp, ++len)
140: continue;
141: if (!*cp) {
142: lbp += len;
143: return (YES);
144: }
145: return (NO);
146: }
147:
148: static void
1.6 deraadt 149: takeprec(void)
1.1 deraadt 150: {
151: for (; isspace(*lbp); ++lbp)
152: continue;
153: if (*lbp == '*') {
154: for (++lbp; isspace(*lbp); ++lbp)
155: continue;
156: if (!isdigit(*lbp))
157: --lbp; /* force failure */
158: else
159: while (isdigit(*++lbp))
160: continue;
161: }
162: }