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

re PR fortran/31472 (gfortran does not detect the illegal use of an access specification in a program, subroutine, or function) 

2007-04-12  Tobias Burnus  <burnus@net-b.de>

	PR fortran/31472
	* decl.c (match_attr_spec): Allow PRIVATE/PUBLIC
	attribute in type definitions.
	(gfc_match_private): Allow PRIVATE statement only
	in specification part of modules.
	(gfc_match_public): Ditto for PUBLIC.
	(gfc_match_derived_decl): Allow PRIVATE/PUBLIC attribute only in
	specificification part of modules.

2007-04-12  Tobias Burnus  <burnus@net-b.de>

	PR fortran/31472
	* gfortran.dg/access_spec_1.f90: New test.
	* gfortran.dg/access_spec_2.f90: New test.
	* gfortran.dg/non_module_public.f90: Match new error message.

From-SVN: r123735
This commit is contained in:
Tobias Burnus 2007-04-12 10:46:30 +02:00 committed by Tobias Burnus
parent 8c5e065b53
commit d51347f96c
6 changed files with 171 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
2007-04-12 Tobias Burnus <burnus@net-b.de>
PR fortran/31472
* decl.c (match_attr_spec): Allow PRIVATE/PUBLIC
attribute in type definitions.
(gfc_match_private): Allow PRIVATE statement only
in specification part of modules.
(gfc_match_public): Ditto for PUBLIC.
(gfc_match_derived_decl): Allow PRIVATE/PUBLIC attribute only in
specificification part of modules.
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31257

153
gcc/fortran/decl.c
View File

