From: Erik Schnetter <schnetter@aei.mpg.de>
Date: Fri, 2 Dec 2005 01:25:58 +0000 (+0000)
Subject: decl.c (gfc_match_old_kind_spec): Improve handling of old style COMPLEX*N
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e45b3c75467600eafb89a989301d207da3f31650;p=gcc.git

decl.c (gfc_match_old_kind_spec): Improve handling of old style COMPLEX*N

2005-12-01  Erik Schnetter  <schnetter@aei.mpg.de>

	* decl.c (gfc_match_old_kind_spec):  Improve handling of old style
	COMPLEX*N

From-SVN: r107853
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f9fd567e785..ceec7b776fc 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2005-12-01  Erik Schnetter  <schnetter@aei.mpg.de>
+
+	* decl.c (gfc_match_old_kind_spec):  Improve handling of old style
+	COMPLEX*N
+
 2005-12-01  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/24789
@@ -19,7 +24,6 @@
 	* invoke.texi: Document -ffree-line-length- and
 	-ffree-line-length-none
 
-
 2005-11-30  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/15809
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 8352c527461..6f047341f3e 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1279,6 +1279,7 @@ match
 gfc_match_old_kind_spec (gfc_typespec * ts)
 {
   match m;
+  int original_kind;
 
   if (gfc_match_char ('*') != MATCH_YES)
     return MATCH_NO;
@@ -1287,17 +1288,24 @@ gfc_match_old_kind_spec (gfc_typespec * ts)
   if (m != MATCH_YES)
     return MATCH_ERROR;
 
+  original_kind = ts->kind;
+
   /* Massage the kind numbers for complex types.  */
-  if (ts->type == BT_COMPLEX && ts->kind == 8)
-    ts->kind = 4;
-  if (ts->type == BT_COMPLEX && ts->kind == 16)
-    ts->kind = 8;
+  if (ts->type == BT_COMPLEX)
+    {
+      if (ts->kind % 2)
+        {
+          gfc_error ("Old-style type declaration %s*%d not supported at %C",
+                     gfc_basic_typename (ts->type), original_kind);
+          return MATCH_ERROR;
+        }
+      ts->kind /= 2;
+    }
 
   if (gfc_validate_kind (ts->type, ts->kind, true) < 0)
     {
-      gfc_error ("Old-style kind %d not supported for type %s at %C",
-		 ts->kind, gfc_basic_typename (ts->type));
-
+      gfc_error ("Old-style type declaration %s*%d not supported at %C",
+                 gfc_basic_typename (ts->type), original_kind);
       return MATCH_ERROR;
     }