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