gcc/fortran/cpp.c

   1 /* Copyright (C) 2008-2022 Free Software Foundation, Inc.
   2
   3 This file is part of GCC.
   4
   5 GCC is free software; you can redistribute it and/or modify it under
   6 the terms of the GNU General Public License as published by the Free
   7 Software Foundation; either version 3, or (at your option) any later
   8 version.
   9
  10 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  11 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  12 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  13 for more details.
  14
  15 You should have received a copy of the GNU General Public License
  16 along with GCC; see the file COPYING3.  If not see
  17 <http://www.gnu.org/licenses/>.  */
  18
  19 #include "config.h"
  20 #include "system.h"
  21 #include "coretypes.h"
  22
  23 #define GCC_C_COMMON_C
  24 #include "options.h"  /* For cpp_reason_option_codes. */
  25 #undef GCC_C_COMMON_C
  26
  27 #include "target.h"
  28 #include "gfortran.h"
  29 #include "diagnostic.h"
  30
  31 #include "toplev.h"
  32
  33 #include "../../libcpp/internal.h"
  34 #include "cpp.h"
  35 #include "incpath.h"
  36 #include "cppbuiltin.h"
  37 #include "mkdeps.h"
  38
  39 #ifndef TARGET_SYSTEM_ROOT
  40 # define TARGET_SYSTEM_ROOT NULL
  41 #endif
  42
  43 #ifndef TARGET_CPU_CPP_BUILTINS
  44 # define TARGET_CPU_CPP_BUILTINS()
  45 #endif
  46
  47 #ifndef TARGET_OS_CPP_BUILTINS
  48 # define TARGET_OS_CPP_BUILTINS()
  49 #endif
  50
  51 #ifndef TARGET_OBJFMT_CPP_BUILTINS
  52 # define TARGET_OBJFMT_CPP_BUILTINS()
  53 #endif
  54
  55
  56 /* Holds switches parsed by gfc_cpp_handle_option (), but whose
  57    handling is deferred to gfc_cpp_init ().  */
  58 typedef struct
  59 {
  60     enum opt_code code;
  61     const char *arg;
  62 }
  63 gfc_cpp_deferred_opt_t;
  64
  65
  66 /* Defined and undefined macros being queued for output with -dU at
  67    the next newline.  */
  68 typedef struct gfc_cpp_macro_queue
  69 {
  70   struct gfc_cpp_macro_queue *next;     /* Next macro in the list.  */
  71   char *macro;                          /* The name of the macro if not
  72                                            defined, the full definition if
  73                                            defined.  */
  74 } gfc_cpp_macro_queue;
  75 static gfc_cpp_macro_queue *cpp_define_queue, *cpp_undefine_queue;
  76
  77 struct gfc_cpp_option_data
  78 {
  79   /* Argument of -cpp, implied by SPEC;
  80      if NULL, preprocessing disabled.  */
  81   const char *temporary_filename;
  82
  83   const char *output_filename;          /* -o <arg>  */
  84   int preprocess_only;                  /* -E  */
  85   int discard_comments;                 /* -C  */
  86   int discard_comments_in_macro_exp;    /* -CC  */
  87   int print_include_names;              /* -H  */
  88   int no_line_commands;                 /* -P  */
  89   char dump_macros;                     /* -d[DMNU]  */
  90   int dump_includes;                    /* -dI  */
  91   int working_directory;                /* -fworking-directory  */
  92   int no_predefined;                    /* -undef */
  93   int standard_include_paths;           /* -nostdinc */
  94   int verbose;                          /* -v */
  95   int deps;                             /* -M */
  96   int deps_skip_system;                 /* -MM */
  97   const char *deps_filename;            /* -M[M]D */
  98   const char *deps_filename_user;       /* -MF <arg> */
  99   int deps_missing_are_generated;       /* -MG */
 100   int deps_phony;                       /* -MP */
 101   int warn_date_time;                   /* -Wdate-time */
 102
 103   const char *multilib;                 /* -imultilib <dir>  */
 104   const char *prefix;                   /* -iprefix <dir>  */
 105   const char *sysroot;                  /* -isysroot <dir>  */
 106
 107   /* Options whose handling needs to be deferred until the
 108      appropriate cpp-objects are created:
 109       -A predicate=answer
 110       -D <macro>[=<val>]
 111       -U <macro>  */
 112   gfc_cpp_deferred_opt_t *deferred_opt;
 113   int deferred_opt_count;
 114 }
 115 gfc_cpp_option;
 116
 117 /* Structures used with libcpp:  */
 118 static cpp_options *cpp_option = NULL;
 119 static cpp_reader *cpp_in = NULL;
 120
 121 /* Encapsulates state used to convert a stream of cpp-tokens into
 122    a text file.  */
 123 static struct
 124 {
 125   FILE *outf;                   /* Stream to write to.  */
 126   const cpp_token *prev;        /* Previous token.  */
 127   const cpp_token *source;      /* Source token for spacing.  */
 128   int src_line;                 /* Line number currently being written.  */
 129   unsigned char printed;        /* Nonzero if something output at line.  */
 130   bool first_time;              /* cb_file_change hasn't been called yet.  */
 131 } print;
 132
 133 /* General output routines.  */
 134 static void scan_translation_unit (cpp_reader *);
 135 static void scan_translation_unit_trad (cpp_reader *);
 136
 137 /* Callback routines for the parser. Most of these are active only
 138    in specific modes.  */
 139 static void cb_file_change (cpp_reader *, const line_map_ordinary *);
 140 static void cb_line_change (cpp_reader *, const cpp_token *, int);
 141 static void cb_define (cpp_reader *, location_t, cpp_hashnode *);
 142 static void cb_undef (cpp_reader *, location_t, cpp_hashnode *);
 143 static void cb_def_pragma (cpp_reader *, location_t);
 144 static void cb_include (cpp_reader *, location_t, const unsigned char *,
 145                         const char *, int, const cpp_token **);
 146 static void cb_ident (cpp_reader *, location_t, const cpp_string *);
 147 static void cb_used_define (cpp_reader *, location_t, cpp_hashnode *);
 148 static void cb_used_undef (cpp_reader *, location_t, cpp_hashnode *);
 149 static bool cb_cpp_diagnostic (cpp_reader *, enum cpp_diagnostic_level,
 150                                enum cpp_warning_reason, rich_location *,
 151                                const char *, va_list *)
 152      ATTRIBUTE_GCC_DIAG(5,0);
 153 void pp_dir_change (cpp_reader *, const char *);
 154
 155 static int dump_macro (cpp_reader *, cpp_hashnode *, void *);
 156 static void dump_queued_macros (cpp_reader *);
 157
 158
 159 static void
 160 cpp_define_builtins (cpp_reader *pfile)
 161 {
 162   /* Initialize CPP built-ins; '1' corresponds to 'flag_hosted'
 163      in C, defines __STDC_HOSTED__?!  */
 164   cpp_init_builtins (pfile, 0);
 165
 166   /* Initialize GFORTRAN specific builtins.
 167      These are documented.  */
 168   define_language_independent_builtin_macros (pfile);
 169   cpp_define (pfile, "__GFORTRAN__=1");
 170   cpp_define (pfile, "_LANGUAGE_FORTRAN=1");
 171
 172   if (flag_openacc)
 173     cpp_define (pfile, "_OPENACC=201711");
 174
 175   if (flag_openmp)
 176     cpp_define (pfile, "_OPENMP=201511");
 177
 178   /* The defines below are necessary for the TARGET_* macros.
 179
 180      FIXME:  Note that builtin_define_std() actually is a function
 181      in c-cppbuiltin.c which uses flags undefined for Fortran.
 182      Let's skip this for now. If needed, one needs to look into it
 183      once more.  */
 184
 185 # define builtin_define(TXT) cpp_define (pfile, TXT)
 186 # define builtin_define_std(TXT)
 187 # define builtin_assert(TXT) cpp_assert (pfile, TXT)
 188
 189   /* FIXME: Pandora's Box
 190     Using the macros below results in multiple breakages:
 191      - mingw will fail to compile this file as dependent macros
 192        assume to be used in c-cppbuiltin.c only. Further, they use
 193        flags only valid/defined in C (same as noted above).
 194        [config/i386/mingw32.h, config/i386/cygming.h]
 195      - other platforms (not as popular) break similarly
 196        [grep for 'builtin_define_with_int_value' in gcc/config/]
 197
 198   TARGET_CPU_CPP_BUILTINS ();
 199   TARGET_OS_CPP_BUILTINS ();
 200   TARGET_OBJFMT_CPP_BUILTINS (); */
 201
 202 #undef builtin_define
 203 #undef builtin_define_std
 204 #undef builtin_assert
 205 }
 206
 207 bool
 208 gfc_cpp_enabled (void)
 209 {
 210   return gfc_cpp_option.temporary_filename != NULL;
 211 }
 212
 213 bool
 214 gfc_cpp_preprocess_only (void)
 215 {
 216   return gfc_cpp_option.preprocess_only;
 217 }
 218
 219 bool
 220 gfc_cpp_makedep (void)
 221 {
 222   return gfc_cpp_option.deps;
 223 }
 224
 225 void
 226 gfc_cpp_add_dep (const char *name, bool system)
 227 {
 228   if (!gfc_cpp_option.deps_skip_system || !system)
 229     if (mkdeps *deps = cpp_get_deps (cpp_in))
 230       deps_add_dep (deps, name);
 231 }
 232
 233 void
 234 gfc_cpp_add_target (const char *name)
 235 {
 236   if (mkdeps *deps = cpp_get_deps (cpp_in))
 237     deps_add_target (deps, name, 0);
 238 }
 239
 240
 241 const char *
 242 gfc_cpp_temporary_file (void)
 243 {
 244   return gfc_cpp_option.temporary_filename;
 245 }
 246
 247 static void
 248 gfc_cpp_register_include_paths (bool verbose_missing_dir_warn)
 249 {
 250   int cxx_stdinc = 0;
 251   cpp_get_options (cpp_in)->warn_missing_include_dirs
 252     = (global_options.x_cpp_warn_missing_include_dirs
 253        && verbose_missing_dir_warn);
 254   register_include_chains (cpp_in, gfc_cpp_option.sysroot,
 255                            gfc_cpp_option.prefix, gfc_cpp_option.multilib,
 256                            gfc_cpp_option.standard_include_paths, cxx_stdinc,
 257                            gfc_cpp_option.verbose);
 258 }
 259
 260 void
 261 gfc_cpp_init_options (unsigned int decoded_options_count,
 262                       struct cl_decoded_option *decoded_options ATTRIBUTE_UNUSED)
 263 {
 264   /* Do not create any objects from libcpp here. If no
 265      preprocessing is requested, this would be wasted
 266      time and effort.
 267
 268      See gfc_cpp_post_options() instead.  */
 269
 270   gfc_cpp_option.temporary_filename = NULL;
 271   gfc_cpp_option.output_filename = NULL;
 272   gfc_cpp_option.preprocess_only = 0;
 273   gfc_cpp_option.discard_comments = 1;
 274   gfc_cpp_option.discard_comments_in_macro_exp = 1;
 275   gfc_cpp_option.print_include_names = 0;
 276   gfc_cpp_option.no_line_commands = 0;
 277   gfc_cpp_option.dump_macros = '\0';
 278   gfc_cpp_option.dump_includes = 0;
 279   gfc_cpp_option.working_directory = -1;
 280   gfc_cpp_option.no_predefined = 0;
 281   gfc_cpp_option.standard_include_paths = 1;
 282   gfc_cpp_option.verbose = 0;
 283   gfc_cpp_option.warn_date_time = 0;
 284   gfc_cpp_option.deps = 0;
 285   gfc_cpp_option.deps_skip_system = 0;
 286   gfc_cpp_option.deps_phony = 0;
 287   gfc_cpp_option.deps_missing_are_generated = 0;
 288   gfc_cpp_option.deps_filename = NULL;
 289   gfc_cpp_option.deps_filename_user = NULL;
 290
 291   gfc_cpp_option.multilib = NULL;
 292   gfc_cpp_option.prefix = NULL;
 293   gfc_cpp_option.sysroot = TARGET_SYSTEM_ROOT;
 294
 295   gfc_cpp_option.deferred_opt = XNEWVEC (gfc_cpp_deferred_opt_t,
 296                                          decoded_options_count);
 297   gfc_cpp_option.deferred_opt_count = 0;
 298 }
 299
 300 int
 301 gfc_cpp_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED)
 302 {
 303   int result = 1;
 304   enum opt_code code = (enum opt_code) scode;
 305
 306   switch (code)
 307   {
 308     default:
 309       result = 0;
 310       break;
 311
 312     case OPT_cpp_:
 313       gfc_cpp_option.temporary_filename = arg;
 314       break;
 315
 316     case OPT_nocpp:
 317       gfc_cpp_option.temporary_filename = 0L;
 318       break;
 319
 320     case OPT_d:
 321       for ( ; *arg; ++arg)
 322         switch (*arg)
 323         {
 324           case 'D':
 325           case 'M':
 326           case 'N':
 327           case 'U':
 328             gfc_cpp_option.dump_macros = *arg;
 329             break;
 330
 331           case 'I':
 332             gfc_cpp_option.dump_includes = 1;
 333             break;
 334         }
 335       break;
 336
 337     case OPT_fworking_directory:
 338       gfc_cpp_option.working_directory = value;
 339       break;
 340
 341     case OPT_idirafter:
 342       gfc_cpp_add_include_path_after (xstrdup(arg), true);
 343       break;
 344
 345     case OPT_imultilib:
 346       gfc_cpp_option.multilib = arg;
 347       break;
 348
 349     case OPT_iprefix:
 350       gfc_cpp_option.prefix = arg;
 351       break;
 352
 353     case OPT_isysroot:
 354       gfc_cpp_option.sysroot = arg;
 355       break;
 356
 357     case OPT_iquote:
 358     case OPT_isystem:
 359       gfc_cpp_add_include_path (xstrdup(arg), true);
 360       break;
 361
 362     case OPT_nostdinc:
 363       gfc_cpp_option.standard_include_paths = value;
 364       break;
 365
 366     case OPT_o:
 367       if (!gfc_cpp_option.output_filename)
 368         gfc_cpp_option.output_filename = arg;
 369       else
 370         gfc_fatal_error ("output filename specified twice");
 371       break;
 372
 373     case OPT_undef:
 374       gfc_cpp_option.no_predefined = value;
 375       break;
 376
 377     case OPT_v:
 378       gfc_cpp_option.verbose = value;
 379       break;
 380
 381     case OPT_Wdate_time:
 382       gfc_cpp_option.warn_date_time = value;
 383       break;
 384
 385     case OPT_A:
 386     case OPT_D:
 387     case OPT_U:
 388       gfc_cpp_option.deferred_opt[gfc_cpp_option.deferred_opt_count].code = code;
 389       gfc_cpp_option.deferred_opt[gfc_cpp_option.deferred_opt_count].arg = arg;
 390       gfc_cpp_option.deferred_opt_count++;
 391       break;
 392
 393     case OPT_C:
 394       gfc_cpp_option.discard_comments = 0;
 395       break;
 396
 397     case OPT_CC:
 398       gfc_cpp_option.discard_comments = 0;
 399       gfc_cpp_option.discard_comments_in_macro_exp = 0;
 400       break;
 401
 402     case OPT_E:
 403       gfc_cpp_option.preprocess_only = 1;
 404       break;
 405
 406     case OPT_H:
 407       gfc_cpp_option.print_include_names = 1;
 408       break;
 409
 410     case OPT_MM:
 411       gfc_cpp_option.deps_skip_system = 1;
 412       /* fall through */
 413
 414     case OPT_M:
 415       gfc_cpp_option.deps = 1;
 416       break;
 417
 418     case OPT_MMD:
 419       gfc_cpp_option.deps_skip_system = 1;
 420       /* fall through */
 421
 422     case OPT_MD:
 423       gfc_cpp_option.deps = 1;
 424       gfc_cpp_option.deps_filename = arg;
 425       break;
 426
 427     case OPT_MF:
 428       /* If specified multiple times, last one wins.  */
 429       gfc_cpp_option.deps_filename_user = arg;
 430       break;
 431
 432     case OPT_MG:
 433       gfc_cpp_option.deps_missing_are_generated = 1;
 434       break;
 435
 436     case OPT_MP:
 437       gfc_cpp_option.deps_phony = 1;
 438       break;
 439
 440     case OPT_MQ:
 441     case OPT_MT:
 442       gfc_cpp_option.deferred_opt[gfc_cpp_option.deferred_opt_count].code = code;
 443       gfc_cpp_option.deferred_opt[gfc_cpp_option.deferred_opt_count].arg = arg;
 444       gfc_cpp_option.deferred_opt_count++;
 445       break;
 446
 447     case OPT_P:
 448       gfc_cpp_option.no_line_commands = 1;
 449       break;
 450   }
 451
 452   return result;
 453 }
 454
 455 /* This function needs to be called before gfc_cpp_register_include_paths
 456    as the latter may diagnose missing include directories.  */
 457 static void
 458 gfc_cpp_init_cb (void)
 459 {
 460   struct cpp_callbacks *cb;
 461
 462   cb = cpp_get_callbacks (cpp_in);
 463   cb->file_change = cb_file_change;
 464   cb->line_change = cb_line_change;
 465   cb->ident = cb_ident;
 466   cb->def_pragma = cb_def_pragma;
 467   cb->diagnostic = cb_cpp_diagnostic;
 468
 469   if (gfc_cpp_option.dump_includes)
 470     cb->include = cb_include;
 471
 472   if ((gfc_cpp_option.dump_macros == 'D')
 473       || (gfc_cpp_option.dump_macros == 'N'))
 474     {
 475       cb->define = cb_define;
 476       cb->undef  = cb_undef;
 477     }
 478
 479   if (gfc_cpp_option.dump_macros == 'U')
 480     {
 481       cb->before_define = dump_queued_macros;
 482       cb->used_define = cb_used_define;
 483       cb->used_undef = cb_used_undef;
 484     }
 485 }
 486
 487 void
 488 gfc_cpp_post_options (bool verbose_missing_dir_warn)
 489 {
 490   /* Any preprocessing-related option without '-cpp' is considered
 491      an error.  */
 492   if (!gfc_cpp_enabled ()
 493       && (gfc_cpp_preprocess_only ()
 494           || gfc_cpp_makedep ()
 495           || !gfc_cpp_option.discard_comments
 496           || !gfc_cpp_option.discard_comments_in_macro_exp
 497           || gfc_cpp_option.print_include_names
 498           || gfc_cpp_option.no_line_commands
 499           || gfc_cpp_option.dump_macros
 500           || gfc_cpp_option.dump_includes))
 501     gfc_fatal_error ("To enable preprocessing, use %<-cpp%>");
 502
 503   if (!gfc_cpp_enabled ())
 504     return;
 505
 506   cpp_in = cpp_create_reader (CLK_GNUC89, NULL, line_table);
 507   gcc_assert (cpp_in);
 508
 509   /* The cpp_options-structure defines far more flags than those set here.
 510      If any other is implemented, see c-opt.c (sanitize_cpp_opts) for
 511      inter-option dependencies that may need to be enforced.  */
 512   cpp_option = cpp_get_options (cpp_in);
 513   gcc_assert (cpp_option);
 514
 515   /* TODO: allow non-traditional modes, e.g. by -cpp-std=...?  */
 516   cpp_option->traditional = 1;
 517   cpp_option->cplusplus_comments = 0;
 518
 519   cpp_option->cpp_pedantic = pedantic;
 520
 521   cpp_option->dollars_in_ident = flag_dollar_ok;
 522   cpp_option->discard_comments = gfc_cpp_option.discard_comments;
 523   cpp_option->discard_comments_in_macro_exp = gfc_cpp_option.discard_comments_in_macro_exp;
 524   cpp_option->print_include_names = gfc_cpp_option.print_include_names;
 525   cpp_option->preprocessed = gfc_option.flag_preprocessed;
 526   cpp_option->warn_date_time = gfc_cpp_option.warn_date_time;
 527
 528   if (gfc_cpp_makedep ())
 529     {
 530       cpp_option->deps.style = DEPS_USER;
 531       cpp_option->deps.phony_targets = gfc_cpp_option.deps_phony;
 532       cpp_option->deps.missing_files = gfc_cpp_option.deps_missing_are_generated;
 533
 534       /* -MF <arg> overrides -M[M]D.  */
 535       if (gfc_cpp_option.deps_filename_user)
 536         gfc_cpp_option.deps_filename = gfc_cpp_option.deps_filename_user;
 537   }
 538
 539   if (gfc_cpp_option.working_directory == -1)
 540     gfc_cpp_option.working_directory = (debug_info_level != DINFO_LEVEL_NONE);
 541
 542   cpp_post_options (cpp_in);
 543
 544
 545   /* Let diagnostics infrastructure know how to convert input files the same
 546      way libcpp will do it, namely, with no charset conversion but with
 547      skipping of a UTF-8 BOM if present.  */
 548   diagnostic_initialize_input_context (global_dc, nullptr, true);
 549   gfc_cpp_init_cb ();
 550
 551   gfc_cpp_register_include_paths (verbose_missing_dir_warn);
 552 }
 553
 554
 555 void
 556 gfc_cpp_init_0 (void)
 557 {
 558   /* Initialize the print structure.  Setting print.src_line to -1 here is
 559      a trick to guarantee that the first token of the file will cause
 560      a linemarker to be output by maybe_print_line.  */
 561   print.src_line = -1;
 562   print.printed = 0;
 563   print.prev = 0;
 564   print.first_time = 1;
 565
 566   if (gfc_cpp_preprocess_only ())
 567     {
 568       if (gfc_cpp_option.output_filename)
 569         {
 570           /* This needs cheating: with "-E -o <file>", the user wants the
 571              preprocessed output in <file>. However, if nothing is done
 572              about it <file> is also used for assembler output. Hence, it
 573              is necessary to redirect assembler output (actually nothing
 574              as -E implies -fsyntax-only) to another file, otherwise the
 575              output from preprocessing is lost.  */
 576           asm_file_name = gfc_cpp_option.temporary_filename;
 577
 578           print.outf = fopen (gfc_cpp_option.output_filename, "w");
 579           if (print.outf == NULL)
 580             gfc_fatal_error ("opening output file %qs: %s",
 581                              gfc_cpp_option.output_filename,
 582                              xstrerror (errno));
 583         }
 584       else
 585         print.outf = stdout;
 586     }
 587   else
 588     {
 589       print.outf = fopen (gfc_cpp_option.temporary_filename, "w");
 590       if (print.outf == NULL)
 591         gfc_fatal_error ("opening output file %qs: %s",
 592                          gfc_cpp_option.temporary_filename, xstrerror (errno));
 593     }
 594
 595   gcc_assert(cpp_in);
 596   if (!cpp_read_main_file (cpp_in, gfc_source_file))
 597     errorcount++;
 598 }
 599
 600 void
 601 gfc_cpp_init (void)
 602 {
 603   int i;
 604
 605   if (gfc_option.flag_preprocessed)
 606     return;
 607
 608   cpp_change_file (cpp_in, LC_RENAME, _("<built-in>"));
 609   if (!gfc_cpp_option.no_predefined)
 610     {
 611       /* Make sure all of the builtins about to be declared have
 612         BUILTINS_LOCATION has their location_t.  */
 613       cpp_force_token_locations (cpp_in, BUILTINS_LOCATION);
 614
 615       cpp_define_builtins (cpp_in);
 616
 617       cpp_stop_forcing_token_locations (cpp_in);
 618     }
 619
 620   /* Handle deferred options from command-line.  */
 621   cpp_change_file (cpp_in, LC_RENAME, _("<command-line>"));
 622
 623   for (i = 0; i < gfc_cpp_option.deferred_opt_count; i++)
 624     {
 625       gfc_cpp_deferred_opt_t *opt = &gfc_cpp_option.deferred_opt[i];
 626
 627       if (opt->code == OPT_D)
 628         cpp_define (cpp_in, opt->arg);
 629       else if (opt->code == OPT_U)
 630         cpp_undef (cpp_in, opt->arg);
 631       else if (opt->code == OPT_A)
 632         {
 633           if (opt->arg[0] == '-')
 634             cpp_unassert (cpp_in, opt->arg + 1);
 635           else
 636             cpp_assert (cpp_in, opt->arg);
 637         }
 638       else if (opt->code == OPT_MT || opt->code == OPT_MQ)
 639         if (mkdeps *deps = cpp_get_deps (cpp_in))
 640           deps_add_target (deps, opt->arg, opt->code == OPT_MQ);
 641     }
 642
 643   /* Pre-defined macros for non-required INTEGER kind types.  */
 644   for (gfc_integer_info *itype = gfc_integer_kinds; itype->kind != 0; itype++)
 645     {
 646       if (itype->kind == 1)
 647         cpp_define (cpp_in, "__GFC_INT_1__=1");
 648       if (itype->kind == 2)
 649         cpp_define (cpp_in, "__GFC_INT_2__=1");
 650       if (itype->kind == 8)
 651         cpp_define (cpp_in, "__GFC_INT_8__=1");
 652       if (itype->kind == 16)
 653         cpp_define (cpp_in, "__GFC_INT_16__=1");
 654     }
 655
 656   /* Pre-defined macros for non-required REAL kind types.  */
 657   for (gfc_real_info *rtype = gfc_real_kinds; rtype->kind != 0; rtype++)
 658     {
 659       if (rtype->kind == 10)
 660         cpp_define (cpp_in, "__GFC_REAL_10__=1");
 661       if (rtype->kind == 16)
 662         cpp_define (cpp_in, "__GFC_REAL_16__=1");
 663     }
 664
 665   if (gfc_cpp_option.working_directory
 666       && gfc_cpp_option.preprocess_only && !gfc_cpp_option.no_line_commands)
 667     pp_dir_change (cpp_in, get_src_pwd ());
 668 }
 669
 670 bool
 671 gfc_cpp_preprocess (const char *source_file)
 672 {
 673   if (!gfc_cpp_enabled ())
 674     return false;
 675
 676   cpp_change_file (cpp_in, LC_RENAME, source_file);
 677
 678   if (cpp_option->traditional)
 679     scan_translation_unit_trad (cpp_in);
 680   else
 681     scan_translation_unit (cpp_in);
 682
 683   /* -dM command line option.  */
 684   if (gfc_cpp_preprocess_only () &&
 685       gfc_cpp_option.dump_macros == 'M')
 686     {
 687       putc ('\n', print.outf);
 688       cpp_forall_identifiers (cpp_in, dump_macro, NULL);
 689     }
 690
 691   putc ('\n', print.outf);
 692
 693   if (!gfc_cpp_preprocess_only ()
 694       || (gfc_cpp_preprocess_only () && gfc_cpp_option.output_filename))
 695     fclose (print.outf);
 696
 697   return true;
 698 }
 699
 700 void
 701 gfc_cpp_done (void)
 702 {
 703   if (!gfc_cpp_enabled ())
 704     return;
 705
 706   gcc_assert (cpp_in);
 707
 708   if (gfc_cpp_makedep ())
 709     {
 710       if (gfc_cpp_option.deps_filename)
 711         {
 712           FILE *f = fopen (gfc_cpp_option.deps_filename, "w");
 713           if (f)
 714             {
 715               cpp_finish (cpp_in, f);
 716               fclose (f);
 717             }
 718           else
 719             gfc_fatal_error ("opening output file %qs: %s",
 720                              gfc_cpp_option.deps_filename,
 721                              xstrerror (errno));
 722         }
 723       else
 724         cpp_finish (cpp_in, stdout);
 725     }
 726
 727   cpp_undef_all (cpp_in);
 728   cpp_clear_file_cache (cpp_in);
 729 }
 730
 731 /* PATH must be malloc-ed and NULL-terminated.  */
 732 void
 733 gfc_cpp_add_include_path (char *path, bool user_supplied)
 734 {
 735   /* CHAIN sets cpp_dir->sysp which differs from 0 if PATH is a system
 736      include path. Fortran does not define any system include paths.  */
 737   int cxx_aware = 0;
 738
 739   add_path (path, INC_BRACKET, cxx_aware, user_supplied);
 740 }
 741
 742 void
 743 gfc_cpp_add_include_path_after (char *path, bool user_supplied)
 744 {
 745   int cxx_aware = 0;
 746   add_path (path, INC_AFTER, cxx_aware, user_supplied);
 747 }
 748
 749
 750 static void scan_translation_unit_trad (cpp_reader *);
 751 static void account_for_newlines (const unsigned char *, size_t);
 752 static int dump_macro (cpp_reader *, cpp_hashnode *, void *);
 753
 754 static void print_line (location_t, const char *);
 755 static void maybe_print_line (location_t);
 756
 757
 758 /* Writes out the preprocessed file, handling spacing and paste
 759    avoidance issues.  */
 760 static void
 761 scan_translation_unit (cpp_reader *pfile)
 762 {
 763   bool avoid_paste = false;
 764
 765   print.source = NULL;
 766   for (;;)
 767     {
 768       const cpp_token *token = cpp_get_token (pfile);
 769
 770       if (token->type == CPP_PADDING)
 771         {
 772           avoid_paste = true;
 773           if (print.source == NULL
 774               || (!(print.source->flags & PREV_WHITE)
 775                   && token->val.source == NULL))
 776             print.source = token->val.source;
 777           continue;
 778         }
 779
 780       if (token->type == CPP_EOF)
 781         break;
 782
 783       /* Subtle logic to output a space if and only if necessary.  */
 784       if (avoid_paste)
 785         {
 786           if (print.source == NULL)
 787             print.source = token;
 788           if (print.source->flags & PREV_WHITE
 789               || (print.prev
 790                   && cpp_avoid_paste (pfile, print.prev, token))
 791               || (print.prev == NULL && token->type == CPP_HASH))
 792             putc (' ', print.outf);
 793         }
 794       else if (token->flags & PREV_WHITE)
 795         putc (' ', print.outf);
 796
 797       avoid_paste = false;
 798       print.source = NULL;
 799       print.prev = token;
 800       cpp_output_token (token, print.outf);
 801
 802       if (token->type == CPP_COMMENT)
 803         account_for_newlines (token->val.str.text, token->val.str.len);
 804     }
 805 }
 806
 807 /* Adjust print.src_line for newlines embedded in output.  */
 808 static void
 809 account_for_newlines (const unsigned char *str, size_t len)
 810 {
 811   while (len--)
 812     if (*str++ == '\n')
 813       print.src_line++;
 814 }
 815
 816 /* Writes out a traditionally preprocessed file.  */
 817 static void
 818 scan_translation_unit_trad (cpp_reader *pfile)
 819 {
 820   while (_cpp_read_logical_line_trad (pfile))
 821     {
 822       size_t len = pfile->out.cur - pfile->out.base;
 823       maybe_print_line (pfile->out.first_line);
 824       fwrite (pfile->out.base, 1, len, print.outf);
 825       print.printed = 1;
 826       if (!CPP_OPTION (pfile, discard_comments))
 827         account_for_newlines (pfile->out.base, len);
 828     }
 829 }
 830
 831 /* If the token read on logical line LINE needs to be output on a
 832    different line to the current one, output the required newlines or
 833    a line marker.  */
 834 static void
 835 maybe_print_line (location_t src_loc)
 836 {
 837   const line_map_ordinary *map
 838     = linemap_check_ordinary (linemap_lookup (line_table, src_loc));
 839   int src_line = SOURCE_LINE (map, src_loc);
 840
 841   /* End the previous line of text.  */
 842   if (print.printed)
 843     {
 844       putc ('\n', print.outf);
 845       print.src_line++;
 846       print.printed = 0;
 847     }
 848
 849   if (src_line >= print.src_line && src_line < print.src_line + 8)
 850     {
 851       while (src_line > print.src_line)
 852         {
 853           putc ('\n', print.outf);
 854           print.src_line++;
 855         }
 856     }
 857   else
 858     print_line (src_loc, "");
 859 }
 860
 861 /* Output a line marker for logical line LINE.  Special flags are "1"
 862    or "2" indicating entering or leaving a file.  */
 863 static void
 864 print_line (location_t src_loc, const char *special_flags)
 865 {
 866   /* End any previous line of text.  */
 867   if (print.printed)
 868     putc ('\n', print.outf);
 869   print.printed = 0;
 870
 871   if (!gfc_cpp_option.no_line_commands)
 872     {
 873       expanded_location loc;
 874       size_t to_file_len;
 875       unsigned char *to_file_quoted;
 876       unsigned char *p;
 877       int sysp;
 878
 879       loc = expand_location (src_loc);
 880       to_file_len = strlen (loc.file);
 881       to_file_quoted = (unsigned char *) alloca (to_file_len * 4 + 1);
 882
 883       print.src_line = loc.line;
 884
 885       /* cpp_quote_string does not nul-terminate, so we have to do it
 886          ourselves.  */
 887       p = cpp_quote_string (to_file_quoted,
 888                             (const unsigned char *) loc.file, to_file_len);
 889       *p = '\0';
 890       fprintf (print.outf, "# %u \"%s\"%s",
 891                print.src_line == 0 ? 1 : print.src_line,
 892                to_file_quoted, special_flags);
 893
 894       sysp = in_system_header_at (src_loc);
 895       if (sysp == 2)
 896         fputs (" 3 4", print.outf);
 897       else if (sysp == 1)
 898         fputs (" 3", print.outf);
 899
 900       putc ('\n', print.outf);
 901     }
 902 }
 903
 904 static void
 905 cb_file_change (cpp_reader * ARG_UNUSED (pfile), const line_map_ordinary *map)
 906 {
 907   const char *flags = "";
 908
 909   if (gfc_cpp_option.no_line_commands)
 910     return;
 911
 912   if (!map)
 913     return;
 914
 915       if (print.first_time)
 916         {
 917           /* Avoid printing foo.i when the main file is foo.c.  */
 918           if (!cpp_get_options (cpp_in)->preprocessed)
 919             print_line (map->start_location, flags);
 920           print.first_time = 0;
 921         }
 922       else
 923         {
 924           /* Bring current file to correct line when entering a new file.  */
 925           if (map->reason == LC_ENTER)
 926             maybe_print_line (linemap_included_from (map));
 927           if (map->reason == LC_ENTER)
 928             flags = " 1";
 929           else if (map->reason == LC_LEAVE)
 930             flags = " 2";
 931           print_line (map->start_location, flags);
 932         }
 933
 934 }
 935
 936 /* Called when a line of output is started.  TOKEN is the first token
 937    of the line, and at end of file will be CPP_EOF.  */
 938 static void
 939 cb_line_change (cpp_reader *pfile, const cpp_token *token,
 940                 int parsing_args)
 941 {
 942   location_t src_loc = token->src_loc;
 943
 944   if (token->type == CPP_EOF || parsing_args)
 945     return;
 946
 947   maybe_print_line (src_loc);
 948   print.prev = 0;
 949   print.source = 0;
 950
 951   /* Supply enough spaces to put this token in its original column,
 952      one space per column greater than 2, since scan_translation_unit
 953      will provide a space if PREV_WHITE.  Don't bother trying to
 954      reconstruct tabs; we can't get it right in general, and nothing
 955      ought to care.  Some things do care; the fault lies with them.  */
 956   if (!CPP_OPTION (pfile, traditional))
 957     {
 958       const line_map_ordinary *map
 959         = linemap_check_ordinary (linemap_lookup (line_table, src_loc));
 960       int spaces = SOURCE_COLUMN (map, src_loc) - 2;
 961       print.printed = 1;
 962
 963       while (-- spaces >= 0)
 964         putc (' ', print.outf);
 965     }
 966 }
 967
 968 static void
 969 cb_ident (cpp_reader *pfile ATTRIBUTE_UNUSED, location_t line,
 970           const cpp_string *str)
 971 {
 972   maybe_print_line (line);
 973   fprintf (print.outf, "#ident %s\n", str->text);
 974   print.src_line++;
 975 }
 976
 977 static void
 978 cb_define (cpp_reader *pfile ATTRIBUTE_UNUSED, location_t line,
 979            cpp_hashnode *node ATTRIBUTE_UNUSED)
 980 {
 981   maybe_print_line (line);
 982   fputs ("#define ", print.outf);
 983
 984   /* 'D' is whole definition; 'N' is name only.  */
 985   if (gfc_cpp_option.dump_macros == 'D')
 986     fputs ((const char *) cpp_macro_definition (pfile, node),
 987            print.outf);
 988   else
 989     fputs ((const char *) NODE_NAME (node), print.outf);
 990
 991   putc ('\n', print.outf);
 992   if (LOCATION_LINE (line) != 0)
 993     print.src_line++;
 994 }
 995
 996 static void
 997 cb_undef (cpp_reader *pfile ATTRIBUTE_UNUSED, location_t line,
 998           cpp_hashnode *node)
 999 {
1000   maybe_print_line (line);
1001   fprintf (print.outf, "#undef %s\n", NODE_NAME (node));
1002   print.src_line++;
1003 }
1004
1005 static void
1006 cb_include (cpp_reader *pfile ATTRIBUTE_UNUSED, location_t line,
1007             const unsigned char *dir, const char *header, int angle_brackets,
1008             const cpp_token **comments)
1009 {
1010   maybe_print_line (line);
1011   if (angle_brackets)
1012     fprintf (print.outf, "#%s <%s>", dir, header);
1013   else
1014     fprintf (print.outf, "#%s \"%s\"", dir, header);
1015
1016   if (comments != NULL)
1017     {
1018       while (*comments != NULL)
1019         {
1020           if ((*comments)->flags & PREV_WHITE)
1021             putc (' ', print.outf);
1022           cpp_output_token (*comments, print.outf);
1023           ++comments;
1024         }
1025     }
1026
1027   putc ('\n', print.outf);
1028   print.src_line++;
1029 }
1030
1031 /* Dump out the hash table.  */
1032 static int
1033 dump_macro (cpp_reader *pfile, cpp_hashnode *node, void *v ATTRIBUTE_UNUSED)
1034 {
1035   if (cpp_user_macro_p (node))
1036     {
1037       fputs ("#define ", print.outf);
1038       fputs ((const char *) cpp_macro_definition (pfile, node),
1039              print.outf);
1040       putc ('\n', print.outf);
1041       print.src_line++;
1042     }
1043
1044   return 1;
1045 }
1046
1047 static void
1048 cb_used_define (cpp_reader *pfile, location_t line ATTRIBUTE_UNUSED,
1049                 cpp_hashnode *node)
1050 {
1051   gfc_cpp_macro_queue *q;
1052   q = XNEW (gfc_cpp_macro_queue);
1053   q->macro = xstrdup ((const char *) cpp_macro_definition (pfile, node));
1054   q->next = cpp_define_queue;
1055   cpp_define_queue = q;
1056 }
1057
1058 /* Return the gcc option code associated with the reason for a cpp
1059    message, or 0 if none.  */
1060
1061 static int
1062 cb_cpp_diagnostic_cpp_option (enum cpp_warning_reason reason)
1063 {
1064   const struct cpp_reason_option_codes_t *entry;
1065
1066   for (entry = cpp_reason_option_codes; entry->reason != CPP_W_NONE; entry++)
1067     if (entry->reason == reason)
1068       return entry->option_code;
1069   return 0;
1070 }
1071
1072
1073 /* Callback from cpp_error for PFILE to print diagnostics from the
1074    preprocessor.  The diagnostic is of type LEVEL, with REASON set
1075    to the reason code if LEVEL is represents a warning, at location
1076    RICHLOC; MSG is the translated message and AP the arguments.
1077    Returns true if a diagnostic was emitted, false otherwise.  */
1078
1079 static bool
1080 cb_cpp_diagnostic (cpp_reader *pfile ATTRIBUTE_UNUSED,
1081                    enum cpp_diagnostic_level level,
1082                    enum cpp_warning_reason reason,
1083                    rich_location *richloc,
1084                    const char *msg, va_list *ap)
1085 {
1086   diagnostic_info diagnostic;
1087   diagnostic_t dlevel;
1088   bool save_warn_system_headers = global_dc->dc_warn_system_headers;
1089   bool ret;
1090
1091   switch (level)
1092     {
1093     case CPP_DL_WARNING_SYSHDR:
1094       global_dc->dc_warn_system_headers = 1;
1095       /* Fall through.  */
1096     case CPP_DL_WARNING:
1097       dlevel = DK_WARNING;
1098       break;
1099     case CPP_DL_PEDWARN:
1100       dlevel = DK_PEDWARN;
1101       break;
1102     case CPP_DL_ERROR:
1103       dlevel = DK_ERROR;
1104       break;
1105     case CPP_DL_ICE:
1106       dlevel = DK_ICE;
1107       break;
1108     case CPP_DL_NOTE:
1109       dlevel = DK_NOTE;
1110       break;
1111     case CPP_DL_FATAL:
1112       dlevel = DK_FATAL;
1113       break;
1114     default:
1115       gcc_unreachable ();
1116     }
1117   diagnostic_set_info_translated (&diagnostic, msg, ap,
1118                                   richloc, dlevel);
1119   diagnostic_override_option_index (&diagnostic,
1120                                     cb_cpp_diagnostic_cpp_option (reason));
1121   ret = diagnostic_report_diagnostic (global_dc, &diagnostic);
1122   if (level == CPP_DL_WARNING_SYSHDR)
1123     global_dc->dc_warn_system_headers = save_warn_system_headers;
1124   return ret;
1125 }
1126
1127 /* Callback called when -fworking-director and -E to emit working
1128    directory in cpp output file.  */
1129
1130 void
1131 pp_dir_change (cpp_reader *pfile ATTRIBUTE_UNUSED, const char *dir)
1132 {
1133   size_t to_file_len = strlen (dir);
1134   unsigned char *to_file_quoted =
1135      (unsigned char *) alloca (to_file_len * 4 + 1);
1136   unsigned char *p;
1137
1138   /* cpp_quote_string does not nul-terminate, so we have to do it ourselves.  */
1139   p = cpp_quote_string (to_file_quoted, (const unsigned char *) dir, to_file_len);
1140   *p = '\0';
1141   fprintf (print.outf, "# 1 \"%s//\"\n", to_file_quoted);
1142 }
1143
1144 /* Copy a #pragma directive to the preprocessed output.  */
1145 static void
1146 cb_def_pragma (cpp_reader *pfile, location_t line)
1147 {
1148   maybe_print_line (line);
1149   fputs ("#pragma ", print.outf);
1150   cpp_output_line (pfile, print.outf);
1151   print.src_line++;
1152 }
1153
1154 static void
1155 cb_used_undef (cpp_reader *pfile ATTRIBUTE_UNUSED,
1156                location_t line ATTRIBUTE_UNUSED,
1157                cpp_hashnode *node)
1158 {
1159   gfc_cpp_macro_queue *q;
1160   q = XNEW (gfc_cpp_macro_queue);
1161   q->macro = xstrdup ((const char *) NODE_NAME (node));
1162   q->next = cpp_undefine_queue;
1163   cpp_undefine_queue = q;
1164 }
1165
1166 static void
1167 dump_queued_macros (cpp_reader *pfile ATTRIBUTE_UNUSED)
1168 {
1169   gfc_cpp_macro_queue *q;
1170
1171   /* End the previous line of text.  */
1172   if (print.printed)
1173     {
1174       putc ('\n', print.outf);
1175       print.src_line++;
1176       print.printed = 0;
1177     }
1178
1179   for (q = cpp_define_queue; q;)
1180     {
1181       gfc_cpp_macro_queue *oq;
1182       fputs ("#define ", print.outf);
1183       fputs (q->macro, print.outf);
1184       putc ('\n', print.outf);
1185       print.src_line++;
1186       oq = q;
1187       q = q->next;
1188       free (oq->macro);
1189       free (oq);
1190     }
1191   cpp_define_queue = NULL;
1192   for (q = cpp_undefine_queue; q;)
1193     {
1194       gfc_cpp_macro_queue *oq;
1195       fprintf (print.outf, "#undef %s\n", q->macro);
1196       print.src_line++;
1197       oq = q;
1198       q = q->next;
1199       free (oq->macro);
1200       free (oq);
1201     }
1202   cpp_undefine_queue = NULL;
1203 }