procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/43366 ([OOP][F08] Intrinsic assign to polymorphic variable)

Browse source 
2013-09-15  Tobias Burnus  <burnus@net-b.de>

        PR fortran/43366
        * primary.c (gfc_variable_attr): Also handle codimension.
        * resolve.c (resolve_ordinary_assign): Add invalid-diagnostic
        * for
        polymorphic assignment.

2013-09-15  Tobias Burnus  <burnus@net-b.de>

        PR fortran/43366
        * gfortran.dg/class_39.f03: Update dg-error.
        * gfortran.dg/class_5.f03: Ditto.
        * gfortran.dg/class_53.f90: Ditto.
        * gfortran.dg/realloc_on_assign_20.f90: New.
        * gfortran.dg/realloc_on_assign_21.f90: New.
        * gfortran.dg/realloc_on_assign_22.f90: New.

From-SVN: r202713
This commit is contained in:
Tobias Burnus 2013-09-18 20:14:57 +02:00 • committed by Tobias Burnus
parent 3f3fd87d46
commit 83ba23b7aa
10 changed files with 94 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -1,3 +1,10 @@
2013-09-18 Tobias Burnus <burnus@net-b.de>
PR fortran/43366
* primary.c (gfc_variable_attr): Also handle codimension.
* resolve.c (resolve_ordinary_assign): Add invalid-diagnostic for
polymorphic assignment.
2013-09-16 Tobias Burnus <burnus@net-b.de>
PR fortran/58356

7
gcc/fortran/primary.c
View file

@ -2134,7 +2134,7 @@ check_substring:
symbol_attribute
gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
{
int dimension, pointer, allocatable, target;
int dimension, codimension, pointer, allocatable, target;
symbol_attribute attr;
gfc_ref *ref;
gfc_symbol *sym;
@ -2149,12 +2149,14 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
{
dimension = CLASS_DATA (sym)->attr.dimension;
codimension = CLASS_DATA (sym)->attr.codimension;
pointer = CLASS_DATA (sym)->attr.class_pointer;
allocatable = CLASS_DATA (sym)->attr.allocatable;
}
else
{
dimension = attr.dimension;
codimension = attr.codimension;
pointer = attr.pointer;
allocatable = attr.allocatable;
}
@ -2209,11 +2211,13 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
if (comp->ts.type == BT_CLASS)
{
codimension = CLASS_DATA (comp)->attr.codimension;
pointer = CLASS_DATA (comp)->attr.class_pointer;
allocatable = CLASS_DATA (comp)->attr.allocatable;
}
else
{
codimension = comp->attr.codimension;
pointer = comp->attr.pointer;
allocatable = comp->attr.allocatable;
}
@ -2228,6 +2232,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
}
attr.dimension = dimension;
attr.codimension = codimension;
attr.pointer = pointer;
attr.allocatable = allocatable;
attr.target = target;

36
gcc/fortran/resolve.c
View file

@ -9014,6 +9014,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
int rlen = 0;
int n;
gfc_ref *ref;
symbol_attribute attr;
if (gfc_extend_assign (code, ns))
{
@ -9178,14 +9179,35 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
gfc_current_ns->proc_name->attr.implicit_pure = 0;
}
/* F03:7.4.1.2. */
/* FIXME: Valid in Fortran 2008, unless the LHS is both polymorphic
and coindexed; cf. F2008, 7.2.1.2 and PR 43366. */
if (lhs->ts.type == BT_CLASS)
/* F2008, 7.2.1.2. */
attr = gfc_expr_attr (lhs);
if (lhs->ts.type == BT_CLASS && attr.allocatable)
{
gfc_error ("Variable must not be polymorphic in intrinsic assignment at "
"%L - check that there is a matching specific subroutine "
"for '=' operator", &lhs->where);
if (attr.codimension)
{
gfc_error ("Assignment to polymorphic coarray at %L is not "
"permitted", &lhs->where);
return false;
}
if (!gfc_notify_std (GFC_STD_F2008, "Assignment to an allocatable "
"polymorphic variable at %L", &lhs->where))
return false;
if (!gfc_option.flag_realloc_lhs)
{
gfc_error ("Assignment to an allocatable polymorphic variable at %L "
"requires -frealloc-lhs", &lhs->where);
return false;
}
/* See PR 43366. */
gfc_error ("Assignment to an allocatable polymorphic variable at %L "
"is not yet supported", &lhs->where);
return false;
}
else if (lhs->ts.type == BT_CLASS)
{
gfc_error ("Nonallocatable variable must not be polymorphic in intrinsic "
"assignment at %L - check that there is a matching specific "
"subroutine for '=' operator", &lhs->where);
return false;
}

