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