2014-10-09 Tobias Burnus <burnus@net-b.de>
gcc/fortran/
* gfortran.h (gfc_set_implicit_none):
Update prototype.
* symbol.c (gfc_set_implicit_none): Take and
use error location. Move diagnostic from here to ...
* decl.c (gfc_match_implicit_none): ... here. And
update call. Handle empty implicit-none-spec.
(gfc_match_implicit): Handle statement-separator ";".
gcc/testsuite/
* gfortran.dg/implicit_16.f90: New.
@@ -2951,6 +2951,14 @@ gfc_match_implicit_none (void)
char name[GFC_MAX_SYMBOL_LEN + 1];
bool type = false;
bool external = false;
+ locus cur_loc = gfc_current_locus;
+
+ if (gfc_current_ns->seen_implicit_none
+ || gfc_current_ns->has_implicit_none_export)
+ {
+ gfc_error ("Duplicate IMPLICIT NONE statement at %C");
+ return MATCH_ERROR;
+ }
gfc_gobble_whitespace ();
c = gfc_peek_ascii_char ();
@@ -2959,27 +2967,35 @@ gfc_match_implicit_none (void)
(void) gfc_next_ascii_char ();
if (!gfc_notify_std (GFC_STD_F2015, "IMPORT NONE with spec list at %C"))
return MATCH_ERROR;
- for(;;)
+
+ gfc_gobble_whitespace ();
+ if (gfc_peek_ascii_char () == ')')
{
- m = gfc_match (" %n", name);
- if (m != MATCH_YES)
- return MATCH_ERROR;
+ (void) gfc_next_ascii_char ();
+ type = true;
+ }
+ else
+ for(;;)
+ {
+ m = gfc_match (" %n", name);
+ if (m != MATCH_YES)
+ return MATCH_ERROR;
- if (strcmp (name, "type") == 0)
- type = true;
- else if (strcmp (name, "external") == 0)
- external = true;
- else
- return MATCH_ERROR;
+ if (strcmp (name, "type") == 0)
+ type = true;
+ else if (strcmp (name, "external") == 0)
+ external = true;
+ else
+ return MATCH_ERROR;
- gfc_gobble_whitespace ();
- c = gfc_next_ascii_char ();
- if (c == ',')
- continue;
- if (c == ')')
- break;
- return MATCH_ERROR;
- }
+ gfc_gobble_whitespace ();
+ c = gfc_next_ascii_char ();
+ if (c == ',')
+ continue;
+ if (c == ')')
+ break;
+ return MATCH_ERROR;
+ }
}
else
type = true;
@@ -2987,7 +3003,7 @@ gfc_match_implicit_none (void)
if (gfc_match_eos () != MATCH_YES)
return MATCH_ERROR;
- gfc_set_implicit_none (type, external);
+ gfc_set_implicit_none (type, external, &cur_loc);
return MATCH_YES;
}
@@ -3140,8 +3156,8 @@ gfc_match_implicit (void)
{
/* We may have <TYPE> (<RANGE>). */
gfc_gobble_whitespace ();
- c = gfc_next_ascii_char ();
- if ((c == '\n') || (c == ','))
+ c = gfc_peek_ascii_char ();
+ if (c == ',' || c == '\n' || c == ';' || c == '!')
{
/* Check for CHARACTER with no length parameter. */
if (ts.type == BT_CHARACTER && !ts.u.cl)
@@ -3155,6 +3171,10 @@ gfc_match_implicit (void)
/* Record the Successful match. */
if (!gfc_merge_new_implicit (&ts))
return MATCH_ERROR;
+ if (c == ',')
+ c = gfc_next_ascii_char ();
+ else if (gfc_match_eos () == MATCH_ERROR)
+ goto error;
continue;
}
@@ -3190,7 +3210,7 @@ gfc_match_implicit (void)
gfc_gobble_whitespace ();
c = gfc_next_ascii_char ();
- if ((c != '\n') && (c != ','))
+ if (c != ',' && gfc_match_eos () != MATCH_YES)
goto syntax;
if (!gfc_merge_new_implicit (&ts))
@@ -2759,7 +2759,7 @@ extern int gfc_character_storage_size;
void gfc_clear_new_implicit (void);
bool gfc_add_new_implicit_range (int, int);
bool gfc_merge_new_implicit (gfc_typespec *);
-void gfc_set_implicit_none (bool, bool);
+void gfc_set_implicit_none (bool, bool, locus *);
void gfc_check_function_type (gfc_namespace *);
bool gfc_is_intrinsic_typename (const char *);
@@ -114,17 +114,10 @@ static int new_flag[GFC_LETTERS];
/* Handle a correctly parsed IMPLICIT NONE. */
void
-gfc_set_implicit_none (bool type, bool external)
+gfc_set_implicit_none (bool type, bool external, locus *loc)
{
int i;
- if (gfc_current_ns->seen_implicit_none
- || gfc_current_ns->has_implicit_none_export)
- {
- gfc_error_now ("Duplicate IMPLICIT NONE statement at %C");
- return;
- }
-
if (external)
gfc_current_ns->has_implicit_none_export = 1;
@@ -135,8 +128,8 @@ gfc_set_implicit_none (bool type, bool external)
{
if (gfc_current_ns->set_flag[i])
{
- gfc_error_now ("IMPLICIT NONE (type) statement at %C following an "
- "IMPLICIT statement");
+ gfc_error_now ("IMPLICIT NONE (type) statement at %L following an "
+ "IMPLICIT statement", loc);
return;
}
gfc_clear_ts (&gfc_current_ns->default_type[i]);
new file mode 100644
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! { dg-options "" }
+!
+! Support Fortran 2015's IMPLICIT NONE with empty spec list
+!
+! And IMPLICIT with ";" followed by an additional statement.
+! Contributed by Alan Greynolds
+!
+
+module m
+ type t
+ end type t
+end module m
+
+subroutine sub0
+implicit integer (a-h,o-z); parameter (i=0)
+end subroutine sub0
+
+subroutine sub1
+implicit integer (a-h,o-z)!test
+parameter (i=0)
+end subroutine sub1
+
+subroutine sub2
+use m
+implicit type(t) (a-h,o-z); parameter (i=0)
+end subroutine sub2
+
+
+subroutine sub3
+use m
+implicit type(t) (a-h,o-z)! Foobar
+parameter (i=0)
+end subroutine sub3
+
+subroutine sub4
+implicit none ()
+call test()
+i = 1 ! { dg-error "Symbol 'i' at .1. has no IMPLICIT type" }
+end subroutine sub4
Hi all, this patch fixes Alan's issue with IMPLICIT followed by ";". I am not sure whether using the _eos machinery is really needed – especially as "!" seem to be already handled. Additionally, I missed the inner "[...]" for the new: R563 implicit-stmt is IMPLICIT implicit-spec-list or IMPLICIT NONE [ ( [ implicit-none-spec-list ] ) ] Namely, "IMPLICIT NONE ()" is also valid - but was rejected before. As implicit-none-spec implies type,* that's now also handled. (* "An IMPLICIT statement specifies the mapping for the letters in its letter-spec-list. IMPLICIT NONE with an implicit-none-spec of TYPE or with no implicit-none-spec-list specifies the null mapping for all the letters.") And finally, Dominque correctly observed that the location of some of the error messages was rather off, e.g. if there was a long comment following the actual statement. Hence, I have modified the code to provide a better error message. Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias