re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
authorFrancois-Xavier Coudert <fxcoudert@gcc.gnu.org>
Wed, 26 Aug 2015 12:37:42 +0000 (12:37 +0000)
committerFrançois-Xavier Coudert <fxcoudert@gcc.gnu.org>
Wed, 26 Aug 2015 12:37:42 +0000 (12:37 +0000)
PR fortran/29600

* Makefile.am: Add generated/shape_i{1,2}.c
* Makefile.in: Regenerate.
* generated/shape_i1.c: New generated file.
* generated/shape_i2.c: New generated file.
* generated/shape_i4.c: Regenerate.
* generated/shape_i8.c: Regenerate.
* generated/shape_i16.c: Regenerate.
* gfortran.map (GFORTRAN_1.7): Add _gfortran_shape_{1,2}.
* m4/shape.m4: Fix parameter type.

* gfortran.dg/shape_8.f90: New test.

From-SVN: r227210

12 files changed:
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/shape_8.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/generated/shape_i1.c [new file with mode: 0644]
libgfortran/generated/shape_i16.c
libgfortran/generated/shape_i2.c [new file with mode: 0644]
libgfortran/generated/shape_i4.c
libgfortran/generated/shape_i8.c
libgfortran/gfortran.map
libgfortran/m4/shape.m4

index e8365be37f08bffc10c07fe28d3217dc3610f236..ac549889d7e59f254f96dc0979d33655b48b5e16 100644 (file)
@@ -1,3 +1,8 @@
+2015-08-26  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/29600
+       * gfortran.dg/shape_8.f90: New test.
+
 2015-08-25  Marek Polacek  <polacek@redhat.com>
 
        PR middle-end/67330
diff --git a/gcc/testsuite/gfortran.dg/shape_8.f90 b/gcc/testsuite/gfortran.dg/shape_8.f90
new file mode 100644 (file)
index 0000000..51c6e55
--- /dev/null
@@ -0,0 +1,15 @@
+! { dg-do run }
+!
+! Check that we can use SHAPE with optional kind argument
+!
+program test
+   implicit none
+   real, allocatable :: x(:,:)
+
+   allocate(x(2,5))
+   if (any(shape(x) /= [ 2, 5 ])) call abort
+   if (any(shape(x,kind=1) /= [ 2, 5 ])) call abort
+   if (any(shape(x,kind=2) /= [ 2, 5 ])) call abort
+   if (any(shape(x,kind=4) /= [ 2, 5 ])) call abort
+   if (any(shape(x,kind=8) /= [ 2, 5 ])) call abort
+end
index e3ab51f893e1a0671947698879e94595db560885..65e0099a0cd4d2bee4e889dab522a65360b6cc76 100644 (file)
@@ -1,3 +1,16 @@
+2015-08-26  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/29600
+       * Makefile.am: Add generated/shape_i{1,2}.c
+       * Makefile.in: Regenerate.
+       * generated/shape_i1.c: New generated file.
+       * generated/shape_i2.c: New generated file.
+       * generated/shape_i4.c: Regenerate.
+       * generated/shape_i8.c: Regenerate.
+       * generated/shape_i16.c: Regenerate.
+       * gfortran.map (GFORTRAN_1.7): Add _gfortran_shape_{1,2}.
+       * m4/shape.m4: Fix parameter type.
+
 2015-08-26  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        * libgfortran.h (show_variables): Remove prototype.
index e4764337310fb583f3b15b1cedccd7d6756ff693..39d3e11d223ca9885b5d433fc50c44e6c453de16 100644 (file)
@@ -483,6 +483,8 @@ $(srcdir)/generated/transpose_c10.c \
 $(srcdir)/generated/transpose_c16.c
 
 i_shape_c= \
+$(srcdir)/generated/shape_i1.c \
+$(srcdir)/generated/shape_i2.c \
 $(srcdir)/generated/shape_i4.c \
 $(srcdir)/generated/shape_i8.c \
 $(srcdir)/generated/shape_i16.c
