Commit ed019753 by Francois-Xavier Coudert Committed by François-Xavier Coudert

re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)

	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
parent 485adf79
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> 2015-08-25 Marek Polacek <polacek@redhat.com>
PR middle-end/67330 PR middle-end/67330
......
! { 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
2015-08-26 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 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. * libgfortran.h (show_variables): Remove prototype.
* runtime/environ.c (print_spaces, var_source, show_integer, * runtime/environ.c (print_spaces, var_source, show_integer,
show_boolean, show_sep, show_string): Remove functions. show_boolean, show_sep, show_string): Remove functions.
......
...@@ -483,6 +483,8 @@ $(srcdir)/generated/transpose_c10.c \ ...@@ -483,6 +483,8 @@ $(srcdir)/generated/transpose_c10.c \
$(srcdir)/generated/transpose_c16.c $(srcdir)/generated/transpose_c16.c
i_shape_c= \ i_shape_c= \
$(srcdir)/generated/shape_i1.c \
$(srcdir)/generated/shape_i2.c \
$(srcdir)/generated/shape_i4.c \ $(srcdir)/generated/shape_i4.c \
$(srcdir)/generated/shape_i8.c \ $(srcdir)/generated/shape_i8.c \
$(srcdir)/generated/shape_i16.c $(srcdir)/generated/shape_i16.c
......
...@@ -259,7 +259,8 @@ am__objects_23 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \ ...@@ -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_r4.lo transpose_r8.lo transpose_r10.lo \
transpose_r16.lo transpose_c4.lo transpose_c8.lo \ transpose_r16.lo transpose_c4.lo transpose_c8.lo \
transpose_c10.lo transpose_c16.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_25 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo
am__objects_26 = eoshift3_4.lo eoshift3_8.lo eoshift3_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 am__objects_27 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
...@@ -916,6 +917,8 @@ $(srcdir)/generated/transpose_c10.c \ ...@@ -916,6 +917,8 @@ $(srcdir)/generated/transpose_c10.c \
$(srcdir)/generated/transpose_c16.c $(srcdir)/generated/transpose_c16.c
i_shape_c = \ i_shape_c = \
$(srcdir)/generated/shape_i1.c \
$(srcdir)/generated/shape_i2.c \
$(srcdir)/generated/shape_i4.c \ $(srcdir)/generated/shape_i4.c \
$(srcdir)/generated/shape_i8.c \ $(srcdir)/generated/shape_i8.c \
$(srcdir)/generated/shape_i16.c $(srcdir)/generated/shape_i16.c
...@@ -1826,7 +1829,9 @@ distclean-compile: ...@@ -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_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_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r8.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_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_i4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/shape_i8.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@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/signal.Plo@am__quote@
...@@ -4016,6 +4021,20 @@ transpose_c16.lo: $(srcdir)/generated/transpose_c16.c ...@@ -4016,6 +4021,20 @@ transpose_c16.lo: $(srcdir)/generated/transpose_c16.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @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 transpose_c16.lo `test -f '$(srcdir)/generated/transpose_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_c16.c @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 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@ $(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 @am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/shape_i4.Tpo $(DEPDIR)/shape_i4.Plo
......
/* 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
...@@ -31,12 +31,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ...@@ -31,12 +31,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#if defined (HAVE_GFC_INTEGER_16) #if defined (HAVE_GFC_INTEGER_16)
extern void shape_16 (gfc_array_i16 * const restrict ret, 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); export_proto(shape_16);
void void
shape_16 (gfc_array_i16 * const restrict ret, shape_16 (gfc_array_i16 * const restrict ret,
const gfc_array_i16 * const restrict array) const array_t * const restrict array)
{ {
int n; int n;
index_type stride; index_type stride;
......
/* 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
...@@ -31,12 +31,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ...@@ -31,12 +31,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#if defined (HAVE_GFC_INTEGER_4) #if defined (HAVE_GFC_INTEGER_4)
extern void shape_4 (gfc_array_i4 * const restrict ret, 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); export_proto(shape_4);
void void
shape_4 (gfc_array_i4 * const restrict ret, shape_4 (gfc_array_i4 * const restrict ret,
const gfc_array_i4 * const restrict array) const array_t * const restrict array)
{ {
int n; int n;
index_type stride; index_type stride;
......
...@@ -31,12 +31,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ...@@ -31,12 +31,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#if defined (HAVE_GFC_INTEGER_8) #if defined (HAVE_GFC_INTEGER_8)
extern void shape_8 (gfc_array_i8 * const restrict ret, 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); export_proto(shape_8);
void void
shape_8 (gfc_array_i8 * const restrict ret, shape_8 (gfc_array_i8 * const restrict ret,
const gfc_array_i8 * const restrict array) const array_t * const restrict array)
{ {
int n; int n;
index_type stride; index_type stride;
......
...@@ -1285,6 +1285,8 @@ GFORTRAN_1.7 { ...@@ -1285,6 +1285,8 @@ GFORTRAN_1.7 {
__ieee_exceptions_MOD_ieee_support_flag_10; __ieee_exceptions_MOD_ieee_support_flag_10;
__ieee_exceptions_MOD_ieee_support_flag_16; __ieee_exceptions_MOD_ieee_support_flag_16;
_gfortran_mvbits_i16; _gfortran_mvbits_i16;
_gfortran_shape_1;
_gfortran_shape_2;
} GFORTRAN_1.6; } GFORTRAN_1.6;
F2C_1.0 { F2C_1.0 {
......
...@@ -32,12 +32,12 @@ include(iparm.m4)dnl ...@@ -32,12 +32,12 @@ include(iparm.m4)dnl
`#if defined (HAVE_'rtype_name`) `#if defined (HAVE_'rtype_name`)
extern void shape_'rtype_kind` ('rtype` * const restrict ret, 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`); export_proto(shape_'rtype_kind`);
void void
shape_'rtype_kind` ('rtype` * const restrict ret, shape_'rtype_kind` ('rtype` * const restrict ret,
const 'rtype` * const restrict array) const array_t * const restrict array)
{ {
int n; int n;
index_type stride; index_type stride;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment