OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/58793 (Wrong value for _vtab for intrinsic types with CLASS(*): storage_size of class(*) gives wrong result) 

2013-10-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/58793
        * interface.c (compare_parameter): Reject passing TYPE(*)
        to CLASS(*).

2013-10-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/58793
        * gfortran.dg/assumed_type_8.f90: New.

From-SVN: r203945
This commit is contained in:
Tobias Burnus 2013-10-23 07:44:02 +02:00 committed by Tobias Burnus
parent 55384dd76a
commit 3d54e57648
4 changed files with 39 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2013-10-23 Tobias Burnus <burnus@net-b.de>
PR fortran/58793
* interface.c (compare_parameter): Reject passing TYPE(*)
to CLASS(*).
2013-10-22 Paul Thomas <pault@gcc.gnu.org>
PR fortran 57893

9
gcc/fortran/interface.c
View File

@ -1972,6 +1972,15 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
return 0;
}
if (actual->ts.type == BT_ASSUMED && formal->ts.type != BT_ASSUMED)
{
if (where)
gfc_error ("Assumed-type actual argument at %L requires that dummy "
"argument '%s' is of assumed type", &actual->where,
formal->name);
return 0;
}
/* F2008, 12.5.2.5; IR F08/0073. */
if (formal->ts.type == BT_CLASS && formal->attr.class_ok
&& actual->expr_type != EXPR_NULL

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2013-10-23 Tobias Burnus <burnus@net-b.de>
PR fortran/58793
* gfortran.dg/assumed_type_8.f90: New.
2013-10-22 Uros Bizjak <ubizjak@gmail.com>
PR target/58779

19
gcc/testsuite/gfortran.dg/assumed_type_8.f90 Normal file
View File

@ -0,0 +1,19 @@
! { dg-do compile }
!
! Issue came up during the review of PR fortran/58793
!
! Test for TS29113:2012's C407b.
!
program test
use iso_c_binding
integer,target ::aa
call up(c_loc(aa))
contains
subroutine up(x)
class(*) :: x
end subroutine
subroutine bar(x)
type(*) :: x
call up(x) ! { dg-error "Assumed-type actual argument at .1. requires that dummy argument 'x' is of assumed type" }
end subroutine bar
end program test