OSDN Git Service

2005-12-01 Erik Schnetter <schnetter@aei.mpg.de>
authorkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 2 Dec 2005 01:25:58 +0000 (01:25 +0000)
committerkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 2 Dec 2005 01:25:58 +0000 (01:25 +0000)
* decl.c (gfc_match_old_kind_spec):  Improve handling of old style
COMPLEX*N

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@107853 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/decl.c

index f9fd567..ceec7b7 100644 (file)
@@ -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
index 8352c52..6f04734 100644 (file)
@@ -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;
     }