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

re PR fortran/27546 (IMPORT is broken)

Browse source 
fortran/
2006-11-17  Tobias Burnus  <burnus@net-b.de>

    PR fortran/27546
    * primary.c (gfc_match_rvalue): Added IMPORT support.

testsuite/
2006-11-17  Tobias Burnus  <burnus@net-b.de>

    PR fortran/27546
    * gfortran.dg/import.f90: Extended test.
    * gfortran.dg/import2.f90: Extended test.

From-SVN: r119028
This commit is contained in:
Tobias Burnus 2006-11-20 22:29:32 +01:00 • committed by Tobias Burnus
parent 02022f3a70
commit 2a6dcee5c3
5 changed files with 65 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View file

@ -1,3 +1,8 @@
2006-11-20 Tobias Burnus <burnus@net-b.de>
PR fortran/27546
* primary.c (gfc_match_rvalue): Added IMPORT support.
2006-11-20 Tobias Burnus <burnus@net-b.de>
* symbol.c (check_conflict): Add conflict between VOLATILE

3
gcc/fortran/primary.c
View file

@ -1917,7 +1917,8 @@ gfc_match_rvalue (gfc_expr ** result)
if (m != MATCH_YES)
return m;
if (gfc_find_state (COMP_INTERFACE) == SUCCESS)
if (gfc_find_state (COMP_INTERFACE) == SUCCESS
&& !gfc_current_ns->has_import_set)
i = gfc_get_sym_tree (name, NULL, &symtree);
else
i = gfc_get_ha_sym_tree (name, &symtree);

6
gcc/testsuite/ChangeLog
View file

@ -10,6 +10,12 @@
PR tree-opt/25500
* gcc.dg/tree-ssa/sra-4.c: New testcase.
2006-11-20 Tobias Burnus <burnus@net-b.de>
PR fortran/27546
* gfortran.dg/import.f90: Extended test.
* gfortran.dg/import2.f90: Extended test.
2006-11-20 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/volatile3.f90: Add conflict test.

30
gcc/testsuite/gfortran.dg/import.f90
View file

@ -13,18 +13,36 @@ subroutine test(x)
end subroutine test
subroutine bar(x)
subroutine bar(x,y)
type myType
sequence
integer :: i
end type myType
type(myType) :: x
integer(8) :: y
if(y /= 8) call abort()
if(x%i /= 2) call abort()
x%i = 5
y = 42
end subroutine bar
module testmod
implicit none
integer, parameter :: kind = 8
type modType
real :: rv
end type modType
interface
subroutine other(x,y)
import
real(kind) :: x
type(modType) :: y
end subroutine
end interface
end module testmod
program foo
integer, parameter :: dp = 8
type myType
sequence
integer :: i
@ -34,9 +52,10 @@ program foo
integer :: i
end type myType3
interface
subroutine bar(x)
subroutine bar(x,y)
import
type(myType) :: x
integer(dp) :: y
end subroutine bar
subroutine test(x)
import :: myType3
@ -47,10 +66,13 @@ program foo
type(myType) :: y
type(myType3) :: z
integer(8) :: i8
y%i = 2
call bar(y)
if(y%i /= 5) call abort()
i8 = 8
call bar(y,i8)
if(y%i /= 5 .or. i8/= 42) call abort()
z%i = 7
call test(z)
if(z%i /= 1) call abort()
end program foo
! { dg-final { cleanup-modules "testmod" } }

30
gcc/testsuite/gfortran.dg/import2.f90
View file

@ -15,18 +15,36 @@ subroutine test(x)
end subroutine test
subroutine bar(x)
subroutine bar(x,y)
type myType
sequence
integer :: i
end type myType
type(myType) :: x
integer(8) :: y
if(y /= 8) call abort()
if(x%i /= 2) call abort()
x%i = 5
y = 42
end subroutine bar
module testmod
implicit none
integer, parameter :: kind = 8
type modType
real :: rv
end type modType
interface
subroutine other(x,y)
import ! { dg-error "Fortran 2003: IMPORT statement" }
type(modType) :: y ! { dg-error "not been declared within the interface" }
real(kind) :: x ! { dg-error "has not been declared" }
end subroutine
end interface
end module testmod
program foo
integer, parameter :: dp = 8
type myType
sequence
integer :: i
@ -36,9 +54,10 @@ program foo
integer :: i
end type myType3
interface
subroutine bar(x)
subroutine bar(x,y)
import ! { dg-error "Fortran 2003: IMPORT statement" }
type(myType) :: x ! { dg-error "not been declared within the interface" }
integer(dp) :: y ! { dg-error "has not been declared" }
end subroutine bar
subroutine test(x)
import :: myType3 ! { dg-error "Fortran 2003: IMPORT statement" }
@ -49,10 +68,13 @@ program foo
type(myType) :: y
type(myType3) :: z
integer(dp) :: i8
y%i = 2
call bar(y) ! { dg-error "Type/rank mismatch in argument" }
if(y%i /= 5) call abort()
i8 = 8
call bar(y,i8) ! { dg-error "Type/rank mismatch in argument" }
if(y%i /= 5 .or. i8/= 42) call abort()
z%i = 7
call test(z) ! { dg-error "Type/rank mismatch in argument" }
if(z%i /= 1) call abort()
end program foo
! { dg-final { cleanup-modules "testmod" } }