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