OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Tobias Burnus 2014-10-10 08:00:26 +02:00 committed by Tobias Burnus
parent 548cb3d77c
commit a6c631732f
6 changed files with 100 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -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

66
gcc/fortran/decl.c
View File

@ -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))

2
gcc/fortran/gfortran.h
View File

@ -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 *);

13
gcc/fortran/symbol.c
View File

@ -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]);

4
gcc/testsuite/ChangeLog
View File

@ -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
View 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