]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/fortran/options.cc
Update copyright years.
[thirdparty/gcc.git] / gcc / fortran / options.cc
CommitLineData
6de9cd9a 1/* Parse and display command line options.
83ffe9cd 2 Copyright (C) 2000-2023 Free Software Foundation, Inc.
6de9cd9a
DN
3 Contributed by Andy Vaught
4
9fc4d79b 5This file is part of GCC.
6de9cd9a 6
9fc4d79b
TS
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
d234d788 9Software Foundation; either version 3, or (at your option) any later
9fc4d79b 10version.
6de9cd9a 11
9fc4d79b
TS
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.
6de9cd9a
DN
16
17You should have received a copy of the GNU General Public License
d234d788
NC
18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
6de9cd9a 20
6de9cd9a
DN
21#include "config.h"
22#include "system.h"
23#include "coretypes.h"
2adfab87 24#include "target.h"
6de9cd9a 25#include "tree.h"
2adfab87
AM
26#include "gfortran.h"
27#include "diagnostic.h" /* For global_dc. */
6de9cd9a 28#include "opts.h"
41804a5b 29#include "toplev.h" /* For save_decoded_options. */
670637ee 30#include "cpp.h"
de3aebff 31#include "langhooks.h"
6de9cd9a
DN
32
33gfc_option_t gfc_option;
34
7ed760c7
FR
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
6de9cd9a 49
a47eec17 50/* Set flags that control warnings and errors for different
5fb41e29
TB
51 Fortran standards to their default values. Keep in sync with
52 libgfortran/runtime/compile_options.c (init_compile_options). */
a47eec17
JD
53
54static void
55set_default_std_flags (void)
56{
57 gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
f489fba1 58 | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
286f737c 59 | GFC_STD_F2008_OBS | GFC_STD_GNU | GFC_STD_LEGACY
8179b067 60 | GFC_STD_F2018 | GFC_STD_F2018_DEL | GFC_STD_F2018_OBS;
67e9518e 61 gfc_option.warn_std = GFC_STD_F2018_DEL | GFC_STD_F95_DEL | GFC_STD_LEGACY;
a47eec17
JD
62}
63
7ed760c7 64/* Set (or unset) the DEC extension flags. */
f6288c24
FR
65
66static void
67set_dec_flags (int value)
68{
7ed760c7
FR
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);
88a8126a 77 SET_BITFLAG (flag_dec_format_defaults, value, value);
17f62b7e 78 SET_BITFLAG (flag_dec_blank_format_item, value, value);
2afeb1ca 79 SET_BITFLAG (flag_dec_char_conversions, value, value);
7ed760c7
FR
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. */
7c23ac0d
FR
92 if (value)
93 {
7c23ac0d 94 gfc_option.allow_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL
7ed760c7 95 | GFC_STD_GNU | GFC_STD_LEGACY;
7c23ac0d
FR
96 gfc_option.warn_std &= ~(GFC_STD_LEGACY | GFC_STD_F95_DEL);
97 }
f6288c24
FR
98}
99
7ed760c7
FR
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}
f6288c24 116
7a9bf9a4
JM
117/* Return language mask for Fortran options. */
118
119unsigned int
120gfc_option_lang_mask (void)
121{
122 return CL_Fortran;
123}
124
a75bfaa6
JM
125/* Initialize options structure OPTS. */
126
127void
128gfc_init_options_struct (struct gcc_options *opts)
129{
130 opts->x_flag_errno_math = 0;
321bff11 131 opts->frontend_set_flag_errno_math = true;
a75bfaa6 132 opts->x_flag_associative_math = -1;
321bff11 133 opts->frontend_set_flag_associative_math = true;
a75bfaa6 134}
7a9bf9a4 135
5fb41e29 136/* Get ready for options handling. Keep in sync with
1cc0e193 137 libgfortran/runtime/compile_options.c (init_compile_options). */
6de9cd9a 138
7a9bf9a4
JM
139void
140gfc_init_options (unsigned int decoded_options_count,
141 struct cl_decoded_option *decoded_options)
6de9cd9a 142{
e0bcf78c 143 gfc_source_file = NULL;
6de9cd9a
DN
144 gfc_option.module_dir = NULL;
145 gfc_option.source_form = FORM_UNKNOWN;
dfbfb630
JD
146 gfc_option.max_continue_fixed = 255;
147 gfc_option.max_continue_free = 255;
6de9cd9a 148 gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN;
3f139fcf 149 gfc_option.max_errors = 25;
6de9cd9a 150
2d7c7df6 151 gfc_option.flag_preprocessed = 0;
e0bcf78c 152 gfc_option.flag_d_lines = -1;
c3e799e1 153 set_init_local_zero (0);
51b09ce3 154
944b8b35 155 gfc_option.fpe = 0;
fa86f4f9
TB
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;
d3d3011f 160 gfc_option.rtcheck = 0;
944b8b35 161
f6288c24 162 set_dec_flags (0);
a47eec17 163 set_default_std_flags ();
6de9cd9a 164
670637ee 165 /* Initialize cpp-related options. */
7a9bf9a4 166 gfc_cpp_init_options (decoded_options_count, decoded_options);
8e54f6d3 167 gfc_diagnostics_init ();
6de9cd9a
DN
168}
169
170
e0bcf78c
TS
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{
e0bcf78c
TS
177 static const struct
178 {
179 const char *extension;
180 gfc_source_form form;
181 }
182 exttype[] =
183 {
184 {
185 ".f90", FORM_FREE}
186 ,
187 {
188 ".f95", FORM_FREE}
189 ,
190 {
7befd5d2
TB
191 ".f03", FORM_FREE}
192 ,
193 {
f489fba1
FXC
194 ".f08", FORM_FREE}
195 ,
196 {
e0bcf78c
TS
197 ".f", FORM_FIXED}
198 ,
199 {
200 ".for", FORM_FIXED}
201 ,
202 {
1200489c
TB
203 ".ftn", FORM_FIXED}
204 ,
205 {
e0bcf78c
TS
206 "", 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 (fileext, 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
6de9cd9a
DN
247/* Finalize commandline options. */
248
249bool
250gfc_post_options (const char **pfilename)
251{
2d7c7df6 252 const char *filename = *pfilename, *canon_source_file = NULL;
b424a572 253 char *source_path;
83aac698 254 bool verbose_missing_dir_warn;
b424a572 255 int i;
6de9cd9a 256
417ea5c0
TB
257 /* This needs to be after the commandline has been processed.
258 In Fortran, the options is by default enabled, in C/C++
83aac698
TB
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
00f34291 263 = (OPTION_SET_P (cpp_warn_missing_include_dirs)
83aac698 264 && global_options.x_cpp_warn_missing_include_dirs);
417ea5c0
TB
265 SET_OPTION_IF_UNSET (&global_options, &global_options_set,
266 cpp_warn_missing_include_dirs, 1);
83aac698 267 gfc_check_include_dirs (verbose_missing_dir_warn);
417ea5c0 268
c3e799e1
FR
269 /* Finalize DEC flags. */
270 post_dec_flags (flag_dec);
271
8ce94e44
JM
272 /* Excess precision other than "fast" requires front-end
273 support. */
df375b03 274 if (flag_excess_precision == EXCESS_PRECISION_STANDARD)
a3f9f006 275 sorry ("%<-fexcess-precision=standard%> for Fortran");
f19a3270 276 else if (flag_excess_precision == EXCESS_PRECISION_FLOAT16)
277 sorry ("%<-fexcess-precision=16%> for Fortran");
278
df375b03 279 flag_excess_precision = EXCESS_PRECISION_FAST;
8ce94e44 280
feef2551
TB
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
203c7ebf
TB
286 if (flag_protect_parens == -1)
287 flag_protect_parens = !optimize_fast;
7a994646 288
950a884b
TK
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)
203c7ebf 292 flag_stack_arrays = optimize_fast;
2d8c9ad5 293
597553ab 294 /* By default, disable (re)allocation during assignment for -std=f95,
1cc0e193 295 and enable it for F2003/F2008/GNU/Legacy. */
203c7ebf 296 if (flag_realloc_lhs == -1)
597553ab
PT
297 {
298 if (gfc_option.allow_std & GFC_STD_F2003)
203c7ebf 299 flag_realloc_lhs = 1;
597553ab 300 else
203c7ebf 301 flag_realloc_lhs = 0;
597553ab
PT
302 }
303
d3d3011f
FXC
304 /* -fbounds-check is equivalent to -fcheck=bounds */
305 if (flag_bounds_check)
306 gfc_option.rtcheck |= GFC_RTCHECK_BOUNDS;
307
2153915d 308 if (flag_compare_debug)
c61819ff 309 flag_dump_fortran_original = 0;
2153915d 310
3a789837 311 /* Make -fmax-errors visible to gfortran's diagnostic machinery. */
00f34291 312 if (OPTION_SET_P (flag_max_errors))
3a789837
NF
313 gfc_option.max_errors = flag_max_errors;
314
6de9cd9a
DN
315 /* Verify the input file name. */
316 if (!filename || strcmp (filename, "-") == 0)
317 {
318 filename = "";
319 }
320
2d7c7df6
JJ
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;
e0bcf78c 336
b424a572
FXC
337 /* Adds the path where the source file is to the list of include files. */
338
2d7c7df6
JJ
339 i = strlen (canon_source_file);
340 while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i]))
b424a572 341 i--;
edf1eac2 342
b424a572
FXC
343 if (i != 0)
344 {
ece3f663 345 source_path = (char *) alloca (i + 1);
2d7c7df6 346 memcpy (source_path, canon_source_file, i);
b424a572 347 source_path[i] = 0;
83aac698
TB
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);
b424a572
FXC
352 }
353 else
83aac698 354 gfc_add_include_path (".", true, true, false, false);
b424a572 355
2d7c7df6 356 if (canon_source_file != gfc_source_file)
cede9502 357 free (CONST_CAST (char *, canon_source_file));
2d7c7df6 358
e0bcf78c
TS
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;
4c35d099 370 main_input_filename = filename;
db30e21c 371 gfc_warning_now (0, "Reading file %qs as free form",
4daa149b 372 (filename[0] == '\0') ? "<stdin>" : filename);
e0bcf78c
TS
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)
db30e21c 381 gfc_warning_now (0, "%<-fd-lines-as-comments%> has no effect "
a56abdcc 382 "in free form");
e0bcf78c 383 else if (gfc_option.flag_d_lines == 1)
db30e21c 384 gfc_warning_now (0, "%<-fd-lines-as-code%> has no effect in free form");
aecfd035
TB
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. */
00f34291 391 if (warn_line_truncation && !OPTION_SET_P (warnings_are_errors)
aecfd035
TB
392 && (global_dc->classify_diagnostic[OPT_Wline_truncation] ==
393 DK_UNSPECIFIED))
394 diagnostic_classify_diagnostic (global_dc, OPT_Wline_truncation,
395 DK_ERROR, UNKNOWN_LOCATION);
e0bcf78c 396 }
57e1270f
FR
397 else
398 {
399 /* With -fdec, set -fd-lines-as-comments by default in fixed form. */
400 if (flag_dec && gfc_option.flag_d_lines == -1)
401 gfc_option.flag_d_lines = 0;
402
403 if (warn_line_truncation == -1)
404 warn_line_truncation = 0;
405 }
6de9cd9a 406
fc2d8429
RS
407 /* If -pedantic, warn about the use of GNU extensions. */
408 if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
409 gfc_option.warn_std |= GFC_STD_GNU;
c0309c74
RS
410 /* -std=legacy -pedantic is effectively -std=gnu. */
411 if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
412 gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY;
fc2d8429 413
973ff4c0
TS
414 /* If the user didn't explicitly specify -f(no)-second-underscore we
415 use it if we're trying to be compatible with f2c, and not
416 otherwise. */
203c7ebf 417 if (flag_second_underscore == -1)
c61819ff 418 flag_second_underscore = flag_f2c;
973ff4c0 419
c61819ff 420 if (!flag_automatic && flag_max_stack_var_size != -2
203c7ebf 421 && flag_max_stack_var_size != 0)
db30e21c 422 gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
203c7ebf 423 flag_max_stack_var_size);
c61819ff 424 else if (!flag_automatic && flag_recursive)
91c4891a
ME
425 gfc_warning_now (OPT_Woverwrite_recursive, "Flag %<-fno-automatic%> "
426 "overwrites %<-frecursive%>");
f4e7ea81
TB
427 else if (!flag_automatic && (flag_openmp || flag_openacc))
428 gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> "
429 "implied by %qs", flag_openmp ? "-fopenmp" : "-fopenacc");
c61819ff 430 else if (flag_max_stack_var_size != -2 && flag_recursive)
db30e21c 431 gfc_warning_now (0, "Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>",
203c7ebf 432 flag_max_stack_var_size);
f4e7ea81
TB
433 else if (flag_max_stack_var_size != -2 && (flag_openmp || flag_openacc))
434 gfc_warning_now (0, "Flag %<-fmax-stack-var-size=%d%> overwrites "
435 "%<-frecursive%> implied by %qs", flag_max_stack_var_size,
436 flag_openmp ? "-fopenmp" : "-fopenacc");
1e7de83b 437
653f6dc5 438 /* Implement -frecursive as -fmax-stack-var-size=-1. */
c61819ff 439 if (flag_recursive)
203c7ebf 440 flag_max_stack_var_size = -1;
1e7de83b 441
653f6dc5 442 /* Implied -frecursive; implemented as -fmax-stack-var-size=-1. */
f4e7ea81
TB
443 if (flag_max_stack_var_size == -2 && flag_automatic
444 && (flag_openmp || flag_openacc))
653f6dc5 445 {
c61819ff 446 flag_recursive = 1;
203c7ebf 447 flag_max_stack_var_size = -1;
653f6dc5
TB
448 }
449
950a884b
TK
450 /* Set flag_stack_arrays correctly. */
451 if (flag_stack_arrays == -1)
452 flag_stack_arrays = 0;
453
1e7de83b 454 /* Set default. */
203c7ebf 455 if (flag_max_stack_var_size == -2)
54320207 456 flag_max_stack_var_size = 65536;
1e7de83b 457
d05d9ac7 458 /* Implement -fno-automatic as -fmax-stack-var-size=0. */
c61819ff 459 if (!flag_automatic)
203c7ebf 460 flag_max_stack_var_size = 0;
3fbab549 461
c7b608a9
TK
462 /* If the user did not specify an inline matmul limit, inline up to the BLAS
463 limit or up to 30 if no external BLAS is specified. */
f1abbf69 464
c7b608a9
TK
465 if (flag_inline_matmul_limit < 0)
466 {
467 if (flag_external_blas)
468 flag_inline_matmul_limit = flag_blas_matmul_limit;
469 else
470 flag_inline_matmul_limit = 30;
471 }
f1abbf69 472
51a30b32
TK
473 /* Optimization implies front end optimization, unless the user
474 specified it directly. */
475
203c7ebf 476 if (flag_frontend_optimize == -1)
bf9197df 477 flag_frontend_optimize = optimize && !optimize_debug;
203c7ebf 478
d88412fc
TK
479 /* Same for front end loop interchange. */
480
481 if (flag_frontend_loop_interchange == -1)
482 flag_frontend_loop_interchange = optimize;
483
95d27703
TK
484 /* Do inline packing by default if optimizing, but not if
485 optimizing for size. */
486 if (flag_inline_arg_packing == -1)
487 flag_inline_arg_packing = optimize && !optimize_size;
488
c61819ff
TB
489 if (flag_max_array_constructor < 65535)
490 flag_max_array_constructor = 65535;
491
203c7ebf
TB
492 if (flag_fixed_line_length != 0 && flag_fixed_line_length < 7)
493 gfc_fatal_error ("Fixed line length must be at least seven");
494
495 if (flag_free_line_length != 0 && flag_free_line_length < 4)
496 gfc_fatal_error ("Free line length must be at least three");
497
498 if (flag_max_subrecord_length > MAX_SUBRECORD_LENGTH)
499 gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
500 MAX_SUBRECORD_LENGTH);
51a30b32 501
83aac698 502 gfc_cpp_post_options (verbose_missing_dir_warn);
670637ee 503
de3aebff
JJ
504 if (gfc_option.allow_std & GFC_STD_F2008)
505 lang_hooks.name = "GNU Fortran2008";
506 else if (gfc_option.allow_std & GFC_STD_F2003)
507 lang_hooks.name = "GNU Fortran2003";
508
566916e6 509 return gfc_cpp_preprocess_only ();
6de9cd9a
DN
510}
511
512
6de9cd9a
DN
513static void
514gfc_handle_module_path_options (const char *arg)
515{
516
517 if (gfc_option.module_dir != NULL)
ddc05d11 518 gfc_fatal_error ("gfortran: Only one %<-J%> option allowed");
6de9cd9a 519
93acb62c 520 gfc_option.module_dir = XCNEWVEC (char, strlen (arg) + 2);
6de9cd9a 521 strcpy (gfc_option.module_dir, arg);
7376d710 522
417ea5c0 523 gfc_add_include_path (gfc_option.module_dir, true, false, true, true);
22b00a9f
TB
524
525 strcat (gfc_option.module_dir, "/");
6de9cd9a
DN
526}
527
edf1eac2 528
fa86f4f9
TB
529/* Handle options -ffpe-trap= and -ffpe-summary=. */
530
944b8b35 531static void
fa86f4f9 532gfc_handle_fpe_option (const char *arg, bool trap)
944b8b35
FXC
533{
534 int result, pos = 0, n;
57b4d355 535 /* precision is a backwards compatibility alias for inexact. */
944b8b35 536 static const char * const exception[] = { "invalid", "denormal", "zero",
edf1eac2 537 "overflow", "underflow",
57b4d355 538 "inexact", "precision", NULL };
944b8b35
FXC
539 static const int opt_exception[] = { GFC_FPE_INVALID, GFC_FPE_DENORMAL,
540 GFC_FPE_ZERO, GFC_FPE_OVERFLOW,
57b4d355
JB
541 GFC_FPE_UNDERFLOW, GFC_FPE_INEXACT,
542 GFC_FPE_INEXACT,
944b8b35 543 0 };
fa86f4f9 544
1cc0e193 545 /* As the default for -ffpe-summary= is nonzero, set it to 0. */
fa86f4f9
TB
546 if (!trap)
547 gfc_option.fpe_summary = 0;
548
944b8b35
FXC
549 while (*arg)
550 {
551 while (*arg == ',')
552 arg++;
edf1eac2 553
944b8b35
FXC
554 while (arg[pos] && arg[pos] != ',')
555 pos++;
edf1eac2 556
944b8b35 557 result = 0;
fa86f4f9 558 if (!trap && strncmp ("none", arg, pos) == 0)
944b8b35 559 {
fa86f4f9
TB
560 gfc_option.fpe_summary = 0;
561 arg += pos;
562 pos = 0;
563 continue;
564 }
565 else if (!trap && strncmp ("all", arg, pos) == 0)
566 {
567 gfc_option.fpe_summary = GFC_FPE_INVALID | GFC_FPE_DENORMAL
568 | GFC_FPE_ZERO | GFC_FPE_OVERFLOW
569 | GFC_FPE_UNDERFLOW | GFC_FPE_INEXACT;
570 arg += pos;
571 pos = 0;
572 continue;
573 }
574 else
575 for (n = 0; exception[n] != NULL; n++)
576 {
944b8b35
FXC
577 if (exception[n] && strncmp (exception[n], arg, pos) == 0)
578 {
fa86f4f9
TB
579 if (trap)
580 gfc_option.fpe |= opt_exception[n];
581 else
582 gfc_option.fpe_summary |= opt_exception[n];
944b8b35
FXC
583 arg += pos;
584 pos = 0;
585 result = 1;
586 break;
587 }
fa86f4f9
TB
588 }
589 if (!result && !trap)
ddc05d11 590 gfc_fatal_error ("Argument to %<-ffpe-trap%> is not valid: %s", arg);
fa86f4f9 591 else if (!result)
ddc05d11 592 gfc_fatal_error ("Argument to %<-ffpe-summary%> is not valid: %s", arg);
fa86f4f9 593
944b8b35
FXC
594 }
595}
596
edf1eac2 597
d3d3011f
FXC
598static void
599gfc_handle_runtime_check_option (const char *arg)
600{
601 int result, pos = 0, n;
602 static const char * const optname[] = { "all", "bounds", "array-temps",
22bdbb0f 603 "recursion", "do", "pointer",
df1afcca 604 "mem", "bits", NULL };
d3d3011f
FXC
605 static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
606 GFC_RTCHECK_ARRAY_TEMPS,
33abc845 607 GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO,
22bdbb0f 608 GFC_RTCHECK_POINTER, GFC_RTCHECK_MEM,
df1afcca 609 GFC_RTCHECK_BITS, 0 };
d3d3011f
FXC
610
611 while (*arg)
612 {
613 while (*arg == ',')
614 arg++;
615
616 while (arg[pos] && arg[pos] != ',')
617 pos++;
618
619 result = 0;
620 for (n = 0; optname[n] != NULL; n++)
621 {
622 if (optname[n] && strncmp (optname[n], arg, pos) == 0)
623 {
624 gfc_option.rtcheck |= optmask[n];
625 arg += pos;
626 pos = 0;
627 result = 1;
628 break;
629 }
6ba3079d 630 else if (optname[n] && pos > 3 && startswith (arg, "no-")
a4c54bf2
JD
631 && strncmp (optname[n], arg+3, pos-3) == 0)
632 {
633 gfc_option.rtcheck &= ~optmask[n];
634 arg += pos;
635 pos = 0;
636 result = 1;
637 break;
638 }
d3d3011f
FXC
639 }
640 if (!result)
ddc05d11 641 gfc_fatal_error ("Argument to %<-fcheck%> is not valid: %s", arg);
d3d3011f
FXC
642 }
643}
644
645
6de9cd9a
DN
646/* Handle command-line options. Returns 0 if unrecognized, 1 if
647 recognized and handled. */
edf1eac2 648
5f20c657 649bool
00abf86c 650gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value,
a4d8c676 651 int kind ATTRIBUTE_UNUSED, location_t loc ATTRIBUTE_UNUSED,
5f20c657 652 const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
6de9cd9a 653{
5f20c657 654 bool result = true;
6de9cd9a
DN
655 enum opt_code code = (enum opt_code) scode;
656
670637ee 657 if (gfc_cpp_handle_option (scode, arg, value) == 1)
5f20c657 658 return true;
670637ee 659
6de9cd9a
DN
660 switch (code)
661 {
662 default:
7c02f68b
MLI
663 if (cl_options[code].flags & gfc_option_lang_mask ())
664 break;
5f20c657 665 result = false;
6de9cd9a
DN
666 break;
667
0d52899f 668 case OPT_fcheck_array_temporaries:
c3e799e1 669 SET_BITFLAG (gfc_option.rtcheck, value, GFC_RTCHECK_ARRAY_TEMPS);
0d52899f
TB
670 break;
671
e0bcf78c
TS
672 case OPT_fd_lines_as_code:
673 gfc_option.flag_d_lines = 1;
674 break;
675
676 case OPT_fd_lines_as_comments:
677 gfc_option.flag_d_lines = 0;
678 break;
679
6de9cd9a
DN
680 case OPT_ffixed_form:
681 gfc_option.source_form = FORM_FIXED;
682 break;
683
684 case OPT_ffree_form:
685 gfc_option.source_form = FORM_FREE;
686 break;
687
31198773 688 case OPT_fintrinsic_modules_path:
f34dea03 689 case OPT_fintrinsic_modules_path_:
308f961b
TK
690
691 /* This is needed because omp_lib.h is in a directory together
692 with intrinsic modules. Do no warn because during testing
693 without an installed compiler, we would get lots of bogus
694 warnings for a missing include directory. */
417ea5c0 695 gfc_add_include_path (arg, false, false, false, true);
308f961b 696
31198773
FXC
697 gfc_add_intrinsic_modules_path (arg);
698 break;
699
2d7c7df6
JJ
700 case OPT_fpreprocessed:
701 gfc_option.flag_preprocessed = value;
702 break;
703
6de9cd9a
DN
704 case OPT_fmax_identifier_length_:
705 if (value > GFC_MAX_SYMBOL_LEN)
eb6d74fa 706 gfc_fatal_error ("Maximum supported identifier length is %d",
6de9cd9a
DN
707 GFC_MAX_SYMBOL_LEN);
708 gfc_option.max_identifier_length = value;
709 break;
710
51b09ce3 711 case OPT_finit_local_zero:
c3e799e1 712 set_init_local_zero (value);
51b09ce3
AL
713 break;
714
715 case OPT_finit_logical_:
716 if (!strcasecmp (arg, "false"))
717 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
718 else if (!strcasecmp (arg, "true"))
719 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
720 else
ddc05d11 721 gfc_fatal_error ("Unrecognized option to %<-finit-logical%>: %s",
51b09ce3
AL
722 arg);
723 break;
724
51b09ce3
AL
725 case OPT_finit_integer_:
726 gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
66086032 727 gfc_option.flag_init_integer_value = strtol (arg, NULL, 10);
51b09ce3
AL
728 break;
729
730 case OPT_finit_character_:
731 if (value >= 0 && value <= 127)
732 {
733 gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
734 gfc_option.flag_init_character_value = (char)value;
735 }
736 else
ddc05d11 737 gfc_fatal_error ("The value of n in %<-finit-character=n%> must be "
51b09ce3
AL
738 "between 0 and 127");
739 break;
740
6de9cd9a 741 case OPT_I:
417ea5c0 742 gfc_add_include_path (arg, true, false, true, true);
6de9cd9a
DN
743 break;
744
745 case OPT_J:
6de9cd9a 746 gfc_handle_module_path_options (arg);
2d0b4bcd 747 break;
ccc2ed87 748
944b8b35 749 case OPT_ffpe_trap_:
fa86f4f9
TB
750 gfc_handle_fpe_option (arg, true);
751 break;
752
753 case OPT_ffpe_summary_:
754 gfc_handle_fpe_option (arg, false);
944b8b35
FXC
755 break;
756
6de9cd9a 757 case OPT_std_f95:
67e9518e 758 gfc_option.allow_std = GFC_STD_OPT_F95;
6de9cd9a 759 gfc_option.warn_std = GFC_STD_F95_OBS;
dfbfb630
JD
760 gfc_option.max_continue_fixed = 19;
761 gfc_option.max_continue_free = 39;
6de9cd9a 762 gfc_option.max_identifier_length = 31;
73e42eef 763 warn_ampersand = 1;
16db2a6a 764 warn_tabs = 1;
6de9cd9a
DN
765 break;
766
767 case OPT_std_f2003:
67e9518e 768 gfc_option.allow_std = GFC_STD_OPT_F03;
b7892582 769 gfc_option.warn_std = GFC_STD_F95_OBS;
6de9cd9a 770 gfc_option.max_identifier_length = 63;
73e42eef 771 warn_ampersand = 1;
16db2a6a 772 warn_tabs = 1;
6de9cd9a
DN
773 break;
774
f489fba1 775 case OPT_std_f2008:
67e9518e 776 gfc_option.allow_std = GFC_STD_OPT_F08;
58fc89f6 777 gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
f489fba1 778 gfc_option.max_identifier_length = 63;
73e42eef 779 warn_ampersand = 1;
16db2a6a 780 warn_tabs = 1;
f489fba1
FXC
781 break;
782
4650947d 783 case OPT_std_f2008ts:
8179b067 784 case OPT_std_f2018:
67e9518e 785 gfc_option.allow_std = GFC_STD_OPT_F18;
8179b067
JB
786 gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS
787 | GFC_STD_F2018_OBS;
788 gfc_option.max_identifier_length = 63;
789 warn_ampersand = 1;
790 warn_tabs = 1;
791 break;
792
6de9cd9a 793 case OPT_std_gnu:
a47eec17 794 set_default_std_flags ();
c0309c74
RS
795 break;
796
797 case OPT_std_legacy:
a47eec17 798 set_default_std_flags ();
c0309c74 799 gfc_option.warn_std = 0;
b7892582
JB
800 break;
801
25d8f0a2 802 case OPT_fshort_enums:
5498f011 803 /* Handled in language-independent code. */
25d8f0a2 804 break;
eaa90d25 805
d3d3011f
FXC
806 case OPT_fcheck_:
807 gfc_handle_runtime_check_option (arg);
808 break;
f6288c24
FR
809
810 case OPT_fdec:
c3e799e1
FR
811 /* Set (or unset) the DEC extension flags. */
812 set_dec_flags (value);
f6288c24 813 break;
6de9cd9a
DN
814 }
815
f2bc201f
MLI
816 Fortran_handle_option_auto (&global_options, &global_options_set,
817 scode, arg, value,
818 gfc_option_lang_mask (), kind,
819 loc, handlers, global_dc);
6de9cd9a
DN
820 return result;
821}
41804a5b
TB
822
823
824/* Return a string with the options passed to the compiler; used for
825 Fortran's compiler_options() intrinsic. */
826
827char *
828gfc_get_option_string (void)
829{
830 unsigned j;
831 size_t len, pos;
832 char *result;
833
58b2a358
TB
834 /* Allocate and return a one-character string with '\0'. */
835 if (!save_decoded_options_count)
836 return XCNEWVEC (char, 1);
837
41804a5b
TB
838 /* Determine required string length. */
839
840 len = 0;
841 for (j = 1; j < save_decoded_options_count; j++)
842 {
843 switch (save_decoded_options[j].opt_index)
844 {
845 case OPT_o:
846 case OPT_d:
847 case OPT_dumpbase:
1dedc12d 848 case OPT_dumpbase_ext:
41804a5b 849 case OPT_dumpdir:
41804a5b
TB
850 case OPT_quiet:
851 case OPT_version:
852 case OPT_fintrinsic_modules_path:
f34dea03 853 case OPT_fintrinsic_modules_path_:
41804a5b
TB
854 /* Ignore these. */
855 break;
856 default:
1cc0e193 857 /* Ignore file names. */
41804a5b
TB
858 if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
859 len += 1
860 + strlen (save_decoded_options[j].orig_option_with_args_text);
861 }
862 }
863
93acb62c 864 result = XCNEWVEC (char, len);
41804a5b
TB
865
866 pos = 0;
867 for (j = 1; j < save_decoded_options_count; j++)
868 {
869 switch (save_decoded_options[j].opt_index)
870 {
871 case OPT_o:
872 case OPT_d:
873 case OPT_dumpbase:
1dedc12d 874 case OPT_dumpbase_ext:
41804a5b 875 case OPT_dumpdir:
41804a5b
TB
876 case OPT_quiet:
877 case OPT_version:
878 case OPT_fintrinsic_modules_path:
f34dea03 879 case OPT_fintrinsic_modules_path_:
41804a5b
TB
880 /* Ignore these. */
881 continue;
882
883 case OPT_cpp_:
884 /* Use "-cpp" rather than "-cpp=<temporary file>". */
885 len = 4;
886 break;
887
888 default:
1cc0e193 889 /* Ignore file names. */
41804a5b
TB
890 if (save_decoded_options[j].orig_option_with_args_text[0] != '-')
891 continue;
892
893 len = strlen (save_decoded_options[j].orig_option_with_args_text);
894 }
895
896 memcpy (&result[pos], save_decoded_options[j].orig_option_with_args_text, len);
897 pos += len;
898 result[pos++] = ' ';
899 }
900
901 result[--pos] = '\0';
902 return result;
903}
c3e799e1
FR
904
905#undef SET_BITFLAG
906#undef SET_BITFLAG2
907#undef SET_FLAG