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