gfortran.h (gfc_set_implicit_none): Update prototype.
2014-10-10 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. From-SVN: r216057
This commit is contained in:
parent
548cb3d77c
commit
a6c631732f
6 changed files with 100 additions and 34 deletions
|
@ -1,3 +1,12 @@
|
|||
2014-10-10 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
* 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 ";".
|
||||
|
||||
2014-10-09 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
* f95-lang.c (gfc_init_builtin_functions): Add more floating-point
|
||||
|
|
|
@ -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;
|
||||
|
||||
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;
|
||||
(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;
|
||||
|
||||
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]);
|
||||
|
|
|
@ -1,3 +1,7 @@
|
|||
2014-10-10 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
* gfortran.dg/implicit_16.f90: New.
|
||||
|
||||
2014-10-09 Paolo Carlini <paolo.carlini@oracle.com>
|
||||
|
||||
* g++.dg/cpp0x/constexpr-using3.C: New.
|
||||
|
|
40
gcc/testsuite/gfortran.dg/implicit_16.f90
Normal file
40
gcc/testsuite/gfortran.dg/implicit_16.f90
Normal file
|
@ -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
|
Loading…
Add table
Reference in a new issue