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