/* Array things
- Copyright (C) 2000, 2001, 2002, 2004 Free Software Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2004, 2005 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
You should have received a copy of the GNU General Public License
along with GCC; see the file COPYING. If not, write to the Free
-Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA. */
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA. */
#include "config.h"
+#include "system.h"
#include "gfortran.h"
#include "match.h"
-#include <string.h>
-#include <assert.h>
-
/* This parameter is the size of the largest array constructor that we
will expand to an array constructor without iterators.
Constructors larger than this will remain in the iterator form. */
-#define GFC_MAX_AC_EXPAND 100
+#define GFC_MAX_AC_EXPAND 65535
/**************** Array reference matching subroutines *****************/
}
}
- gfc_error ("Array reference at %C cannot have more than "
- stringize (GFC_MAX_DIMENSIONS) " dimensions");
+ gfc_error ("Array reference at %C cannot have more than %d dimensions",
+ GFC_MAX_DIMENSIONS);
error:
return MATCH_ERROR;
if (as->rank >= GFC_MAX_DIMENSIONS)
{
- gfc_error ("Array specification at %C has more than "
- stringize (GFC_MAX_DIMENSIONS) " dimensions");
+ gfc_error ("Array specification at %C has more than %d dimensions",
+ GFC_MAX_DIMENSIONS);
goto cleanup;
}
if (as == NULL)
return SUCCESS;
- if (gfc_add_dimension (&sym->attr, error_loc) == FAILURE)
+ if (gfc_add_dimension (&sym->attr, sym->name, error_loc) == FAILURE)
return FAILURE;
sym->as = as;
gfc_expr *expr;
locus where;
match m;
+ const char *end_delim;
if (gfc_match (" (/") == MATCH_NO)
- return MATCH_NO;
+ {
+ if (gfc_match (" [") == MATCH_NO)
+ return MATCH_NO;
+ else
+ {
+ if (gfc_notify_std (GFC_STD_F2003, "New in Fortran 2003: [...] "
+ "style array constructors at %C") == FAILURE)
+ return MATCH_ERROR;
+ end_delim = " ]";
+ }
+ }
+ else
+ end_delim = " /)";
where = gfc_current_locus;
head = tail = NULL;
- if (gfc_match (" /)") == MATCH_YES)
- goto empty; /* Special case */
+ if (gfc_match (end_delim) == MATCH_YES)
+ {
+ gfc_error ("Empty array constructor at %C is not allowed");
+ goto cleanup;
+ }
for (;;)
{
break;
}
- if (gfc_match (" /)") == MATCH_NO)
+ if (gfc_match (end_delim) == MATCH_NO)
goto syntax;
-empty:
expr = gfc_get_expr ();
expr->expr_type = EXPR_ARRAY;
{
if (cons_state == CONS_BAD)
- return 0; /* Supress further errors */
+ return 0; /* Suppress further errors */
if (cons_state == CONS_START)
{
}
-/* Recursive work function for gfc_check_constructor_type(). */
+/* Recursive work function for gfc_check_constructor_type(). */
static try
check_constructor_type (gfc_constructor * c)
for (; p; p = p->next)
{
if (p->iterator != NULL
- && gfc_resolve_iterator (p->iterator) == FAILURE)
+ && gfc_resolve_iterator (p->iterator, false) == FAILURE)
t = FAILURE;
if (gfc_resolve_expr (p->expr) == FAILURE)
return t;
}
+/* Resolve character array constructor. If it is a constant character array and
+ not specified character length, update character length to the maximum of
+ its element constructors' length. */
+
+static void
+resolve_character_array_constructor (gfc_expr * expr)
+{
+ gfc_constructor * p;
+ int max_length;
+
+ gcc_assert (expr->expr_type == EXPR_ARRAY);
+ gcc_assert (expr->ts.type == BT_CHARACTER);
+
+ max_length = -1;
+
+ if (expr->ts.cl == NULL)
+ {
+ expr->ts.cl = gfc_get_charlen ();
+ expr->ts.cl->next = gfc_current_ns->cl_list;
+ gfc_current_ns->cl_list = expr->ts.cl;
+ }
+
+ if (expr->ts.cl->length == NULL)
+ {
+ /* Find the maximum length of the elements. Do nothing for variable array
+ constructor. */
+ for (p = expr->value.constructor; p; p = p->next)
+ if (p->expr->expr_type == EXPR_CONSTANT)
+ max_length = MAX (p->expr->value.character.length, max_length);
+ else
+ return;
+
+ if (max_length != -1)
+ {
+ /* Update the character length of the array constructor. */
+ expr->ts.cl->length = gfc_int_expr (max_length);
+ /* Update the element constructors. */
+ for (p = expr->value.constructor; p; p = p->next)
+ gfc_set_constant_character_len (max_length, p->expr);
+ }
+ }
+}
-/* Resolve all of the expressions in an array list.
- TODO: String lengths. */
+/* Resolve all of the expressions in an array list. */
try
gfc_resolve_array_constructor (gfc_expr * expr)
t = resolve_array_list (expr->value.constructor);
if (t == SUCCESS)
t = gfc_check_constructor_type (expr);
+ if (t == SUCCESS && expr->ts.type == BT_CHARACTER)
+ resolve_character_array_constructor (expr);
return t;
}
/********* Subroutines for determining the size of an array *********/
-/* These are needed just to accomodate RESHAPE(). There are no
+/* These are needed just to accommodate RESHAPE(). There are no
diagnostics here, we just return a negative number if something
- goes wrong. */
+ goes wrong. */
/* Get the size of single dimension of an array specification. The
return &ref->u.ar;
}
+
+
+/* Find out if an array shape is known at compile time. */
+
+int
+gfc_is_compile_time_shape (gfc_array_spec *as)
+{
+ int i;
+
+ if (as->type != AS_EXPLICIT)
+ return 0;
+
+ for (i = 0; i < as->rank; i++)
+ if (!gfc_is_constant_expr (as->lower[i])
+ || !gfc_is_constant_expr (as->upper[i]))
+ return 0;
+
+ return 1;
+}
OSDN Git Service
