From 72d3915eadd1121d8b2f0be04fafc17e9232be81 Mon Sep 17 00:00:00 2001 From: Jim MacArthur Date: Thu, 5 Nov 2015 18:57:53 +0000 Subject: [PATCH 13/23] Allow per-variable kind specification. INTEGER*4 x*2, y*8 The per-variable sizes override the kind specified in the type. At the moment, you can follow this with an array specification, so INTEGER x*2(10) is OK, but not the other way round. This feature is enabled by the `-std=extra-legacy` compiler flag. --- 0013-Allow-per-variable-kind-specification.patch Allow per-variable kind specification. INTEGER*4 x*2, y*8 The per-variable sizes override the kind specified in the type. At the moment, you can follow this with an array specification, so INTEGER x*2(10) is OK, but not the other way round. This feature is enabled by the `-std=extra-legacy` compiler flag. Test written by: Francisco Redondo Marchena diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 3ad9c2c8b40..faa08d9c4bb 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1019,6 +1019,24 @@ syntax: return MATCH_ERROR; } +/* This matches the nonstandard kind given after a variable name, like: + INTEGER x*2, y*4 + The per-variable kind will override any kind given in the type + declaration. +*/ + +static match +match_per_symbol_kind (int *length) +{ + match m; + + m = gfc_match_char ('*'); + if (m != MATCH_YES) + return m; + + m = gfc_match_small_literal_int (length, NULL); + return m; +} /* Special subroutine for finding a symbol. Check if the name is found in the current name space. If not, and we're compiling a function or @@ -2193,10 +2211,13 @@ variable_decl (int elem) bool t; gfc_symbol *sym; match cl_match; + match kind_match; + int overridden_kind; initializer = NULL; as = NULL; cp_as = NULL; + kind_match = MATCH_NO; /* When we get here, we've just matched a list of attributes and maybe a type and a double colon. The next thing we expect to see @@ -2213,12 +2234,20 @@ variable_decl (int elem) cl_match = MATCH_NO; /* Check for a character length clause before an array clause */ - if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) - && current_ts.type == BT_CHARACTER) + if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) { - cl_match = match_character_length_clause (&cl, &cl_deferred, elem); - if (cl_match == MATCH_ERROR) - goto cleanup; + if (current_ts.type == BT_CHARACTER) + { + cl_match = match_character_length_clause (&cl, &cl_deferred, elem); + if (cl_match == MATCH_ERROR) + goto cleanup; + } + else + { + kind_match = match_per_symbol_kind (&overridden_kind); + if (kind_match == MATCH_ERROR) + goto cleanup; + } } /* Now we could see the optional array spec. or character length. */ @@ -2412,6 +2441,13 @@ variable_decl (int elem) goto cleanup; } + if (kind_match == MATCH_YES) + { + gfc_find_symbol (name, gfc_current_ns, 1, &sym); + /* sym *must* be found at this point */ + sym->ts.kind = overridden_kind; + } + if (!check_function_name (name)) { m = MATCH_ERROR; diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f new file mode 100644 index 00000000000..0341a176aca --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f @@ -0,0 +1,12 @@ +! { dg-do compile } +! { dg-options "-std=extra-legacy" } +! +! Test kind specification in variable not in type +! + PROGRAM spec_in_var + INTEGER ai*1/1/ + REAL ar*4/1.0/ + + if(ai.NE.1) STOP 1 + if(abs(ar - 1.0) > 1.0D-6) STOP 2 + END