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 f9fd567e785208529b836040f368f0bdc94eb01c..ceec7b776fc0ba19fc6acdd69372d17d50eb3437 100644 (file)
--- 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 8352c5274617be611eabf61d7db9a478af7787ce..6f047341f3e3768d15e53d1262d65cce3b8a6c76 100644 (file)
--- 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;
     }