index f0ddb38f5aba3431f89fe932d8d89116a09f07c3..7ed080cf7b0d4c006263a90596187b07a1d48a03 100644 (file)
@@ -259,7 +259,8 @@ am__objects_23 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \
        transpose_r4.lo transpose_r8.lo transpose_r10.lo \
        transpose_r16.lo transpose_c4.lo transpose_c8.lo \
        transpose_c10.lo transpose_c16.lo
-am__objects_24 = shape_i4.lo shape_i8.lo shape_i16.lo
+am__objects_24 = shape_i1.lo shape_i2.lo shape_i4.lo shape_i8.lo \
+       shape_i16.lo
 am__objects_25 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo
 am__objects_26 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo
 am__objects_27 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
@@ -916,6 +917,8 @@ $(srcdir)/generated/transpose_c10.c \
 $(srcdir)/generated/transpose_c16.c
 
 i_shape_c = \
+$(srcdir)/generated/shape_i1.c \
+$(srcdir)/generated/shape_i2.c \
 $(srcdir)/generated/shape_i4.c \
 $(srcdir)/generated/shape_i8.c \
 $(srcdir)/generated/shape_i16.c
@@ -1826,7 +1829,9 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r16.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r4.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/shape_i1.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/shape_i16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/shape_i2.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/shape_i4.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/shape_i8.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/signal.Plo@am__quote@
@@ -4016,6 +4021,20 @@ transpose_c16.lo: $(srcdir)/generated/transpose_c16.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c16.lo `test -f '$(srcdir)/generated/transpose_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_c16.c
 
+shape_i1.lo: $(srcdir)/generated/shape_i1.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT shape_i1.lo -MD -MP -MF $(DEPDIR)/shape_i1.Tpo -c -o shape_i1.lo `test -f '$(srcdir)/generated/shape_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i1.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/shape_i1.Tpo $(DEPDIR)/shape_i1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/shape_i1.c' object='shape_i1.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i1.lo `test -f '$(srcdir)/generated/shape_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i1.c
+
+shape_i2.lo: $(srcdir)/generated/shape_i2.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT shape_i2.lo -MD -MP -MF $(DEPDIR)/shape_i2.Tpo -c -o shape_i2.lo `test -f '$(srcdir)/generated/shape_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i2.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/shape_i2.Tpo $(DEPDIR)/shape_i2.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/shape_i2.c' object='shape_i2.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i2.lo `test -f '$(srcdir)/generated/shape_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i2.c
+
 shape_i4.lo: $(srcdir)/generated/shape_i4.c
 @am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT shape_i4.lo -MD -MP -MF $(DEPDIR)/shape_i4.Tpo -c -o shape_i4.lo `test -f '$(srcdir)/generated/shape_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i4.c
 @am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/shape_i4.Tpo $(DEPDIR)/shape_i4.Plo
diff --git a/libgfortran/generated/shape_i1.c b/libgfortran/generated/shape_i1.c
new file mode 100644 (file)
index 0000000..6ac8e14
--- /dev/null
@@ -0,0 +1,67 @@
+/* Implementation of the SHAPE intrinsic
+   Copyright (C) 2002-2015 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+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 <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_1)
+
+extern void shape_1 (gfc_array_i1 * const restrict ret, 
+       const array_t * const restrict array);
+export_proto(shape_1);
+
+void
+shape_1 (gfc_array_i1 * const restrict ret, 
+       const array_t * const restrict array)
+{
+  int n;
+  index_type stride;
+  index_type extent;
+  int rank;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (ret->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1);
+      ret->offset = 0;
+      ret->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_1));
+    }
+
+  stride = GFC_DESCRIPTOR_STRIDE(ret,0);
+
+  if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
+    return;
+
+  for (n = 0; n < rank; n++)
+    {
+      extent = GFC_DESCRIPTOR_EXTENT(array,n);
+      ret->base_addr[n * stride] = extent > 0 ? extent : 0 ;
+    }
+}
+
+#endif
index a9cb8a25b8efadf623bc590b0e10f986069b9e4f..4cb43c8b5b1e1f54516baed32c0c6e09c47c3a11 100644 (file)
@@ -31,12 +31,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #if defined (HAVE_GFC_INTEGER_16)
 
 extern void shape_16 (gfc_array_i16 * const restrict ret, 
-       const gfc_array_i16 * const restrict array);
+       const array_t * const restrict array);
 export_proto(shape_16);
 
 void
 shape_16 (gfc_array_i16 * const restrict ret, 
-       const gfc_array_i16 * const restrict array)
+       const array_t * const restrict array)
 {
   int n;
   index_type stride;
diff --git a/libgfortran/generated/shape_i2.c b/libgfortran/generated/shape_i2.c
new file mode 100644 (file)
index 0000000..982d9cc
--- /dev/null
@@ -0,0 +1,67 @@
+/* Implementation of the SHAPE intrinsic
+   Copyright (C) 2002-2015 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+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 <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_2)
+
+extern void shape_2 (gfc_array_i2 * const restrict ret, 
+       const array_t * const restrict array);
+export_proto(shape_2);
+
+void
+shape_2 (gfc_array_i2 * const restrict ret, 
+       const array_t * const restrict array)
+{
+  int n;
+  index_type stride;
+  index_type extent;
+  int rank;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (ret->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1);
+      ret->offset = 0;
+      ret->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_2));
+    }
+
+  stride = GFC_DESCRIPTOR_STRIDE(ret,0);
+
+  if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
+    return;
+
+  for (n = 0; n < rank; n++)
+    {
+      extent = GFC_DESCRIPTOR_EXTENT(array,n);
+      ret->base_addr[n * stride] = extent > 0 ? extent : 0 ;
+    }
+}
+
+#endif
index 04654eae76db8332989b31442daf290c93702933..8a912b35b9f4c7ac711bf7298324de0746b0edba 100644 (file)
@@ -31,12 +31,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #if defined (HAVE_GFC_INTEGER_4)
 
 extern void shape_4 (gfc_array_i4 * const restrict ret, 
-       const gfc_array_i4 * const restrict array);
+       const array_t * const restrict array);
 export_proto(shape_4);
 
 void
 shape_4 (gfc_array_i4 * const restrict ret, 
-       const gfc_array_i4 * const restrict array)
+       const array_t * const restrict array)
 {
   int n;
   index_type stride;
index 7b0988875c0d2924ce4756645af573d71dfe153d..d33add63e477374835e8fc2133e7aeff773355e6 100644 (file)
@@ -31,12 +31,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #if defined (HAVE_GFC_INTEGER_8)
 
 extern void shape_8 (gfc_array_i8 * const restrict ret, 
-       const gfc_array_i8 * const restrict array);
+       const array_t * const restrict array);
 export_proto(shape_8);
 
 void
 shape_8 (gfc_array_i8 * const restrict ret, 
-       const gfc_array_i8 * const restrict array)
+       const array_t * const restrict array)
 {
   int n;
   index_type stride;
index 6684063988978b8426a415976ce3ece1c066572f..5f011de68a1919533a09688cac2e0b88b46e0980 100644 (file)
@@ -1285,6 +1285,8 @@ GFORTRAN_1.7 {
     __ieee_exceptions_MOD_ieee_support_flag_10;
     __ieee_exceptions_MOD_ieee_support_flag_16;
     _gfortran_mvbits_i16;
+    _gfortran_shape_1;
+    _gfortran_shape_2;
 } GFORTRAN_1.6; 
 
 F2C_1.0 {
index ffdcebe8d8e6908517231b0cd1d229fc813c7d00..e389d92f00b3e96cb47aa756a2f1f8ee3dc95cf1 100644 (file)
@@ -32,12 +32,12 @@ include(iparm.m4)dnl
 `#if defined (HAVE_'rtype_name`)
 
 extern void shape_'rtype_kind` ('rtype` * const restrict ret, 
-       const 'rtype` * const restrict array);
+       const array_t * const restrict array);
 export_proto(shape_'rtype_kind`);
 
 void
 shape_'rtype_kind` ('rtype` * const restrict ret, 
-       const 'rtype` * const restrict array)
+       const array_t * const restrict array)
 {
   int n;
   index_type stride;