summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog19
-rw-r--r--gcc/fortran/decl.c16
-rw-r--r--gcc/fortran/dump-parse-tree.c2
-rw-r--r--gcc/fortran/gfortran.h3
-rw-r--r--gcc/fortran/parse.c2
-rw-r--r--gcc/fortran/primary.c11
-rw-r--r--gcc/fortran/resolve.c59
-rw-r--r--gcc/fortran/symbol.c17
-rw-r--r--gcc/testsuite/ChangeLog7
-rw-r--r--gcc/testsuite/gfortran.dg/abstract_type_1.f9013
-rw-r--r--gcc/testsuite/gfortran.dg/abstract_type_2.f0313
-rw-r--r--gcc/testsuite/gfortran.dg/abstract_type_3.f0351
-rw-r--r--gcc/testsuite/gfortran.dg/abstract_type_4.f0328
13 files changed, 234 insertions, 7 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 516a9745cad..a878f0b7d1e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,22 @@
+2008-09-02 Daniel Kraft <d@domob.eu>
+
+ * gfortran.h (struct gfc_namespace): New member `implicit_loc'.
+ (gfc_add_abstract): New method.
+ * decl.c (gfc_get_type_attr_spec): Match ABSTRACT attribute.
+ (gfc_match_derived_decl): Copy abstract attribute in derived symbol.
+ * dump-parse-tree.c (show_attr): Show ABSTRACT attribute as `ABSTRACT'
+ only to allow for ABSTRACT types.
+ * parse.c (parse_interface): Use new gfc_add_abstract.
+ * primary.c (gfc_match_structure_constructor): Check that no ABSTRACT
+ type is constructed.
+ * resolve.c (resolve_typespec_used): New method.
+ (resolve_fl_derived): Check type in respect to ABSTRACT attribute and
+ check that no component is of an ABSTRACT type.
+ (resolve_symbol): Check that no symbol is of an ABSTRACT type.
+ (resolve_types): Check IMPLICIT declarations for ABSTRACT types.
+ * symbol.c (gfc_merge_new_implicit): Remember loci of IMPLICIT's.
+ (gfc_add_abstract): New method.
+
2008-09-01 Daniel Kraft <d@domob.eu>
PR fortran/37193
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index b3ec1a66e22..7e4cabf21ad 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -6361,7 +6361,7 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name)
if (gfc_add_access (attr, ACCESS_PUBLIC, NULL, NULL) == FAILURE)
return MATCH_ERROR;
}
- else if (gfc_match(" , bind ( c )") == MATCH_YES)
+ else if (gfc_match (" , bind ( c )") == MATCH_YES)
{
/* If the type is defined to be bind(c) it then needs to make
sure that all fields are interoperable. This will
@@ -6372,6 +6372,15 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name)
/* TODO: attr conflicts need to be checked, probably in symbol.c. */
}
+ else if (gfc_match (" , abstract") == MATCH_YES)
+ {
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ABSTRACT type at %C")
+ == FAILURE)
+ return MATCH_ERROR;
+
+ if (gfc_add_abstract (attr, &gfc_current_locus) == FAILURE)
+ return MATCH_ERROR;
+ }
else if (name && gfc_match(" , extends ( %n )", name) == MATCH_YES)
{
if (gfc_add_extension (attr, &gfc_current_locus) == FAILURE)
@@ -6479,11 +6488,9 @@ gfc_match_derived_decl (void)
if (attr.is_bind_c != 0)
sym->attr.is_bind_c = attr.is_bind_c;
-
/* Construct the f2k_derived namespace if it is not yet there. */
if (!sym->f2k_derived)
sym->f2k_derived = gfc_get_namespace (NULL, 0);
-
if (extended && !sym->components)
{
@@ -6507,6 +6514,9 @@ gfc_match_derived_decl (void)
st->n.sym = sym;
}
+ /* Take over the ABSTRACT attribute. */
+ sym->attr.abstract = attr.abstract;
+
gfc_new_block = sym;
return MATCH_YES;
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 05d32c29a76..32c97d06b73 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -619,7 +619,7 @@ show_attr (symbol_attribute *attr)
fputs (" IN-COMMON", dumpfile);
if (attr->abstract)
- fputs (" ABSTRACT INTERFACE", dumpfile);
+ fputs (" ABSTRACT", dumpfile);
if (attr->function)
fputs (" FUNCTION", dumpfile);
if (attr->subroutine)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 400ef395005..444027baa44 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1244,6 +1244,8 @@ typedef struct gfc_namespace
int set_flag[GFC_LETTERS];
/* Keeps track of the implicit types associated with the letters. */
gfc_typespec default_type[GFC_LETTERS];
+ /* Store the positions of IMPLICIT statements. */
+ locus implicit_loc[GFC_LETTERS];
/* If this is a namespace of a procedure, this points to the procedure. */
struct gfc_symbol *proc_name;
@@ -2260,6 +2262,7 @@ gfc_try gfc_add_function (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
+gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where);
gfc_try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
gfc_try gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index c5493dff705..a96f77d8416 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2170,7 +2170,7 @@ loop:
if (current_interface.type == INTERFACE_ABSTRACT)
{
- gfc_new_block->attr.abstract = 1;
+ gfc_add_abstract (&gfc_new_block->attr, &gfc_current_locus);
if (gfc_is_intrinsic_typename (gfc_new_block->name))
gfc_error ("Name '%s' of ABSTRACT INTERFACE at %C "
"cannot be the same as an intrinsic type",
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index c18774962fc..6689443200e 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2125,7 +2125,8 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
}
match
-gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, bool parent)
+gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result,
+ bool parent)
{
gfc_structure_ctor_component *comp_tail, *comp_head, *comp_iter;
gfc_constructor *ctor_head, *ctor_tail;
@@ -2145,6 +2146,13 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, bool parent
gfc_find_component (sym, NULL, false, true);
+ /* Check that we're not about to construct an ABSTRACT type. */
+ if (!parent && sym->attr.abstract)
+ {
+ gfc_error ("Can't construct ABSTRACT type '%s' at %C", sym->name);
+ return MATCH_ERROR;
+ }
+
/* Match the component list and store it in a list together with the
corresponding component names. Check for empty argument list first. */
if (gfc_match_char (')') != MATCH_YES)
@@ -2243,6 +2251,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, bool parent
{
gfc_current_locus = where;
gfc_free_expr (comp_tail->val);
+ comp_tail->val = NULL;
m = gfc_match_structure_constructor (comp->ts.derived,
&comp_tail->val, true);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 440461c82a8..61053c3463c 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -82,6 +82,33 @@ gfc_is_formal_arg (void)
return formal_arg_flag;
}
+
+/* Ensure a typespec used is valid; for instance, TYPE(t) is invalid if t is
+ an ABSTRACT derived-type. If where is not NULL, an error message with that
+ locus is printed, optionally using name. */
+
+static gfc_try
+resolve_typespec_used (gfc_typespec* ts, locus* where, const char* name)
+{
+ if (ts->type == BT_DERIVED && ts->derived->attr.abstract)
+ {
+ if (where)
+ {
+ if (name)
+ gfc_error ("'%s' at %L is of the ABSTRACT type '%s'",
+ name, where, ts->derived->name);
+ else
+ gfc_error ("ABSTRACT type '%s' used at %L",
+ ts->derived->name, where);
+ }
+
+ return FAILURE;
+ }
+
+ return SUCCESS;
+}
+
+
/* Resolve types of formal argument lists. These have to be done early so that
the formal argument lists of module procedures can be copied to the
containing module before the individual procedures are resolved
@@ -8420,8 +8447,21 @@ resolve_fl_derived (gfc_symbol *sym)
if (super_type && resolve_fl_derived (super_type) == FAILURE)
return FAILURE;
+ /* An ABSTRACT type must be extensible. */
+ if (sym->attr.abstract && (sym->attr.is_bind_c || sym->attr.sequence))
+ {
+ gfc_error ("Non-extensible derived-type '%s' at %L must not be ABSTRACT",
+ sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+
for (c = sym->components; c != NULL; c = c->next)
{
+ /* Check type-spec if this is not the parent-type component. */
+ if ((!sym->attr.extension || c != sym->components)
+ && resolve_typespec_used (&c->ts, &c->loc, c->name) == FAILURE)
+ return FAILURE;
+
/* If this type is an extension, see if this component has the same name
as an inherited type-bound procedure. */
if (super_type
@@ -9115,6 +9155,13 @@ resolve_symbol (gfc_symbol *sym)
|| (a->dummy && a->intent == INTENT_OUT))
apply_default_init (sym);
}
+
+ /* If this symbol has a type-spec, check it. */
+ if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER
+ || (sym->attr.flavor == FL_PROCEDURE && sym->attr.function))
+ if (resolve_typespec_used (&sym->ts, &sym->declared_at, sym->name)
+ == FAILURE)
+ return;
}
@@ -10070,6 +10117,18 @@ resolve_types (gfc_namespace *ns)
gfc_current_ns = ns;
+ /* Check that all IMPLICIT types are ok. */
+ if (!ns->seen_implicit_none)
+ {
+ unsigned letter;
+ for (letter = 0; letter != GFC_LETTERS; ++letter)
+ if (ns->set_flag[letter]
+ && resolve_typespec_used (&ns->default_type[letter],
+ &ns->implicit_loc[letter],
+ NULL) == FAILURE)
+ return;
+ }
+
resolve_entries (ns);
resolve_common_vars (ns->blank_common.head, false);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 5b7db4c75ea..7c8b7bc7f38 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -188,14 +188,15 @@ gfc_merge_new_implicit (gfc_typespec *ts)
{
if (new_flag[i])
{
-
if (gfc_current_ns->set_flag[i])
{
gfc_error ("Letter %c already has an IMPLICIT type at %C",
i + 'A');
return FAILURE;
}
+
gfc_current_ns->default_type[i] = *ts;
+ gfc_current_ns->implicit_loc[i] = gfc_current_locus;
gfc_current_ns->set_flag[i] = 1;
}
}
@@ -1319,6 +1320,20 @@ gfc_add_proc (symbol_attribute *attr, const char *name, locus *where)
}
+gfc_try
+gfc_add_abstract (symbol_attribute* attr, locus* where)
+{
+ if (attr->abstract)
+ {
+ duplicate_attr ("ABSTRACT", where);
+ return FAILURE;
+ }
+
+ attr->abstract = 1;
+ return SUCCESS;
+}
+
+
/* Flavors are special because some flavors are not what Fortran
considers attributes and can be reaffirmed multiple times. */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c5a4f5c8482..55577332b3e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2008-09-02 Daniel Kraft <d@domob.eu>
+
+ * gfortran.dg/abstract_type_1.f90: New test.
+ * gfortran.dg/abstract_type_2.f03: New test.
+ * gfortran.dg/abstract_type_3.f03: New test.
+ * gfortran.dg/abstract_type_4.f03: New test.
+
2008-09-01 Aldy Hernandez <aldyh@redhat.com>
* gcc.dg/20010516-1.c: Test for columns.
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_1.f90 b/gcc/testsuite/gfortran.dg/abstract_type_1.f90
new file mode 100644
index 00000000000..b6baa3abab8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_1.f90
@@ -0,0 +1,13 @@
+! { dg-do "compile" }
+! { dg-options "-std=f95" }
+
+! Abstract Types.
+! Check that ABSTRACT is rejected for F95.
+
+MODULE m
+
+ TYPE, ABSTRACT :: t ! { dg-error "Fortran 2003" }
+ INTEGER :: x
+ END TYPE t ! { dg-error "END MODULE" }
+
+END MODULE m
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_2.f03 b/gcc/testsuite/gfortran.dg/abstract_type_2.f03
new file mode 100644
index 00000000000..6dcfe1492ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_2.f03
@@ -0,0 +1,13 @@
+! { dg-do "compile" }
+
+! Abstract Types.
+! Check for parser errors.
+
+MODULE m
+ IMPLICIT NONE
+
+ TYPE, ABSTRACT, EXTENDS(abst_t), ABSTRACT :: error_t ! { dg-error "Duplicate ABSTRACT attribute" }
+ INTEGER :: y
+ END TYPE error_t ! { dg-error "END MODULE" }
+
+END MODULE m
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_3.f03 b/gcc/testsuite/gfortran.dg/abstract_type_3.f03
new file mode 100644
index 00000000000..abeeec9dc6a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_3.f03
@@ -0,0 +1,51 @@
+! { dg-do "compile" }
+
+! Abstract Types.
+! Check for errors when using abstract types in an inappropriate way.
+
+MODULE m
+ USE ISO_C_BINDING
+ IMPLICIT NONE
+
+ TYPE, ABSTRACT, BIND(C) :: bindc_t ! { dg-error "must not be ABSTRACT" }
+ INTEGER(C_INT) :: x
+ END TYPE bindc_t
+
+ TYPE, ABSTRACT :: sequence_t ! { dg-error "must not be ABSTRACT" }
+ SEQUENCE
+ INTEGER :: x
+ END TYPE sequence_t
+
+ TYPE, ABSTRACT :: abst_t
+ INTEGER :: x = 0
+ END TYPE abst_t
+
+ TYPE, EXTENDS(abst_t) :: concrete_t
+ INTEGER :: y = 1
+ END TYPE concrete_t
+
+ TYPE :: myt
+ TYPE(abst_t) :: comp ! { dg-error "is of the ABSTRACT type 'abst_t'" }
+ END TYPE myt
+
+ ! This should be ok.
+ TYPE, ABSTRACT, EXTENDS(concrete_t) :: again_abst_t
+ INTEGER :: z = 2
+ END TYPE again_abst_t
+
+CONTAINS
+
+ TYPE(abst_t) FUNCTION func () ! { dg-error "of the ABSTRACT type 'abst_t'" }
+ END FUNCTION func
+
+ SUBROUTINE sub (arg) ! { dg-error "is of the ABSTRACT type 'again_abst_t'" }
+ IMPLICIT NONE
+ TYPE(again_abst_t) :: arg
+ arg = again_abst_t () ! { dg-error "Can't construct ABSTRACT type 'again_abst_t'" }
+ END SUBROUTINE sub
+
+ SUBROUTINE impl ()
+ IMPLICIT TYPE(abst_t) (a-z) ! { dg-error "ABSTRACT type 'abst_t' used" }
+ END SUBROUTINE impl
+
+END MODULE m
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_4.f03 b/gcc/testsuite/gfortran.dg/abstract_type_4.f03
new file mode 100644
index 00000000000..89fd3b03272
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_4.f03
@@ -0,0 +1,28 @@
+! { dg-do "compile" }
+
+! Abstract Types.
+! Check for module file IO.
+
+MODULE m
+ IMPLICIT NONE
+
+ TYPE, ABSTRACT :: abst_t
+ INTEGER :: x
+ END TYPE abst_t
+
+ TYPE, EXTENDS(abst_t) :: concrete_t
+ INTEGER :: y
+ END TYPE concrete_t
+
+END MODULE m
+
+PROGRAM main
+ USE m
+ IMPLICIT NONE
+
+ TYPE(abst_t) :: abst ! { dg-error "is of the ABSTRACT type 'abst_t'" }
+ TYPE(concrete_t) :: conc
+
+ ! See if constructing the extending type works.
+ conc = concrete_t (1, 2)
+END PROGRAM main
View Lorry Controller Status