From patchwork Wed Aug 11 10:42:06 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Daniel Kraft X-Patchwork-Id: 61466 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 94A6FB70AE for ; Wed, 11 Aug 2010 20:37:14 +1000 (EST) Received: (qmail 29631 invoked by alias); 11 Aug 2010 10:37:10 -0000 Received: (qmail 29613 invoked by uid 22791); 11 Aug 2010 10:37:08 -0000 X-SWARE-Spam-Status: No, hits=-2.5 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_LOW, SPF_HELO_PASS X-Spam-Check-By: sourceware.org Received: from taro.utanet.at (HELO taro.utanet.at) (213.90.36.45) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 11 Aug 2010 10:37:00 +0000 Received: from paris.xoc.tele2net.at ([213.90.36.7]) by taro.utanet.at with esmtp (Exim 4.71) (envelope-from ) id 1Oj8g3-0002BR-Tb; Wed, 11 Aug 2010 12:36:55 +0200 Received: from d86-33-197-6.cust.tele2.at ([86.33.197.6] helo=[192.168.1.18]) by paris.xoc.tele2net.at with esmtpa (Exim 4.71) (envelope-from ) id 1Oj8g3-0003Dw-Dm; Wed, 11 Aug 2010 12:36:55 +0200 Message-ID: <4C627E7E.6080009@domob.eu> Date: Wed, 11 Aug 2010 12:42:06 +0200 From: Daniel Kraft User-Agent: Thunderbird 2.0.0.0 (X11/20070425) MIME-Version: 1.0 To: Fortran List , gcc-patches Subject: [Patch, Fortran] F2008: Implied-shape arrays Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Hi all, while waiting review on my ASSOCIATE stuff (Tobias promised to do so when he comes back), here's another patch implementing a small feature; namely, Fortran 2008's implied-shape arrays. This seems particularly useful in some places to me, although it is just a minor one (I would have liked to use it in real-world code already myself). Basically, everything is handled in the parser / matcher; an implied-shape array gets transformed into an explicit one as soon as the initializer is known. The only small complication is that when parsing the array-spec in case of a DIMENSION attribute, we may not already know whether this is a PARAMETER or not -- and thus, if (*) should be implied-shape or assumed-size. But I think the handling in my patch should be rather clear and still simple. No regressions on GNU/Linux-x86-32. Ok for trunk? Cheers, Daniel Index: gcc/fortran/decl.c =================================================================== --- gcc/fortran/decl.c (revision 163056) +++ gcc/fortran/decl.c (working copy) @@ -1378,6 +1378,51 @@ add_init_expr_to_sym (const char *name, } } + /* If sym is implied-shape, set its upper bounds from init. */ + if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension + && sym->as->type == AS_IMPLIED_SHAPE) + { + int dim; + + if (init->rank == 0) + { + gfc_error ("Can't initialize implied-shape array at %L" + " with scalar", &sym->declared_at); + return FAILURE; + } + gcc_assert (sym->as->rank == init->rank); + + /* Shape should be present, we get an initialization expression. */ + gcc_assert (init->shape); + + for (dim = 0; dim < sym->as->rank; ++dim) + { + int k; + gfc_expr* lower; + gfc_expr* e; + + lower = sym->as->lower[dim]; + if (lower->expr_type != EXPR_CONSTANT) + { + gfc_error ("Non-constant lower bound in implied-shape" + " declaration at %L", &lower->where); + return FAILURE; + } + + /* All dimensions must be without upper bound. */ + gcc_assert (!sym->as->upper[dim]); + + k = lower->ts.kind; + e = gfc_get_constant_expr (BT_INTEGER, k, &sym->declared_at); + mpz_add (e->value.integer, + lower->value.integer, init->shape[dim]); + mpz_sub_ui (e->value.integer, e->value.integer, 1); + sym->as->upper[dim] = e; + } + + sym->as->type = AS_EXPLICIT; + } + /* Need to check if the expression we initialized this to was one of the iso_c_binding named constants. If so, and we're a parameter (constant), let it be iso_c. @@ -1650,6 +1695,34 @@ variable_decl (int elem) else if (current_as) merge_array_spec (current_as, as, true); + /* At this point, we know for sure if the symbol is PARAMETER and can thus + determine (and check) whether it can be implied-shape. If it + was parsed as assumed-size, change it because PARAMETERs can not + be assumed-size. */ + if (as) + { + if (as->type == AS_IMPLIED_SHAPE && current_attr.flavor != FL_PARAMETER) + { + m = MATCH_ERROR; + gfc_error ("Non-PARAMETER symbol '%s' at %L can't be implied-shape", + name, &var_locus); + goto cleanup; + } + + if (as->type == AS_ASSUMED_SIZE && as->rank == 1 + && current_attr.flavor == FL_PARAMETER) + as->type = AS_IMPLIED_SHAPE; + + if (as->type == AS_IMPLIED_SHAPE + && gfc_notify_std (GFC_STD_F2008, + "Fortran 2008: Implied-shape array at %L", + &var_locus) == FAILURE) + { + m = MATCH_ERROR; + goto cleanup; + } + } + char_len = NULL; cl = NULL; Index: gcc/fortran/array.c =================================================================== --- gcc/fortran/array.c (revision 163056) +++ gcc/fortran/array.c (working copy) @@ -463,6 +463,12 @@ gfc_match_array_spec (gfc_array_spec **a as->rank++; current_type = match_array_element_spec (as); + /* Note that current_type == AS_ASSUMED_SIZE for both assumed-size + and implied-shape specifications. If the rank is at least 2, we can + distinguish between them. But for rank 1, we currently return + ASSUMED_SIZE; this gets adjusted later when we know for sure + whether the symbol parsed is a PARAMETER or not. */ + if (as->rank == 1) { if (current_type == AS_UNKNOWN) @@ -475,6 +481,15 @@ gfc_match_array_spec (gfc_array_spec **a case AS_UNKNOWN: goto cleanup; + case AS_IMPLIED_SHAPE: + if (current_type != AS_ASSUMED_SHAPE) + { + gfc_error ("Bad array specification for implied-shape" + " array at %C"); + goto cleanup; + } + break; + case AS_EXPLICIT: if (current_type == AS_ASSUMED_SIZE) { @@ -513,6 +528,12 @@ gfc_match_array_spec (gfc_array_spec **a goto cleanup; case AS_ASSUMED_SIZE: + if (as->rank == 2 && current_type == AS_ASSUMED_SIZE) + { + as->type = AS_IMPLIED_SHAPE; + break; + } + gfc_error ("Bad specification for assumed size array at %C"); goto cleanup; } @@ -570,6 +591,7 @@ coarray: else switch (as->cotype) { /* See how current spec meshes with the existing. */ + case AS_IMPLIED_SHAPE: case AS_UNKNOWN: goto cleanup; Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 163056) +++ gcc/fortran/gfortran.h (working copy) @@ -157,7 +157,7 @@ expr_t; /* Array types. */ typedef enum { AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED, - AS_ASSUMED_SIZE, AS_UNKNOWN + AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_UNKNOWN } array_type; Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 163056) +++ gcc/fortran/resolve.c (working copy) @@ -11673,20 +11673,24 @@ resolve_symbol (gfc_symbol *sym) } /* Assumed size arrays and assumed shape arrays must be dummy - arguments. */ + arguments. Array-spec's of implied-shape should have been resolved to + AS_EXPLICIT already. */ - if (sym->as != NULL - && ((sym->as->type == AS_ASSUMED_SIZE && !sym->as->cp_was_assumed) - || sym->as->type == AS_ASSUMED_SHAPE) - && sym->attr.dummy == 0) - { - if (sym->as->type == AS_ASSUMED_SIZE) - gfc_error ("Assumed size array at %L must be a dummy argument", - &sym->declared_at); - else - gfc_error ("Assumed shape array at %L must be a dummy argument", - &sym->declared_at); - return; + if (sym->as) + { + gcc_assert (sym->as->type != AS_IMPLIED_SHAPE); + if (((sym->as->type == AS_ASSUMED_SIZE && !sym->as->cp_was_assumed) + || sym->as->type == AS_ASSUMED_SHAPE) + && sym->attr.dummy == 0) + { + if (sym->as->type == AS_ASSUMED_SIZE) + gfc_error ("Assumed size array at %L must be a dummy argument", + &sym->declared_at); + else + gfc_error ("Assumed shape array at %L must be a dummy argument", + &sym->declared_at); + return; + } } /* Make sure symbols with known intent or optional are really dummy Index: gcc/testsuite/gfortran.dg/implied_shape_1.f08 =================================================================== --- gcc/testsuite/gfortran.dg/implied_shape_1.f08 (revision 0) +++ gcc/testsuite/gfortran.dg/implied_shape_1.f08 (revision 0) @@ -0,0 +1,37 @@ +! { dg-do run } +! { dg-options "-std=f2008 -fall-intrinsics" } + +! Test for correct semantics of implied-shape arrays. + +! Contributed by Daniel Kraft, d@domob.eu. + +PROGRAM main + IMPLICIT NONE + + INTEGER, PARAMETER :: n = 3 + + ! Should be able to reduce complex expressions. + REAL, PARAMETER :: arr1(n:*) = SQRT ((/ 1.0, 2.0, 3.0 /)) + 42 + + ! With dimension statement. + REAL, DIMENSION(*), PARAMETER :: arr2 = arr1 + + ! Rank > 1. + INTEGER, PARAMETER :: arr3(n:*, *) = RESHAPE ((/ 1, 2, 3, 4 /), (/ 2, 2/)) + + ! Character array. + CHARACTER(LEN=*), PARAMETER :: arr4(*) = (/ CHARACTER(LEN=3) :: "ab", "cde" /) + + IF (LBOUND (arr1, 1) /= n .OR. UBOUND (arr1, 1) /= n + 2) CALL abort () + IF (SIZE (arr1) /= 3) CALL abort () + + IF (LBOUND (arr2, 1) /= 1 .OR. UBOUND (arr2, 1) /= 3) CALL abort () + IF (SIZE (arr2) /= 3) CALL abort () + + IF (ANY (LBOUND (arr3) /= (/ n, 1 /) .OR. UBOUND (arr3) /= (/ n + 1, 2 /))) & + CALL abort () + IF (SIZE (arr3) /= 4) CALL abort () + + IF (LBOUND (arr4, 1) /= 1 .OR. UBOUND (arr4, 1) /= 2) CALL abort () + IF (SIZE (arr4) /= 2) CALL abort () +END PROGRAM main Index: gcc/testsuite/gfortran.dg/implied_shape_3.f08 =================================================================== --- gcc/testsuite/gfortran.dg/implied_shape_3.f08 (revision 0) +++ gcc/testsuite/gfortran.dg/implied_shape_3.f08 (revision 0) @@ -0,0 +1,35 @@ +! { dg-do compile } +! { dg-options "-std=f2008" } + +! Test for errors with implied-shape declarations. + +! Contributed by Daniel Kraft, d@domob.eu. + +PROGRAM main + IMPLICIT NONE + + INTEGER :: n + INTEGER, PARAMETER :: mat(2, 2) = RESHAPE ((/ 1, 2, 3, 4 /), (/ 2, 2 /)) + + ! Malformed declaration. + INTEGER, PARAMETER :: arr1(*, *, 5) = mat ! { dg-error "Bad array specification for implied-shape array" } + + ! Rank mismatch in initialization. + INTEGER, PARAMETER :: arr2(*, *) = (/ 1, 2, 3, 4 /) ! { dg-error "Incompatible ranks" } + + ! Non-PARAMETER implied-shape, with and without initializer. + INTEGER :: arr3(*, *) ! { dg-error "Non-PARAMETER" } + INTEGER :: arr4(*, *) = mat ! { dg-error "Non-PARAMETER" } + + ! Missing initializer. + INTEGER, PARAMETER :: arr5(*) ! { dg-error "is missing an initializer" } + + ! Initialization from scalar. + INTEGER, PARAMETER :: arr6(*) = 0 ! { dg-error "with scalar" } + + ! Automatic bounds. + n = 2 + BLOCK + INTEGER, PARAMETER :: arr7(n:*) = (/ 2, 3, 4 /) ! { dg-error "Non-constant lower bound" } + END BLOCK +END PROGRAM main Index: gcc/testsuite/gfortran.dg/implied_shape_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/implied_shape_2.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/implied_shape_2.f90 (revision 0) @@ -0,0 +1,11 @@ +! { dg-do compile } +! { dg-options "-std=f95" } + +! Test for rejection of implied-shape prior to Fortran 2008. + +! Contributed by Daniel Kraft, d@domob.eu. + +PROGRAM main + IMPLICIT NONE + INTEGER, PARAMETER :: arr(*) = (/ 2, 3, 4 /) ! { dg-error "Fortran 2008" } +END PROGRAM main