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