http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52101
--- Comment #5 from Steve Kargl <sgk at troutmask dot apl.washington.edu>
2012-02-03 22:46:53 UTC ---
On Fri, Feb 03, 2012 at 09:16:47PM +0000, kargl at gcc dot gnu.org wrote:
> I believe that John is correct. The form 'CHARACTER*n string'
> is obsolescent while the form 'CHARACTER string*n' is not.
> From Sec 5.1 in the F2003 standard,
>
>
> R504 entity-decl is object-name [( array-spec )] [ * char-length ]
> [ initialization ]
> or function-name [ * char-length ]
This patch seems to do the right thing.
troutmask:sgk[208] cat foo.f90
program foo
character*10 s
character t*10
s = 'foo'
t = 'bar'
end program foo
troutmask:sgk[209] gfc4x -c foo.f90
troutmask:sgk[210] gfc4x -c -std=f95 foo.f90
foo.f90:2.15:
character*10 s
1
Warning: Obsolescent feature: Old-style character length at (1)
Index: decl.c
===================================================================
--- decl.c (revision 183872)
+++ decl.c (working copy)
@@ -722,7 +722,7 @@ syntax:
char_len_param_value in parenthesis. */
static match
-match_char_length (gfc_expr **expr, bool *deferred)
+match_char_length (gfc_expr **expr, bool *deferred, bool entity_decl)
{
int length;
match m;
@@ -738,7 +738,8 @@ match_char_length (gfc_expr **expr, bool
if (m == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: "
+ if (entity_decl
+ && gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: "
"Old-style character length at %C") == FAILURE)
return MATCH_ERROR;
*expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, length);
@@ -1845,7 +1846,7 @@ variable_decl (int elem)
if (current_ts.type == BT_CHARACTER)
{
- switch (match_char_length (&char_len, &cl_deferred))
+ switch (match_char_length (&char_len, &cl_deferred, false))
{
case MATCH_YES:
cl = gfc_new_charlen (gfc_current_ns, NULL);
@@ -2407,7 +2408,7 @@ gfc_match_char_spec (gfc_typespec *ts)
/* Try the old-style specification first. */
old_char_selector = 0;
- m = match_char_length (&len, &deferred);
+ m = match_char_length (&len, &deferred, true);
if (m != MATCH_NO)
{
if (m == MATCH_YES)
