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