{
gfc_expr *e;
- e = cons->expr;
- cons->expr = NULL;
+ if (cons)
+ {
+ e = cons->expr;
+ cons->expr = NULL;
+ }
+ else
+ e = gfc_copy_expr (p);
e->ref = p->ref->next;
p->ref->next = NULL;
gfc_replace_expr (p, e);
{
gfc_constructor *cons;
gfc_expr *newp;
+ gfc_ref *last_ref;
while (p->ref)
{
switch (p->ref->u.ar.type)
{
case AR_ELEMENT:
+ /* <type/kind spec>, parameter :: x(<int>) = scalar_expr
+ will generate this. */
+ if (p->expr_type != EXPR_ARRAY)
+ {
+ remove_subobject_ref (p, NULL);
+ break;
+ }
if (find_array_element (p->value.constructor, &p->ref->u.ar,
&cons) == FAILURE)
return FAILURE;
return FAILURE;
}
- /* If this is a CHARACTER array and we possibly took a
- substring out of it, update the type-spec's character
- length according to the first element (as all should have
- the same length). */
- if (p->ts.type == BT_CHARACTER)
+ if (p->ts.type == BT_DERIVED
+ && p->ref->next
+ && p->value.constructor)
{
- int string_len;
+ /* There may have been component references. */
+ p->ts = p->value.constructor->expr->ts;
+ }
- gcc_assert (p->ref->next);
- gcc_assert (!p->ref->next->next);
- gcc_assert (p->ref->next->type == REF_SUBSTRING);
+ last_ref = p->ref;
+ for (; last_ref->next; last_ref = last_ref->next) {};
+ if (p->ts.type == BT_CHARACTER
+ && last_ref->type == REF_SUBSTRING)
+ {
+ /* If this is a CHARACTER array and we possibly took
+ a substring out of it, update the type-spec's
+ character length according to the first element
+ (as all should have the same length). */
+ int string_len;
if (p->value.constructor)
{
const gfc_expr* first = p->value.constructor->expr;
--- /dev/null
+! { dg-do compile }
+! Test the fix for pr41167, in which the first argument of 'pack', below,
+! was simplified incorrectly, with the results indicated.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+program gfcbug88
+ implicit none
+ type t
+ character(len=8) :: name
+ end type t
+ type(t) ,parameter :: obstyp(2)= (/ t ('A'), t ('B') /)
+ character(9) :: chr(1)
+
+ print *, pack (" "//obstyp(:)% name, (/ .true., .false. /)) ! Used to ICE on compilation
+ chr = pack (" "//obstyp(:)% name, (/ .true., .false. /)) ! Used to give conversion error
+end program gfcbug88
--- /dev/null
+! { dg-do compile }
+! Test the fix for the problems in PR41044
+!
+! Contributed by <ros@rzg.mpg.de>
+! Reduced by Joos VandeVondele <jv244@cam.ac.uk>
+!
+ Subroutine PS_INIT (bkgd, punit, pform, psize, rot90, bbox, clip, eps, &
+ caller)
+ type psfd ! paper size and frame defaults
+ character(3) :: n
+ real :: p(2)
+ real :: f(4)
+ end type psfd
+ character(4) :: fn, orich, pfmt
+ type(psfd), parameter :: pfd(0:11)=(/ &
+ psfd(' ',(/ 0.0, 0.0/),(/200.,120.,800.,560./)), & ! A0_L
+ psfd('A0 ',(/ 840.9,1189.2/),(/140., 84.,560.,400./)), & ! A0_P
+ psfd('A1 ',(/ 594.6, 840.9/),(/100., 60.,400.,280./)), & ! A1_P
+ psfd('A2 ',(/ 420.4, 594.6/),(/ 70., 42.,280.,200./)), & ! A2_P
+ psfd('A3 ',(/ 297.3, 420.4/),(/ 50., 30.,200.,140./)), & ! A3_P
+ psfd('A4 ',(/ 210.2, 297.3/),(/ 35., 21.,140.,100./)), & ! A4_P
+ psfd('A5 ',(/ 148.7, 210.2/),(/ 25., 15.,100., 70./)), & ! A5_P
+ psfd('A6 ',(/ 105.1, 148.7/),(/ 18., 11., 70., 50./)), & ! A6_P
+ psfd(' ',(/ 0.0, 0.0/),(/ 50., 30.,200.,140./)), & ! Letter_L
+ psfd('LET',(/ 215.9, 279.4/),(/ 35., 21.,140.,100./)), & ! Letter_P
+ psfd(' ',(/ 0.0, 0.0/),(/ 50., 30.,200.,140./)), & ! Legal_L
+ psfd('LEG',(/ 215.9, 355.6/),(/ 35., 21.,140.,100./))/) ! Legal_P
+ if (len_trim(pfmt) > 0) then ! set paper format
+ idx=sum(maxloc(index(pfd%n,pfmt(1:3))))-1
+ end if
+ end subroutine PS_INIT
+
+! This, additional problem, was posted as comment #8 by Tobias Burnus <burnus@gcc.gnu.org>
+ type t
+ integer :: i
+ end type t
+ type(t), parameter :: a(1) = t(4) ! [t(4)] worked OK
+ real(a(1)%i) :: b
+end
projects / gcc.git / commitdiff