summaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
authorpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>2006-02-19 15:24:26 +0000
committerpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>2006-02-19 15:24:26 +0000
commit199bf9f50a5777ffad206e07f96443a8668f1b4c (patch)
tree7e6b3bd04608f088a0f80dc2b3cc893f1bca8e49 /gcc/fortran
parent5e52722ac0f802622f80c235319423bbd010b943 (diff)
downloadgcc-199bf9f50a5777ffad206e07f96443a8668f1b4c.tar.gz
2005-02-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25054 * resolve.c (is_non_constant_shape_array): New function. (resolve_fl_variable): Remove code for the new function and call it. (resolve_fl_namelist): New function. Add test for namelist array with non-constant shape, using is_non_constant_shape_array. (resolve_symbol): Remove code for resolve_fl_namelist and call it. PR fortran/25089 * match.c (match_namelist): Increment the refs field of an accepted namelist object symbol. * resolve.c (resolve_fl_namelist): Test namelist objects for a conflict with contained or module procedures. 2005-02-19 Paul Thomas <pault@gcc.gnu.org> PR fortran/25054 * gfortran.dg/namelist_5.f90: New test. PR fortran/25089 * gfortran.dg/namelist_4.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111268 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog15
-rw-r--r--gcc/fortran/match.c1
-rw-r--r--gcc/fortran/resolve.c142
3 files changed, 109 insertions, 49 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 83a9059b8a3..5486c8eb78a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+2005-02-19 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/25054
+ * resolve.c (is_non_constant_shape_array): New function.
+ (resolve_fl_variable): Remove code for the new function and call it.
+ (resolve_fl_namelist): New function. Add test for namelist array
+ with non-constant shape, using is_non_constant_shape_array.
+ (resolve_symbol): Remove code for resolve_fl_namelist and call it.
+
+ PR fortran/25089
+ * match.c (match_namelist): Increment the refs field of an accepted
+ namelist object symbol.
+ * resolve.c (resolve_fl_namelist): Test namelist objects for a conflict
+ with contained or module procedures.
+
2006-02-18 Roger Sayle <roger@eyesopen.com>
* trans-stmt.c (struct temporary_list): Delete.
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index a2b9c41d549..4c2fe1b71ce 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2589,6 +2589,7 @@ gfc_match_namelist (void)
nl = gfc_get_namelist ();
nl->sym = sym;
+ sym->refs++;
if (group_name->namelist == NULL)
group_name->namelist = group_name->namelist_tail = nl;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1de2446aa1f..63b2cd9904d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4598,6 +4598,35 @@ resolve_charlen (gfc_charlen *cl)
}
+/* Test for non-constant shape arrays. */
+
+static bool
+is_non_constant_shape_array (gfc_symbol *sym)
+{
+ gfc_expr *e;
+ int i;
+
+ if (sym->as != NULL)
+ {
+ /* Unfortunately, !gfc_is_compile_time_shape hits a legal case that
+ has not been simplified; parameter array references. Do the
+ simplification now. */
+ for (i = 0; i < sym->as->rank; i++)
+ {
+ e = sym->as->lower[i];
+ if (e && (resolve_index_expr (e) == FAILURE
+ || !gfc_is_constant_expr (e)))
+ return true;
+
+ e = sym->as->upper[i];
+ if (e && (resolve_index_expr (e) == FAILURE
+ || !gfc_is_constant_expr (e)))
+ return true;
+ }
+ }
+ return false;
+}
+
/* Resolution of common features of flavors variable and procedure. */
static try
@@ -4652,43 +4681,17 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
return FAILURE;
/* The shape of a main program or module array needs to be constant. */
- if (sym->as != NULL
- && sym->ns->proc_name
+ if (sym->ns->proc_name
&& (sym->ns->proc_name->attr.flavor == FL_MODULE
|| sym->ns->proc_name->attr.is_main_program)
&& !sym->attr.use_assoc
&& !sym->attr.allocatable
- && !sym->attr.pointer)
+ && !sym->attr.pointer
+ && is_non_constant_shape_array (sym))
{
- /* Unfortunately, !gfc_is_compile_time_shape hits a legal case that
- has not been simplified; parameter array references. Do the
- simplification now. */
- flag = 0;
- for (i = 0; i < sym->as->rank; i++)
- {
- e = sym->as->lower[i];
- if (e && (resolve_index_expr (e) == FAILURE
- || !gfc_is_constant_expr (e)))
- {
- flag = 1;
- break;
- }
-
- e = sym->as->upper[i];
- if (e && (resolve_index_expr (e) == FAILURE
- || !gfc_is_constant_expr (e)))
- {
- flag = 1;
- break;
- }
- }
-
- if (flag)
- {
- gfc_error ("The module or main program array '%s' at %L must "
+ gfc_error ("The module or main program array '%s' at %L must "
"have constant shape", sym->name, &sym->declared_at);
return FAILURE;
- }
}
if (sym->ts.type == BT_CHARACTER)
@@ -4961,6 +4964,64 @@ resolve_fl_derived (gfc_symbol *sym)
static try
+resolve_fl_namelist (gfc_symbol *sym)
+{
+ gfc_namelist *nl;
+ gfc_symbol *nlsym;
+
+ /* Reject PRIVATE objects in a PUBLIC namelist. */
+ if (gfc_check_access(sym->attr.access, sym->ns->default_access))
+ {
+ for (nl = sym->namelist; nl; nl = nl->next)
+ {
+ if (!nl->sym->attr.use_assoc
+ && !(sym->ns->parent == nl->sym->ns)
+ && !gfc_check_access(nl->sym->attr.access,
+ nl->sym->ns->default_access))
+ {
+ gfc_error ("PRIVATE symbol '%s' cannot be member of "
+ "PUBLIC namelist at %L", nl->sym->name,
+ &sym->declared_at);
+ return FAILURE;
+ }
+ }
+ }
+
+ /* Reject namelist arrays that are not constant shape. */
+ for (nl = sym->namelist; nl; nl = nl->next)
+ {
+ if (is_non_constant_shape_array (nl->sym))
+ {
+ gfc_error ("The array '%s' must have constant shape to be "
+ "a NAMELIST object at %L", nl->sym->name,
+ &sym->declared_at);
+ return FAILURE;
+ }
+ }
+
+ /* 14.1.2 A module or internal procedure represent local entities
+ of the same type as a namelist member and so are not allowed.
+ Note that this is sometimes caught by check_conflict so the
+ same message has been used. */
+ for (nl = sym->namelist; nl; nl = nl->next)
+ {
+ nlsym = NULL;
+ if (sym->ns->parent && nl->sym && nl->sym->name)
+ gfc_find_symbol (nl->sym->name, sym->ns->parent, 0, &nlsym);
+ if (nlsym && nlsym->attr.flavor == FL_PROCEDURE)
+ {
+ gfc_error ("PROCEDURE attribute conflicts with NAMELIST "
+ "attribute in '%s' at %L", nlsym->name,
+ &sym->declared_at);
+ return FAILURE;
+ }
+ }
+
+ return SUCCESS;
+}
+
+
+static try
resolve_fl_parameter (gfc_symbol *sym)
{
/* A parameter array's shape needs to be constant. */
@@ -5007,7 +5068,6 @@ resolve_symbol (gfc_symbol * sym)
/* Zero if we are checking a formal namespace. */
static int formal_ns_flag = 1;
int formal_ns_save, check_constant, mp_flag;
- gfc_namelist *nl;
gfc_symtree *symtree;
gfc_symtree *this_symtree;
gfc_namespace *ns;
@@ -5162,23 +5222,8 @@ resolve_symbol (gfc_symbol * sym)
break;
case FL_NAMELIST:
- /* Reject PRIVATE objects in a PUBLIC namelist. */
- if (gfc_check_access(sym->attr.access, sym->ns->default_access))
- {
- for (nl = sym->namelist; nl; nl = nl->next)
- {
- if (!nl->sym->attr.use_assoc
- &&
- !(sym->ns->parent == nl->sym->ns)
- &&
- !gfc_check_access(nl->sym->attr.access,
- nl->sym->ns->default_access))
- gfc_error ("PRIVATE symbol '%s' cannot be member of "
- "PUBLIC namelist at %L", nl->sym->name,
- &sym->declared_at);
- }
- }
-
+ if (resolve_fl_namelist (sym) == FAILURE)
+ return;
break;
case FL_PARAMETER:
@@ -5192,7 +5237,6 @@ resolve_symbol (gfc_symbol * sym)
break;
}
-
/* Make sure that intrinsic exist */
if (sym->attr.intrinsic
&& ! gfc_intrinsic_name(sym->name, 0)
View Lorry Controller Status