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