gcc/fortran/

2010-08-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * gcc/fortran/intrinsic.c (add_functions): Add norm2 and parity.
        * gcc/fortran/intrinsic.h (gfc_check_norm2, gfc_check_parity):
        gfc_simplify_norm2, gfc_simplify_parity, gfc_resolve_norm2,
        gfc_resolve_parity): New prototypes.
        * gcc/fortran/gfortran.h (gfc_isym_id): New enum items
        GFC_ISYM_NORM2 and GFC_ISYM_PARITY.
        * gcc/fortran/iresolve.c (gfc_resolve_norm2,
        gfc_resolve_parity): New functions.
        * gcc/fortran/check.c (gfc_check_norm2, gfc_check_parity):
        New functions.
        * gcc/fortran/trans-intrinsic.c (gfc_conv_intrinsic_arith,
        gfc_conv_intrinsic_function): Handle NORM2 and PARITY.
        * gcc/fortran/intrinsic.texi (NORM2, PARITY): Add.
        * gcc/fortran/simplify.c (simplify_transformation_to_array):
        Add post-processing opterator.
        (gfc_simplify_all, gfc_simplify_any, gfc_simplify_count,
        gfc_simplify_product, gfc_simplify_sum): Update call.
        (add_squared, do_sqrt, gfc_simplify_norm2, do_xor,
        gfc_simplify_parity): New functions.

gcc/testsuite/
2010-08-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * gcc/testsuite/gfortran.dg/norm2_1.f90: New.
        * gcc/testsuite/gfortran.dg/norm2_2.f90: New.
        * gcc/testsuite/gfortran.dg/norm2_3.f90: New.
        * gcc/testsuite/gfortran.dg/norm2_4.f90: New.
        * gcc/testsuite/gfortran.dg/parity_1.f90: New.
        * gcc/testsuite/gfortran.dg/parity_2.f90: New.
        * gcc/testsuite/gfortran.dg/parity_3.f90: New.

