Mercurial > hg > CbC > CbC_gcc

comparison gcc/fortran/options.c @ 111:04ced10e8804

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