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