libgfortran/
2010-08-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * libgfortran/m4/ifunction.m4 (FINISH_ARRAY_FUNCTION,
        ARRAY_FUNCTION): Allow expression after loop.
        * libgfortran/m4/norm2.m4: New for _gfortran_norm2_r{4,8,10,16}.
        * libgfortran/m4/parity.m4: New for
        * _gfortran_parity_l{1,2,4,8,16}.
        * libgfortran/gfortran.map: Add new functions.
        * libgfortran/Makefile.am: Ditto.
        * libgfortran/m4/minloc1.m4: Add empty argument for
        * ARRAY_FUNCTION.
        * libgfortran/m4/maxloc1.m4: Ditto.
        * libgfortran/m4/all.m4: Ditto.
        * libgfortran/m4/minval.m4: Ditto.
        * libgfortran/m4/maxval.m4: Ditto.
        * libgfortran/m4/count.m4: Ditto.
        * libgfortran/m4/product.m4: Ditto.
        * libgfortran/m4/any.m4: Ditto.
        * Makefile.in: Regenerated.
        * generated/minval_r8.c: Regenerated.
        * generated/maxloc1_4_r8.c: Regenerated.
        * generated/minloc1_16_r16.c: Regenerated.
        * generated/norm2_r4.c: Regenerated.
        * generated/sum_i8.c: Regenerated.
        * generated/parity_l2.c: Regenerated.
        * generated/any_l16.c: Regenerated.
        * generated/maxval_i2.c: Regenerated.
        * generated/any_l2.c: Regenerated.
        * generated/product_r4.c: Regenerated.
        * generated/maxloc1_8_i4.c: Regenerated.
        * generated/parity_l16.c: Regenerated.
        * generated/all_l1.c: Regenerated.
        * generated/product_i2.c: Regenerated.
        * generated/minloc1_8_r16.c: Regenerated.
        * generated/maxloc1_8_r16.c: Regenerated.
        * generated/sum_r16.c: Regenerated.
        * generated/sum_i1.c: Regenerated.
        * generated/minloc1_4_r8.c: Regenerated.
        * generated/maxloc1_16_r16.c: Regenerated.
        * generated/minloc1_16_i4.c: Regenerated.
        * generated/maxloc1_16_i4.c: Regenerated.
        * generated/maxval_r16.c: Regenerated.
        * generated/product_c10.c: Regenerated.
        * generated/minloc1_8_i4.c: Regenerated.
        * generated/all_l2.c: Regenerated.
        * generated/product_c4.c: Regenerated.
        * generated/sum_r4.c: Regenerated.
        * generated/all_l16.c: Regenerated.
        * generated/minloc1_16_r10.c: Regenerated.
        * generated/sum_i2.c: Regenerated.
        * generated/maxloc1_8_r8.c: Regenerated.
        * generated/minval_i16.c: Regenerated.
        * generated/parity_l4.c: Regenerated.
        * generated/maxval_i4.c: Regenerated.
        * generated/any_l4.c: Regenerated.
        * generated/minval_i8.c: Regenerated.
        * generated/maxloc1_4_i8.c: Regenerated.
        * generated/minloc1_4_i16.c: Regenerated.
        * generated/maxloc1_4_i16.c: Regenerated.
        * generated/minloc1_8_r10.c: Regenerated.
        * generated/product_i4.c: Regenerated.
        * generated/maxloc1_8_r10.c: Regenerated.
        * generated/sum_c16.c: Regenerated.
        * generated/minloc1_16_r8.c: Regenerated.
        * generated/maxloc1_16_r8.c: Regenerated.
        * generated/count_4_l.c: Regenerated.
        * generated/sum_r10.c: Regenerated.
        * generated/count_8_l.c: Regenerated.
        * generated/sum_c4.c: Regenerated.
        * generated/maxloc1_16_r10.c: Regenerated.
        * generated/minloc1_8_r8.c: Regenerated.
        * generated/maxval_r10.c: Regenerated.
        * generated/minval_i1.c: Regenerated.
        * generated/maxloc1_4_i1.c: Regenerated.
        * generated/minloc1_4_i8.c: Regenerated.
        * generated/product_i16.c: Regenerated.
        * generated/all_l4.c: Regenerated.
        * generated/norm2_r16.c: Regenerated.
        * generated/minval_r4.c: Regenerated.
        * generated/maxloc1_4_r4.c: Regenerated.
        * generated/sum_i4.c: Regenerated.
        * generated/maxval_r8.c: Regenerated.
        * generated/norm2_r8.c: Regenerated.
        * generated/minloc1_4_i1.c: Regenerated.
        * generated/minval_r16.c: Regenerated.
        * generated/minval_i2.c: Regenerated.
        * generated/maxloc1_4_i2.c: Regenerated.
        * generated/product_r8.c: Regenerated.
        * generated/maxloc1_8_i8.c: Regenerated.
        * generated/sum_c10.c: Regenerated.
        * generated/minloc1_4_r16.c: Regenerated.
        * generated/maxloc1_4_r16.c: Regenerated.
        * generated/count_1_l.c: Regenerated.
        * generated/minloc1_4_r4.c: Regenerated.
        * generated/minloc1_16_i8.c: Regenerated.
        * generated/maxloc1_16_i8.c: Regenerated.
        * generated/minloc1_4_i2.c: Regenerated.
        * generated/maxloc1_8_i1.c: Regenerated.
        * generated/minloc1_8_i8.c: Regenerated.
        * generated/product_r16.c: Regenerated.
        * generated/product_c8.c: Regenerated.
        * generated/sum_r8.c: Regenerated.
        * generated/norm2_r10.c: Regenerated.
        * generated/minloc1_16_i16.c: Regenerated.
        * generated/maxloc1_8_r4.c: Regenerated.
        * generated/minloc1_16_i1.c: Regenerated.
        * generated/maxloc1_16_i1.c: Regenerated.
        * generated/minval_r10.c: Regenerated.
        * generated/count_16_l.c: Regenerated.
        * generated/parity_l8.c: Regenerated.
        * generated/minloc1_8_i1.c: Regenerated.
        * generated/minval_i4.c: Regenerated.
        * generated/maxloc1_4_i4.c: Regenerated.
        * generated/maxloc1_8_i2.c: Regenerated.
        * generated/maxval_i8.c: Regenerated.
        * generated/any_l8.c: Regenerated.
        * generated/minloc1_4_r10.c: Regenerated.
        * generated/minloc1_8_i16.c: Regenerated.
        * generated/maxloc1_4_r10.c: Regenerated.
        * generated/maxloc1_8_i16.c: Regenerated.
        * generated/minloc1_16_r4.c: Regenerated.
        * generated/maxloc1_16_r4.c: Regenerated.
        * generated/product_i8.c: Regenerated.
        * generated/sum_i16.c: Regenerated.
        * generated/count_2_l.c: Regenerated.
        * generated/maxloc1_16_i16.c: Regenerated.
        * generated/minloc1_8_r4.c: Regenerated.
        * generated/sum_c8.c: Regenerated.
        * generated/minloc1_16_i2.c: Regenerated.
        * generated/maxloc1_16_i2.c: Regenerated.
        * generated/parity_l1.c: Regenerated.
        * generated/maxval_i16.c: Regenerated.
        * generated/maxval_i1.c: Regenerated.
        * generated/minloc1_4_i4.c: Regenerated.
        * generated/any_l1.c: Regenerated.
        * generated/minloc1_8_i2.c: Regenerated.
        * generated/product_c16.c: Regenerated.
        * generated/product_r10.c: Regenerated.
        * generated/product_i1.c: Regenerated.
        * generated/all_l8.c: Regenerated.
        * generated/maxval_r4.c: Regenerated.



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

