diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ce7b74437c3..3bc5b394af6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2007-04-12 Tobias Burnus + + 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 PR fortran/31257 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index c9383ccce69..67d05b850ea 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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 ( , ) or - pointer ( , ), ( , ), ... - The pointer, if already declared, should be an integer. Otherwise, we + pointer ( , ), ( , ), ... + 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) => (( *) ipt)(i) + ar(i) => (( *) 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 (¤t_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 (¤t_attr); gfc_add_cray_pointee (¤t_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 (¤t_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) (¤t_ts)->type = BT_INTEGER; (¤t_ts)->kind = gfc_c_int_kind; - + gfc_clear_attr (¤t_attr); t = gfc_add_flavor (¤t_attr, FL_PARAMETER, NULL, NULL); if (t == FAILURE) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 196c19a41bb..dfe1f300a21 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2007-04-12 Tobias Burnus + + 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 PR testsuite/31538 diff --git a/gcc/testsuite/gfortran.dg/access_spec_1.f90 b/gcc/testsuite/gfortran.dg/access_spec_1.f90 new file mode 100644 index 00000000000..2c080c9c62f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/access_spec_1.f90 @@ -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" } } diff --git a/gcc/testsuite/gfortran.dg/access_spec_2.f90 b/gcc/testsuite/gfortran.dg/access_spec_2.f90 new file mode 100644 index 00000000000..7b67e6c8597 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/access_spec_2.f90 @@ -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" } } diff --git a/gcc/testsuite/gfortran.dg/non_module_public.f90 b/gcc/testsuite/gfortran.dg/non_module_public.f90 index cf99dd737de..3201a1598e5 100644 --- a/gcc/testsuite/gfortran.dg/non_module_public.f90 +++ b/gcc/testsuite/gfortran.dg/non_module_public.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } ! PR20837 - A symbol may not be declared PUBLIC or PRIVATE outside a module. ! Contributed by Joost VandeVondele -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