From 72d3915eadd1121d8b2f0be04fafc17e9232be81 Mon Sep 17 00:00:00 2001

From: Jim MacArthur <jim.macarthur@codethink.co.uk>

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 <francisco.marchena@codethink.co.uk>

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