10
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,13 @@
2013-09-18 Tobias Burnus <burnus@net-b.de>
PR fortran/43366
* gfortran.dg/class_39.f03: Update dg-error.
* gfortran.dg/class_5.f03: Ditto.
* gfortran.dg/class_53.f90: Ditto.
* gfortran.dg/realloc_on_assign_20.f90: New.
* gfortran.dg/realloc_on_assign_21.f90: New.
* gfortran.dg/realloc_on_assign_22.f90: New.
2013-09-18 Paolo Carlini <paolo.carlini@oracle.com>
PR c++/58457

2
gcc/testsuite/gfortran.dg/class_39.f03
View file

@ -8,6 +8,6 @@
end type T
contains
class(T) function add() ! { dg-error "must be dummy, allocatable or pointer" }
add = 1 ! { dg-error "Variable must not be polymorphic in intrinsic assignment" }
add = 1 ! { dg-error "Nonallocatable variable must not be polymorphic in intrinsic assignment" }
end function
end

3
gcc/testsuite/gfortran.dg/class_5.f03
View file

@ -20,7 +20,7 @@
x = t2(45,478)
allocate(t2 :: cp)
cp = x ! { dg-error "Variable must not be polymorphic" }
cp = x ! { dg-error "Nonallocatable variable must not be polymorphic" }
select type (cp)
type is (t2)
@ -28,4 +28,3 @@
end select
end

2
gcc/testsuite/gfortran.dg/class_53.f90
View file

@ -13,6 +13,6 @@ end type
type(arr_t) :: this
class(arr_t) :: elem ! { dg-error "must be dummy, allocatable or pointer" }
elem = this ! { dg-error "Variable must not be polymorphic in intrinsic assignment" }
elem = this ! { dg-error "Nonallocatable variable must not be polymorphic in intrinsic assignment" }
end

13
gcc/testsuite/gfortran.dg/realloc_on_assign_20.f90 Normal file
View file

@ -0,0 +1,13 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! PR fortran/43366
!
! Invalid assignment to an allocatable polymorphic var.
!
type t
end type t
class(t), allocatable :: var
var = t() ! { dg-error "Fortran 2008: Assignment to an allocatable polymorphic variable" }
end

13
gcc/testsuite/gfortran.dg/realloc_on_assign_21.f90 Normal file
View file

@ -0,0 +1,13 @@
! { dg-do compile }
! { dg-options "-fno-realloc-lhs" }
!
! PR fortran/43366
!
! Invalid assignment to an allocatable polymorphic var.
!
type t
end type t
class(t), allocatable :: var
var = t() ! { dg-error "Assignment to an allocatable polymorphic variable at .1. requires -frealloc-lhs" }
end

13
gcc/testsuite/gfortran.dg/realloc_on_assign_22.f90 Normal file
View file

@ -0,0 +1,13 @@
! { dg-do compile }
! { dg-options "-fcoarray=single" }
!
! PR fortran/43366
!
! Invalid assignment to an allocatable polymorphic var.
!
type t
end type t
class(t), allocatable :: caf[:]
caf = t() ! { dg-error "Assignment to polymorphic coarray at .1. is not permitted" }
end