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