Blob Blame History Raw
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