gcc/fortran/options.c

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