From e3c4580e400367dfceec3e4c0539b43fcb4ed340 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 24 Mar 2011 16:08:50 +0000 Subject: [PATCH] einfo.ads (Size_Depends_On_Discriminant): Adjust description. * einfo.ads (Size_Depends_On_Discriminant): Adjust description. * layout.adb (Compute_Size_Depends_On_Discriminant): New procedure to compute Set_Size_Depends_On_Discriminant. (Layout_Type): Call it on array types in back-end layout mode. * sem_util.adb (Requires_Transient_Scope): Return true for array types only if the size depends on the value of discriminants. * gcc-interface/utils2.c (build_binary_op) : Use the RHS type if the RHS is a call to a function that returns an unconstrained type with default discriminant. From-SVN: r171402 --- gcc/ada/ChangeLog | 12 ++++++ gcc/ada/einfo.ads | 6 +-- gcc/ada/gcc-interface/utils2.c | 11 ++++- gcc/ada/layout.adb | 60 ++++++++++++++++++++++++++- gcc/ada/sem_util.adb | 8 ++-- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gnat.dg/array16.adb | 22 ++++++++++ gcc/testsuite/gnat.dg/array16.ads | 31 ++++++++++++++ gcc/testsuite/gnat.dg/array16_pkg.ads | 5 +++ 9 files changed, 151 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/array16.adb create mode 100644 gcc/testsuite/gnat.dg/array16.ads create mode 100644 gcc/testsuite/gnat.dg/array16_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e586919fd0c..a76fb316494 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2011-03-24 Eric Botcazou + + * einfo.ads (Size_Depends_On_Discriminant): Adjust description. + * layout.adb (Compute_Size_Depends_On_Discriminant): New procedure + to compute Set_Size_Depends_On_Discriminant. + (Layout_Type): Call it on array types in back-end layout mode. + * sem_util.adb (Requires_Transient_Scope): Return true for array + types only if the size depends on the value of discriminants. + * gcc-interface/utils2.c (build_binary_op) : Use the RHS + type if the RHS is a call to a function that returns an unconstrained + type with default discriminant. + 2011-03-24 Eric Botcazou * gcc-interface/trans.c (gnat_to_gnu): Remove obsolete case of diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 88fabd76fc9..051688ae376 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -3573,8 +3573,8 @@ package Einfo is -- Size_Depends_On_Discriminant (Flag177) -- Present in all entities for types and subtypes. Indicates that the -- size of the type depends on the value of one or more discriminants. --- Currently, this flag is only set in front end layout mode for arrays --- which have one or more bounds depending on a discriminant value. +-- Currently, this flag is only set for arrays which have one or more +-- bounds depending on a discriminant value. -- Size_Known_At_Compile_Time (Flag92) -- Present in all entities for types and subtypes. Indicates that the diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index 07d6b5bd0bf..78f5fd94c33 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -186,7 +186,7 @@ known_alignment (tree exp) static tree find_common_type (tree t1, tree t2) { - /* ??? As of today, various constructs lead here with types of different + /* ??? As of today, various constructs lead to here with types of different sizes even when both constants (e.g. tagged types, packable vs regular component types, padded vs unpadded types, ...). While some of these would better be handled upstream (types should be made consistent before @@ -609,6 +609,15 @@ build_binary_op (enum tree_code op_code, tree result_type, && !integer_zerop (TYPE_SIZE (right_type))) operation_type = left_type; + /* If we have a call to a function that returns an unconstrained type + with default discriminant on the RHS, use the RHS type (which is + padded) as we cannot compute the size of the actual assignment. */ + else if (TREE_CODE (right_operand) == CALL_EXPR + && TYPE_IS_PADDING_P (right_type) + && CONTAINS_PLACEHOLDER_P + (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (right_type))))) + operation_type = right_type; + /* Find the best type to use for copying between aggregate types. */ else if (((TREE_CODE (left_type) == ARRAY_TYPE && TREE_CODE (right_type) == ARRAY_TYPE) diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 0c4db36b46f..7ae89b53f27 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -109,6 +109,12 @@ package body Layout is -- are of an enumeration type (so that the subtraction cannot be -- done directly) by applying the Pos operator to Hi/Lo first. + procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id); + -- Given an array type or an array subtype E, compute whether its size + -- depends on the value of one or more discriminants and set the flag + -- Size_Depends_On_Discriminant accordingly. This need not be called + -- in front end layout mode since it does the computation on its own. + function Expr_From_SO_Ref (Loc : Source_Ptr; D : SO_Ref; @@ -1289,6 +1295,49 @@ package body Layout is end if; end Layout_Array_Type; + ------------------------------------------ + -- Compute_Size_Depends_On_Discriminant -- + ------------------------------------------ + + procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id) is + Indx : Node_Id; + Ityp : Entity_Id; + Lo : Node_Id; + Hi : Node_Id; + Res : Boolean := False; + begin + -- Loop to process array indexes + + Indx := First_Index (E); + while Present (Indx) loop + Ityp := Etype (Indx); + + -- If an index of the array is a generic formal type then there is + -- no point in determining a size for the array type. + + if Is_Generic_Type (Ityp) then + return; + end if; + + Lo := Type_Low_Bound (Ityp); + Hi := Type_High_Bound (Ityp); + + if (Nkind (Lo) = N_Identifier + and then Ekind (Entity (Lo)) = E_Discriminant) + or else (Nkind (Hi) = N_Identifier + and then Ekind (Entity (Hi)) = E_Discriminant) + then + Res := True; + end if; + + Next_Index (Indx); + end loop; + + if Res then + Set_Size_Depends_On_Discriminant (E); + end if; + end Compute_Size_Depends_On_Discriminant; + ------------------- -- Layout_Object -- ------------------- @@ -2631,6 +2680,15 @@ package body Layout is Set_Alignment (E, Uint_1); end if; end if; + + -- We need to know whether the size depends on the value of one + -- or more discriminants to select the return mechanism. Skip if + -- errors are present, to prevent cascaded messages. + + if Serious_Errors_Detected = 0 then + Compute_Size_Depends_On_Discriminant (E); + end if; + end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b218b8ea663..3a6ca5f3456 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -10473,11 +10473,11 @@ package body Sem_Util is if Requires_Transient_Scope (Component_Type (Typ)) then return True; - -- Otherwise, we only need a transient scope if the size is not - -- known at compile time. + -- Otherwise, we only need a transient scope if the size depends on + -- the value of one or more discriminants. else - return not Size_Known_At_Compile_Time (Typ); + return Size_Depends_On_Discriminant (Typ); end if; -- All other cases do not require a transient scope diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 14efc3fa1de..dab36a8c684 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-03-24 Eric Botcazou + + * gnat.dg/array16.ad[sb]: New test. + * gnat.dg/array16.ads: New helper. + 2011-03-24 Eric Botcazou * gnat.dg/derived_type2.adb: New test. diff --git a/gcc/testsuite/gnat.dg/array16.adb b/gcc/testsuite/gnat.dg/array16.adb new file mode 100644 index 00000000000..18abf8f8199 --- /dev/null +++ b/gcc/testsuite/gnat.dg/array16.adb @@ -0,0 +1,22 @@ +package body Array16 is + + function F1 (A : access My_T1) return My_T1 is + begin + return A.all; + end; + + function F2 (A : access My_T2) return My_T2 is + begin + return A.all; + end; + + procedure Proc (A : access My_T1; B : access My_T2) is + L1 : My_T1 := F1(A); + L2 : My_T2 := F2(B); + begin + if L1.D = 0 and then L2(1) = 0 then + raise Program_Error; + end if; + end; + +end Array16; diff --git a/gcc/testsuite/gnat.dg/array16.ads b/gcc/testsuite/gnat.dg/array16.ads new file mode 100644 index 00000000000..69452c98f3a --- /dev/null +++ b/gcc/testsuite/gnat.dg/array16.ads @@ -0,0 +1,31 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatn -fdump-tree-optimized" } + +with Array16_Pkg; + +package Array16 is + + type T1 (D : Integer) is record + case D is + when 1 => I : Integer; + when others => null; + end case; + end record; + + type Arr is array (Integer range <>) of Integer; + + type My_T1 is new T1 (Array16_Pkg.N); + type My_T2 is new Arr (1 .. Integer'Min (2, Array16_Pkg.N)); + + function F1 (A : access My_T1) return My_T1; + pragma Inline (F1); + + function F2 (A : access My_T2) return My_T2; + pragma Inline (F2); + + procedure Proc (A : access My_T1; B : access My_T2); + +end Array16; + +-- { dg-final { scan-tree-dump-not "secondary_stack" "optimized" } } +-- { dg-final { cleanup-tree-dump "optimized" } } diff --git a/gcc/testsuite/gnat.dg/array16_pkg.ads b/gcc/testsuite/gnat.dg/array16_pkg.ads new file mode 100644 index 00000000000..93447978cd4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/array16_pkg.ads @@ -0,0 +1,5 @@ +package Array16_Pkg is + + function N return Integer; + +end Array16_Pkg; -- 2.30.2