From 2fbd4117c6872453531aa88123f0ea8efdf1b4df Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 31 Aug 2009 12:22:32 +0200 Subject: [PATCH] re PR fortran/40996 ([F03] ALLOCATABLE scalars) 2009-08-31 Janus Weil PR fortran/40996 * check.c (gfc_check_allocated): Implement allocatable scalars. * resolve.c (resolve_allocate_expr,resolve_fl_var_and_proc): Ditto. * trans-intrinsic.c (gfc_conv_allocated): Ditto. 2009-08-31 Janus Weil PR fortran/40996 * gfortran.dg/allocatable_scalar_1.f90: New. * gfortran.dg/allocatable_scalar_2.f90: Renamed from finalize_9.f03. * gfortran.dg/finalize_9.f03: Renamed to allocatable_scalar_2.f90. * gfortran.dg/proc_ptr_comp_pass_4.f90: Modified. From-SVN: r151240 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/check.c | 3 --- gcc/fortran/resolve.c | 15 +++++++++------ gcc/fortran/trans-intrinsic.c | 18 +++++++++++++++--- gcc/testsuite/ChangeLog | 8 ++++++++ .../gfortran.dg/allocatable_scalar_1.f90 | 18 ++++++++++++++++++ ...finalize_9.f03 => allocatable_scalar_2.f90} | 3 +++ .../gfortran.dg/proc_ptr_comp_pass_4.f90 | 2 +- 8 files changed, 61 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocatable_scalar_1.f90 rename gcc/testsuite/gfortran.dg/{finalize_9.f03 => allocatable_scalar_2.f90} (89%) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ce732e07c412..3d2aad65b9ed 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2009-08-31 Janus Weil + + PR fortran/40996 + * check.c (gfc_check_allocated): Implement allocatable scalars. + * resolve.c (resolve_allocate_expr,resolve_fl_var_and_proc): Ditto. + * trans-intrinsic.c (gfc_conv_allocated): Ditto. + 2009-08-30 Daniel Kraft PR fortran/37425 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 6e2ce4102251..01775abdd305 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -546,9 +546,6 @@ gfc_check_allocated (gfc_expr *array) return FAILURE; } - if (array_check (array, 0) == FAILURE) - return FAILURE; - return SUCCESS; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f10a4123a6b2..b665c3545033 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5643,7 +5643,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) code->next = init_st; } - if (pointer && dimension == 0) + if (pointer || dimension == 0) return SUCCESS; /* Make sure the next-to-last reference node is an array specification. */ @@ -7955,11 +7955,14 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) if (sym->attr.allocatable) { if (sym->attr.dimension) - gfc_error ("Allocatable array '%s' at %L must have " - "a deferred shape", sym->name, &sym->declared_at); - else - gfc_error ("Scalar object '%s' at %L may not be ALLOCATABLE", - sym->name, &sym->declared_at); + { + gfc_error ("Allocatable array '%s' at %L must have " + "a deferred shape", sym->name, &sym->declared_at); + return FAILURE; + } + else if (gfc_notify_std (GFC_STD_F2003, "Scalar object '%s' at %L " + "may not be ALLOCATABLE", sym->name, + &sym->declared_at) == FAILURE) return FAILURE; } diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3b2cbd11428b..b9e5b865b190 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4564,10 +4564,22 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr) gfc_init_se (&arg1se, NULL); arg1 = expr->value.function.actual; ss1 = gfc_walk_expr (arg1->expr); - arg1se.descriptor_only = 1; - gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1); - tmp = gfc_conv_descriptor_data_get (arg1se.expr); + if (ss1 == gfc_ss_terminator) + { + /* Allocatable scalar. */ + arg1se.want_pointer = 1; + gfc_conv_expr (&arg1se, arg1->expr); + tmp = arg1se.expr; + } + else + { + /* Allocatable array. */ + arg1se.descriptor_only = 1; + gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1); + tmp = gfc_conv_descriptor_data_get (arg1se.expr); + } + tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3173f578ce90..6641a43fd2ee 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2009-08-31 Janus Weil + + PR fortran/40996 + * gfortran.dg/allocatable_scalar_1.f90: New. + * gfortran.dg/allocatable_scalar_2.f90: Renamed from finalize_9.f03. + * gfortran.dg/finalize_9.f03: Renamed to allocatable_scalar_2.f90. + * gfortran.dg/proc_ptr_comp_pass_4.f90: Modified. + 2009-08-30 Richard Guenther PR tree-optimization/41186 diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_1.f90 new file mode 100644 index 000000000000..d83d2f7f72bd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_1.f90 @@ -0,0 +1,18 @@ +! { dg-do run } +! +! PR 40996: [F03] ALLOCATABLE scalars +! +! Contributed by Janus Weil + +implicit none +real, allocatable :: scalar + +allocate(scalar) +scalar = exp(1.) +print *,scalar +if (.not. allocated(scalar)) call abort() +deallocate(scalar) +if (allocated(scalar)) call abort() + +end + diff --git a/gcc/testsuite/gfortran.dg/finalize_9.f03 b/gcc/testsuite/gfortran.dg/allocatable_scalar_2.f90 similarity index 89% rename from gcc/testsuite/gfortran.dg/finalize_9.f03 rename to gcc/testsuite/gfortran.dg/allocatable_scalar_2.f90 index 464036efc388..5ad58ca38ab3 100644 --- a/gcc/testsuite/gfortran.dg/finalize_9.f03 +++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_2.f90 @@ -1,8 +1,11 @@ ! { dg-do compile } +! { dg-options "-std=f95" } ! Parsing of finalizer procedure definitions. ! While ALLOCATABLE scalars are not implemented, this even used to ICE. ! Thanks Tobias Burnus for the test! integer, allocatable :: x ! { dg-error "may not be ALLOCATABLE" } + end + diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 index b52c810cdf28..0a28b5340b33 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 @@ -51,7 +51,7 @@ contains type(t2) :: y2 end subroutine - subroutine foo3 (x3,y3) ! { dg-error "may not be ALLOCATABLE" } + subroutine foo3 (x3,y3) type(t3),allocatable :: x3 type(t3) :: y3 end subroutine -- 2.43.5