]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/generated/shape_i4.c
re PR fortran/37577 ([meta-bug] change internal array descriptor format for better...
[thirdparty/gcc.git] / libgfortran / generated / shape_i4.c
CommitLineData
6de9cd9a 1/* Implementation of the SHAPE intrinsic
748086b7 2 Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
6de9cd9a
DN
3 Contributed by Paul Brook <paul@nowt.org>
4
57dea9f6 5This file is part of the GNU Fortran 95 runtime library (libgfortran).
6de9cd9a 6
57dea9f6
TM
7Libgfortran is free software; you can redistribute it and/or
8modify it under the terms of the GNU General Public
6de9cd9a 9License as published by the Free Software Foundation; either
748086b7 10version 3 of the License, or (at your option) any later version.
57dea9f6
TM
11
12Libgfortran is distributed in the hope that it will be useful,
6de9cd9a
DN
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
57dea9f6 15GNU General Public License for more details.
6de9cd9a 16
748086b7
JJ
17Under Section 7 of GPL version 3, you are granted additional
18permissions described in the GCC Runtime Library Exception, version
193.1, as published by the Free Software Foundation.
20
21You should have received a copy of the GNU General Public License and
22a copy of the GCC Runtime Library Exception along with this program;
23see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24<http://www.gnu.org/licenses/>. */
6de9cd9a 25
36ae8a61 26#include "libgfortran.h"
6de9cd9a
DN
27#include <stdlib.h>
28#include <assert.h>
36ae8a61 29
6de9cd9a 30
644cb69f
FXC
31#if defined (HAVE_GFC_INTEGER_4)
32
64acfd99
JB
33extern void shape_4 (gfc_array_i4 * const restrict ret,
34 const gfc_array_i4 * const restrict array);
7f68c75f 35export_proto(shape_4);
7d7b8bfe 36
6de9cd9a 37void
64acfd99
JB
38shape_4 (gfc_array_i4 * const restrict ret,
39 const gfc_array_i4 * const restrict array)
6de9cd9a
DN
40{
41 int n;
42 index_type stride;
ee440dd0 43 index_type extent;
6de9cd9a 44
dfb55fdc 45 stride = GFC_DESCRIPTOR_STRIDE(ret,0);
6de9cd9a 46
dfb55fdc 47 if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
bc814056
TK
48 return;
49
6de9cd9a
DN
50 for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
51 {
dfb55fdc 52 extent = GFC_DESCRIPTOR_EXTENT(array,n);
ee440dd0 53 ret->data[n * stride] = extent > 0 ? extent : 0 ;
6de9cd9a
DN
54 }
55}
644cb69f
FXC
56
57#endif