Re: [Fortran-Experiments, merge-patch] Merge VALUE from trunk

[Tobias Burnus <burnus at net-b dot de>]

Steve Kargl wrote:
> I've approved a slightly modified patch on IRC.  Tobias has 
> cleanup some GMP issues with the comparison to 1.
>   
Thanks for reviewing. Committed at r121965 to Fortran-Experiments.

For the commited resolve.c patch see below.

Following Steve's suggestion (cf. also below),
I plan to also commit the following as part of the PR 30783 patch to the
trunk:

       gfc_error ("'%s' at %L cannot have the VALUE attribute because "
-                "it is not a dummy", sym->name, &sym->declared_at);
+                "it is not a dummy argument", sym->name,
&sym->declared_at);

Tobias


Index: resolve.c
===================================================================
--- resolve.c   (Revision 121139)
+++ resolve.c
@@ -675,7 +675,7 @@
     return 1;

   if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic
-      || a.optional || a.pointer || a.save || a.target || a.volatile_
+      || a.optional || a.pointer || a.save || a.target || a.volatile_
|| a.value
       || a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN)
     return 1;

@@ -6214,6 +6214,34 @@
       return;
     }

+  if (sym->attr.value && !sym->attr.dummy)
+    {
+      gfc_error ("'%s' at %L cannot have the VALUE attribute because "
+                "it is not a dummy argument", sym->name,
&sym->declared_at);
+      return;
+    }
+
+  if (sym->attr.value && sym->ts.type == BT_CHARACTER)
+    {
+      gfc_charlen *cl = sym->ts.cl;
+      if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
+       {
+         gfc_error ("Character dummy variable '%s' at %L with VALUE "
+                    "attribute must have constant length",
+                    sym->name, &sym->declared_at);
+         return;
+       }
+
+      if (sym->ts.is_c_interop
+         && mpz_cmp_si (cl->length->value.integer, 1) != 0)
+       {
+         gfc_error ("C interoperable character dummy variable '%s' at %L "
+                    "with VALUE attribute must have length one",
+                    sym->name, &sym->declared_at);
+         return;
+       }
+    }
+
   /* If a derived type symbol has reached this point, without its
      type being declared, we have an error.  Notice that most
      conditions that produce undefined derived types have already