|
111
|
1 /* Parse and display command line options.
|
|
145
|
2 Copyright (C) 2000-2020 Free Software Foundation, Inc.
|
|
111
|
3 Contributed by Andy Vaught
|
|
|
4
|
|
|
5 This file is part of GCC.
|
|
|
6
|
|
|
7 GCC is free software; you can redistribute it and/or modify it under
|
|
|
8 the terms of the GNU General Public License as published by the Free
|
|
|
9 Software Foundation; either version 3, or (at your option) any later
|
|
|
10 version.
|
|
|
11
|
|
|
12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
|
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
15 for more details.
|
|
|
16
|
|
|
17 You should have received a copy of the GNU General Public License
|
|
|
18 along with GCC; see the file COPYING3. If not see
|
|
|
19 <http://www.gnu.org/licenses/>. */
|
|
|
20
|
|
|
21 #include "config.h"
|
|
|
22 #include "system.h"
|
|
|
23 #include "coretypes.h"
|
|
|
24 #include "target.h"
|
|
|
25 #include "tree.h"
|
|
|
26 #include "gfortran.h"
|
|
|
27 #include "diagnostic.h" /* For global_dc. */
|
|
|
28 #include "opts.h"
|
|
|
29 #include "toplev.h" /* For save_decoded_options. */
|
|
|
30 #include "cpp.h"
|
|
|
31 #include "langhooks.h"
|
|
|
32
|
|
|
33 gfc_option_t gfc_option;
|
|
|
34
|
|
145
|
35 #define SET_FLAG(flag, condition, on_value, off_value) \
|
|
|
36 do \
|
|
|
37 { \
|
|
|
38 if (condition) \
|
|
|
39 flag = (on_value); \
|
|
|
40 else \
|
|
|
41 flag = (off_value); \
|
|
|
42 } while (0)
|
|
|
43
|
|
|
44 #define SET_BITFLAG2(m) m
|
|
|
45
|
|
|
46 #define SET_BITFLAG(flag, condition, value) \
|
|
|
47 SET_BITFLAG2 (SET_FLAG (flag, condition, (flag | (value)), (flag & ~(value))))
|
|
|
48
|
|
111
|
49
|
|
|
50 /* Set flags that control warnings and errors for different
|
|
|
51 Fortran standards to their default values. Keep in sync with
|
|
|
52 libgfortran/runtime/compile_options.c (init_compile_options). */
|
|
|
53
|
|
|
54 static void
|
|
|
55 set_default_std_flags (void)
|
|
|
56 {
|
|
|
57 gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
|
|
|
58 | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
|
|
131
|
59 | GFC_STD_F2008_OBS | GFC_STD_GNU | GFC_STD_LEGACY
|
|
|
60 | GFC_STD_F2018 | GFC_STD_F2018_DEL | GFC_STD_F2018_OBS;
|
|
|
61 gfc_option.warn_std = GFC_STD_F2018_DEL | GFC_STD_F95_DEL | GFC_STD_LEGACY;
|
|
111
|
62 }
|
|
|
63
|
|
145
|
64 /* Set (or unset) the DEC extension flags. */
|
|
111
|
65
|
|
|
66 static void
|
|
|
67 set_dec_flags (int value)
|
|
|
68 {
|
|
145
|
69 /* Set (or unset) other DEC compatibility extensions. */
|
|
|
70 SET_BITFLAG (flag_dollar_ok, value, value);
|
|
|
71 SET_BITFLAG (flag_cray_pointer, value, value);
|
|
|
72 SET_BITFLAG (flag_dec_structure, value, value);
|
|
|
73 SET_BITFLAG (flag_dec_intrinsic_ints, value, value);
|
|
|
74 SET_BITFLAG (flag_dec_static, value, value);
|
|
|
75 SET_BITFLAG (flag_dec_math, value, value);
|
|
|
76 SET_BITFLAG (flag_dec_include, value, value);
|
|
|
77 SET_BITFLAG (flag_dec_format_defaults, value, value);
|
|
|
78 SET_BITFLAG (flag_dec_blank_format_item, value, value);
|
|
|
79 SET_BITFLAG (flag_dec_char_conversions, value, value);
|
|
|
80 }
|
|
|
81
|
|
|
82 /* Finalize DEC flags. */
|
|
|
83
|
|
|
84 static void
|
|
|
85 post_dec_flags (int value)
|
|
|
86 {
|
|
|
87 /* Don't warn for legacy code if -fdec is given; however, setting -fno-dec
|
|
|
88 does not force these warnings. We make one final determination on this
|
|
|
89 at the end because -std= is always set first; thus, we can avoid
|
|
|
90 clobbering the user's desired standard settings in gfc_handle_option
|
|
|
91 e.g. when -fdec and -fno-dec are both given. */
|
|
111
|
92 if (value)
|
|
|
93 {
|
|
|
94 gfc_option.allow_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL
|
|
145
|
95 | GFC_STD_GNU | GFC_STD_LEGACY;
|
|
111
|
96 gfc_option.warn_std &= ~(GFC_STD_LEGACY | GFC_STD_F95_DEL);
|
|
|
97 }
|
|
|
98 }
|
|
|
99
|
|
145
|
100 /* Enable (or disable) -finit-local-zero. */
|
|
|
101
|
|
|
102 static void
|
|
|
103 set_init_local_zero (int value)
|
|
|
104 {
|
|
|
105 gfc_option.flag_init_integer_value = 0;
|
|
|
106 gfc_option.flag_init_character_value = (char)0;
|
|
|
107
|
|
|
108 SET_FLAG (gfc_option.flag_init_integer, value, GFC_INIT_INTEGER_ON,
|
|
|
109 GFC_INIT_INTEGER_OFF);
|
|
|
110 SET_FLAG (gfc_option.flag_init_logical, value, GFC_INIT_LOGICAL_FALSE,
|
|
|
111 GFC_INIT_LOGICAL_OFF);
|
|
|
112 SET_FLAG (gfc_option.flag_init_character, value, GFC_INIT_CHARACTER_ON,
|
|
|
113 GFC_INIT_CHARACTER_OFF);
|
|
|
114 SET_FLAG (flag_init_real, value, GFC_INIT_REAL_ZERO, GFC_INIT_REAL_OFF);
|
|
|
115 }
|
|
111
|
116
|
|
|
117 /* Return language mask for Fortran options. */
|
|
|
118
|
|
|
119 unsigned int
|
|
|
120 gfc_option_lang_mask (void)
|
|
|
121 {
|
|
|
122 return CL_Fortran;
|
|
|
123 }
|
|
|
124
|
|
|
125 /* Initialize options structure OPTS. */
|
|
|
126
|
|
|
127 void
|
|
|
128 gfc_init_options_struct (struct gcc_options *opts)
|
|
|
129 {
|
|
|
130 opts->x_flag_errno_math = 0;
|
|
|
131 opts->frontend_set_flag_errno_math = true;
|
|
|
132 opts->x_flag_associative_math = -1;
|
|
|
133 opts->frontend_set_flag_associative_math = true;
|
|
|
134 }
|
|
|
135
|
|
|
136 /* Get ready for options handling. Keep in sync with
|
|
|
137 libgfortran/runtime/compile_options.c (init_compile_options). */
|
|
|
138
|
|
|
139 void
|
|
|
140 gfc_init_options (unsigned int decoded_options_count,
|
|
|
141 struct cl_decoded_option *decoded_options)
|
|
|
142 {
|
|
|
143 gfc_source_file = NULL;
|
|
|
144 gfc_option.module_dir = NULL;
|
|
|
145 gfc_option.source_form = FORM_UNKNOWN;
|
|
|
146 gfc_option.max_continue_fixed = 255;
|
|
|
147 gfc_option.max_continue_free = 255;
|
|
|
148 gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN;
|
|
|
149 gfc_option.max_errors = 25;
|
|
|
150
|
|
|
151 gfc_option.flag_preprocessed = 0;
|
|
|
152 gfc_option.flag_d_lines = -1;
|
|
145
|
153 set_init_local_zero (0);
|
|
111
|
154
|
|
|
155 gfc_option.fpe = 0;
|
|
|
156 /* All except GFC_FPE_INEXACT. */
|
|
|
157 gfc_option.fpe_summary = GFC_FPE_INVALID | GFC_FPE_DENORMAL
|
|
|
158 | GFC_FPE_ZERO | GFC_FPE_OVERFLOW
|
|
|
159 | GFC_FPE_UNDERFLOW;
|
|
|
160 gfc_option.rtcheck = 0;
|
|
|
161
|
|
|
162 /* ??? Wmissing-include-dirs is disabled by default in C/C++ but
|
|
|
163 enabled by default in Fortran. Ideally, we should express this
|
|
|
164 in .opt, but that is not supported yet. */
|
|
145
|
165 SET_OPTION_IF_UNSET (&global_options, &global_options_set,
|
|
|
166 cpp_warn_missing_include_dirs, 1);
|
|
111
|
167
|
|
|
168 set_dec_flags (0);
|
|
|
169
|
|
|
170 set_default_std_flags ();
|
|
|
171
|
|
|
172 /* Initialize cpp-related options. */
|
|
|
173 gfc_cpp_init_options (decoded_options_count, decoded_options);
|
|
|
174 gfc_diagnostics_init ();
|
|
|
175 }
|
|
|
176
|
|
|
177
|
|
|
178 /* Determine the source form from the filename extension. We assume
|
|
|
179 case insensitivity. */
|
|
|
180
|
|
|
181 static gfc_source_form
|
|
|
182 form_from_filename (const char *filename)
|
|
|
183 {
|
|
|
184 static const struct
|
|
|
185 {
|
|
|
186 const char *extension;
|
|
|
187 gfc_source_form form;
|
|
|
188 }
|
|
|
189 exttype[] =
|
|
|
190 {
|
|
|
191 {
|
|
|
192 ".f90", FORM_FREE}
|
|
|
193 ,
|
|
|
194 {
|
|
|
195 ".f95", FORM_FREE}
|
|
|
196 ,
|
|
|
197 {
|
|
|
198 ".f03", FORM_FREE}
|
|
|
199 ,
|
|
|
200 {
|
|
|
201 ".f08", FORM_FREE}
|
|
|
202 ,
|
|
|
203 {
|
|
|
204 ".f", FORM_FIXED}
|
|
|
205 ,
|
|
|
206 {
|
|
|
207 ".for", FORM_FIXED}
|
|
|
208 ,
|
|
|
209 {
|
|
|
210 ".ftn", FORM_FIXED}
|
|
|
211 ,
|
|
|
212 {
|
|
|
213 "", FORM_UNKNOWN}
|
|
|
214 }; /* sentinel value */
|
|
|
215
|
|
|
216 gfc_source_form f_form;
|
|
|
217 const char *fileext;
|
|
|
218 int i;
|
|
|
219
|
|
|
220 /* Find end of file name. Note, filename is either a NULL pointer or
|
|
|
221 a NUL terminated string. */
|
|
|
222 i = 0;
|
|
|
223 while (filename[i] != '\0')
|
|
|
224 i++;
|
|
|
225
|
|
|
226 /* Find last period. */
|
|
|
227 while (i >= 0 && (filename[i] != '.'))
|
|
|
228 i--;
|
|
|
229
|
|
|
230 /* Did we see a file extension? */
|
|
|
231 if (i < 0)
|
|
|
232 return FORM_UNKNOWN; /* Nope */
|
|
|
233
|
|
|
234 /* Get file extension and compare it to others. */
|
|
|
235 fileext = &(filename[i]);
|
|
|
236
|
|
|
237 i = -1;
|
|
|
238 f_form = FORM_UNKNOWN;
|
|
|
239 do
|
|
|
240 {
|
|
|
241 i++;
|
|
|
242 if (strcasecmp (fileext, exttype[i].extension) == 0)
|
|
|
243 {
|
|
|
244 f_form = exttype[i].form;
|
|
|
245 break;
|
|
|
246 }
|
|
|
247 }
|
|
|
248 while (exttype[i].form != FORM_UNKNOWN);
|
|
|
249
|
|
|
250 return f_form;
|
|
|
251 }
|
|
|
252
|
|
|
253
|
|
|
254 /* Finalize commandline options. */
|
|
|
255
|
|
|
256 bool
|
|
|
257 gfc_post_options (const char **pfilename)
|
|
|
258 {
|
|
|
259 const char *filename = *pfilename, *canon_source_file = NULL;
|
|
|
260 char *source_path;
|
|
|
261 int i;
|
|
|
262
|
|
145
|
263 /* Finalize DEC flags. */
|
|
|
264 post_dec_flags (flag_dec);
|
|
|
265
|
|
111
|
266 /* Excess precision other than "fast" requires front-end
|
|
|
267 support. */
|
|
145
|
268 if (flag_excess_precision == EXCESS_PRECISION_STANDARD)
|
|
|
269 sorry ("%<-fexcess-precision=standard%> for Fortran");
|
|
|
270 flag_excess_precision = EXCESS_PRECISION_FAST;
|
|
111
|
271
|
|
|
272 /* Fortran allows associative math - but we cannot reassociate if
|
|
|
273 we want traps or signed zeros. Cf. also flag_protect_parens. */
|
|
|
274 if (flag_associative_math == -1)
|
|
|
275 flag_associative_math = (!flag_trapping_math && !flag_signed_zeros);
|
|
|
276
|
|
|
277 if (flag_protect_parens == -1)
|
|
|
278 flag_protect_parens = !optimize_fast;
|
|
|
279
|
|
|
280 /* -Ofast sets implies -fstack-arrays unless an explicit size is set for
|
|
|
281 stack arrays. */
|
|
|
282 if (flag_stack_arrays == -1 && flag_max_stack_var_size == -2)
|
|
|
283 flag_stack_arrays = optimize_fast;
|
|
|
284
|
|
|
285 /* By default, disable (re)allocation during assignment for -std=f95,
|
|
|
286 and enable it for F2003/F2008/GNU/Legacy. */
|
|
|
287 if (flag_realloc_lhs == -1)
|
|
|
288 {
|
|
|
289 if (gfc_option.allow_std & GFC_STD_F2003)
|
|
|
290 flag_realloc_lhs = 1;
|
|
|
291 else
|
|
|
292 flag_realloc_lhs = 0;
|
|
|
293 }
|
|
|
294
|
|
|
295 /* -fbounds-check is equivalent to -fcheck=bounds */
|
|
|
296 if (flag_bounds_check)
|
|
|
297 gfc_option.rtcheck |= GFC_RTCHECK_BOUNDS;
|
|
|
298
|
|
|
299 if (flag_compare_debug)
|
|
|
300 flag_dump_fortran_original = 0;
|
|
|
301
|
|
|
302 /* Make -fmax-errors visible to gfortran's diagnostic machinery. */
|
|
|
303 if (global_options_set.x_flag_max_errors)
|
|
|
304 gfc_option.max_errors = flag_max_errors;
|
|
|
305
|
|
|
306 /* Verify the input file name. */
|
|
|
307 if (!filename || strcmp (filename, "-") == 0)
|
|
|
308 {
|
|
|
309 filename = "";
|
|
|
310 }
|
|
|
311
|
|
|
312 if (gfc_option.flag_preprocessed)
|
|
|
313 {
|
|
|
314 /* For preprocessed files, if the first tokens are of the form # NUM.
|
|
|
315 handle the directives so we know the original file name. */
|
|
|
316 gfc_source_file = gfc_read_orig_filename (filename, &canon_source_file);
|
|
|
317 if (gfc_source_file == NULL)
|
|
|
318 gfc_source_file = filename;
|
|
|
319 else
|
|
|
320 *pfilename = gfc_source_file;
|
|
|
321 }
|
|
|
322 else
|
|
|
323 gfc_source_file = filename;
|
|
|
324
|
|
|
325 if (canon_source_file == NULL)
|
|
|
326 canon_source_file = gfc_source_file;
|
|
|
327
|
|
|
328 /* Adds the path where the source file is to the list of include files. */
|
|
|
329
|
|
|
330 i = strlen (canon_source_file);
|
|
|
331 while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i]))
|
|
|
332 i--;
|
|
|
333
|
|
|
334 if (i != 0)
|
|
|
335 {
|
|
|
336 source_path = (char *) alloca (i + 1);
|
|
|
337 memcpy (source_path, canon_source_file, i);
|
|
|
338 source_path[i] = 0;
|
|
|
339 gfc_add_include_path (source_path, true, true, true);
|
|
|
340 }
|
|
|
341 else
|
|
|
342 gfc_add_include_path (".", true, true, true);
|
|
|
343
|
|
|
344 if (canon_source_file != gfc_source_file)
|
|
|
345 free (CONST_CAST (char *, canon_source_file));
|
|
|
346
|
|
|
347 /* Decide which form the file will be read in as. */
|
|
|
348
|
|
|
349 if (gfc_option.source_form != FORM_UNKNOWN)
|
|
|
350 gfc_current_form = gfc_option.source_form;
|
|
|
351 else
|
|
|
352 {
|
|
|
353 gfc_current_form = form_from_filename (filename);
|
|
|
354
|
|
|
355 if (gfc_current_form == FORM_UNKNOWN)
|
|
|
356 {
|
|
|
357 gfc_current_form = FORM_FREE;
|
|
131
|
358 main_input_filename = filename;
|
|
111
|
359 gfc_warning_now (0, "Reading file %qs as free form",
|
|
|
360 (filename[0] == '\0') ? "<stdin>" : filename);
|
|
|
361 }
|
|
|
362 }
|
|
|
363
|
|
|
364 /* If the user specified -fd-lines-as-{code|comments} verify that we're
|
|
|
365 in fixed form. */
|
|
|
366 if (gfc_current_form == FORM_FREE)
|
|
|
367 {
|
|
|
368 if (gfc_option.flag_d_lines == 0)
|
|
|
369 gfc_warning_now (0, "%<-fd-lines-as-comments%> has no effect "
|
|
|
370 "in free form");
|
|
|
371 else if (gfc_option.flag_d_lines == 1)
|
|
|
372 gfc_warning_now (0, "%<-fd-lines-as-code%> has no effect in free form");
|
|
|
373
|
|
|
374 if (warn_line_truncation == -1)
|
|
|
375 warn_line_truncation = 1;
|
|
|
376
|
|
|
377 /* Enable -Werror=line-truncation when -Werror and -Wno-error have
|
|
|
378 not been set. */
|
|
|
379 if (warn_line_truncation && !global_options_set.x_warnings_are_errors
|
|
|
380 && (global_dc->classify_diagnostic[OPT_Wline_truncation] ==
|
|
|
381 DK_UNSPECIFIED))
|
|
|
382 diagnostic_classify_diagnostic (global_dc, OPT_Wline_truncation,
|
|
|
383 DK_ERROR, UNKNOWN_LOCATION);
|
|
|
384 }
|
|
|
385 else
|
|
|
386 {
|
|
|
387 /* With -fdec, set -fd-lines-as-comments by default in fixed form. */
|
|
|
388 if (flag_dec && gfc_option.flag_d_lines == -1)
|
|
|
389 gfc_option.flag_d_lines = 0;
|
|
|
390
|
|
|
391 if (warn_line_truncation == -1)
|
|
|
392 warn_line_truncation = 0;
|
|
|
393 }
|
|
|
394
|
|
|
395 /* If -pedantic, warn about the use of GNU extensions. */
|
|
|
396 if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
|
|
|
397 gfc_option.warn_std |= GFC_STD_GNU;
|
|
|
398 /* -std=legacy -pedantic is effectively -std=gnu. */
|
|
|
399 if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
|
|
|
400 gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY;
|
|
|
401
|
|
|
402 /* If the user didn't explicitly specify -f(no)-second-underscore we
|
|
|
403 use it if we're trying to be compatible with f2c, and not
|
|
|
404 otherwise. */
|
|
|
405 if (flag_second_underscore == -1)
|
|
|
406 flag_second_underscore = flag_f2c;
|
|
|
407
|
|
|
408 if (!flag_automatic && flag_max_stack_var_size != -2
|
|
|
409 && flag_max_stack_var_size != 0)
|
|
|
410 gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
|
|
|
411 flag_max_stack_var_size);
|
|
|
412 else if (!flag_automatic && flag_recursive)
|
|
145
|
413 gfc_warning_now (OPT_Woverwrite_recursive, "Flag %<-fno-automatic%> "
|
|
|
414 "overwrites %<-frecursive%>");
|
|
111
|
415 else if (!flag_automatic && flag_openmp)
|
|
|
416 gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> implied by "
|
|
|
417 "%<-fopenmp%>");
|
|
|
418 else if (flag_max_stack_var_size != -2 && flag_recursive)
|
|
|
419 gfc_warning_now (0, "Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>",
|
|
|
420 flag_max_stack_var_size);
|
|
|
421 else if (flag_max_stack_var_size != -2 && flag_openmp)
|
|
|
422 gfc_warning_now (0, "Flag %<-fmax-stack-var-size=%d%> overwrites %<-frecursive%> "
|
|
|
423 "implied by %<-fopenmp%>", flag_max_stack_var_size);
|
|
|
424
|
|
|
425 /* Implement -frecursive as -fmax-stack-var-size=-1. */
|
|
|
426 if (flag_recursive)
|
|
|
427 flag_max_stack_var_size = -1;
|
|
|
428
|
|
|
429 /* Implied -frecursive; implemented as -fmax-stack-var-size=-1. */
|
|
|
430 if (flag_max_stack_var_size == -2 && flag_openmp && flag_automatic)
|
|
|
431 {
|
|
|
432 flag_recursive = 1;
|
|
|
433 flag_max_stack_var_size = -1;
|
|
|
434 }
|
|
|
435
|
|
|
436 /* Set flag_stack_arrays correctly. */
|
|
|
437 if (flag_stack_arrays == -1)
|
|
|
438 flag_stack_arrays = 0;
|
|
|
439
|
|
|
440 /* Set default. */
|
|
|
441 if (flag_max_stack_var_size == -2)
|
|
145
|
442 flag_max_stack_var_size = 65536;
|
|
111
|
443
|
|
|
444 /* Implement -fno-automatic as -fmax-stack-var-size=0. */
|
|
|
445 if (!flag_automatic)
|
|
|
446 flag_max_stack_var_size = 0;
|
|
|
447
|
|
|
448 /* If the user did not specify an inline matmul limit, inline up to the BLAS
|
|
|
449 limit or up to 30 if no external BLAS is specified. */
|
|
|
450
|
|
|
451 if (flag_inline_matmul_limit < 0)
|
|
|
452 {
|
|
|
453 if (flag_external_blas)
|
|
|
454 flag_inline_matmul_limit = flag_blas_matmul_limit;
|
|
|
455 else
|
|
|
456 flag_inline_matmul_limit = 30;
|
|
|
457 }
|
|
|
458
|
|
|
459 /* Optimization implies front end optimization, unless the user
|
|
|
460 specified it directly. */
|
|
|
461
|
|
|
462 if (flag_frontend_optimize == -1)
|
|
131
|
463 flag_frontend_optimize = optimize && !optimize_debug;
|
|
|
464
|
|
|
465 /* Same for front end loop interchange. */
|
|
|
466
|
|
|
467 if (flag_frontend_loop_interchange == -1)
|
|
|
468 flag_frontend_loop_interchange = optimize;
|
|
111
|
469
|
|
145
|
470 /* Do inline packing by default if optimizing, but not if
|
|
|
471 optimizing for size. */
|
|
|
472 if (flag_inline_arg_packing == -1)
|
|
|
473 flag_inline_arg_packing = optimize && !optimize_size;
|
|
|
474
|
|
111
|
475 if (flag_max_array_constructor < 65535)
|
|
|
476 flag_max_array_constructor = 65535;
|
|
|
477
|
|
|
478 if (flag_fixed_line_length != 0 && flag_fixed_line_length < 7)
|
|
|
479 gfc_fatal_error ("Fixed line length must be at least seven");
|
|
|
480
|
|
|
481 if (flag_free_line_length != 0 && flag_free_line_length < 4)
|
|
|
482 gfc_fatal_error ("Free line length must be at least three");
|
|
|
483
|
|
|
484 if (flag_max_subrecord_length > MAX_SUBRECORD_LENGTH)
|
|
|
485 gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
|
|
|
486 MAX_SUBRECORD_LENGTH);
|
|
|
487
|
|
|
488 gfc_cpp_post_options ();
|
|
|
489
|
|
|
490 if (gfc_option.allow_std & GFC_STD_F2008)
|
|
|
491 lang_hooks.name = "GNU Fortran2008";
|
|
|
492 else if (gfc_option.allow_std & GFC_STD_F2003)
|
|
|
493 lang_hooks.name = "GNU Fortran2003";
|
|
|
494
|
|
|
495 return gfc_cpp_preprocess_only ();
|
|
|
496 }
|
|
|
497
|
|
|
498
|
|
|
499 static void
|
|
|
500 gfc_handle_module_path_options (const char *arg)
|
|
|
501 {
|
|
|
502
|
|
|
503 if (gfc_option.module_dir != NULL)
|
|
|
504 gfc_fatal_error ("gfortran: Only one %<-J%> option allowed");
|
|
|
505
|
|
|
506 gfc_option.module_dir = XCNEWVEC (char, strlen (arg) + 2);
|
|
|
507 strcpy (gfc_option.module_dir, arg);
|
|
|
508
|
|
|
509 gfc_add_include_path (gfc_option.module_dir, true, false, true);
|
|
|
510
|
|
|
511 strcat (gfc_option.module_dir, "/");
|
|
|
512 }
|
|
|
513
|
|
|
514
|
|
|
515 /* Handle options -ffpe-trap= and -ffpe-summary=. */
|
|
|
516
|
|
|
517 static void
|
|
|
518 gfc_handle_fpe_option (const char *arg, bool trap)
|
|
|
519 {
|
|
|
520 int result, pos = 0, n;
|
|
|
521 /* precision is a backwards compatibility alias for inexact. */
|
|
|
522 static const char * const exception[] = { "invalid", "denormal", "zero",
|
|
|
523 "overflow", "underflow",
|
|
|
524 "inexact", "precision", NULL };
|
|
|
525 static const int opt_exception[] = { GFC_FPE_INVALID, GFC_FPE_DENORMAL,
|
|
|
526 GFC_FPE_ZERO, GFC_FPE_OVERFLOW,
|
|
|
527 GFC_FPE_UNDERFLOW, GFC_FPE_INEXACT,
|
|
|
528 GFC_FPE_INEXACT,
|
|
|
529 0 };
|
|
|
530
|
|
|
531 /* As the default for -ffpe-summary= is nonzero, set it to 0. */
|
|
|
532 if (!trap)
|
|
|
533 gfc_option.fpe_summary = 0;
|
|
|
534
|
|
|
535 while (*arg)
|
|
|
536 {
|
|
|
537 while (*arg == ',')
|
|
|
538 arg++;
|
|
|
539
|
|
|
540 while (arg[pos] && arg[pos] != ',')
|
|
|
541 pos++;
|
|
|
542
|
|
|
543 result = 0;
|
|
|
544 if (!trap && strncmp ("none", arg, pos) == 0)
|
|
|
545 {
|
|
|
546 gfc_option.fpe_summary = 0;
|
|
|
547 arg += pos;
|
|
|
548 pos = 0;
|
|
|
549 continue;
|
|
|
550 }
|
|
|
551 else if (!trap && strncmp ("all", arg, pos) == 0)
|
|
|
552 {
|
|
|
553 gfc_option.fpe_summary = GFC_FPE_INVALID | GFC_FPE_DENORMAL
|
|
|
554 | GFC_FPE_ZERO | GFC_FPE_OVERFLOW
|
|
|
555 | GFC_FPE_UNDERFLOW | GFC_FPE_INEXACT;
|
|
|
556 arg += pos;
|
|
|
557 pos = 0;
|
|
|
558 continue;
|
|
|
559 }
|
|
|
560 else
|
|
|
561 for (n = 0; exception[n] != NULL; n++)
|
|
|
562 {
|
|
|
563 if (exception[n] && strncmp (exception[n], arg, pos) == 0)
|
|
|
564 {
|
|
|
565 if (trap)
|
|
|
566 gfc_option.fpe |= opt_exception[n];
|
|
|
567 else
|
|
|
568 gfc_option.fpe_summary |= opt_exception[n];
|
|
|
569 arg += pos;
|
|
|
570 pos = 0;
|
|
|
571 result = 1;
|
|
|
572 break;
|
|
|
573 }
|
|
|
574 }
|
|
|
575 if (!result && !trap)
|
|
|
576 gfc_fatal_error ("Argument to %<-ffpe-trap%> is not valid: %s", arg);
|
|
|
577 else if (!result)
|
|
|
578 gfc_fatal_error ("Argument to %<-ffpe-summary%> is not valid: %s", arg);
|
|
|
579
|
|
|
580 }
|
|
|
581 }
|
|
|
582
|
|
|
583
|
|
|
584 static void
|
|
|
585 gfc_handle_runtime_check_option (const char *arg)
|
|
|
586 {
|
|
|
587 int result, pos = 0, n;
|
|
|
588 static const char * const optname[] = { "all", "bounds", "array-temps",
|
|
|
589 "recursion", "do", "pointer",
|
|
145
|
590 "mem", "bits", NULL };
|
|
111
|
591 static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
|
|
|
592 GFC_RTCHECK_ARRAY_TEMPS,
|
|
|
593 GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO,
|
|
|
594 GFC_RTCHECK_POINTER, GFC_RTCHECK_MEM,
|
|
145
|
595 GFC_RTCHECK_BITS, 0 };
|
|
111
|
596
|
|
|
597 while (*arg)
|
|
|
598 {
|
|
|
599 while (*arg == ',')
|
|
|
600 arg++;
|
|
|
601
|
|
|
602 while (arg[pos] && arg[pos] != ',')
|
|
|
603 pos++;
|
|
|
604
|
|
|
605 result = 0;
|
|
|
606 for (n = 0; optname[n] != NULL; n++)
|
|
|
607 {
|
|
|
608 if (optname[n] && strncmp (optname[n], arg, pos) == 0)
|
|
|
609 {
|
|
|
610 gfc_option.rtcheck |= optmask[n];
|
|
|
611 arg += pos;
|
|
|
612 pos = 0;
|
|
|
613 result = 1;
|
|
|
614 break;
|
|
|
615 }
|
|
131
|
616 else if (optname[n] && pos > 3 && gfc_str_startswith (arg, "no-")
|
|
111
|
617 && strncmp (optname[n], arg+3, pos-3) == 0)
|
|
|
618 {
|
|
|
619 gfc_option.rtcheck &= ~optmask[n];
|
|
|
620 arg += pos;
|
|
|
621 pos = 0;
|
|
|
622 result = 1;
|
|
|
623 break;
|
|
|
624 }
|
|
|
625 }
|
|
|
626 if (!result)
|
|
|
627 gfc_fatal_error ("Argument to %<-fcheck%> is not valid: %s", arg);
|
|
|
628 }
|
|
|
629 }
|
|
|
630
|
|
|
631
|
|
|
632 /* Handle command-line options. Returns 0 if unrecognized, 1 if
|
|
|
633 recognized and handled. */
|
|
|
634
|
|
|
635 bool
|
|
131
|
636 gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value,
|
|
111
|
637 int kind ATTRIBUTE_UNUSED, location_t loc ATTRIBUTE_UNUSED,
|
|
|
638 const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
|
|
|
639 {
|
|
|
640 bool result = true;
|
|
|
641 enum opt_code code = (enum opt_code) scode;
|
|
|
642
|
|
|
643 if (gfc_cpp_handle_option (scode, arg, value) == 1)
|
|
|
644 return true;
|
|
|
645
|
|
|
646 switch (code)
|
|
|
647 {
|
|
|
648 default:
|
|
|
649 if (cl_options[code].flags & gfc_option_lang_mask ())
|
|
|
650 break;
|
|
|
651 result = false;
|
|
|
652 break;
|
|
|
653
|
|
|
654 case OPT_fcheck_array_temporaries:
|
|
145
|
655 SET_BITFLAG (gfc_option.rtcheck, value, GFC_RTCHECK_ARRAY_TEMPS);
|
|
111
|
656 break;
|
|
|
657
|
|
|
658 case OPT_fd_lines_as_code:
|
|
|
659 gfc_option.flag_d_lines = 1;
|
|
|
660 break;
|
|
|
661
|
|
|
662 case OPT_fd_lines_as_comments:
|
|
|
663 gfc_option.flag_d_lines = 0;
|
|
|
664 break;
|
|
|
665
|
|
|
666 case OPT_ffixed_form:
|
|
|
667 gfc_option.source_form = FORM_FIXED;
|
|
|
668 break;
|
|
|
669
|
|
|
670 case OPT_ffree_form:
|
|
|
671 gfc_option.source_form = FORM_FREE;
|
|
|
672 break;
|
|
|
673
|
|
|
674 case OPT_static_libgfortran:
|
|
|
675 #ifndef HAVE_LD_STATIC_DYNAMIC
|
|
|
676 gfc_fatal_error ("%<-static-libgfortran%> is not supported in this "
|
|
|
677 "configuration");
|
|
|
678 #endif
|
|
|
679 break;
|
|
|
680
|
|
|
681 case OPT_fintrinsic_modules_path:
|
|
|
682 case OPT_fintrinsic_modules_path_:
|
|
|
683
|
|
|
684 /* This is needed because omp_lib.h is in a directory together
|
|
|
685 with intrinsic modules. Do no warn because during testing
|
|
|
686 without an installed compiler, we would get lots of bogus
|
|
|
687 warnings for a missing include directory. */
|
|
|
688 gfc_add_include_path (arg, false, false, false);
|
|
|
689
|
|
|
690 gfc_add_intrinsic_modules_path (arg);
|
|
|
691 break;
|
|
|
692
|
|
|
693 case OPT_fpreprocessed:
|
|
|
694 gfc_option.flag_preprocessed = value;
|
|
|
695 break;
|
|
|
696
|
|
|
697 case OPT_fmax_identifier_length_:
|
|
|
698 if (value > GFC_MAX_SYMBOL_LEN)
|
|
|
699 gfc_fatal_error ("Maximum supported identifier length is %d",
|
|
|
700 GFC_MAX_SYMBOL_LEN);
|
|
|
701 gfc_option.max_identifier_length = value;
|
|
|
702 break;
|
|
|
703
|
|
|
704 case OPT_finit_local_zero:
|
|
145
|
705 set_init_local_zero (value);
|
|
111
|
706 break;
|
|
|
707
|
|
|
708 case OPT_finit_logical_:
|
|
|
709 if (!strcasecmp (arg, "false"))
|
|
|
710 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
|
|
|
711 else if (!strcasecmp (arg, "true"))
|
|
|
712 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
|
|
|
713 else
|
|
|
714 gfc_fatal_error ("Unrecognized option to %<-finit-logical%>: %s",
|
|
|
715 arg);
|
|
|
716 break;
|
|
|
717
|
|
|
718 case OPT_finit_integer_:
|
|
|
719 gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
|
|
145
|
720 gfc_option.flag_init_integer_value = strtol (arg, NULL, 10);
|
|
111
|
721 break;
|
|
|
722
|
|
|
723 case OPT_finit_character_:
|
|
|
724 if (value >= 0 && value <= 127)
|
|
|
725 {
|
|
|
726 gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
|
|
|
727 gfc_option.flag_init_character_value = (char)value;
|
|
|
728 }
|
|
|
729 else
|
|
|
730 gfc_fatal_error ("The value of n in %<-finit-character=n%> must be "
|
|
|
731 "between 0 and 127");
|
|
|
732 break;
|
|
|
733
|
|
|
734 case OPT_I:
|
|
|
735 gfc_add_include_path (arg, true, false, true);
|
|
|
736 break;
|
|
|
737
|
|
|
738 case OPT_J:
|
|
|
739 gfc_handle_module_path_options (arg);
|
|
|
740 break;
|
|
|
741
|
|
|
742 case OPT_ffpe_trap_:
|
|
|
743 gfc_handle_fpe_option (arg, true);
|
|
|
744 break;
|
|
|
745
|
|
|
746 case OPT_ffpe_summary_:
|
|
|
747 gfc_handle_fpe_option (arg, false);
|
|
|
748 break;
|
|
|
749
|
|
|
750 case OPT_std_f95:
|
|
131
|
751 gfc_option.allow_std = GFC_STD_OPT_F95;
|
|
111
|
752 gfc_option.warn_std = GFC_STD_F95_OBS;
|
|
|
753 gfc_option.max_continue_fixed = 19;
|
|
|
754 gfc_option.max_continue_free = 39;
|
|
|
755 gfc_option.max_identifier_length = 31;
|
|
|
756 warn_ampersand = 1;
|
|
|
757 warn_tabs = 1;
|
|
|
758 break;
|
|
|
759
|
|
|
760 case OPT_std_f2003:
|
|
131
|
761 gfc_option.allow_std = GFC_STD_OPT_F03;
|
|
111
|
762 gfc_option.warn_std = GFC_STD_F95_OBS;
|
|
|
763 gfc_option.max_identifier_length = 63;
|
|
|
764 warn_ampersand = 1;
|
|
|
765 warn_tabs = 1;
|
|
|
766 break;
|
|
|
767
|
|
|
768 case OPT_std_f2008:
|
|
131
|
769 gfc_option.allow_std = GFC_STD_OPT_F08;
|
|
111
|
770 gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
|
|
|
771 gfc_option.max_identifier_length = 63;
|
|
|
772 warn_ampersand = 1;
|
|
|
773 warn_tabs = 1;
|
|
|
774 break;
|
|
|
775
|
|
|
776 case OPT_std_f2008ts:
|
|
131
|
777 case OPT_std_f2018:
|
|
|
778 gfc_option.allow_std = GFC_STD_OPT_F18;
|
|
|
779 gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS
|
|
|
780 | GFC_STD_F2018_OBS;
|
|
111
|
781 gfc_option.max_identifier_length = 63;
|
|
|
782 warn_ampersand = 1;
|
|
|
783 warn_tabs = 1;
|
|
|
784 break;
|
|
|
785
|
|
|
786 case OPT_std_gnu:
|
|
|
787 set_default_std_flags ();
|
|
|
788 break;
|
|
|
789
|
|
|
790 case OPT_std_legacy:
|
|
|
791 set_default_std_flags ();
|
|
|
792 gfc_option.warn_std = 0;
|
|
|
793 break;
|
|
|
794
|
|
|
795 case OPT_fshort_enums:
|
|
|
796 /* Handled in language-independent code. */
|
|
|
797 break;
|
|
|
798
|
|
|
799 case OPT_fcheck_:
|
|
|
800 gfc_handle_runtime_check_option (arg);
|
|
|
801 break;
|
|
|
802
|
|
|
803 case OPT_fdec:
|
|
145
|
804 /* Set (or unset) the DEC extension flags. */
|
|
|
805 set_dec_flags (value);
|
|
111
|
806 break;
|
|
|
807 }
|
|
|
808
|
|
|
809 Fortran_handle_option_auto (&global_options, &global_options_set,
|
|
|
810 scode, arg, value,
|
|
|
811 gfc_option_lang_mask (), kind,
|
|
|
812 loc, handlers, global_dc);
|
|
|
813 return result;
|
|
|
814 }
|
|
|
815
|
|
|
816
|
|
|
817 /* Return a string with the options passed to the compiler; used for
|
|
|
818 Fortran's compiler_options() intrinsic. */
|
|
|
819
|
|
|
820 char *
|
|
|
821 gfc_get_option_string (void)
|
|
|
822 {
|
|
|
823 unsigned j;
|
|
|
824 size_t len, pos;
|
|
|
825 char *result;
|
|
|
826
|
|
|
827 /* Allocate and return a one-character string with '\0'. */
|
|
|
828 if (!save_decoded_options_count)
|
|
|
829 return XCNEWVEC (char, 1);
|
|
|
830
|
|
|
831 /* Determine required string length. */
|
|
|
832
|
|
|
833 len = 0;
|
|
|
834 for (j = 1; j < save_decoded_options_count; j++)
|
|
|
835 {
|
|
|
836 switch (save_decoded_options[j].opt_index)
|
|
|
837 {
|
|
|
838 case OPT_o:
|
|
|
839 case OPT_d:
|
|
|
840 case OPT_dumpbase:
|
|
|
841 case OPT_dumpdir:
|
|
|
842 case OPT_auxbase:
|
|
|
843 case OPT_quiet:
|
|
|
844 case OPT_version:
|
|
|
845 case OPT_fintrinsic_modules_path:
|
|
|
846 case OPT_fintrinsic_modules_path_:
|
|
|
847 /* Ignore these. */
|
|
|
848 break;
|
|
|
849 default:
|
|
|
850 /* Ignore file names. */
|
|
|
851 if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
|
|
|
852 len += 1
|
|
|
853 + strlen (save_decoded_options[j].orig_option_with_args_text);
|
|
|
854 }
|
|
|
855 }
|
|
|
856
|
|
|
857 result = XCNEWVEC (char, len);
|
|
|
858
|
|
|
859 pos = 0;
|
|
|
860 for (j = 1; j < save_decoded_options_count; j++)
|
|
|
861 {
|
|
|
862 switch (save_decoded_options[j].opt_index)
|
|
|
863 {
|
|
|
864 case OPT_o:
|
|
|
865 case OPT_d:
|
|
|
866 case OPT_dumpbase:
|
|
|
867 case OPT_dumpdir:
|
|
|
868 case OPT_auxbase:
|
|
|
869 case OPT_quiet:
|
|
|
870 case OPT_version:
|
|
|
871 case OPT_fintrinsic_modules_path:
|
|
|
872 case OPT_fintrinsic_modules_path_:
|
|
|
873 /* Ignore these. */
|
|
|
874 continue;
|
|
|
875
|
|
|
876 case OPT_cpp_:
|
|
|
877 /* Use "-cpp" rather than "-cpp=<temporary file>". */
|
|
|
878 len = 4;
|
|
|
879 break;
|
|
|
880
|
|
|
881 default:
|
|
|
882 /* Ignore file names. */
|
|
|
883 if (save_decoded_options[j].orig_option_with_args_text[0] != '-')
|
|
|
884 continue;
|
|
|
885
|
|
|
886 len = strlen (save_decoded_options[j].orig_option_with_args_text);
|
|
|
887 }
|
|
|
888
|
|
|
889 memcpy (&result[pos], save_decoded_options[j].orig_option_with_args_text, len);
|
|
|
890 pos += len;
|
|
|
891 result[pos++] = ' ';
|
|
|
892 }
|
|
|
893
|
|
|
894 result[--pos] = '\0';
|
|
|
895 return result;
|
|
|
896 }
|
|
145
|
897
|
|
|
898 #undef SET_BITFLAG
|
|
|
899 #undef SET_BITFLAG2
|
|
|
900 #undef SET_FLAG
|
