]> git.ipfire.org Git - thirdparty/gcc.git/blob - gcc/fortran/options.c
Replace gfc_getmem with XCNEW, XCNEWVEC or xcalloc
[thirdparty/gcc.git] / gcc / fortran / options.c
1 /* Parse and display command line options.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
3 2009, 2010, 2011
4 Free Software Foundation, Inc.
5 Contributed by Andy Vaught
6
7 This file is part of GCC.
8
9 GCC is free software; you can redistribute it and/or modify it under
10 the terms of the GNU General Public License as published by the Free
11 Software Foundation; either version 3, or (at your option) any later
12 version.
13
14 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
15 WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with GCC; see the file COPYING3. If not see
21 <http://www.gnu.org/licenses/>. */
22
23 #include "config.h"
24 #include "system.h"
25 #include "coretypes.h"
26 #include "tree.h"
27 #include "flags.h"
28 #include "intl.h"
29 #include "opts.h"
30 #include "toplev.h" /* For save_decoded_options. */
31 #include "options.h"
32 #include "params.h"
33 #include "tree-inline.h"
34 #include "gfortran.h"
35 #include "target.h"
36 #include "cpp.h"
37 #include "diagnostic-core.h" /* For sorry. */
38 #include "tm.h"
39
40 gfc_option_t gfc_option;
41
42
43 /* Set flags that control warnings and errors for different
44 Fortran standards to their default values. Keep in sync with
45 libgfortran/runtime/compile_options.c (init_compile_options). */
46
47 static void
48 set_default_std_flags (void)
49 {
50 gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
51 | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
52 | GFC_STD_F2008_OBS | GFC_STD_GNU | GFC_STD_LEGACY;
53 gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY;
54 }
55
56
57 /* Return language mask for Fortran options. */
58
59 unsigned int
60 gfc_option_lang_mask (void)
61 {
62 return CL_Fortran;
63 }
64
65 /* Initialize options structure OPTS. */
66
67 void
68 gfc_init_options_struct (struct gcc_options *opts)
69 {
70 opts->x_flag_errno_math = 0;
71 opts->x_flag_associative_math = -1;
72 }
73
74 /* Get ready for options handling. Keep in sync with
75 libgfortran/runtime/compile_options.c (init_compile_options). */
76
77 void
78 gfc_init_options (unsigned int decoded_options_count,
79 struct cl_decoded_option *decoded_options)
80 {
81 gfc_source_file = NULL;
82 gfc_option.module_dir = NULL;
83 gfc_option.source_form = FORM_UNKNOWN;
84 gfc_option.fixed_line_length = 72;
85 gfc_option.free_line_length = 132;
86 gfc_option.max_continue_fixed = 255;
87 gfc_option.max_continue_free = 255;
88 gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN;
89 gfc_option.max_subrecord_length = 0;
90 gfc_option.flag_max_array_constructor = 65535;
91 gfc_option.convert = GFC_CONVERT_NATIVE;
92 gfc_option.record_marker = 0;
93 gfc_option.dump_fortran_original = 0;
94 gfc_option.dump_fortran_optimized = 0;
95
96 gfc_option.warn_aliasing = 0;
97 gfc_option.warn_ampersand = 0;
98 gfc_option.warn_character_truncation = 0;
99 gfc_option.warn_array_temp = 0;
100 gfc_option.gfc_warn_conversion = 0;
101 gfc_option.warn_conversion_extra = 0;
102 gfc_option.warn_function_elimination = 0;
103 gfc_option.warn_implicit_interface = 0;
104 gfc_option.warn_line_truncation = 0;
105 gfc_option.warn_surprising = 0;
106 gfc_option.warn_tabs = 1;
107 gfc_option.warn_underflow = 1;
108 gfc_option.warn_intrinsic_shadow = 0;
109 gfc_option.warn_intrinsics_std = 0;
110 gfc_option.warn_align_commons = 1;
111 gfc_option.warn_unused_dummy_argument = 0;
112 gfc_option.max_errors = 25;
113
114 gfc_option.flag_all_intrinsics = 0;
115 gfc_option.flag_default_double = 0;
116 gfc_option.flag_default_integer = 0;
117 gfc_option.flag_default_real = 0;
118 gfc_option.flag_dollar_ok = 0;
119 gfc_option.flag_underscoring = 1;
120 gfc_option.flag_whole_file = 1;
121 gfc_option.flag_f2c = 0;
122 gfc_option.flag_second_underscore = -1;
123 gfc_option.flag_implicit_none = 0;
124
125 /* Default value of flag_max_stack_var_size is set in gfc_post_options. */
126 gfc_option.flag_max_stack_var_size = -2;
127 gfc_option.flag_stack_arrays = 0;
128
129 gfc_option.flag_range_check = 1;
130 gfc_option.flag_pack_derived = 0;
131 gfc_option.flag_repack_arrays = 0;
132 gfc_option.flag_preprocessed = 0;
133 gfc_option.flag_automatic = 1;
134 gfc_option.flag_backslash = 0;
135 gfc_option.flag_module_private = 0;
136 gfc_option.flag_backtrace = 0;
137 gfc_option.flag_allow_leading_underscore = 0;
138 gfc_option.flag_dump_core = 0;
139 gfc_option.flag_external_blas = 0;
140 gfc_option.blas_matmul_limit = 30;
141 gfc_option.flag_cray_pointer = 0;
142 gfc_option.flag_d_lines = -1;
143 gfc_option.gfc_flag_openmp = 0;
144 gfc_option.flag_sign_zero = 1;
145 gfc_option.flag_recursive = 0;
146 gfc_option.flag_init_integer = GFC_INIT_INTEGER_OFF;
147 gfc_option.flag_init_integer_value = 0;
148 gfc_option.flag_init_real = GFC_INIT_REAL_OFF;
149 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_OFF;
150 gfc_option.flag_init_character = GFC_INIT_CHARACTER_OFF;
151 gfc_option.flag_init_character_value = (char)0;
152 gfc_option.flag_align_commons = 1;
153 gfc_option.flag_protect_parens = 1;
154 gfc_option.flag_realloc_lhs = -1;
155 gfc_option.flag_aggressive_function_elimination = 0;
156 gfc_option.flag_frontend_optimize = -1;
157
158 gfc_option.fpe = 0;
159 gfc_option.rtcheck = 0;
160 gfc_option.coarray = GFC_FCOARRAY_NONE;
161
162 set_default_std_flags ();
163
164 /* Initialize cpp-related options. */
165 gfc_cpp_init_options (decoded_options_count, decoded_options);
166 }
167
168
169 /* Determine the source form from the filename extension. We assume
170 case insensitivity. */
171
172 static gfc_source_form
173 form_from_filename (const char *filename)
174 {
175 static const struct
176 {
177 const char *extension;
178 gfc_source_form form;
179 }
180 exttype[] =
181 {
182 {
183 ".f90", FORM_FREE}
184 ,
185 {
186 ".f95", FORM_FREE}
187 ,
188 {
189 ".f03", FORM_FREE}
190 ,
191 {
192 ".f08", FORM_FREE}
193 ,
194 {
195 ".f", FORM_FIXED}
196 ,
197 {
198 ".for", FORM_FIXED}
199 ,
200 {
201 ".ftn", FORM_FIXED}
202 ,
203 {
204 "", FORM_UNKNOWN}
205 }; /* sentinel value */
206
207 gfc_source_form f_form;
208 const char *fileext;
209 int i;
210
211 /* Find end of file name. Note, filename is either a NULL pointer or
212 a NUL terminated string. */
213 i = 0;
214 while (filename[i] != '\0')
215 i++;
216
217 /* Find last period. */
218 while (i >= 0 && (filename[i] != '.'))
219 i--;
220
221 /* Did we see a file extension? */
222 if (i < 0)
223 return FORM_UNKNOWN; /* Nope */
224
225 /* Get file extension and compare it to others. */
226 fileext = &(filename[i]);
227
228 i = -1;
229 f_form = FORM_UNKNOWN;
230 do
231 {
232 i++;
233 if (strcasecmp (fileext, exttype[i].extension) == 0)
234 {
235 f_form = exttype[i].form;
236 break;
237 }
238 }
239 while (exttype[i].form != FORM_UNKNOWN);
240
241 return f_form;
242 }
243
244
245 /* Finalize commandline options. */
246
247 bool
248 gfc_post_options (const char **pfilename)
249 {
250 const char *filename = *pfilename, *canon_source_file = NULL;
251 char *source_path;
252 int i;
253
254 /* Excess precision other than "fast" requires front-end
255 support. */
256 if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD
257 && TARGET_FLT_EVAL_METHOD_NON_DEFAULT)
258 sorry ("-fexcess-precision=standard for Fortran");
259 flag_excess_precision_cmdline = EXCESS_PRECISION_FAST;
260
261 /* Whole program needs whole file mode. */
262 if (flag_whole_program)
263 gfc_option.flag_whole_file = 1;
264
265 /* Enable whole-file mode if LTO is in effect. */
266 if (flag_lto)
267 gfc_option.flag_whole_file = 1;
268
269 /* Fortran allows associative math - but we cannot reassociate if
270 we want traps or signed zeros. Cf. also flag_protect_parens. */
271 if (flag_associative_math == -1)
272 flag_associative_math = (!flag_trapping_math && !flag_signed_zeros);
273
274 /* By default, disable (re)allocation during assignment for -std=f95,
275 and enable it for F2003/F2008/GNU/Legacy. */
276 if (gfc_option.flag_realloc_lhs == -1)
277 {
278 if (gfc_option.allow_std & GFC_STD_F2003)
279 gfc_option.flag_realloc_lhs = 1;
280 else
281 gfc_option.flag_realloc_lhs = 0;
282 }
283
284 /* -fbounds-check is equivalent to -fcheck=bounds */
285 if (flag_bounds_check)
286 gfc_option.rtcheck |= GFC_RTCHECK_BOUNDS;
287
288 if (flag_compare_debug)
289 gfc_option.dump_fortran_original = 0;
290
291 /* Make -fmax-errors visible to gfortran's diagnostic machinery. */
292 if (global_options_set.x_flag_max_errors)
293 gfc_option.max_errors = flag_max_errors;
294
295 /* Verify the input file name. */
296 if (!filename || strcmp (filename, "-") == 0)
297 {
298 filename = "";
299 }
300
301 if (gfc_option.flag_preprocessed)
302 {
303 /* For preprocessed files, if the first tokens are of the form # NUM.
304 handle the directives so we know the original file name. */
305 gfc_source_file = gfc_read_orig_filename (filename, &canon_source_file);
306 if (gfc_source_file == NULL)
307 gfc_source_file = filename;
308 else
309 *pfilename = gfc_source_file;
310 }
311 else
312 gfc_source_file = filename;
313
314 if (canon_source_file == NULL)
315 canon_source_file = gfc_source_file;
316
317 /* Adds the path where the source file is to the list of include files. */
318
319 i = strlen (canon_source_file);
320 while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i]))
321 i--;
322
323 if (i != 0)
324 {
325 source_path = (char *) alloca (i + 1);
326 memcpy (source_path, canon_source_file, i);
327 source_path[i] = 0;
328 gfc_add_include_path (source_path, true, true);
329 }
330 else
331 gfc_add_include_path (".", true, true);
332
333 if (canon_source_file != gfc_source_file)
334 free (CONST_CAST (char *, canon_source_file));
335
336 /* Decide which form the file will be read in as. */
337
338 if (gfc_option.source_form != FORM_UNKNOWN)
339 gfc_current_form = gfc_option.source_form;
340 else
341 {
342 gfc_current_form = form_from_filename (filename);
343
344 if (gfc_current_form == FORM_UNKNOWN)
345 {
346 gfc_current_form = FORM_FREE;
347 gfc_warning_now ("Reading file '%s' as free form",
348 (filename[0] == '\0') ? "<stdin>" : filename);
349 }
350 }
351
352 /* If the user specified -fd-lines-as-{code|comments} verify that we're
353 in fixed form. */
354 if (gfc_current_form == FORM_FREE)
355 {
356 if (gfc_option.flag_d_lines == 0)
357 gfc_warning_now ("'-fd-lines-as-comments' has no effect "
358 "in free form");
359 else if (gfc_option.flag_d_lines == 1)
360 gfc_warning_now ("'-fd-lines-as-code' has no effect in free form");
361 }
362
363 /* If -pedantic, warn about the use of GNU extensions. */
364 if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
365 gfc_option.warn_std |= GFC_STD_GNU;
366 /* -std=legacy -pedantic is effectively -std=gnu. */
367 if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
368 gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY;
369
370 /* If the user didn't explicitly specify -f(no)-second-underscore we
371 use it if we're trying to be compatible with f2c, and not
372 otherwise. */
373 if (gfc_option.flag_second_underscore == -1)
374 gfc_option.flag_second_underscore = gfc_option.flag_f2c;
375
376 if (!gfc_option.flag_automatic && gfc_option.flag_max_stack_var_size != -2
377 && gfc_option.flag_max_stack_var_size != 0)
378 gfc_warning_now ("Flag -fno-automatic overwrites -fmax-stack-var-size=%d",
379 gfc_option.flag_max_stack_var_size);
380 else if (!gfc_option.flag_automatic && gfc_option.flag_recursive)
381 gfc_warning_now ("Flag -fno-automatic overwrites -frecursive");
382 else if (!gfc_option.flag_automatic && gfc_option.gfc_flag_openmp)
383 gfc_warning_now ("Flag -fno-automatic overwrites -frecursive implied by "
384 "-fopenmp");
385 else if (gfc_option.flag_max_stack_var_size != -2
386 && gfc_option.flag_recursive)
387 gfc_warning_now ("Flag -frecursive overwrites -fmax-stack-var-size=%d",
388 gfc_option.flag_max_stack_var_size);
389 else if (gfc_option.flag_max_stack_var_size != -2
390 && gfc_option.gfc_flag_openmp)
391 gfc_warning_now ("Flag -fmax-stack-var-size=%d overwrites -frecursive "
392 "implied by -fopenmp",
393 gfc_option.flag_max_stack_var_size);
394
395 /* Implement -frecursive as -fmax-stack-var-size=-1. */
396 if (gfc_option.flag_recursive)
397 gfc_option.flag_max_stack_var_size = -1;
398
399 /* Implied -frecursive; implemented as -fmax-stack-var-size=-1. */
400 if (gfc_option.flag_max_stack_var_size == -2 && gfc_option.gfc_flag_openmp
401 && gfc_option.flag_automatic)
402 {
403 gfc_option.flag_recursive = 1;
404 gfc_option.flag_max_stack_var_size = -1;
405 }
406
407 /* Set default. */
408 if (gfc_option.flag_max_stack_var_size == -2)
409 gfc_option.flag_max_stack_var_size = 32768;
410
411 /* Implement -fno-automatic as -fmax-stack-var-size=0. */
412 if (!gfc_option.flag_automatic)
413 gfc_option.flag_max_stack_var_size = 0;
414
415 if (pedantic)
416 {
417 gfc_option.warn_ampersand = 1;
418 gfc_option.warn_tabs = 0;
419 }
420
421 if (pedantic && gfc_option.flag_whole_file)
422 gfc_option.flag_whole_file = 2;
423
424 /* Optimization implies front end optimization, unless the user
425 specified it directly. */
426
427 if (gfc_option.flag_frontend_optimize == -1)
428 gfc_option.flag_frontend_optimize = optimize;
429
430 gfc_cpp_post_options ();
431
432 /* FIXME: return gfc_cpp_preprocess_only ();
433
434 The return value of this function indicates whether the
435 backend needs to be initialized. On -E, we don't need
436 the backend. However, if we return 'true' here, an
437 ICE occurs. Initializing the backend doesn't hurt much,
438 hence, for now we can live with it as is. */
439 return false;
440 }
441
442
443 /* Set the options for -Wall. */
444
445 static void
446 set_Wall (int setting)
447 {
448 gfc_option.warn_aliasing = setting;
449 gfc_option.warn_ampersand = setting;
450 gfc_option.gfc_warn_conversion = setting;
451 gfc_option.warn_line_truncation = setting;
452 gfc_option.warn_surprising = setting;
453 gfc_option.warn_tabs = !setting;
454 gfc_option.warn_underflow = setting;
455 gfc_option.warn_intrinsic_shadow = setting;
456 gfc_option.warn_intrinsics_std = setting;
457 gfc_option.warn_character_truncation = setting;
458 gfc_option.warn_unused_dummy_argument = setting;
459
460 warn_unused = setting;
461 warn_return_type = setting;
462 warn_switch = setting;
463 warn_uninitialized = setting;
464 }
465
466
467 static void
468 gfc_handle_module_path_options (const char *arg)
469 {
470
471 if (gfc_option.module_dir != NULL)
472 gfc_fatal_error ("gfortran: Only one -J option allowed");
473
474 gfc_option.module_dir = XCNEWVEC (char, strlen (arg) + 2);
475 strcpy (gfc_option.module_dir, arg);
476
477 gfc_add_include_path (gfc_option.module_dir, true, false);
478
479 strcat (gfc_option.module_dir, "/");
480 }
481
482
483 static void
484 gfc_handle_fpe_trap_option (const char *arg)
485 {
486 int result, pos = 0, n;
487 static const char * const exception[] = { "invalid", "denormal", "zero",
488 "overflow", "underflow",
489 "precision", NULL };
490 static const int opt_exception[] = { GFC_FPE_INVALID, GFC_FPE_DENORMAL,
491 GFC_FPE_ZERO, GFC_FPE_OVERFLOW,
492 GFC_FPE_UNDERFLOW, GFC_FPE_PRECISION,
493 0 };
494
495 while (*arg)
496 {
497 while (*arg == ',')
498 arg++;
499
500 while (arg[pos] && arg[pos] != ',')
501 pos++;
502
503 result = 0;
504 for (n = 0; exception[n] != NULL; n++)
505 {
506 if (exception[n] && strncmp (exception[n], arg, pos) == 0)
507 {
508 gfc_option.fpe |= opt_exception[n];
509 arg += pos;
510 pos = 0;
511 result = 1;
512 break;
513 }
514 }
515 if (!result)
516 gfc_fatal_error ("Argument to -ffpe-trap is not valid: %s", arg);
517 }
518 }
519
520
521 static void
522 gfc_handle_coarray_option (const char *arg)
523 {
524 if (strcmp (arg, "none") == 0)
525 gfc_option.coarray = GFC_FCOARRAY_NONE;
526 else if (strcmp (arg, "single") == 0)
527 gfc_option.coarray = GFC_FCOARRAY_SINGLE;
528 else if (strcmp (arg, "lib") == 0)
529 gfc_option.coarray = GFC_FCOARRAY_LIB;
530 else
531 gfc_fatal_error ("Argument to -fcoarray is not valid: %s", arg);
532 }
533
534
535 static void
536 gfc_handle_runtime_check_option (const char *arg)
537 {
538 int result, pos = 0, n;
539 static const char * const optname[] = { "all", "bounds", "array-temps",
540 "recursion", "do", "pointer",
541 "mem", NULL };
542 static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
543 GFC_RTCHECK_ARRAY_TEMPS,
544 GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO,
545 GFC_RTCHECK_POINTER, GFC_RTCHECK_MEM,
546 0 };
547
548 while (*arg)
549 {
550 while (*arg == ',')
551 arg++;
552
553 while (arg[pos] && arg[pos] != ',')
554 pos++;
555
556 result = 0;
557 for (n = 0; optname[n] != NULL; n++)
558 {
559 if (optname[n] && strncmp (optname[n], arg, pos) == 0)
560 {
561 gfc_option.rtcheck |= optmask[n];
562 arg += pos;
563 pos = 0;
564 result = 1;
565 break;
566 }
567 }
568 if (!result)
569 gfc_fatal_error ("Argument to -fcheck is not valid: %s", arg);
570 }
571 }
572
573
574 /* Handle command-line options. Returns 0 if unrecognized, 1 if
575 recognized and handled. */
576
577 bool
578 gfc_handle_option (size_t scode, const char *arg, int value,
579 int kind ATTRIBUTE_UNUSED, location_t loc ATTRIBUTE_UNUSED,
580 const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
581 {
582 bool result = true;
583 enum opt_code code = (enum opt_code) scode;
584
585 if (gfc_cpp_handle_option (scode, arg, value) == 1)
586 return true;
587
588 switch (code)
589 {
590 default:
591 result = false;
592 break;
593
594 case OPT_Wall:
595 set_Wall (value);
596 break;
597
598 case OPT_Waliasing:
599 gfc_option.warn_aliasing = value;
600 break;
601
602 case OPT_Wampersand:
603 gfc_option.warn_ampersand = value;
604 break;
605
606 case OPT_Warray_temporaries:
607 gfc_option.warn_array_temp = value;
608 break;
609
610 case OPT_Wcharacter_truncation:
611 gfc_option.warn_character_truncation = value;
612 break;
613
614 case OPT_Wconversion:
615 gfc_option.gfc_warn_conversion = value;
616 break;
617
618 case OPT_Wconversion_extra:
619 gfc_option.warn_conversion_extra = value;
620 break;
621
622 case OPT_Wfunction_elimination:
623 gfc_option.warn_function_elimination = value;
624 break;
625
626 case OPT_Wimplicit_interface:
627 gfc_option.warn_implicit_interface = value;
628 break;
629
630 case OPT_Wimplicit_procedure:
631 gfc_option.warn_implicit_procedure = value;
632 break;
633
634 case OPT_Wline_truncation:
635 gfc_option.warn_line_truncation = value;
636 break;
637
638 case OPT_Wreturn_type:
639 warn_return_type = value;
640 break;
641
642 case OPT_Wsurprising:
643 gfc_option.warn_surprising = value;
644 break;
645
646 case OPT_Wtabs:
647 gfc_option.warn_tabs = value;
648 break;
649
650 case OPT_Wunderflow:
651 gfc_option.warn_underflow = value;
652 break;
653
654 case OPT_Wintrinsic_shadow:
655 gfc_option.warn_intrinsic_shadow = value;
656 break;
657
658 case OPT_Walign_commons:
659 gfc_option.warn_align_commons = value;
660 break;
661
662 case OPT_Wunused_dummy_argument:
663 gfc_option.warn_unused_dummy_argument = value;
664 break;
665
666 case OPT_fall_intrinsics:
667 gfc_option.flag_all_intrinsics = 1;
668 break;
669
670 case OPT_fautomatic:
671 gfc_option.flag_automatic = value;
672 break;
673
674 case OPT_fallow_leading_underscore:
675 gfc_option.flag_allow_leading_underscore = value;
676 break;
677
678 case OPT_fbackslash:
679 gfc_option.flag_backslash = value;
680 break;
681
682 case OPT_fbacktrace:
683 gfc_option.flag_backtrace = value;
684 break;
685
686 case OPT_fcheck_array_temporaries:
687 gfc_option.rtcheck |= GFC_RTCHECK_ARRAY_TEMPS;
688 break;
689
690 case OPT_fdump_core:
691 gfc_option.flag_dump_core = value;
692 break;
693
694 case OPT_fcray_pointer:
695 gfc_option.flag_cray_pointer = value;
696 break;
697
698 case OPT_ff2c:
699 gfc_option.flag_f2c = value;
700 break;
701
702 case OPT_fdollar_ok:
703 gfc_option.flag_dollar_ok = value;
704 break;
705
706 case OPT_fexternal_blas:
707 gfc_option.flag_external_blas = value;
708 break;
709
710 case OPT_fblas_matmul_limit_:
711 gfc_option.blas_matmul_limit = value;
712 break;
713
714 case OPT_fd_lines_as_code:
715 gfc_option.flag_d_lines = 1;
716 break;
717
718 case OPT_fd_lines_as_comments:
719 gfc_option.flag_d_lines = 0;
720 break;
721
722 case OPT_fdump_fortran_original:
723 case OPT_fdump_parse_tree:
724 gfc_option.dump_fortran_original = value;
725 break;
726
727 case OPT_fdump_fortran_optimized:
728 gfc_option.dump_fortran_optimized = value;
729 break;
730
731 case OPT_ffixed_form:
732 gfc_option.source_form = FORM_FIXED;
733 break;
734
735 case OPT_ffixed_line_length_none:
736 gfc_option.fixed_line_length = 0;
737 break;
738
739 case OPT_ffixed_line_length_:
740 if (value != 0 && value < 7)
741 gfc_fatal_error ("Fixed line length must be at least seven.");
742 gfc_option.fixed_line_length = value;
743 break;
744
745 case OPT_ffree_form:
746 gfc_option.source_form = FORM_FREE;
747 break;
748
749 case OPT_fopenmp:
750 gfc_option.gfc_flag_openmp = value;
751 break;
752
753 case OPT_ffree_line_length_none:
754 gfc_option.free_line_length = 0;
755 break;
756
757 case OPT_ffree_line_length_:
758 if (value != 0 && value < 4)
759 gfc_fatal_error ("Free line length must be at least three.");
760 gfc_option.free_line_length = value;
761 break;
762
763 case OPT_funderscoring:
764 gfc_option.flag_underscoring = value;
765 break;
766
767 case OPT_fwhole_file:
768 gfc_option.flag_whole_file = value;
769 break;
770
771 case OPT_fsecond_underscore:
772 gfc_option.flag_second_underscore = value;
773 break;
774
775 case OPT_static_libgfortran:
776 #ifndef HAVE_LD_STATIC_DYNAMIC
777 gfc_fatal_error ("-static-libgfortran is not supported in this "
778 "configuration");
779 #endif
780 break;
781
782 case OPT_fimplicit_none:
783 gfc_option.flag_implicit_none = value;
784 break;
785
786 case OPT_fintrinsic_modules_path:
787 gfc_add_include_path (arg, false, false);
788 gfc_add_intrinsic_modules_path (arg);
789 break;
790
791 case OPT_fmax_array_constructor_:
792 gfc_option.flag_max_array_constructor = value > 65535 ? value : 65535;
793 break;
794
795 case OPT_fmax_stack_var_size_:
796 gfc_option.flag_max_stack_var_size = value;
797 break;
798
799 case OPT_fstack_arrays:
800 gfc_option.flag_stack_arrays = value;
801 break;
802
803 case OPT_fmodule_private:
804 gfc_option.flag_module_private = value;
805 break;
806
807 case OPT_frange_check:
808 gfc_option.flag_range_check = value;
809 break;
810
811 case OPT_fpack_derived:
812 gfc_option.flag_pack_derived = value;
813 break;
814
815 case OPT_frepack_arrays:
816 gfc_option.flag_repack_arrays = value;
817 break;
818
819 case OPT_fpreprocessed:
820 gfc_option.flag_preprocessed = value;
821 break;
822
823 case OPT_fmax_identifier_length_:
824 if (value > GFC_MAX_SYMBOL_LEN)
825 gfc_fatal_error ("Maximum supported identifier length is %d",
826 GFC_MAX_SYMBOL_LEN);
827 gfc_option.max_identifier_length = value;
828 break;
829
830 case OPT_fdefault_integer_8:
831 gfc_option.flag_default_integer = value;
832 break;
833
834 case OPT_fdefault_real_8:
835 gfc_option.flag_default_real = value;
836 break;
837
838 case OPT_fdefault_double_8:
839 gfc_option.flag_default_double = value;
840 break;
841
842 case OPT_finit_local_zero:
843 gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
844 gfc_option.flag_init_integer_value = 0;
845 gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
846 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
847 gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
848 gfc_option.flag_init_character_value = (char)0;
849 break;
850
851 case OPT_finit_logical_:
852 if (!strcasecmp (arg, "false"))
853 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
854 else if (!strcasecmp (arg, "true"))
855 gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
856 else
857 gfc_fatal_error ("Unrecognized option to -finit-logical: %s",
858 arg);
859 break;
860
861 case OPT_finit_real_:
862 if (!strcasecmp (arg, "zero"))
863 gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
864 else if (!strcasecmp (arg, "nan"))
865 gfc_option.flag_init_real = GFC_INIT_REAL_NAN;
866 else if (!strcasecmp (arg, "snan"))
867 gfc_option.flag_init_real = GFC_INIT_REAL_SNAN;
868 else if (!strcasecmp (arg, "inf"))
869 gfc_option.flag_init_real = GFC_INIT_REAL_INF;
870 else if (!strcasecmp (arg, "-inf"))
871 gfc_option.flag_init_real = GFC_INIT_REAL_NEG_INF;
872 else
873 gfc_fatal_error ("Unrecognized option to -finit-real: %s",
874 arg);
875 break;
876
877 case OPT_finit_integer_:
878 gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
879 gfc_option.flag_init_integer_value = atoi (arg);
880 break;
881
882 case OPT_finit_character_:
883 if (value >= 0 && value <= 127)
884 {
885 gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
886 gfc_option.flag_init_character_value = (char)value;
887 }
888 else
889 gfc_fatal_error ("The value of n in -finit-character=n must be "
890 "between 0 and 127");
891 break;
892
893 case OPT_I:
894 gfc_add_include_path (arg, true, false);
895 break;
896
897 case OPT_J:
898 gfc_handle_module_path_options (arg);
899 break;
900
901 case OPT_fsign_zero:
902 gfc_option.flag_sign_zero = value;
903 break;
904
905 case OPT_ffpe_trap_:
906 gfc_handle_fpe_trap_option (arg);
907 break;
908
909 case OPT_std_f95:
910 gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77
911 | GFC_STD_F2008_OBS;
912 gfc_option.warn_std = GFC_STD_F95_OBS;
913 gfc_option.max_continue_fixed = 19;
914 gfc_option.max_continue_free = 39;
915 gfc_option.max_identifier_length = 31;
916 gfc_option.warn_ampersand = 1;
917 gfc_option.warn_tabs = 0;
918 break;
919
920 case OPT_std_f2003:
921 gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
922 | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008_OBS;
923 gfc_option.warn_std = GFC_STD_F95_OBS;
924 gfc_option.max_identifier_length = 63;
925 gfc_option.warn_ampersand = 1;
926 gfc_option.warn_tabs = 0;
927 break;
928
929 case OPT_std_f2008:
930 gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
931 | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS;
932 gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
933 gfc_option.max_identifier_length = 63;
934 gfc_option.warn_ampersand = 1;
935 gfc_option.warn_tabs = 0;
936 break;
937
938 case OPT_std_gnu:
939 set_default_std_flags ();
940 break;
941
942 case OPT_std_legacy:
943 set_default_std_flags ();
944 gfc_option.warn_std = 0;
945 break;
946
947 case OPT_Wintrinsics_std:
948 gfc_option.warn_intrinsics_std = value;
949 break;
950
951 case OPT_fshort_enums:
952 /* Handled in language-independent code. */
953 break;
954
955 case OPT_fconvert_little_endian:
956 gfc_option.convert = GFC_CONVERT_LITTLE;
957 break;
958
959 case OPT_fconvert_big_endian:
960 gfc_option.convert = GFC_CONVERT_BIG;
961 break;
962
963 case OPT_fconvert_native:
964 gfc_option.convert = GFC_CONVERT_NATIVE;
965 break;
966
967 case OPT_fconvert_swap:
968 gfc_option.convert = GFC_CONVERT_SWAP;
969 break;
970
971 case OPT_frecord_marker_4:
972 gfc_option.record_marker = 4;
973 break;
974
975 case OPT_frecord_marker_8:
976 gfc_option.record_marker = 8;
977 break;
978
979 case OPT_fmax_subrecord_length_:
980 if (value > MAX_SUBRECORD_LENGTH)
981 gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
982 MAX_SUBRECORD_LENGTH);
983
984 gfc_option.max_subrecord_length = value;
985 break;
986
987 case OPT_frecursive:
988 gfc_option.flag_recursive = value;
989 break;
990
991 case OPT_falign_commons:
992 gfc_option.flag_align_commons = value;
993 break;
994
995 case OPT_faggressive_function_elimination:
996 gfc_option.flag_aggressive_function_elimination = value;
997 break;
998
999 case OPT_ffrontend_optimize:
1000 gfc_option.flag_frontend_optimize = value;
1001 break;
1002
1003 case OPT_fprotect_parens:
1004 gfc_option.flag_protect_parens = value;
1005 break;
1006
1007 case OPT_frealloc_lhs:
1008 gfc_option.flag_realloc_lhs = value;
1009 break;
1010
1011 case OPT_fcheck_:
1012 gfc_handle_runtime_check_option (arg);
1013 break;
1014
1015 case OPT_fcoarray_:
1016 gfc_handle_coarray_option (arg);
1017 break;
1018 }
1019
1020 return result;
1021 }
1022
1023
1024 /* Return a string with the options passed to the compiler; used for
1025 Fortran's compiler_options() intrinsic. */
1026
1027 char *
1028 gfc_get_option_string (void)
1029 {
1030 unsigned j;
1031 size_t len, pos;
1032 char *result;
1033
1034 /* Determine required string length. */
1035
1036 len = 0;
1037 for (j = 1; j < save_decoded_options_count; j++)
1038 {
1039 switch (save_decoded_options[j].opt_index)
1040 {
1041 case OPT_o:
1042 case OPT_d:
1043 case OPT_dumpbase:
1044 case OPT_dumpdir:
1045 case OPT_auxbase:
1046 case OPT_quiet:
1047 case OPT_version:
1048 case OPT_fintrinsic_modules_path:
1049 /* Ignore these. */
1050 break;
1051 default:
1052 /* Ignore file names. */
1053 if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
1054 len += 1
1055 + strlen (save_decoded_options[j].orig_option_with_args_text);
1056 }
1057 }
1058
1059 result = XCNEWVEC (char, len);
1060
1061 pos = 0;
1062 for (j = 1; j < save_decoded_options_count; j++)
1063 {
1064 switch (save_decoded_options[j].opt_index)
1065 {
1066 case OPT_o:
1067 case OPT_d:
1068 case OPT_dumpbase:
1069 case OPT_dumpdir:
1070 case OPT_auxbase:
1071 case OPT_quiet:
1072 case OPT_version:
1073 case OPT_fintrinsic_modules_path:
1074 /* Ignore these. */
1075 continue;
1076
1077 case OPT_cpp_:
1078 /* Use "-cpp" rather than "-cpp=<temporary file>". */
1079 len = 4;
1080 break;
1081
1082 default:
1083 /* Ignore file names. */
1084 if (save_decoded_options[j].orig_option_with_args_text[0] != '-')
1085 continue;
1086
1087 len = strlen (save_decoded_options[j].orig_option_with_args_text);
1088 }
1089
1090 memcpy (&result[pos], save_decoded_options[j].orig_option_with_args_text, len);
1091 pos += len;
1092 result[pos++] = ' ';
1093 }
1094
1095 result[--pos] = '\0';
1096 return result;
1097 }