1/* Parse and display command line options.
2 Copyright (C) 2000-2023 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along 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
33gfc_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
54static void
55set_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
66static void
67set_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
84static void
85post_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
102static void
103set_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
119unsigned int
120gfc_option_lang_mask (void)
121{
122 return CL_Fortran;
123}
124
125/* Initialize options structure OPTS. */
126
127void
128gfc_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
139void
140gfc_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
174static gfc_source_form
175form_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
249bool
250gfc_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
512static void
513gfc_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
530static void
531gfc_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
600static void
601gfc_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
651bool
652gfc_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
829char *
830gfc_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

source code of gcc/fortran/options.cc