===================================================================
@@ -127,8 +127,8 @@ static bool no_backend;
#define MAX_LINE 75
/* Decoded options, and number of such options. */
-static struct cl_decoded_option *save_decoded_options;
-static unsigned int save_decoded_options_count;
+struct cl_decoded_option *save_decoded_options;
+unsigned int save_decoded_options_count;
/* Name of top-level original source file (what was input to cpp).
This comes from the #-command at the beginning of the actual input.
===================================================================
@@ -29,6 +29,11 @@ along with GCC; see the file COPYING3.
#define skip_leading_substring(whole, part) \
(strncmp (whole, part, strlen (part)) ? NULL : whole + strlen (part))
+/* Decoded options, and number of such options. */
+extern struct cl_decoded_option *save_decoded_options;
+extern unsigned int save_decoded_options_count;
+
+
extern int toplev_main (int, char **);
extern void strip_off_ending (char *, int);
extern void rest_of_decl_compilation (tree, int, int);
===================================================================
@@ -949,7 +949,20 @@ generic_correspondence (gfc_formal_argli
goto next;
if (f2 != NULL && compare_type_rank (f1->sym, f2->sym))
- goto next;
+ {
+ /* Fortran 2008, 12.4.3.4.5 adds more checks to distinguish
+ interfaces of generics procedures. */
+ if (!(gfc_option.allow_std & GFC_STD_F2008)
+ || !((f1->sym->attr.procedure && !f2->sym->attr.procedure)
+ || (!f1->sym->attr.procedure && f2->sym->attr.procedure)
+ || (f1->sym->attr.pointer && f2->sym->attr.allocatable)
+ || (f1->sym->attr.allocatable && f2->sym->attr.pointer)
+ || (f1->sym->attr.function && f1->sym->as
+ && f1->sym->as->rank && !f2->sym->attr.function)
+ || (f2->sym->attr.function && f2->sym->as
+ && f2->sym->as->rank && !f1->sym->attr.function)))
+ goto next;
+ }
/* Now search for a disambiguating keyword argument starting at
the current non-match. */
===================================================================
@@ -2403,6 +2403,7 @@ void gfc_init_options (unsigned int,
bool gfc_handle_option (size_t, const char *, int, int,
const struct cl_option_handlers *);
bool gfc_post_options (const char **);
+char *gfc_get_option_string (void);
/* f95-lang.c */
void gfc_maybe_initialize_eh (void);
===================================================================
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.
#include "flags.h"
#include "intl.h"
#include "opts.h"
+#include "toplev.h" /* For decoded options. */
#include "options.h"
#include "params.h"
#include "tree-inline.h"
@@ -966,3 +967,68 @@ gfc_handle_option (size_t scode, const c
return result;
}
+
+
+char *
+gfc_get_option_string (void)
+{
+ unsigned j;
+ size_t len, pos;
+ char *result;
+
+ /* Determine required string length. */
+
+ len = 0;
+ for (j = 1; j < save_decoded_options_count; j++)
+ {
+ switch (save_decoded_options[j].opt_index)
+ {
+ case OPT_o:
+ case OPT_d:
+ case OPT_dumpbase:
+ case OPT_dumpdir:
+ case OPT_auxbase:
+ case OPT_quiet:
+ case OPT_version:
+ case OPT_fintrinsic_modules_path:
+ /* Ignore these. */
+ continue;
+ }
+
+ /* Ignore file names. */
+ if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
+ len += 1 + strlen (save_decoded_options[j].orig_option_with_args_text);
+ }
+
+ result = (char *) gfc_getmem (len);
+
+ pos = 0;
+ for (j = 1; j < save_decoded_options_count; j++)
+ {
+ switch (save_decoded_options[j].opt_index)
+ {
+ case OPT_o:
+ case OPT_d:
+ case OPT_dumpbase:
+ case OPT_dumpdir:
+ case OPT_auxbase:
+ case OPT_quiet:
+ case OPT_version:
+ case OPT_fintrinsic_modules_path:
+ /* Ignore these. */
+ continue;
+ }
+
+ /* Ignore file names. */
+ if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
+ {
+ len = strlen (save_decoded_options[j].orig_option_with_args_text);
+ memcpy (&result[pos], save_decoded_options[j].orig_option_with_args_text, len);
+ pos += len;
+ result[pos++] = ' ';
+ }
+ }
+
+ result[--pos] = '\0';
+ return result;
+}
===================================================================
@@ -6739,9 +6739,14 @@ gfc_convert_char_constant (gfc_expr *e,
gfc_expr *
gfc_simplify_compiler_options (void)
{
- /* FIXME: PR40569 - return the proper compiler arguments. */
- return gfc_get_character_expr (gfc_default_character_kind,
- &gfc_current_locus, "", 0);
+ char *str;
+ gfc_expr *result;
+
+ str = gfc_get_option_string ();
+ result = gfc_get_character_expr (gfc_default_character_kind,
+ &gfc_current_locus, str, strlen (str));
+ gfc_free (str);
+ return result;
}