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