gcc/fortran/options.c

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