User account creation filtered due to spam.

View | Details | Raw Unified | Return to bug 27997 | Differences between
and this patch

Collapse All | Expand All

(-)array.c (-9 / +53 lines)
Lines 871-879 gfc_match_array_constructor (gfc_expr ** Link Here
871
{
871
{
872
  gfc_constructor *head, *tail, *new;
872
  gfc_constructor *head, *tail, *new;
873
  gfc_expr *expr;
873
  gfc_expr *expr;
874
  gfc_typespec ts;
874
  locus where;
875
  locus where;
875
  match m;
876
  match m;
876
  const char *end_delim;
877
  const char *end_delim;
878
  bool seen_ts;
877
879
878
  if (gfc_match (" (/") == MATCH_NO)
880
  if (gfc_match (" (/") == MATCH_NO)
879
    {
881
    {
Lines 892-902 gfc_match_array_constructor (gfc_expr ** Link Here
892
894
893
  where = gfc_current_locus;
895
  where = gfc_current_locus;
894
  head = tail = NULL;
896
  head = tail = NULL;
897
  seen_ts = false;
898
899
  /* Try to match an optionnal "type-spec ::"  */
900
  if (gfc_match_type_spec (&ts, 0) == MATCH_YES)
901
    {
902
      seen_ts = true;
903
904
      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor "
905
			  "including type specification at %C") == FAILURE)
906
	return MATCH_ERROR;
907
908
      if (gfc_match (" ::") == MATCH_NO)
909
	{
910
	  gfc_error ("Syntax error, missing \"::\" after type specification "
911
		     "in array constructor at %C");
912
	  goto cleanup;
913
	}
914
    }
895
915
896
  if (gfc_match (end_delim) == MATCH_YES)
916
  if (gfc_match (end_delim) == MATCH_YES)
897
    {
917
    {
898
      gfc_error ("Empty array constructor at %C is not allowed");
918
      if (seen_ts)
899
      goto cleanup;
919
	goto done;
920
      else
921
	{
922
	  gfc_error ("Empty array constructor at %C is not allowed");
923
	  goto cleanup;
924
	}
900
    }
925
    }
901
926
902
  for (;;)
927
  for (;;)
Lines 921-926 gfc_match_array_constructor (gfc_expr ** Link Here
921
  if (gfc_match (end_delim) == MATCH_NO)
946
  if (gfc_match (end_delim) == MATCH_NO)
922
    goto syntax;
947
    goto syntax;
923
948
949
done:
924
  expr = gfc_get_expr ();
950
  expr = gfc_get_expr ();
925
951
926
  expr->expr_type = EXPR_ARRAY;
952
  expr->expr_type = EXPR_ARRAY;
Lines 928-933 gfc_match_array_constructor (gfc_expr ** Link Here
928
  expr->value.constructor = head;
954
  expr->value.constructor = head;
929
  /* Size must be calculated at resolution time.  */
955
  /* Size must be calculated at resolution time.  */
930
956
957
  if (seen_ts)
958
    expr->ts = ts;
959
  else
960
    expr->ts.type = BT_UNKNOWN;
961
931
  expr->where = where;
962
  expr->where = where;
932
  expr->rank = 1;
963
  expr->rank = 1;
933
964
Lines 958-964 static enum Link Here
958
cons_state;
989
cons_state;
959
990
960
static int
991
static int
961
check_element_type (gfc_expr *expr)
992
check_element_type (gfc_expr *expr, bool convert)
962
{
993
{
963
  if (cons_state == CONS_BAD)
994
  if (cons_state == CONS_BAD)
964
    return 0;			/* Suppress further errors */
995
    return 0;			/* Suppress further errors */
Lines 979-984 check_element_type (gfc_expr *expr) Link Here
979
  if (gfc_compare_types (&constructor_ts, &expr->ts))
1010
  if (gfc_compare_types (&constructor_ts, &expr->ts))
980
    return 0;
1011
    return 0;
981
1012
1013
  if (convert)
1014
    return gfc_convert_type (expr, &constructor_ts, 1) == SUCCESS ? 0 : 1;
1015
982
  gfc_error ("Element in %s array constructor at %L is %s",
1016
  gfc_error ("Element in %s array constructor at %L is %s",
983
	     gfc_typename (&constructor_ts), &expr->where,
1017
	     gfc_typename (&constructor_ts), &expr->where,
984
	     gfc_typename (&expr->ts));
1018
	     gfc_typename (&expr->ts));
Lines 991-997 check_element_type (gfc_expr *expr) Link Here
991
/* Recursive work function for gfc_check_constructor_type().  */
1025
/* Recursive work function for gfc_check_constructor_type().  */
992
1026
993
static try
1027
static try
994
check_constructor_type (gfc_constructor *c)
1028
check_constructor_type (gfc_constructor *c, bool convert)
995
{
1029
{
996
  gfc_expr *e;
1030
  gfc_expr *e;
997
1031
Lines 1001-1013 check_constructor_type (gfc_constructor Link Here
1001
1035
1002
      if (e->expr_type == EXPR_ARRAY)
1036
      if (e->expr_type == EXPR_ARRAY)
1003
	{
1037
	{
1004
	  if (check_constructor_type (e->value.constructor) == FAILURE)
1038
	  if (check_constructor_type (e->value.constructor, convert) == FAILURE)
1005
	    return FAILURE;
1039
	    return FAILURE;
1006
1040
1007
	  continue;
1041
	  continue;
1008
	}
1042
	}
1009
1043
1010
      if (check_element_type (e))
1044
      if (check_element_type (e, convert))
1011
	return FAILURE;
1045
	return FAILURE;
1012
    }
1046
    }
1013
1047
Lines 1023-1032 gfc_check_constructor_type (gfc_expr *e) Link Here
1023
{
1057
{
1024
  try t;
1058
  try t;
1025
1059
1026
  cons_state = CONS_START;
1060
  if (e->ts.type != BT_UNKNOWN)
1027
  gfc_clear_ts (&constructor_ts);
1061
    {
1062
      cons_state = CONS_GOOD;
1063
      constructor_ts = e->ts;
1064
    }
1065
  else
1066
    {
1067
      cons_state = CONS_START;
1068
      gfc_clear_ts (&constructor_ts);
1069
    }
1028
1070
1029
  t = check_constructor_type (e->value.constructor);
1071
  /* If e->ts.type != BT_UNKNOWN, the array constructor included a
1072
     typespec, and we will now convert the values on the fly.  */
1073
  t = check_constructor_type (e->value.constructor, e->ts.type != BT_UNKNOWN);
1030
  if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
1074
  if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
1031
    e->ts = constructor_ts;
1075
    e->ts = constructor_ts;
1032
1076

Return to bug 27997