gcc/fortran/options.c

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