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