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