|
 |
3db796 |
From 72d3915eadd1121d8b2f0be04fafc17e9232be81 Mon Sep 17 00:00:00 2001
|
|
|
3db796 |
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
|
3db796 |
Date: Thu, 5 Nov 2015 18:57:53 +0000
|
|
|
3db796 |
Subject: [PATCH 13/23] Allow per-variable kind specification.
|
|
|
3db796 |
|
|
|
3db796 |
INTEGER*4 x*2, y*8
|
|
|
3db796 |
|
|
|
3db796 |
The per-variable sizes override the kind specified in the type.
|
|
|
3db796 |
At the moment, you can follow this with an array specification, so
|
|
|
3db796 |
INTEGER x*2(10) is OK, but not the other way round.
|
|
|
3db796 |
|
|
|
3db796 |
This feature is enabled by the `-std=extra-legacy` compiler flag.
|
|
|
3db796 |
---
|
|
|
3db796 |
|
|
|
3db796 |
0013-Allow-per-variable-kind-specification.patch
|
|
|
3db796 |
|
|
|
3db796 |
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
|
|
|
3db796 |
index 3ad9c2c..832904a 100644
|
|
|
3db796 |
--- a/gcc/fortran/decl.c
|
|
|
3db796 |
+++ b/gcc/fortran/decl.c
|
|
|
3db796 |
@@ -1019,6 +1019,24 @@ syntax:
|
|
|
3db796 |
return MATCH_ERROR;
|
|
|
3db796 |
}
|
|
|
3db796 |
|
|
|
3db796 |
+/* This matches the nonstandard kind given after a variable name, like:
|
|
|
3db796 |
+ INTEGER x*2, y*4
|
|
|
3db796 |
+ The per-variable kind will override any kind given in the type
|
|
|
3db796 |
+ declaration.
|
|
|
3db796 |
+*/
|
|
|
3db796 |
+
|
|
|
3db796 |
+static match
|
|
|
3db796 |
+match_per_symbol_kind (int *length)
|
|
|
3db796 |
+{
|
|
|
3db796 |
+ match m;
|
|
|
3db796 |
+
|
|
|
3db796 |
+ m = gfc_match_char ('*');
|
|
|
3db796 |
+ if (m != MATCH_YES)
|
|
|
3db796 |
+ return m;
|
|
|
3db796 |
+
|
|
|
3db796 |
+ m = gfc_match_small_literal_int (length, NULL);
|
|
|
3db796 |
+ return m;
|
|
|
3db796 |
+}
|
|
|
3db796 |
|
|
|
3db796 |
/* Special subroutine for finding a symbol. Check if the name is found
|
|
|
3db796 |
in the current name space. If not, and we're compiling a function or
|
|
|
3db796 |
@@ -2193,10 +2211,13 @@ variable_decl (int elem)
|
|
|
3db796 |
bool t;
|
|
|
3db796 |
gfc_symbol *sym;
|
|
|
3db796 |
match cl_match;
|
|
|
3db796 |
+ match kind_match;
|
|
|
3db796 |
+ int overridden_kind;
|
|
|
3db796 |
|
|
|
3db796 |
initializer = NULL;
|
|
|
3db796 |
as = NULL;
|
|
|
3db796 |
cp_as = NULL;
|
|
|
3db796 |
+ kind_match = MATCH_NO;
|
|
|
3db796 |
|
|
|
3db796 |
/* When we get here, we've just matched a list of attributes and
|
|
|
3db796 |
maybe a type and a double colon. The next thing we expect to see
|
|
|
3db796 |
@@ -2216,9 +2237,18 @@ variable_decl (int elem)
|
|
|
3db796 |
if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
|
|
|
3db796 |
&& current_ts.type == BT_CHARACTER)
|
|
|
3db796 |
{
|
|
|
3db796 |
- cl_match = match_character_length_clause (&cl, &cl_deferred, elem);
|
|
|
3db796 |
- if (cl_match == MATCH_ERROR)
|
|
|
3db796 |
- goto cleanup;
|
|
|
3db796 |
+ if (current_ts.type == BT_CHARACTER)
|
|
|
3db796 |
+ {
|
|
|
3db796 |
+ cl_match = match_character_length_clause (&cl, &cl_deferred, elem);
|
|
|
3db796 |
+ if (cl_match == MATCH_ERROR)
|
|
|
3db796 |
+ goto cleanup;
|
|
|
3db796 |
+ }
|
|
|
3db796 |
+ else
|
|
|
3db796 |
+ {
|
|
|
3db796 |
+ kind_match = match_per_symbol_kind (&overridden_kind);
|
|
|
3db796 |
+ if (kind_match == MATCH_ERROR)
|
|
|
3db796 |
+ goto cleanup;
|
|
|
3db796 |
+ }
|
|
|
3db796 |
}
|
|
|
3db796 |
|
|
|
3db796 |
/* Now we could see the optional array spec. or character length. */
|
|
|
3db796 |
@@ -2412,6 +2442,13 @@ variable_decl (int elem)
|
|
|
3db796 |
goto cleanup;
|
|
|
3db796 |
}
|
|
|
3db796 |
|
|
|
3db796 |
+ if (kind_match == MATCH_YES)
|
|
|
3db796 |
+ {
|
|
|
3db796 |
+ gfc_find_symbol (name, gfc_current_ns, 1, &sym);
|
|
|
3db796 |
+ /* sym *must* be found at this point */
|
|
|
3db796 |
+ sym->ts.kind = overridden_kind;
|
|
|
3db796 |
+ }
|
|
|
3db796 |
+
|
|
|
3db796 |
if (!check_function_name (name))
|
|
|
3db796 |
{
|
|
|
3db796 |
m = MATCH_ERROR;
|