@ -477,7 +477,7 @@ match_old_style_init (const char *name)
/* Match the stuff following a DATA statement. If ERROR_FLAG is set,
we are matching a DATA statement and are therefore issuing an error
if we encounter something unexpected, if not, we're trying to match
if we encounter something unexpected, if not, we're trying to match
an old-style initialization expression of the form INTEGER I /2/. */
match
@ -624,9 +624,9 @@ find_special (const char *name, gfc_symbol **result)
int i;
i = gfc_get_symbol (name, NULL, result);
if (i == 0)
if (i == 0)
goto end;
if (gfc_current_state () != COMP_SUBROUTINE
&& gfc_current_state () != COMP_FUNCTION)
goto end;
@ -812,15 +812,15 @@ gfc_set_constant_character_len (int len, gfc_expr *expr, bool array)
}
/* Function to create and update the enumerator history
/* Function to create and update the enumerator history
using the information passed as arguments.
Pointer "max_enum" is also updated, to point to
enum history node containing largest initializer.
Pointer "max_enum" is also updated, to point to
enum history node containing largest initializer.
SYM points to the symbol node of enumerator.
INIT points to its enumerator value. */
static void
static void
create_enum_history (gfc_symbol *sym, gfc_expr *init)
{
enumerator_history *new_enum_history;
@ -842,20 +842,20 @@ create_enum_history (gfc_symbol *sym, gfc_expr *init)
new_enum_history->next = enum_history;
enum_history = new_enum_history;
if (mpz_cmp (max_enum->initializer->value.integer,
if (mpz_cmp (max_enum->initializer->value.integer,
new_enum_history->initializer->value.integer) < 0)
max_enum = new_enum_history;
}
}
/* Function to free enum kind history. */
/* Function to free enum kind history. */
void
void
gfc_free_enum_history (void)
{
enumerator_history *current = enum_history;
enumerator_history *next;
enumerator_history *current = enum_history;
enumerator_history *next;
while (current != NULL)
{
@ -1215,13 +1215,13 @@ variable_decl (int elem)
{
if (gfc_set_array_spec (sym, cp_as, &var_locus) == FAILURE)
gfc_internal_error ("Couldn't set pointee array spec.");
/* Fix the array spec. */
m = gfc_mod_pointee_as (sym->as);
m = gfc_mod_pointee_as (sym->as);
if (m == MATCH_ERROR)
goto cleanup;
}
}
}
goto cleanup;
}
else
@ -1229,8 +1229,8 @@ variable_decl (int elem)
gfc_free_array_spec (cp_as);
}
}
/* OK, we've successfully matched the declaration. Now put the
symbol in the current namespace, because it might be used in the
optional initialization expression for this symbol, e.g. this is
@ -1294,7 +1294,7 @@ variable_decl (int elem)
if (gfc_notify_std (GFC_STD_GNU, "Extension: Old-style "
"initialization at %C") == FAILURE)
return MATCH_ERROR;
return match_old_style_init (name);
}
@ -1667,7 +1667,7 @@ done:
to the matched specification. This is necessary for FUNCTION and
IMPLICIT statements.
If implicit_flag is nonzero, then we don't check for the optional
If implicit_flag is nonzero, then we don't check for the optional
kind specification. Not doing so is needed for matching an IMPLICIT
statement correctly. */
@ -1683,7 +1683,7 @@ match_type_spec (gfc_typespec *ts, int implicit_flag)
if (gfc_match (" byte") == MATCH_YES)
{
if (gfc_notify_std(GFC_STD_GNU, "Extension: BYTE type at %C")
if (gfc_notify_std(GFC_STD_GNU, "Extension: BYTE type at %C")
== FAILURE)
return MATCH_ERROR;
@ -1693,7 +1693,7 @@ match_type_spec (gfc_typespec *ts, int implicit_flag)
"is not available on the target machine");
return MATCH_ERROR;
}
ts->type = BT_INTEGER;
ts->kind = 1;
return MATCH_YES;
@ -2082,7 +2082,7 @@ gfc_match_import (void)
return MATCH_ERROR;
}
if (gfc_find_symtree (gfc_current_ns->sym_root,name))
if (gfc_find_symtree (gfc_current_ns->sym_root,name))
{
gfc_warning ("'%s' is already IMPORTed from host scoping unit "
"at %C.", name);
@ -2189,7 +2189,7 @@ match_attr_spec (void)
d = (decl_types) gfc_match_strings (decls);
if (d == DECL_NONE || d == DECL_COLON)
break;
seen[d]++;
seen_at[d] = gfc_current_locus;
@ -2292,13 +2292,14 @@ match_attr_spec (void)
if (gfc_current_state () == COMP_DERIVED
&& d != DECL_DIMENSION && d != DECL_POINTER
&& d != DECL_COLON && d != DECL_NONE)
&& d != DECL_COLON && d != DECL_PRIVATE
&& d != DECL_PUBLIC && d != DECL_NONE)
{
if (d == DECL_ALLOCATABLE)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ALLOCATABLE "
"attribute at %C in a TYPE definition")
== FAILURE)
== FAILURE)
{
m = MATCH_ERROR;
goto cleanup;
@ -2307,7 +2308,7 @@ match_attr_spec (void)
else
{
gfc_error ("Attribute at %L is not allowed in a TYPE definition",
&seen_at[d]);
&seen_at[d]);
m = MATCH_ERROR;
goto cleanup;
}
@ -2320,11 +2321,26 @@ match_attr_spec (void)
attr = "PRIVATE";
else
attr = "PUBLIC";
gfc_error ("%s attribute at %L is not allowed outside of a MODULE",
attr, &seen_at[d]);
m = MATCH_ERROR;
goto cleanup;
if (gfc_current_state () == COMP_DERIVED
&& gfc_state_stack->previous
&& gfc_state_stack->previous->state == COMP_MODULE)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Attribute %s "
"at %L in a TYPE definition", attr,
&seen_at[d])
== FAILURE)
{
m = MATCH_ERROR;
goto cleanup;
}
}
else
{
gfc_error ("%s attribute at %L is not allowed outside of the "
"specification part of a module", attr, &seen_at[d]);
m = MATCH_ERROR;
goto cleanup;
}
}
switch (d)
@ -3146,7 +3162,7 @@ contained_procedure (void)
return 0;
}
/* Set the kind of each enumerator. The kind is selected such that it is
/* Set the kind of each enumerator. The kind is selected such that it is
interoperable with the corresponding C enumeration type, making
sure that -fshort-enums is honored. */
@ -3161,14 +3177,14 @@ set_enum_kind(void)
return;
if (!gfc_option.fshort_enums)
return;
return;
i = 0;
do
{
kind = gfc_integer_kinds[i++].kind;
}
while (kind < gfc_c_int_kind
while (kind < gfc_c_int_kind
&& gfc_check_integer_range (max_enum->initializer->value.integer,
kind) != ARITH_OK);
@ -3438,7 +3454,7 @@ attr_decl1 (void)
m = MATCH_ERROR;
goto cleanup;
}
if (sym->attr.cray_pointee && sym->as != NULL)
{
/* Fix the array spec. */
@ -3508,14 +3524,14 @@ attr_decl (void)
/* This routine matches Cray Pointer declarations of the form:
pointer ( <pointer>, <pointee> )
or
pointer ( <pointer1>, <pointee1> ), ( <pointer2>, <pointee2> ), ...
The pointer, if already declared, should be an integer. Otherwise, we
pointer ( <pointer1>, <pointee1> ), ( <pointer2>, <pointee2> ), ...
The pointer, if already declared, should be an integer. Otherwise, we
set it as BT_INTEGER with kind gfc_index_integer_kind. The pointee may
be either a scalar, or an array declaration. No space is allocated for
the pointee. For the statement
the pointee. For the statement
pointer (ipt, ar(10))
any subsequent uses of ar will be translated (in C-notation) as
ar(i) => ((<type> *) ipt)(i)
ar(i) => ((<type> *) ipt)(i)
After gimplification, pointee variable will disappear in the code. */
static match
@ -3533,9 +3549,9 @@ cray_pointer_decl (void)
if (gfc_match_char ('(') != MATCH_YES)
{
gfc_error ("Expected '(' at %C");
return MATCH_ERROR;
return MATCH_ERROR;
}
/* Match pointer. */
var_locus = gfc_current_locus;
gfc_clear_attr (&current_attr);
@ -3543,22 +3559,22 @@ cray_pointer_decl (void)
current_ts.type = BT_INTEGER;
current_ts.kind = gfc_index_integer_kind;
m = gfc_match_symbol (&cptr, 0);
m = gfc_match_symbol (&cptr, 0);
if (m != MATCH_YES)
{
gfc_error ("Expected variable name at %C");
return m;
}
if (gfc_add_cray_pointer (&cptr->attr, &var_locus) == FAILURE)
return MATCH_ERROR;
gfc_set_sym_referenced (cptr);
gfc_set_sym_referenced (cptr);
if (cptr->ts.type == BT_UNKNOWN) /* Override the type, if necessary. */
{
cptr->ts.type = BT_INTEGER;
cptr->ts.kind = gfc_index_integer_kind;
cptr->ts.kind = gfc_index_integer_kind;
}
else if (cptr->ts.type != BT_INTEGER)
{
@ -3573,10 +3589,10 @@ cray_pointer_decl (void)
if (gfc_match_char (',') != MATCH_YES)
{
gfc_error ("Expected \",\" at %C");
return MATCH_ERROR;
return MATCH_ERROR;
}
/* Match Pointee. */
/* Match Pointee. */
var_locus = gfc_current_locus;
gfc_clear_attr (&current_attr);
gfc_add_cray_pointee (&current_attr, &var_locus);
@ -3589,7 +3605,7 @@ cray_pointer_decl (void)
gfc_error ("Expected variable name at %C");
return m;
}
/* Check for an optional array spec. */
m = gfc_match_array_spec (&as);
if (m == MATCH_ERROR)
@ -3916,6 +3932,16 @@ gfc_match_private (gfc_statement *st)
if (gfc_match ("private") != MATCH_YES)
return MATCH_NO;
if (gfc_current_state () != COMP_MODULE
&& (gfc_current_state () != COMP_DERIVED
|| !gfc_state_stack->previous
|| gfc_state_stack->previous->state != COMP_MODULE))
{
gfc_error ("PRIVATE statement at %C is only allowed in the "
"specification part of a module");
return MATCH_ERROR;
}
if (gfc_current_state () == COMP_DERIVED)
{
if (gfc_match_eos () == MATCH_YES)
@ -3946,6 +3972,13 @@ gfc_match_public (gfc_statement *st)
if (gfc_match ("public") != MATCH_YES)
return MATCH_NO;
if (gfc_current_state () != COMP_MODULE)
{
gfc_error ("PUBLIC statement at %C is only allowed in the "
"specification part of a module");
return MATCH_ERROR;
}
if (gfc_match_eos () == MATCH_YES)
{
*st = ST_PUBLIC;
@ -4315,9 +4348,10 @@ gfc_match_derived_decl (void)
loop:
if (gfc_match (" , private") == MATCH_YES)
{
if (gfc_find_state (COMP_MODULE) == FAILURE)
if (gfc_current_state () != COMP_MODULE)
{
gfc_error ("Derived type at %C can only be PRIVATE within a MODULE");
gfc_error ("Derived type at %C can only be PRIVATE in the "
"specification part of a module");
return MATCH_ERROR;
}
@ -4328,9 +4362,10 @@ loop:
if (gfc_match (" , public") == MATCH_YES)
{
if (gfc_find_state (COMP_MODULE) == FAILURE)
if (gfc_current_state () != COMP_MODULE)
{
gfc_error ("Derived type at %C can only be PUBLIC within a MODULE");
gfc_error ("Derived type at %C can only be PUBLIC in the "
"specification part of a module");
return MATCH_ERROR;
}
@ -4510,12 +4545,12 @@ enumerator_decl (void)
by 1 and is used to initialize the current enumerator. */
if (initializer == NULL)
initializer = gfc_enum_initializer (last_initializer, old_locus);
if (initializer == NULL || initializer->ts.type != BT_INTEGER)
{
gfc_error("ENUMERATOR %L not initialized with integer expression",
&var_locus);
m = MATCH_ERROR;
m = MATCH_ERROR;
gfc_free_enum_history ();
goto cleanup;
}
@ -4547,9 +4582,9 @@ gfc_match_enumerator_def (void)
{
match m;
try t;
gfc_clear_ts (&current_ts);
m = gfc_match (" enumerator");
if (m != MATCH_YES)
return m;
@ -4559,7 +4594,7 @@ gfc_match_enumerator_def (void)
return m;
colon_seen = (m == MATCH_YES);
if (gfc_current_state () != COMP_ENUM)
{
gfc_error ("ENUM definition statement expected before %C");
@ -4569,7 +4604,7 @@ gfc_match_enumerator_def (void)
(&current_ts)->type = BT_INTEGER;
(&current_ts)->kind = gfc_c_int_kind;
gfc_clear_attr (&current_attr);
t = gfc_add_flavor (&current_attr, FL_PARAMETER, NULL, NULL);
if (t == FAILURE)

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
2007-04-12 Tobias Burnus <burnus@net-b.de>
PR fortran/31472
* gfortran.dg/access_spec_1.f90: New test.
* gfortran.dg/access_spec_2.f90: New test.
* gfortran.dg/non_module_public.f90: Match new error message.
2007-04-11 Paul Thomas <pault@gcc.gnu.org>
PR testsuite/31538

18
gcc/testsuite/gfortran.dg/access_spec_1.f90 Normal file
View File

@ -0,0 +1,18 @@
! { dg-do compile }
! PR fortran/31472
! Access specifications: Valid Fortran 2003 code
module mod
implicit none
private
integer, public :: i
integer, private :: z
integer :: j, x
private :: j
public :: x
type, public :: bar
PRIVATE
integer, public :: y ! Fortran 2003
integer, private :: z ! Fortran 2003
end type
end module
! { dg-final { cleanup-modules "mod" } }

40
gcc/testsuite/gfortran.dg/access_spec_2.f90 Normal file
View File

@ -0,0 +1,40 @@
! { dg-do compile }
! { dg-options "-std=f95" }
! PR fortran/31472
! Access specifications: Invalid Fortran 95 code
module test
implicit none
integer, public :: x
public :: x ! { dg-error "was already specified" }
private :: x ! { dg-error "was already specified" }
end module test
module mod
implicit none
private
type, public :: bar
PRIVATE
integer, public :: y ! { dg-error "Fortran 2003: Attribute PUBLIC" }
integer, public :: z ! { dg-error "Fortran 2003: Attribute PUBLIC" }
end type ! { dg-error "Derived type definition at" }
contains
subroutine foo
integer :: x
private :: x ! { dg-error "only allowed in the specification part of a module" }
type, private :: t ! { dg-error "only be PRIVATE in the specification part of a module" }
integer :: z
end type t ! { dg-error "Expecting END SUBROUTINE statement" }
type :: ttt
integer,public :: z ! { dg-error "not allowed outside of the specification part of a module" }
end type ttt ! { dg-error "Derived type definition at" }
end subroutine
end module
program x
implicit none
integer :: i
public :: i ! { dg-error "only allowed in the specification part of a module" }
integer,public :: j ! { dg-error "not allowed outside of the specification part of a module" }
end program x
! { dg-final { cleanup-modules "test mod" } }

2
gcc/testsuite/gfortran.dg/non_module_public.f90
View File

@ -1,5 +1,5 @@
! { dg-do compile }
! PR20837 - A symbol may not be declared PUBLIC or PRIVATE outside a module.
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
integer, parameter, public :: i=1 ! { dg-error "allowed outside of a MODULE" }
integer, parameter, public :: i=1 ! { dg-error "outside of the specification part of a module" }
END