diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3580963bdef3..b7e4c4ad34c7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-07-08 Tobias Burnus + + * module.c (gfc_match_use): Support renaming of operators + in USE statements. + * gfortran.texi (Fortran 2003 Status): Document support of + renaming of operators. + 2007-07-08 Tobias Burnus PR fortran/30973 diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 3f4a14943c24..52b4c2c1c8c0 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -764,6 +764,9 @@ host-associated derived types. attribute; supported intrinsic modules: @code{ISO_FORTRAN_ENV}, @code{OMP_LIB} and @code{OMP_LIB_KINDS}. +@item +Renaming of operators in the @code{USE} statement. + @end itemize diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index fcae6bd7d3f7..5b8bd550f9a3 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -488,7 +488,7 @@ gfc_match_use (void) { char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1]; gfc_use_rename *tail = NULL, *new; - interface_type type; + interface_type type, type2; gfc_intrinsic_op operator; match m; @@ -588,9 +588,16 @@ gfc_match_use (void) gfc_error ("Missing generic specification in USE statement at %C"); goto cleanup; + case INTERFACE_USER_OP: case INTERFACE_GENERIC: m = gfc_match (" =>"); + if (type == INTERFACE_USER_OP && m == MATCH_YES + && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Renaming " + "operators in USE statements at %C") + == FAILURE)) + goto cleanup; + if (only_flag) { if (m != MATCH_YES) @@ -598,8 +605,9 @@ gfc_match_use (void) else { strcpy (new->local_name, name); - - m = gfc_match_name (new->use_name); + m = gfc_match_generic_spec (&type2, new->use_name, &operator); + if (type != type2) + goto syntax; if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) @@ -612,7 +620,9 @@ gfc_match_use (void) goto syntax; strcpy (new->local_name, name); - m = gfc_match_name (new->use_name); + m = gfc_match_generic_spec (&type2, new->use_name, &operator); + if (type != type2) + goto syntax; if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) @@ -627,11 +637,10 @@ gfc_match_use (void) goto cleanup; } - break; + if (type == INTERFACE_USER_OP) + new->operator = operator; - case INTERFACE_USER_OP: - strcpy (new->use_name, name); - /* Fall through */ + break; case INTERFACE_INTRINSIC_OP: new->operator = operator; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index dbc2c1fe91b8..cef80b0e2548 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-03-08 Tobias Burnus + + * gfortran.dg/use_5.f90: New test. + * gfortran.dg/use_6.f90: Ditto. + * gfortran.dg/use_7.f90: Ditto. + 2007-03-08 Tobias Burnus PR fortran/30973 diff --git a/gcc/testsuite/gfortran.dg/use_5.f90 b/gcc/testsuite/gfortran.dg/use_5.f90 new file mode 100644 index 000000000000..6d2de048043c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_5.f90 @@ -0,0 +1,49 @@ +! { dg-do "run" } +! Renaming of operators +module z + interface operator(.addfive.) + module procedure sub2 + end interface +contains +function sub2(x) + integer :: sub + integer,intent(in) :: x + sub2 = x + 5 +end function sub2 +end module z + +module y + interface operator(.addfive.) + module procedure sub + end interface +contains +function sub(x) + integer :: sub + integer,intent(in) :: x + sub = x + 15 +end function sub +end module y + +module x + interface operator(.addfive.) + module procedure sub + end interface +contains +function sub(x) + integer :: sub + integer,intent(in) :: x + sub = x + 25 +end function sub +end module x + +use x, only : operator(.bar.) => operator(.addfive.) +use y, operator(.my.) => operator(.addfive.) +use z + integer :: i + i = 2 + if ((.bar. i) /= 2+25) call abort () + if ((.my. i) /= 2+15) call abort () + if ((.addfive. i) /= 2+5) call abort () +end + +! { dg-final { cleanup-tree-dump "x y z" } } diff --git a/gcc/testsuite/gfortran.dg/use_6.f90 b/gcc/testsuite/gfortran.dg/use_6.f90 new file mode 100644 index 000000000000..f0b133e67aef --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_6.f90 @@ -0,0 +1,45 @@ +! { dg-do "compile" } +! { dg-options "-std=f95" } +! Renaming of operators +module z + interface operator(.addfive.) + module procedure sub2 + end interface +contains +function sub2(x) + integer :: sub + integer,intent(in) :: x + sub2 = x + 5 +end function sub2 +end module z + +module y + interface operator(.addfive.) + module procedure sub + end interface +contains +function sub(x) + integer :: sub + integer,intent(in) :: x + sub = x + 15 +end function sub +end module y + +module x + interface operator(.addfive.) + module procedure sub + end interface +contains +function sub(x) + integer :: sub + integer,intent(in) :: x + sub = x + 25 +end function sub +end module x + +use x, only : operator(.bar.) => operator(.addfive.) ! { dg-error "Fortran 2003: Renaming operators in USE statements" } +use y, operator(.my.) => operator(.addfive.) ! { dg-error "Fortran 2003: Renaming operators in USE statements" } +use z +end + +! { dg-final { cleanup-tree-dump "x y z" } } diff --git a/gcc/testsuite/gfortran.dg/use_7.f90 b/gcc/testsuite/gfortran.dg/use_7.f90 new file mode 100644 index 000000000000..3973176b09bc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_7.f90 @@ -0,0 +1,49 @@ +! { dg-do "compile" } +! Renaming of operators +module z + type myT + integer :: t + end type myT + interface operator(+) + module procedure sub2 + end interface +contains +function sub2(x) + type(myT) :: sub2 + type(myT),intent(in) :: x + sub2%t = x%t + 5 +end function sub2 +end module z + +module y + interface operator(.addfive.) + module procedure sub + end interface +contains +function sub(x) + integer :: sub + integer,intent(in) :: x + sub = x + 15 +end function sub +end module y + +module x + interface operator(.addfive.) + module procedure sub + end interface +contains +function sub(x) + integer :: sub + integer,intent(in) :: x + sub = x + 25 +end function sub +end module x + +use z, operator(-) => operator(+) ! { dg-error "Syntax error in USE statement" } +use z, operator(.op.) => operator(+) ! { dg-error "Syntax error in USE statement" } +use x, only : bar => operator(.addfive.) ! { dg-error "Syntax error in USE statement" } +use y, operator(.my.) => sub ! { dg-error "Syntax error in USE statement" } +use y, operator(+) => operator(.addfive.) ! { dg-error "Syntax error in USE statement" } +end + +! { dg-final { cleanup-tree-dump "x y z" } }