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