11 files changed, 126 insertions, 26 deletions

diff --git a/libgfortran/m4/all.m4 b/libgfortran/m4/all.m4
index 4dc4d1dc2a1..cc174207817 100644
--- a/libgfortran/m4/all.m4
+++ b/libgfortran/m4/all.m4
@@ -1,8 +1,8 @@
 `/* Implementation of the ALL intrinsic
-   Copyright 2002, 2007, 2009 Free Software Foundation, Inc.
+   Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -39,6 +39,6 @@ ARRAY_FUNCTION(1,
     {
       result = 0;
       break;
-    }')`
+    }', `')`
 
 #endif'
diff --git a/libgfortran/m4/any.m4 b/libgfortran/m4/any.m4
index e2a22705faf..81ec31046f5 100644
--- a/libgfortran/m4/any.m4
+++ b/libgfortran/m4/any.m4
@@ -1,8 +1,8 @@
 `/* Implementation of the ANY intrinsic
-   Copyright 2002, 2007, 2009 Free Software Foundation, Inc.
+   Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -39,6 +39,6 @@ ARRAY_FUNCTION(0,
     {
       result = 1;
       break;
-    }')`
+    }', `')`
 
 #endif'
diff --git a/libgfortran/m4/count.m4 b/libgfortran/m4/count.m4
index 5a669954c50..5998c20e685 100644
--- a/libgfortran/m4/count.m4
+++ b/libgfortran/m4/count.m4
@@ -1,8 +1,8 @@
 `/* Implementation of the COUNT intrinsic
-   Copyright 2002, 2007, 2009 Free Software Foundation, Inc.
+   Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -35,6 +35,6 @@ include(ifunction_logical.m4)dnl
 ARRAY_FUNCTION(0,
 `  result = 0;',
 `  if (*src)
-    result++;')`
+    result++;', `')`
 
 #endif'
diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4
index 6c34eb9d7ae..3d425e0108e 100644
--- a/libgfortran/m4/ifunction.m4
+++ b/libgfortran/m4/ifunction.m4
@@ -1,6 +1,6 @@
 dnl Support macro file for intrinsic functions.
 dnl Contains the generic sections of the array functions.
-dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran)
+dnl This file is part of the GNU Fortran Runtime Library (libgfortran)
 dnl Distributed under the GNU GPL with exception.  See COPYING for details.
 dnl
 dnl Pass the implementation for a single section as the parameter to
@@ -140,6 +140,7 @@ define(START_ARRAY_BLOCK,
 ')dnl
 define(FINISH_ARRAY_FUNCTION,
 `	      }
+	    '$1`
 	    *dest = result;
 	  }
       }
@@ -496,7 +497,7 @@ define(ARRAY_FUNCTION,
 $2
 START_ARRAY_BLOCK($1)
 $3
-FINISH_ARRAY_FUNCTION')dnl
+FINISH_ARRAY_FUNCTION($4)')dnl
 define(MASKED_ARRAY_FUNCTION,
 `START_MASKED_ARRAY_FUNCTION
 $2
diff --git a/libgfortran/m4/maxloc1.m4 b/libgfortran/m4/maxloc1.m4
index 84b5a35c5c4..44872ee61a0 100644
--- a/libgfortran/m4/maxloc1.m4
+++ b/libgfortran/m4/maxloc1.m4
@@ -1,8 +1,8 @@
 `/* Implementation of the MAXLOC intrinsic
-   Copyright 2002, 2007, 2009 Free Software Foundation, Inc.
+   Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -56,7 +56,7 @@ ARRAY_FUNCTION(0,
 		  {
 		    maxval = *src;
 		    result = (rtype_name)n + 1;
-		  }')
+		  }', `')
 
 MASKED_ARRAY_FUNCTION(0,
 `	atype_name maxval;
diff --git a/libgfortran/m4/maxval.m4 b/libgfortran/m4/maxval.m4
index 7557eb130a1..15390688056 100644
--- a/libgfortran/m4/maxval.m4
+++ b/libgfortran/m4/maxval.m4
@@ -1,8 +1,8 @@
 `/* Implementation of the MAXVAL intrinsic
-   Copyright 2002, 2007, 2009 Free Software Foundation, Inc.
+   Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -48,7 +48,7 @@ ARRAY_FUNCTION(atype_min,
 	      {
 #endif
 		if (*src > result)
-		  result = *src;')
+		  result = *src;', `')
 
 MASKED_ARRAY_FUNCTION(atype_min,
 `#if defined ('atype_inf`)
diff --git a/libgfortran/m4/minloc1.m4 b/libgfortran/m4/minloc1.m4
index 6fa5e69ccc7..e0bd3cd88ce 100644
--- a/libgfortran/m4/minloc1.m4
+++ b/libgfortran/m4/minloc1.m4
@@ -1,8 +1,8 @@
 `/* Implementation of the MINLOC intrinsic
-   Copyright 2002, 2007, 2009 Free Software Foundation, Inc.
+   Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -94,7 +94,7 @@ MASKED_ARRAY_FUNCTION(0,
 		  {
 		    minval = *src;
 		    result = (rtype_name)n + 1;
-		  }')
+		  }', `')
 
 SCALAR_ARRAY_FUNCTION(0)
 
diff --git a/libgfortran/m4/minval.m4 b/libgfortran/m4/minval.m4
index 3acae2eaa88..037dd672595 100644
--- a/libgfortran/m4/minval.m4
+++ b/libgfortran/m4/minval.m4
@@ -1,8 +1,8 @@
 `/* Implementation of the MINVAL intrinsic
-   Copyright 2002, 2007, 2009 Free Software Foundation, Inc.
+   Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -81,7 +81,7 @@ MASKED_ARRAY_FUNCTION(atype_max,
 	      {
 #endif
 		if (*msrc && *src < result)
-		  result = *src;')
+		  result = *src;', `')
 
 SCALAR_ARRAY_FUNCTION(atype_max)
 
diff --git a/libgfortran/m4/norm2.m4 b/libgfortran/m4/norm2.m4
new file mode 100644
index 00000000000..e1d6b972df4
--- /dev/null
+++ b/libgfortran/m4/norm2.m4
@@ -0,0 +1,59 @@
+`/* Implementation of the NORM2 intrinsic
+   Copyright 2010 Free Software Foundation, Inc.
+   Contributed by Tobias Burnus  <burnus@net-b.de>
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <math.h>
+#include <assert.h>'
+
+include(iparm.m4)dnl
+include(ifunction.m4)dnl
+include(`mtype.m4')dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
+ARRAY_FUNCTION(`0.0'Q,
+`	'rtype_name` scale;
+	result = 0.0'Q`;
+	scale = 1.0'Q`;',
+`	  if (*src != 0.0'Q`)
+	    {
+	      'rtype_name` absX, val;
+	      absX = fabs'q` (*src);
+	      if (scale < absX)
+		{
+		  val = scale / absX;
+		  result = 1.0'Q` + result * val * val;
+		  scale = absX;
+		}
+	      else
+		{
+		  val = absX / scale;
+		  result += val * val;
+		}
+	    }',
+`   result = scale * sqrt'q` (result);')
+
+#endif
diff --git a/libgfortran/m4/parity.m4 b/libgfortran/m4/parity.m4
new file mode 100644
index 00000000000..037e96db913
--- /dev/null
+++ b/libgfortran/m4/parity.m4
@@ -0,0 +1,40 @@
+`/* Implementation of the NORM2 intrinsic
+   Copyright 2010 Free Software Foundation, Inc.
+   Contributed by Tobias Burnus  <burnus@net-b.de>
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <math.h>
+#include <assert.h>'
+
+include(iparm.m4)dnl
+include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
+ARRAY_FUNCTION(0,
+`  result = 0;',
+`  result = result != *src;', `')
+
+#endif
diff --git a/libgfortran/m4/product.m4 b/libgfortran/m4/product.m4
index 669b106e0c2..6f6f2c01184 100644
--- a/libgfortran/m4/product.m4
+++ b/libgfortran/m4/product.m4
@@ -1,8 +1,8 @@
 `/* Implementation of the PRODUCT intrinsic
-   Copyright 2002, 2007, 2009 Free Software Foundation, Inc.
+   Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -34,7 +34,7 @@ include(ifunction.m4)dnl
 
 ARRAY_FUNCTION(1,
 `  result = 1;',
-`  result *= *src;')
+`  result *= *src;', `')
 
 MASKED_ARRAY_FUNCTION(1,
 `  result = 1;',