GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: usr.bin/ctags/fortran.c Lines: 0 49 0.0 %
Date: 2017-11-07 Branches: 0 74 0.0 %

Line Branch Exec Source
1
/*	$OpenBSD: fortran.c,v 1.9 2013/11/26 13:18:55 deraadt Exp $	*/
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.
16
 * 3. Neither the name of the University nor the names of its contributors
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
40
static void takeprec(void);
41
42
char *lbp;				/* line buffer pointer */
43
44
int
45
PF_funcs(void)
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((unsigned char)*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((unsigned char)*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((unsigned char)*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((unsigned char)*lbp); ++lbp)
112
			continue;
113
		if (!*lbp)
114
			continue;
115
		for (cp = lbp + 1; *cp && intoken(*cp); ++cp)
116
			continue;
117
		if ((cp = lbp + 1))
118
			continue;
119
		*cp = EOS;
120
		(void)strlcpy(tok, lbp, sizeof tok);	/* possible trunc */
121
		get_line();			/* process line for ex(1) */
122
		pfnote(tok, lineno);
123
		pfcnt = YES;
124
	}
125
	/*NOTREACHED*/
126
}
127
128
/*
129
 * cicmp --
130
 *	do case-independent strcmp
131
 */
132
int
133
cicmp(char *cp)
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
149
takeprec(void)
150
{
151
	for (; isspace((unsigned char)*lbp); ++lbp)
152
		continue;
153
	if (*lbp == '*') {
154
		for (++lbp; isspace((unsigned char)*lbp); ++lbp)
155
			continue;
156
		if (!isdigit((unsigned char)*lbp))
157
			--lbp;			/* force failure */
158
		else
159
			while (isdigit((unsigned char)*++lbp))
160
				continue;
161
	}
162
}