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

re PR fortran/52270 ([OOP] Polymorphic vars: wrong intent(in) check, passing nonptr variable to intent(in) ptr dummy)

Browse source 
2012-03-02  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52270
        * expr.c (gfc_check_vardef_context): Fix check for
        intent-in polymorphic pointer .
        * interface.c (compare_parameter): Allow passing TYPE to
        intent-in polymorphic pointer.

2012-03-02  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52270
        * gfortran.dg/class_51.f90: New.

From-SVN: r184784
This commit is contained in:
Tobias Burnus 2012-03-02 14:07:46 +01:00 • committed by Tobias Burnus
parent 2d68f67f2f
commit f18075fff5
6 changed files with 70 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -1,3 +1,11 @@
2012-03-02 Tobias Burnus <burnus@net-b.de>
PR fortran/52270
* expr.c (gfc_check_vardef_context): Fix check for
intent-in polymorphic pointer .
* interface.c (compare_parameter): Allow passing TYPE to
intent-in polymorphic pointer.
2012-03-02 Tobias Burnus <burnus@net-b.de>
PR fortran/52452

3
gcc/fortran/expr.c
View file

@ -4648,7 +4648,8 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
the component of sub-component of a pointer. Obviously,
procedure pointers are of no interest here. */
check_intentin = true;
ptr_component = sym->attr.pointer;
ptr_component = (sym->ts.type == BT_CLASS && CLASS_DATA (sym))
? CLASS_DATA (sym)->attr.class_pointer : sym->attr.pointer;
for (ref = e->ref; ref && check_intentin; ref = ref->next)
{
if (ptr_component && ref->type == REF_COMPONENT)

11
gcc/fortran/interface.c
View file

@ -1579,7 +1579,9 @@ compare_pointer (gfc_symbol *formal, gfc_expr *actual)
{
symbol_attribute attr;
if (formal->attr.pointer)
if (formal->attr.pointer
|| (formal->ts.type == BT_CLASS && CLASS_DATA (formal)
&& CLASS_DATA (formal)->attr.class_pointer))
{
attr = gfc_expr_attr (actual);
@ -1706,10 +1708,11 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
gfc_typename (&formal->ts));
return 0;
}
/* F2008, 12.5.2.5. */
/* F2008, 12.5.2.5; IR F08/0073. */
if (formal->ts.type == BT_CLASS
&& (CLASS_DATA (formal)->attr.class_pointer
&& ((CLASS_DATA (formal)->attr.class_pointer
&& !formal->attr.intent == INTENT_IN)
|| CLASS_DATA (formal)->attr.allocatable))
{
if (actual->ts.type != BT_CLASS)

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2012-03-02 Tobias Burnus <burnus@net-b.de>
PR fortran/52270
* gfortran.dg/class_51.f90: New.
2012-03-02 Tobias Burnus <burnus@net-b.de>
PR fortran/52452

25
gcc/testsuite/gfortran.dg/class_51.f90 Normal file
View file

@ -0,0 +1,25 @@
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! PR fortran/52270
!
! From IR F08/0073 by Malcolm Cohen
!
Program m013
Type t
Real c
End Type
Type(t),Target :: x
Call sub(x)
Print *,x%c
if (x%c /= 3) call abort ()
Contains
Subroutine sub(p)
Class(t),Pointer,Intent(In) :: p
p%c = 3
End Subroutine
End Program
! { dg-final { scan-tree-dump-times "sub \\(&class" 1 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

23
gcc/testsuite/gfortran.dg/class_52.f90 Normal file
View file

@ -0,0 +1,23 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! PR fortran/52270
!
! From IR F08/0073 by Malcolm Cohen
!
Program m013
Type t
Real c
End Type
Type(t),Target :: x
Call sub(x) ! { dg-error "Fortran 2008: Non-pointer actual argument" }
Print *,x%c
if (x%c /= 3) call abort ()
Contains
Subroutine sub(p)
Class(t),Pointer,Intent(In) :: p
p%c = 3
End Subroutine
End Program