diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 5 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 48 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/blockdata_1.f90 | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/blockdata_2.f90 | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/common_11.f90 | 30 |
7 files changed, 84 insertions, 20 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a3d2ee8..f7b85b0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2007-01-06 Tobias Burnus <burnus@net-b.de> + + PR fortran/34658 + * match.c (gfc_match_common): Remove blank common in + DATA BLOCK warning. + * resolve.c (resolve_common_vars): New function. + (resolve_common_blocks): Move checks to resolve_common_vars + and invoke that function. + (resolve_types): Call resolve_common_vars for blank commons. + 2008-01-06 Tobias Burnus <burnus@net-b.de> PR fortran/34655 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 78ed754..9a9ed8a 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2784,11 +2784,6 @@ gfc_match_common (void) if (name[0] == '\0') { - if (gfc_current_ns->is_block_data) - { - gfc_warning ("BLOCK DATA unit cannot contain blank COMMON " - "at %C"); - } t = &gfc_current_ns->blank_common; if (t->head == NULL) t->where = gfc_current_locus; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6cde79f..0f96cd6 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -646,23 +646,27 @@ has_default_initializer (gfc_symbol *der) return c != NULL; } - -/* Resolve common blocks. */ +/* Resolve common variables. */ static void -resolve_common_blocks (gfc_symtree *common_root) +resolve_common_vars (gfc_symbol *sym, bool named_common) { - gfc_symbol *sym, *csym; - - if (common_root == NULL) - return; + gfc_symbol *csym = sym; - if (common_root->left) - resolve_common_blocks (common_root->left); - if (common_root->right) - resolve_common_blocks (common_root->right); - - for (csym = common_root->n.common->head; csym; csym = csym->common_next) + for (; csym; csym = csym->common_next) { + if (csym->value || csym->attr.data) + { + if (!csym->ns->is_block_data) + gfc_notify_std (GFC_STD_GNU, "Variable '%s' at %L is in COMMON " + "but only in BLOCK DATA initialization is " + "allowed", csym->name, &csym->declared_at); + else if (!named_common) + gfc_notify_std (GFC_STD_GNU, "Initialized variable '%s' at %L is " + "in a blank COMMON but initialization is only " + "allowed in named common blocks", csym->name, + &csym->declared_at); + } + if (csym->ts.type != BT_DERIVED) continue; @@ -680,6 +684,23 @@ resolve_common_blocks (gfc_symtree *common_root) "may not have default initializer", csym->name, &csym->declared_at); } +} + +/* Resolve common blocks. */ +static void +resolve_common_blocks (gfc_symtree *common_root) +{ + gfc_symbol *sym; + + if (common_root == NULL) + return; + + if (common_root->left) + resolve_common_blocks (common_root->left); + if (common_root->right) + resolve_common_blocks (common_root->right); + + resolve_common_vars (common_root->n.common->head, true); gfc_find_symbol (common_root->name, gfc_current_ns, 0, &sym); if (sym == NULL) @@ -8939,6 +8960,7 @@ resolve_types (gfc_namespace *ns) resolve_entries (ns); + resolve_common_vars (ns->blank_common.head, false); resolve_common_blocks (ns->common_root); resolve_contained_functions (ns); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 39188cc..f59e8aa 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2007-01-06 Tobias Burnus <burnus@net-b.de> + + PR fortran/34658 + * gfortran.dg/common_11.f90: New. + * gfortran.dg/blockdata_1.f90: Update test case. + * gfortran.dg/blockdata_2.f90: Update test case. + 2008-01-06 Tobias Burnus <burnus@net-b.de> * gfortran.dg/equiv_constraint_9.f90: Fix typo. diff --git a/gcc/testsuite/gfortran.dg/blockdata_1.f90 b/gcc/testsuite/gfortran.dg/blockdata_1.f90 index 81cd02c..74910c4 100644 --- a/gcc/testsuite/gfortran.dg/blockdata_1.f90 +++ b/gcc/testsuite/gfortran.dg/blockdata_1.f90 @@ -14,7 +14,7 @@ end blockdata d1 block data d2 common /b/ u - common j ! { dg-warning "cannot contain blank COMMON" } + common j ! { dg-warning "blank COMMON but initialization is only allowed in named common" } data j /1/ end block data d2 ! diff --git a/gcc/testsuite/gfortran.dg/blockdata_2.f90 b/gcc/testsuite/gfortran.dg/blockdata_2.f90 index a1370c8..b4badba 100644 --- a/gcc/testsuite/gfortran.dg/blockdata_2.f90 +++ b/gcc/testsuite/gfortran.dg/blockdata_2.f90 @@ -3,6 +3,6 @@ ! proc_name from an unnamed block data which we intended to use as locus ! for a blank common. block data - common c ! { dg-warning "cannot contain blank COMMON" } + common c end !block data end diff --git a/gcc/testsuite/gfortran.dg/common_11.f90 b/gcc/testsuite/gfortran.dg/common_11.f90 new file mode 100644 index 0000000..ec01515 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/common_11.f90 @@ -0,0 +1,30 @@ +! { dg-do compile } +! +! PR fortran/34658 +! +! Check for more COMMON constrains +! +block data + implicit none + integer :: x, a ! { dg-warning "Initialized variable 'a' at .1. is in a blank COMMON" } + integer :: y = 5, b = 5 ! { dg-warning "Initialized variable 'b' at .1. is in a blank COMMON" } + data x/5/, a/5/ + common // a, b + common /a/ x, y +end block data + +subroutine foo() + implicit none + type t + sequence + integer :: i = 5 + end type t + type(t) x ! { dg-error "may not have default initializer" } + common // x +end subroutine foo + +program test + implicit none + common /a/ I ! { dg-warning "in COMMON but only in BLOCK DATA initialization" } + integer :: I = 43 +end program test |