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   /* precision is a backwards compatibility alias for inexact.  */
 496   static const char * const exception[] = { "invalid", "denormal", "zero",
 497                                             "overflow", "underflow",
 498                                             "inexact", "precision", NULL };
 499   static const int opt_exception[] = { GFC_FPE_INVALID, GFC_FPE_DENORMAL,
 500                                        GFC_FPE_ZERO, GFC_FPE_OVERFLOW,
 501                                        GFC_FPE_UNDERFLOW, GFC_FPE_INEXACT,
 502                                        GFC_FPE_INEXACT,
 503                                        0 };
 504
 505   while (*arg)
 506     {
 507       while (*arg == ',')
 508         arg++;
 509
 510       while (arg[pos] && arg[pos] != ',')
 511         pos++;
 512
 513       result = 0;
 514       for (n = 0; exception[n] != NULL; n++)
 515         {
 516           if (exception[n] && strncmp (exception[n], arg, pos) == 0)
 517             {
 518               gfc_option.fpe |= opt_exception[n];
 519               arg += pos;
 520               pos = 0;
 521               result = 1;
 522               break;
 523             }
 524         }
 525       if (!result)
 526         gfc_fatal_error ("Argument to -ffpe-trap is not valid: %s", arg);
 527     }
 528 }
 529
 530
 531 static void
 532 gfc_handle_coarray_option (const char *arg)
 533 {
 534   if (strcmp (arg, "none") == 0)
 535     gfc_option.coarray = GFC_FCOARRAY_NONE;
 536   else if (strcmp (arg, "single") == 0)
 537     gfc_option.coarray = GFC_FCOARRAY_SINGLE;
 538   else if (strcmp (arg, "lib") == 0)
 539     gfc_option.coarray = GFC_FCOARRAY_LIB;
 540   else
 541     gfc_fatal_error ("Argument to -fcoarray is not valid: %s", arg);
 542 }
 543
 544
 545 static void
 546 gfc_handle_runtime_check_option (const char *arg)
 547 {
 548   int result, pos = 0, n;
 549   static const char * const optname[] = { "all", "bounds", "array-temps",
 550                                           "recursion", "do", "pointer",
 551                                           "mem", NULL };
 552   static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
 553                                  GFC_RTCHECK_ARRAY_TEMPS,
 554                                  GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO,
 555                                  GFC_RTCHECK_POINTER, GFC_RTCHECK_MEM,
 556                                  0 };
 557
 558   while (*arg)
 559     {
 560       while (*arg == ',')
 561         arg++;
 562
 563       while (arg[pos] && arg[pos] != ',')
 564         pos++;
 565
 566       result = 0;
 567       for (n = 0; optname[n] != NULL; n++)
 568         {
 569           if (optname[n] && strncmp (optname[n], arg, pos) == 0)
 570             {
 571               gfc_option.rtcheck |= optmask[n];
 572               arg += pos;
 573               pos = 0;
 574               result = 1;
 575               break;
 576             }
 577         }
 578       if (!result)
 579         gfc_fatal_error ("Argument to -fcheck is not valid: %s", arg);
 580     }
 581 }
 582
 583
 584 /* Handle command-line options.  Returns 0 if unrecognized, 1 if
 585    recognized and handled.  */
 586
 587 bool
 588 gfc_handle_option (size_t scode, const char *arg, int value,
 589                    int kind ATTRIBUTE_UNUSED, location_t loc ATTRIBUTE_UNUSED,
 590                    const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
 591 {
 592   bool result = true;
 593   enum opt_code code = (enum opt_code) scode;
 594
 595   if (gfc_cpp_handle_option (scode, arg, value) == 1)
 596     return true;
 597
 598   switch (code)
 599     {
 600     default:
 601       result = false;
 602       break;
 603
 604     case OPT_Wall:
 605       set_Wall (value);
 606       break;
 607
 608     case OPT_Waliasing:
 609       gfc_option.warn_aliasing = value;
 610       break;
 611
 612     case OPT_Wampersand:
 613       gfc_option.warn_ampersand = value;
 614       break;
 615
 616     case OPT_Warray_temporaries:
 617       gfc_option.warn_array_temp = value;
 618       break;
 619
 620     case OPT_Wcharacter_truncation:
 621       gfc_option.warn_character_truncation = value;
 622       break;
 623
 624     case OPT_Wconversion:
 625       gfc_option.gfc_warn_conversion = value;
 626       break;
 627
 628     case OPT_Wconversion_extra:
 629       gfc_option.warn_conversion_extra = value;
 630       break;
 631
 632     case OPT_Wfunction_elimination:
 633       gfc_option.warn_function_elimination = value;
 634       break;
 635
 636     case OPT_Wimplicit_interface:
 637       gfc_option.warn_implicit_interface = value;
 638       break;
 639
 640     case OPT_Wimplicit_procedure:
 641       gfc_option.warn_implicit_procedure = value;
 642       break;
 643
 644     case OPT_Wline_truncation:
 645       gfc_option.warn_line_truncation = value;
 646       break;
 647
 648     case OPT_Wreturn_type:
 649       warn_return_type = value;
 650       break;
 651
 652     case OPT_Wsurprising:
 653       gfc_option.warn_surprising = value;
 654       break;
 655
 656     case OPT_Wtabs:
 657       gfc_option.warn_tabs = value;
 658       break;
 659
 660     case OPT_Wunderflow:
 661       gfc_option.warn_underflow = value;
 662       break;
 663
 664     case OPT_Wintrinsic_shadow:
 665       gfc_option.warn_intrinsic_shadow = value;
 666       break;
 667
 668     case OPT_Walign_commons:
 669       gfc_option.warn_align_commons = value;
 670       break;
 671
 672     case OPT_Wreal_q_constant:
 673       gfc_option.warn_real_q_constant = value;
 674       break;
 675
 676     case OPT_Wunused_dummy_argument:
 677       gfc_option.warn_unused_dummy_argument = value;
 678       break;
 679
 680     case OPT_fall_intrinsics:
 681       gfc_option.flag_all_intrinsics = 1;
 682       break;
 683
 684     case OPT_fautomatic:
 685       gfc_option.flag_automatic = value;
 686       break;
 687
 688     case OPT_fallow_leading_underscore:
 689       gfc_option.flag_allow_leading_underscore = value;
 690       break;
 691
 692     case OPT_fbackslash:
 693       gfc_option.flag_backslash = value;
 694       break;
 695
 696     case OPT_fbacktrace:
 697       gfc_option.flag_backtrace = value;
 698       break;
 699
 700     case OPT_fcheck_array_temporaries:
 701       gfc_option.rtcheck |= GFC_RTCHECK_ARRAY_TEMPS;
 702       break;
 703
 704     case OPT_fcray_pointer:
 705       gfc_option.flag_cray_pointer = value;
 706       break;
 707
 708     case OPT_ff2c:
 709       gfc_option.flag_f2c = value;
 710       break;
 711
 712     case OPT_fdollar_ok:
 713       gfc_option.flag_dollar_ok = value;
 714       break;
 715
 716     case OPT_fexternal_blas:
 717       gfc_option.flag_external_blas = value;
 718       break;
 719
 720     case OPT_fblas_matmul_limit_:
 721       gfc_option.blas_matmul_limit = value;
 722       break;
 723
 724     case OPT_fd_lines_as_code:
 725       gfc_option.flag_d_lines = 1;
 726       break;
 727
 728     case OPT_fd_lines_as_comments:
 729       gfc_option.flag_d_lines = 0;
 730       break;
 731
 732     case OPT_fdump_fortran_original:
 733     case OPT_fdump_parse_tree:
 734       gfc_option.dump_fortran_original = value;
 735       break;
 736
 737     case OPT_fdump_fortran_optimized:
 738       gfc_option.dump_fortran_optimized = value;
 739       break;
 740
 741     case OPT_ffixed_form:
 742       gfc_option.source_form = FORM_FIXED;
 743       break;
 744
 745     case OPT_ffixed_line_length_none:
 746       gfc_option.fixed_line_length = 0;
 747       break;
 748
 749     case OPT_ffixed_line_length_:
 750       if (value != 0 && value < 7)
 751         gfc_fatal_error ("Fixed line length must be at least seven.");
 752       gfc_option.fixed_line_length = value;
 753       break;
 754
 755     case OPT_ffree_form:
 756       gfc_option.source_form = FORM_FREE;
 757       break;
 758
 759     case OPT_fopenmp:
 760       gfc_option.gfc_flag_openmp = value;
 761       break;
 762
 763     case OPT_ffree_line_length_none:
 764       gfc_option.free_line_length = 0;
 765       break;
 766
 767     case OPT_ffree_line_length_:
 768       if (value != 0 && value < 4)
 769         gfc_fatal_error ("Free line length must be at least three.");
 770       gfc_option.free_line_length = value;
 771       break;
 772
 773     case OPT_funderscoring:
 774       gfc_option.flag_underscoring = value;
 775       break;
 776
 777     case OPT_fwhole_file:
 778       gfc_option.flag_whole_file = value;
 779       break;
 780
 781     case OPT_fsecond_underscore:
 782       gfc_option.flag_second_underscore = value;
 783       break;
 784
 785     case OPT_static_libgfortran:
 786 #ifndef HAVE_LD_STATIC_DYNAMIC
 787       gfc_fatal_error ("-static-libgfortran is not supported in this "
 788                        "configuration");
 789 #endif
 790       break;
 791
 792     case OPT_fimplicit_none:
 793       gfc_option.flag_implicit_none = value;
 794       break;
 795
 796     case OPT_fintrinsic_modules_path:
 797       gfc_add_include_path (arg, false, false);
 798       gfc_add_intrinsic_modules_path (arg);
 799       break;
 800
 801     case OPT_fmax_array_constructor_:
 802       gfc_option.flag_max_array_constructor = value > 65535 ? value : 65535;
 803       break;
 804
 805     case OPT_fmax_stack_var_size_:
 806       gfc_option.flag_max_stack_var_size = value;
 807       break;
 808
 809     case OPT_fstack_arrays:
 810       gfc_option.flag_stack_arrays = value;
 811       break;
 812
 813     case OPT_fmodule_private:
 814       gfc_option.flag_module_private = value;
 815       break;
 816
 817     case OPT_frange_check:
 818       gfc_option.flag_range_check = value;
 819       break;
 820
 821     case OPT_fpack_derived:
 822       gfc_option.flag_pack_derived = value;
 823       break;
 824
 825     case OPT_frepack_arrays:
 826       gfc_option.flag_repack_arrays = value;
 827       break;
 828
 829     case OPT_fpreprocessed:
 830       gfc_option.flag_preprocessed = value;
 831       break;
 832
 833     case OPT_fmax_identifier_length_:
 834       if (value > GFC_MAX_SYMBOL_LEN)
 835         gfc_fatal_error ("Maximum supported identifier length is %d",
 836                          GFC_MAX_SYMBOL_LEN);
 837       gfc_option.max_identifier_length = value;
 838       break;
 839
 840     case OPT_fdefault_integer_8:
 841       gfc_option.flag_default_integer = value;
 842       break;
 843
 844     case OPT_fdefault_real_8:
 845       gfc_option.flag_default_real = value;
 846       break;
 847
 848     case OPT_fdefault_double_8:
 849       gfc_option.flag_default_double = value;
 850       break;
 851
 852     case OPT_finit_local_zero:
 853       gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
 854       gfc_option.flag_init_integer_value = 0;
 855       gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
 856       gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
 857       gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
 858       gfc_option.flag_init_character_value = (char)0;
 859       break;
 860
 861     case OPT_finit_logical_:
 862       if (!strcasecmp (arg, "false"))
 863         gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
 864       else if (!strcasecmp (arg, "true"))
 865         gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
 866       else
 867         gfc_fatal_error ("Unrecognized option to -finit-logical: %s",
 868                          arg);
 869       break;
 870
 871     case OPT_finit_real_:
 872       if (!strcasecmp (arg, "zero"))
 873         gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
 874       else if (!strcasecmp (arg, "nan"))
 875         gfc_option.flag_init_real = GFC_INIT_REAL_NAN;
 876       else if (!strcasecmp (arg, "snan"))
 877         gfc_option.flag_init_real = GFC_INIT_REAL_SNAN;
 878       else if (!strcasecmp (arg, "inf"))
 879         gfc_option.flag_init_real = GFC_INIT_REAL_INF;
 880       else if (!strcasecmp (arg, "-inf"))
 881         gfc_option.flag_init_real = GFC_INIT_REAL_NEG_INF;
 882       else
 883         gfc_fatal_error ("Unrecognized option to -finit-real: %s",
 884                          arg);
 885       break;
 886
 887     case OPT_finit_integer_:
 888       gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
 889       gfc_option.flag_init_integer_value = atoi (arg);
 890       break;
 891
 892     case OPT_finit_character_:
 893       if (value >= 0 && value <= 127)
 894         {
 895           gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
 896           gfc_option.flag_init_character_value = (char)value;
 897         }
 898       else
 899         gfc_fatal_error ("The value of n in -finit-character=n must be "
 900                          "between 0 and 127");
 901       break;
 902
 903     case OPT_I:
 904       gfc_add_include_path (arg, true, false);
 905       break;
 906
 907     case OPT_J:
 908       gfc_handle_module_path_options (arg);
 909       break;
 910
 911     case OPT_fsign_zero:
 912       gfc_option.flag_sign_zero = value;
 913       break;
 914
 915     case OPT_ffpe_trap_:
 916       gfc_handle_fpe_trap_option (arg);
 917       break;
 918
 919     case OPT_std_f95:
 920       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77
 921                              | GFC_STD_F2008_OBS;
 922       gfc_option.warn_std = GFC_STD_F95_OBS;
 923       gfc_option.max_continue_fixed = 19;
 924       gfc_option.max_continue_free = 39;
 925       gfc_option.max_identifier_length = 31;
 926       gfc_option.warn_ampersand = 1;
 927       gfc_option.warn_tabs = 0;
 928       break;
 929
 930     case OPT_std_f2003:
 931       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
 932         | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008_OBS;
 933       gfc_option.warn_std = GFC_STD_F95_OBS;
 934       gfc_option.max_identifier_length = 63;
 935       gfc_option.warn_ampersand = 1;
 936       gfc_option.warn_tabs = 0;
 937       break;
 938
 939     case OPT_std_f2008:
 940       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
 941         | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS;
 942       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
 943       gfc_option.max_identifier_length = 63;
 944       gfc_option.warn_ampersand = 1;
 945       gfc_option.warn_tabs = 0;
 946       break;
 947
 948     case OPT_std_f2008tr:
 949       gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
 950         | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS
 951         | GFC_STD_F2008_TR;
 952       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
 953       gfc_option.max_identifier_length = 63;
 954       gfc_option.warn_ampersand = 1;
 955       gfc_option.warn_tabs = 0;
 956       break;
 957
 958     case OPT_std_gnu:
 959       set_default_std_flags ();
 960       break;
 961
 962     case OPT_std_legacy:
 963       set_default_std_flags ();
 964       gfc_option.warn_std = 0;
 965       break;
 966
 967     case OPT_Wintrinsics_std:
 968       gfc_option.warn_intrinsics_std = value;
 969       break;
 970
 971     case OPT_fshort_enums:
 972       /* Handled in language-independent code.  */
 973       break;
 974
 975     case OPT_fconvert_little_endian:
 976       gfc_option.convert = GFC_CONVERT_LITTLE;
 977       break;
 978
 979     case OPT_fconvert_big_endian:
 980       gfc_option.convert = GFC_CONVERT_BIG;
 981       break;
 982
 983     case OPT_fconvert_native:
 984       gfc_option.convert = GFC_CONVERT_NATIVE;
 985       break;
 986
 987     case OPT_fconvert_swap:
 988       gfc_option.convert = GFC_CONVERT_SWAP;
 989       break;
 990
 991     case OPT_frecord_marker_4:
 992       gfc_option.record_marker = 4;
 993       break;
 994
 995     case OPT_frecord_marker_8:
 996       gfc_option.record_marker = 8;
 997       break;
 998
 999     case OPT_fmax_subrecord_length_:
1000       if (value > MAX_SUBRECORD_LENGTH)
1001         gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
1002                          MAX_SUBRECORD_LENGTH);
1003
1004       gfc_option.max_subrecord_length = value;
1005       break;
1006
1007     case OPT_frecursive:
1008       gfc_option.flag_recursive = value;
1009       break;
1010
1011     case OPT_falign_commons:
1012       gfc_option.flag_align_commons = value;
1013       break;
1014
1015     case  OPT_faggressive_function_elimination:
1016       gfc_option.flag_aggressive_function_elimination = value;
1017       break;
1018
1019     case OPT_ffrontend_optimize:
1020       gfc_option.flag_frontend_optimize = value;
1021       break;
1022
1023     case OPT_fprotect_parens:
1024       gfc_option.flag_protect_parens = value;
1025       break;
1026
1027     case OPT_frealloc_lhs:
1028       gfc_option.flag_realloc_lhs = value;
1029       break;
1030
1031     case OPT_fcheck_:
1032       gfc_handle_runtime_check_option (arg);
1033       break;
1034
1035     case OPT_fcoarray_:
1036       gfc_handle_coarray_option (arg);
1037       break;
1038     }
1039
1040   return result;
1041 }
1042
1043
1044 /* Return a string with the options passed to the compiler; used for
1045    Fortran's compiler_options() intrinsic.  */
1046
1047 char *
1048 gfc_get_option_string (void)
1049 {
1050   unsigned j;
1051   size_t len, pos;
1052   char *result;
1053
1054   /* Determine required string length.  */
1055
1056   len = 0;
1057   for (j = 1; j < save_decoded_options_count; j++)
1058     {
1059       switch (save_decoded_options[j].opt_index)
1060         {
1061         case OPT_o:
1062         case OPT_d:
1063         case OPT_dumpbase:
1064         case OPT_dumpdir:
1065         case OPT_auxbase:
1066         case OPT_quiet:
1067         case OPT_version:
1068         case OPT_fintrinsic_modules_path:
1069           /* Ignore these.  */
1070           break;
1071         default:
1072           /* Ignore file names. */
1073           if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
1074             len += 1
1075                  + strlen (save_decoded_options[j].orig_option_with_args_text);
1076         }
1077     }
1078
1079   result = XCNEWVEC (char, len);
1080
1081   pos = 0;
1082   for (j = 1; j < save_decoded_options_count; j++)
1083     {
1084       switch (save_decoded_options[j].opt_index)
1085         {
1086         case OPT_o:
1087         case OPT_d:
1088         case OPT_dumpbase:
1089         case OPT_dumpdir:
1090         case OPT_auxbase:
1091         case OPT_quiet:
1092         case OPT_version:
1093         case OPT_fintrinsic_modules_path:
1094           /* Ignore these.  */
1095           continue;
1096
1097         case OPT_cpp_:
1098           /* Use "-cpp" rather than "-cpp=<temporary file>".  */
1099           len = 4;
1100           break;
1101
1102         default:
1103           /* Ignore file names. */
1104           if (save_decoded_options[j].orig_option_with_args_text[0] != '-')
1105             continue;
1106
1107           len = strlen (save_decoded_options[j].orig_option_with_args_text);
1108         }
1109
1110       memcpy (&result[pos], save_decoded_options[j].orig_option_with_args_text, len);
1111       pos += len;
1112       result[pos++] = ' ';
1113     }
1114
1115   result[--pos] = '\0';
1116   return result;
1117 }