@@ -2152,17 +2152,25 @@ gfc_get_expr_charlen (gfc_expr *e)
break;
case REF_SUBSTRING:
- gfc_init_se (&se, NULL);
- gfc_conv_expr_type (&se, r->u.ss.start, gfc_charlen_type_node);
- length = se.expr;
- gfc_conv_expr_type (&se, r->u.ss.end, gfc_charlen_type_node);
- length = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_charlen_type_node,
- se.expr, length);
- length = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_charlen_type_node, length,
- gfc_index_one_node);
- break;
+ {
+ tree start;
+
+ gfc_init_se (&se, NULL);
+ gcc_assert (r->u.ss.start);
+ gfc_conv_expr_type (&se, r->u.ss.start, gfc_charlen_type_node);
+ start = se.expr;
+ if (r->u.ss.end)
+ gfc_conv_expr_type (&se, r->u.ss.end, gfc_charlen_type_node);
+ else
+ se.expr = length;
+ length = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_charlen_type_node,
+ se.expr, start);
+ length = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_charlen_type_node, length,
+ gfc_index_one_node);
+ break;
+ }
default:
gcc_unreachable ();
new file mode 100644
@@ -0,0 +1,218 @@
+! { dg-do run }
+!
+! Tests fix for PR100948
+!
+! Based on contribution by JG. Steinmetz <gscfq@t-online.de>
+!
+
+program dct_p
+
+ implicit none
+
+ integer, parameter :: n = 2
+ integer, parameter :: m = 3
+
+ character(len=*), parameter :: u(*) = ["abc", "uvw"]
+
+ type :: dca_t
+ character(:), allocatable :: c(:)
+ end type dca_t
+
+ type :: dcp_t
+ character(:), pointer :: c(:)
+ end type dcp_t
+
+ character(len=m), target :: a(n)
+
+ a = u
+ if (size(a)/=n) stop 1
+ if (len(a)/=m) stop 2
+ if (any(a/=u)) stop 3
+ call dcs0(a)
+ if (size(a)/=n) stop 4
+ if (len(a)/=m) stop 5
+ if (any(a/=u)) stop 6
+ a = u
+ call dcs1(a)
+ if (size(a)/=n) stop 7
+ if (len(a)/=m) stop 8
+ if (any(a/=u)) stop 9
+ a = u
+ call dcs2(a)
+ if (size(a)/=n) stop 10
+ if (len(a)/=m) stop 11
+ if (any(a/=u)) stop 12
+ a = u
+ call dcs3(a)
+ if (size(a)/=n) stop 13
+ if (len(a)/=m) stop 14
+ if (any(a/=u)) stop 15
+ a = u
+ call dcs4(a)
+ if (size(a)/=n) stop 16
+ if (len(a)/=m) stop 17
+ if (any(a/=u)) stop 18
+ a = u
+ call dcs5(a)
+ if (size(a)/=n) stop 19
+ if (len(a)/=m) stop 20
+ if (any(a/=u)) stop 21
+ a = u
+ call dcs6(a)
+ if (size(a)/=n) stop 22
+ if (len(a)/=m) stop 23
+ if (any(a/=u)) stop 24
+ a = u
+ call dcs7(a)
+ if (size(a)/=n) stop 25
+ if (len(a)/=m) stop 26
+ if (any(a/=u)) stop 27
+ stop
+
+contains
+
+ subroutine dcs0(a)
+ character(len=*), intent(in) :: a(:)
+
+ if (size(a)/=n) stop 28
+ if (len(a)/=m) stop 29
+ if (any(a/=u)) stop 30
+ associate (q => a(:)(:))
+ if (size(q)/=n) stop 31
+ if (len(q)/=m) stop 32
+ if (any(q/=u)) stop 33
+ end associate
+ return
+ end subroutine dcs0
+
+ subroutine dcs1(a)
+ character(len=*), intent(in) :: a(:)
+
+ character(len=len(a)) :: b(size(a))
+
+ b = a(:)(:)
+ if (size(b)/=n) stop 34
+ if (len(b)/=m) stop 35
+ if (any(b/=u)) stop 36
+ associate (q => b(:)(:))
+ if (size(q)/=n) stop 37
+ if (len(q)/=m) stop 38
+ if (any(q/=u)) stop 39
+ end associate
+ return
+ end subroutine dcs1
+
+ subroutine dcs2(a)
+ character(len=*), target, intent(in) :: a(:)
+
+ character(:), pointer :: p(:)
+
+ p => a(:)(:)
+ if (.not.associated(p)) stop 40
+ if (.not.associated(p, a)) stop 41
+ if (size(p)/=n) stop 42
+ if (len(p)/=m) stop 43
+ if (any(p/=u)) stop 44
+ associate (q => p(:)(:))
+ if (size(q)/=n) stop 45
+ if (len(q)/=m) stop 46
+ if (any(q/=u)) stop 47
+ end associate
+ return
+ end subroutine dcs2
+
+ subroutine dcs3(a)
+ character(len=*), intent(in) :: a(:)
+
+ character(:), allocatable :: b(:)
+
+ b = a(:)(:)
+ if (size(b)/=n) stop 48
+ if (len(b)/=m) stop 49
+ if (any(b/=u)) stop 50
+ associate (q => b(:)(:))
+ if (size(q)/=n) stop 51
+ if (len(q)/=m) stop 52
+ if (any(q/=u)) stop 53
+ end associate
+ return
+ end subroutine dcs3
+
+ subroutine dcs4(a)
+ character(len=*), intent(in) :: a(:)
+
+ type(dca_t) :: b
+
+ b = dca_t(a)
+ if (.not.allocated(b%c)) stop 54
+ if (size(b%c)/=n) stop 55
+ !if (len(b%c)/=m) stop 56
+ !if (any(b%c/=u)) stop 57
+ associate (q => b%c(:)(:))
+ if (size(q)/=n) stop 58
+ !if (len(q)/=m) stop 59
+ !if (any(q/=u)) stop 60
+ end associate
+ return
+ end subroutine dcs4
+
+ subroutine dcs5(a)
+ character(len=*), target, intent(in) :: a(:)
+
+ type(dcp_t) :: b
+
+ b = dcp_t(a)
+ if (.not.associated(b%c)) stop 61
+ !if (.not.associated(b%c, a)) stop 62
+ if (size(b%c)/=n) stop 63
+ !if (len(b%c)/=m) stop 64
+ !if (any(b%c/=u)) stop 65
+ associate (q => b%c(:)(:))
+ if (size(q)/=n) stop 66
+ !if (len(q)/=m) stop 67
+ !if (any(q/=u)) stop 68
+ end associate
+ return
+ end subroutine dcs5
+
+ subroutine dcs6(a)
+ character(len=*), intent(in) :: a(:)
+
+ type(dca_t), allocatable :: b
+
+ b = dca_t(a)
+ if (.not.allocated(b%c)) stop 69
+ if (size(b%c)/=n) stop 70
+ !if (len(b%c)/=m) stop 71
+ !if (any(b%c/=u)) stop 72
+ associate (q => b%c(:)(:))
+ if (size(q)/=n) stop 73
+ !if (len(q)/=m) stop 74
+ !if (any(q/=u)) stop 75
+ end associate
+ deallocate(b)
+ return
+ end subroutine dcs6
+
+ subroutine dcs7(a)
+ character(len=*), target, intent(in) :: a(:)
+
+ type(dcp_t), allocatable :: b
+
+ b = dcp_t(a)
+ if (.not.associated(b%c)) stop 76
+ !if (.not.associated(b%c, a)) stop 77
+ if (size(b%c)/=n) stop 78
+ !if (len(b%c)/=m) stop 79
+ !if (any(b%c/=u)) stop 80
+ associate (q => b%c(:)(:))
+ if (size(q)/=n) stop 81
+ !if (len(q)/=m) stop 82
+ !if (any(q/=u)) stop 83
+ end associate
+ deallocate(b)
+ return
+ end subroutine dcs7
+
+end program dct_p
+