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