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