diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/fortran/check.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/class.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 5 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 7 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/associate_13.f90 | 21 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/associate_14.f90 | 56 |
8 files changed, 110 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 102f212..38ae004 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2013-01-27 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/55789 + PR fortran/56047 + * gfortran.h : Add associate_var to symbol_attr. + * resolve.c (resolve_assoc_var): Set associate_var attribute. + If the target class_ok is set, set it for the associate + variable. + * check.c (allocatable_check): Associate variables should not + have the allocatable attribute even if their symbols do. + * class.c (gfc_build_class_symbol): Symbols with associate_var + set will always have a good class container. + 2013-01-23 Janus Weil <janus@gcc.gnu.org> PR fortran/56081 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index de1b729..8bd0645 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -454,7 +454,7 @@ allocatable_check (gfc_expr *e, int n) symbol_attribute attr; attr = gfc_variable_attr (e, NULL); - if (!attr.allocatable) + if (!attr.allocatable || attr.associate_var) { gfc_error ("'%s' argument of '%s' intrinsic at %L must be ALLOCATABLE", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 9ef30f6..d8e7b6d 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -568,7 +568,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, return SUCCESS; attr->class_ok = attr->dummy || attr->pointer || attr->allocatable - || attr->select_type_temporary; + || attr->select_type_temporary || attr->associate_var; if (!attr->class_ok) /* We can not build the class container yet. */ diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index ed05c10..6be507f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -803,8 +803,9 @@ typedef struct private_comp:1, zero_comp:1, coarray_comp:1, lock_comp:1, defined_assign_comp:1, unlimited_polymorphic:1; - /* This is a temporary selector for SELECT TYPE. */ - unsigned select_type_temporary:1; + /* This is a temporary selector for SELECT TYPE or an associate + variable for SELECT_TYPE or ASSOCIATE. */ + unsigned select_type_temporary:1, associate_var:1; /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ddb6d67..f2e6b9d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8325,6 +8325,13 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) has no corank. */ sym->as->corank = 0; } + + /* Mark this as an associate variable. */ + sym->attr.associate_var = 1; + + /* If the target is a good class object, so is the associate variable. */ + if (sym->ts.type == BT_CLASS && gfc_expr_attr (target).class_ok) + sym->attr.class_ok = 1; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index db9f367..b2fbe88 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2013-01-27 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/55789 + * gfortran.dg/associate_14.f90: New test. + + PR fortran/56047 + * gfortran.dg/associate_13.f90: New test. + 2013-01-25 Jakub Jelinek <jakub@redhat.com> PR tree-optimization/56098 diff --git a/gcc/testsuite/gfortran.dg/associate_13.f90 b/gcc/testsuite/gfortran.dg/associate_13.f90 new file mode 100644 index 0000000..7c64d3f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_13.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +! +! Tests the fix for PR56047. This is actually a development of +! the test case of comment #10. +! +! Reported by Juergen Reuter <juergen.reuter@desy.de> +! + implicit none + type :: process_variant_def_t + integer :: i + end type + type :: process_component_def_t + class(process_variant_def_t), allocatable :: variant_def + end type + type(process_component_def_t), dimension(1:2) :: initial + allocate (initial(1)%variant_def, source = process_variant_def_t (99)) + associate (template => initial(1)%variant_def) + template%i = 77 + end associate + if (initial(1)%variant_def%i .ne. 77) call abort +end diff --git a/gcc/testsuite/gfortran.dg/associate_14.f90 b/gcc/testsuite/gfortran.dg/associate_14.f90 new file mode 100644 index 0000000..765e365 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_14.f90 @@ -0,0 +1,56 @@ +! { dg-do compile } +! Tests the fix for PR55984. +! +! Contributed by Sylwester Arabas <slayoo@staszic.waw.pl> +! +module bcd_m + type, abstract :: bcd_t + contains + procedure(bcd_fill_halos), deferred :: fill_halos + end type + abstract interface + subroutine bcd_fill_halos(this) + import :: bcd_t + class(bcd_t ) :: this + end subroutine + end interface +end module + +module solver_m + use bcd_m + type, abstract :: solver_t + integer :: n, hlo + class(bcd_t), pointer :: bcx, bcy + contains + procedure(solver_advop), deferred :: advop + end type + abstract interface + subroutine solver_advop(this) + import solver_t + class(solver_t) :: this + end subroutine + end interface + contains +end module + +module solver_mpdata_m + use solver_m + type :: mpdata_t + class(bcd_t), pointer :: bcx, bcy + contains + procedure :: advop => mpdata_advop + end type + contains + subroutine mpdata_advop(this) + class(mpdata_t) :: this + associate ( bcx => this%bcx, bcy => this%bcy ) + call bcx%fill_halos() + end associate + end subroutine +end module + + use solver_mpdata_m + class(mpdata_t), allocatable :: that + call mpdata_advop (that) +end + |