]>
Commit | Line | Data |
---|---|---|
f9bfed22 | 1 | /* Copyright (C) 2002, 2003, 2005, 2007, 2009 Free Software Foundation, Inc. |
6de9cd9a DN |
2 | Contributed by Paul Brook |
3 | ||
57dea9f6 | 4 | This file is part of the GNU Fortran 95 runtime library (libgfortran). |
6de9cd9a | 5 | |
57dea9f6 | 6 | Libgfortran is free software; you can redistribute it and/or modify |
6de9cd9a DN |
7 | it under the terms of the GNU General Public License as published by |
8 | the Free Software Foundation; either version 2, or (at your option) | |
9 | any later version. | |
10 | ||
57dea9f6 TM |
11 | In addition to the permissions in the GNU General Public License, the |
12 | Free Software Foundation gives you unlimited permission to link the | |
13 | compiled version of this file into combinations with other programs, | |
14 | and to distribute those combinations without any restriction coming | |
15 | from the use of this file. (The General Public License restrictions | |
16 | do apply in other respects; for example, they cover modification of | |
17 | the file, and distribution when not linked into a combine | |
18 | executable.) | |
19 | ||
20 | Libgfortran is distributed in the hope that it will be useful, | |
6de9cd9a DN |
21 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
22 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
23 | GNU General Public License for more details. | |
24 | ||
25 | You should have received a copy of the GNU General Public License | |
57dea9f6 | 26 | along with libgfortran; see the file COPYING. If not, write to |
fe2ae685 KC |
27 | the Free Software Foundation, 51 Franklin Street, Fifth Floor, |
28 | Boston, MA 02110-1301, USA. */ | |
6de9cd9a | 29 | |
6de9cd9a | 30 | #include "libgfortran.h" |
36ae8a61 | 31 | #include <string.h> |
6de9cd9a DN |
32 | |
33 | /* Compare a C-style string with a fortran style string in a case-insensitive | |
34 | manner. Used for decoding string options to various statements. Returns | |
35 | zero if not equal, nonzero if equal. */ | |
36 | ||
37 | static int | |
88fdfd5a | 38 | compare0 (const char *s1, gfc_charlen_type s1_len, const char *s2) |
6de9cd9a | 39 | { |
f9bfed22 | 40 | gfc_charlen_type len; |
6de9cd9a | 41 | |
130bcb37 | 42 | /* Strip trailing blanks from the Fortran string. */ |
deeab820 | 43 | len = fstrlen (s1, s1_len); |
88fdfd5a | 44 | if (len != strlen(s2)) return 0; /* don't match */ |
deeab820 | 45 | return strncasecmp (s1, s2, len) == 0; |
6de9cd9a DN |
46 | } |
47 | ||
48 | ||
49 | /* Given a fortran string, return its length exclusive of the trailing | |
50 | spaces. */ | |
88fdfd5a JB |
51 | |
52 | gfc_charlen_type | |
53 | fstrlen (const char *string, gfc_charlen_type len) | |
6de9cd9a | 54 | { |
88fdfd5a JB |
55 | for (; len > 0; len--) |
56 | if (string[len-1] != ' ') | |
6de9cd9a DN |
57 | break; |
58 | ||
88fdfd5a | 59 | return len; |
6de9cd9a DN |
60 | } |
61 | ||
62 | ||
88fdfd5a JB |
63 | /* Copy a Fortran string (not null-terminated, hence length arguments |
64 | for both source and destination strings. Returns the non-padded | |
65 | length of the destination. */ | |
66 | ||
67 | gfc_charlen_type | |
68 | fstrcpy (char *dest, gfc_charlen_type destlen, | |
69 | const char *src, gfc_charlen_type srclen) | |
6de9cd9a | 70 | { |
6de9cd9a DN |
71 | if (srclen >= destlen) |
72 | { | |
73 | /* This will truncate if too long. */ | |
74 | memcpy (dest, src, destlen); | |
88fdfd5a | 75 | return destlen; |
6de9cd9a DN |
76 | } |
77 | else | |
78 | { | |
79 | memcpy (dest, src, srclen); | |
80 | /* Pad with spaces. */ | |
81 | memset (&dest[srclen], ' ', destlen - srclen); | |
88fdfd5a | 82 | return srclen; |
6de9cd9a DN |
83 | } |
84 | } | |
85 | ||
86 | ||
88fdfd5a JB |
87 | /* Copy a null-terminated C string to a non-null-terminated Fortran |
88 | string. Returns the non-padded length of the destination string. */ | |
89 | ||
90 | gfc_charlen_type | |
91 | cf_strcpy (char *dest, gfc_charlen_type dest_len, const char *src) | |
6de9cd9a | 92 | { |
88fdfd5a | 93 | size_t src_len; |
6de9cd9a DN |
94 | |
95 | src_len = strlen (src); | |
96 | ||
88fdfd5a | 97 | if (src_len >= (size_t) dest_len) |
6de9cd9a DN |
98 | { |
99 | /* This will truncate if too long. */ | |
100 | memcpy (dest, src, dest_len); | |
88fdfd5a | 101 | return dest_len; |
6de9cd9a DN |
102 | } |
103 | else | |
104 | { | |
105 | memcpy (dest, src, src_len); | |
106 | /* Pad with spaces. */ | |
107 | memset (&dest[src_len], ' ', dest_len - src_len); | |
88fdfd5a | 108 | return src_len; |
6de9cd9a DN |
109 | } |
110 | } | |
111 | ||
112 | ||
113 | /* Given a fortran string and an array of st_option structures, search through | |
114 | the array to find a match. If the option is not found, we generate an error | |
115 | if no default is provided. */ | |
116 | ||
117 | int | |
88fdfd5a | 118 | find_option (st_parameter_common *cmp, const char *s1, gfc_charlen_type s1_len, |
5e805e44 | 119 | const st_option * opts, const char *error_message) |
6de9cd9a | 120 | { |
6de9cd9a DN |
121 | for (; opts->name; opts++) |
122 | if (compare0 (s1, s1_len, opts->name)) | |
123 | return opts->value; | |
124 | ||
d74b97cc | 125 | generate_error (cmp, LIBERROR_BAD_OPTION, error_message); |
6de9cd9a DN |
126 | |
127 | return -1; | |
128 | } |