2009-07-26 Tobias Burnus <burnus@net-b.de>

        PR fortran/33197
        * intrinsic.c (make_generic): Remove assert as "atan" can be
        both ISYM_ATAN and ISYM_ATAN2.
        (add_functions): Add two-argument variant of ATAN.
        * intrinsic.h (gfc_check_atan_2): Add check for it.
        * intrinsic.texi (ATAN2): Correct and enhance description.
        (ATAN): Describe two-argument variant of ATAN.

2009-07-26  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * gfortran.dg/atan2_1.f90: New test
        * gfortran.dg/atan2_2.f90: New test

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150100 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 363889f..ca320ca 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2009-07-26  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/33197
+       * intrinsic.c (make_generic): Remove assert as "atan" can be
+       both ISYM_ATAN and ISYM_ATAN2.
+       (add_functions): Add two-argument variant of ATAN.
+       * intrinsic.h (gfc_check_atan_2): Add check for it.
+       * intrinsic.texi (ATAN2): Correct and enhance description.
+       (ATAN): Describe two-argument variant of ATAN.
+
 2009-07-25  Tobias Burnus  <burnus@net-b.de>
            Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index e19f812..779af20 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -676,6 +676,19 @@ null_arg:
 
 
 gfc_try
+gfc_check_atan_2 (gfc_expr *y, gfc_expr *x)
+{
+  /* gfc_notify_std would be a wast of time as the return value
+     is seemingly used only for the generic resolution.  The error
+     will be: Too many arguments.  */
+  if ((gfc_option.allow_std & GFC_STD_F2008) == 0)
+    return FAILURE;
+
+  return gfc_check_atan2 (y, x);
+}
+
+
+gfc_try
 gfc_check_atan2 (gfc_expr *y, gfc_expr *x)
 {
   if (type_check (y, 0, BT_REAL) == FAILURE)

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 0b2d1b8..d2cdb59 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1008,8 +1008,6 @@ make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
 
   while (g->name != NULL)
     {
-      gcc_assert (g->id == id);
-
       g->next = g + 1;
       g->specific = 1;
       g++;
@@ -1250,6 +1248,11 @@ add_functions (void)
             gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
             x, BT_REAL, dd, REQUIRED);
 
+  /* Two-argument version of atan, equivalent to atan2.  */
+  add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
+            gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
+            y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
+
   make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
   
   add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,

diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 1e2fbd7..a239ad6 100644 (file)
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -37,6 +37,7 @@ gfc_try gfc_check_achar (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_all_any (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_allocated (gfc_expr *);
 gfc_try gfc_check_associated (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_atan_2 (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_atan2 (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_besn (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_btest (gfc_expr *, gfc_expr *);

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 2e6908f..2c993b9 100644 (file)
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -1353,22 +1353,28 @@ end program test_associated
 @code{ATAN(X)} computes the arctangent of @var{X}.
 
 @item @emph{Standard}:
-Fortran 77 and later, for a complex argument Fortran 2008 or later
+Fortran 77 and later, for a complex argument and for two arguments
+Fortran 2008 or later
 
 @item @emph{Class}:
 Elemental function
 
 @item @emph{Syntax}:
 @code{RESULT = ATAN(X)}
+@code{RESULT = ATAN(Y, X)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX};
+if @var{Y} is present, @var{X} shall be REAL.
+@item @var{Y} shall be of the same type and kind as @var{X}.
 @end multitable
 
 @item @emph{Return value}:
 The return value is of the same type and kind as @var{X}.
-The real part of the result is in radians and lies in the range
+If @var{Y} is present, the result is identical to @code{ATAN2(Y,X)}.
+Otherwise, it the arcus tangent of @var{X}, where the real part of
+the result is in radians and lies in the range
 @math{-\pi/2 \leq \Re \atan(x) \leq \pi/2}.
 
 @item @emph{Example}:
@@ -1401,8 +1407,10 @@ Inverse function: @ref{TAN}
 
 @table @asis
 @item @emph{Description}:
-@code{ATAN2(Y, X)} computes the arctangent of the complex number
-@math{X + i Y}.
+@code{ATAN2(Y, X)} computes the principal value of the argument
+function of the complex number @math{X + i Y}. This function can
+be used to transform from carthesian into polar coordinates and
+allows to determine the angle in the correct quadrant.
 
 @item @emph{Standard}:
 Fortran 77 and later

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a8cea75..f9bbf62 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2009-07-26  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/33197
+       * gfortran.dg/atan2_1.f90: New test
+       * gfortran.dg/atan2_2.f90: New test
+
 2007-07-26  Simon Martin  <simartin@users.sourceforge.net>
 
        PR c++/40749

diff --git a/gcc/testsuite/gfortran.dg/atan2_1.f90 b/gcc/testsuite/gfortran.dg/atan2_1.f90
new file mode 100644 (file)
index 0000000..1f998a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/atan2_1.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+! PR fortran/33197
+!
+! Check for Fortran 2008's ATAN(Y,X) - which is equivalent
+! to Fortran 77's ATAN2(Y,X).
+!
+integer :: i
+real, parameter :: pi4 = 2*acos(0.0)
+real, parameter :: pi8 = 2*acos(0.0d0)
+do i = 1, 10
+  if(atan(1.0,  i/10.0)  -atan2(1.0,  i/10.)    /= 0.0)   call abort()
+  if(atan(1.0d0,i/10.0d0)-atan2(1.0d0,i/10.0d0) /= 0.0d0) call abort()
+end do
+
+! Atan(1,1) = Pi/4
+if (abs(atan(1.0,1.0)    -pi4/4.0)   > epsilon(pi4)) call abort()
+if (abs(atan(1.0d0,1.0d0)-pi8/4.0d0) > epsilon(pi8)) call abort()
+
+! Atan(-1,1) = -Pi/4
+if (abs(atan(-1.0,1.0)    +pi4/4.0)   > epsilon(pi4)) call abort()
+if (abs(atan(-1.0d0,1.0d0)+pi8/4.0d0) > epsilon(pi8)) call abort()
+
+! Atan(1,-1) = 3/4*Pi
+if (abs(atan(1.0,-1.0)    -3.0*pi4/4.0)     > epsilon(pi4)) call abort()
+if (abs(atan(1.0d0,-1.0d0)-3.0d0*pi8/4.0d0) > epsilon(pi8)) call abort()
+
+! Atan(-1,-1) = -3/4*Pi
+if (abs(atan(-1.0,-1.0)    +3.0*pi4/4.0)     > epsilon(pi4)) call abort()
+if (abs(atan(-1.0d0,-1.0d0)+3.0d0*pi8/4.0d0) > epsilon(pi8)) call abort()
+
+! Atan(3,-5) = 2.60117315331920908301906501867... = Pi - 3/2 atan(3/5)
+if (abs(atan(3.0,-5.0)    -2.60117315331920908301906501867) > epsilon(pi4)) call abort()
+if (abs(atan(3.0d0,-5.0d0)-2.60117315331920908301906501867d0) > epsilon(pi8)) call abort()
+
+end

diff --git a/gcc/testsuite/gfortran.dg/atan2_2.f90 b/gcc/testsuite/gfortran.dg/atan2_2.f90
new file mode 100644 (file)
index 0000000..407e83a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/atan2_2.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/33197
+!
+! Check for Fortran 2008's ATAN(Y,X) - which is equivalent
+! to Fortran 77's ATAN2(Y,X).
+!
+real(4)    :: r4
+real(8)    :: r8
+complex(4) :: c4
+complex(8) :: c8
+
+r4 = atan2(r4,r4)
+r8 = atan2(r8,r8)
+
+r4 = atan(r4,r4) ! { dg-error "Too many arguments in call to 'atan'" }
+r8 = atan(r8,r8) ! { dg-error "Too many arguments in call to 'atan'" }
+
+r4 = atan2(r4,r8) ! { dg-error "same type and kind" }
+r4 = atan2(r8,r4) ! { dg-error "same type and kind" }
+
+r4 = atan2(c4,r8) ! { dg-error "must be REAL" }
+r4 = atan2(c8,r4) ! { dg-error "must be REAL" }
+r4 = atan2(r4,c8) ! { dg-error "same type and kind" }
+r4 = atan2(r8,c4) ! { dg-error "same type and kind" }
+
+r4 = atan2(c4,c8) ! { dg-error "must be REAL" }
+r4 = atan2(c8,c4) ! { dg-error "must be REAL" }
+end