From: Arnaud Charlet Date: Thu, 12 Nov 2015 11:54:53 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=df9ad6bc4901bf25c40b136fa6c1b39a78d76f41;p=gcc.git [multiple changes] 2015-11-12 Gary Dismukes * gnat1drv.adb, opt.ads: Minor reformatting. 2015-11-12 Ed Schonberg * sem_ch3.adb (Analyze_Number_Declaration): Call Analyze_Dimension, to propagate dimension information from expression to named number. * sem_dim.ads: Documentation: number declaration and explicit dereference can carry dimension information. * sem_dim.adb (Analyze_Dimension_Number_Declaration): New procedure, to propagate dimension information from expression of declaration to named number, whose type becomes one of the dimensioned base types rather than universal real. (Analyze_Dimension_Binary_Op): a) If one operand is a literal that is the value of a declared constant after constant-foloding, use the dimensions of the declared constant. b) If an operand is a literal that is a contant-folded expression, and expander is active, do not report a dimension mismatch if literal does not carry them, because dimension matching will have been checked previously. From-SVN: r230244 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2931059cfe9..5290312447c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2015-11-12 Gary Dismukes + + * gnat1drv.adb, opt.ads: Minor reformatting. + +2015-11-12 Ed Schonberg + + * sem_ch3.adb (Analyze_Number_Declaration): Call Analyze_Dimension, + to propagate dimension information from expression to named + number. + * sem_dim.ads: Documentation: number declaration and explicit + dereference can carry dimension information. + * sem_dim.adb (Analyze_Dimension_Number_Declaration): New + procedure, to propagate dimension information from expression + of declaration to named number, whose type becomes one of the + dimensioned base types rather than universal real. + (Analyze_Dimension_Binary_Op): + a) If one operand is a literal that is the value of a declared + constant after constant-foloding, use the dimensions of the + declared constant. + b) If an operand is a literal that is a contant-folded expression, + and expander is active, do not report a dimension mismatch if + literal does not carry them, because dimension matching will + have been checked previously. + 2015-11-12 Ed Schonberg * sem_ch8.adb (Find_Selected_Component): In a synchronized diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index e84719a893e..e36533a0ddc 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -155,7 +155,7 @@ procedure Gnat1drv is Operating_Mode := Generate_Code; -- Suppress alignment checks since we do not have access to alignment - -- info on the target + -- info on the target. Suppress_Options.Suppress (Alignment_Check) := False; end if; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 60aeb28c9af..9041a88929b 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -200,7 +200,7 @@ package Opt is Alternate_Main_Name : String_Ptr := null; -- GNATBIND - -- Set to non null when Bind_Alternate_Main_Name is True. This value + -- Set to non-null when Bind_Alternate_Main_Name is True. This value -- is modified as needed by Gnatbind.Scan_Bind_Arg. ASIS_Mode : Boolean := False; @@ -424,7 +424,7 @@ package Opt is -- The value given to the -g parameter. The default value for -g with -- no value is 2. If no -g is specified, defaults to 0. -- Note that the generated code should never depend on this variable, - -- since we want debug info to be non intrusive on the generate code. + -- since we want debug info to be nonintrusive on the generate code. Default_Exit_Status : Int := 0; -- GNATBIND @@ -1317,8 +1317,8 @@ package Opt is Setup_Projects : Boolean := False; -- GNAT DRIVER - -- Set to True for GNAT SETUP: the Project Manager creates non existing - -- object, library and exec directories. + -- Set to True for GNAT SETUP: the Project Manager creates nonexistent + -- object, library, and exec directories. Shared_Libgnat : Boolean; -- GNATBIND @@ -1880,7 +1880,7 @@ package Opt is -- to date version of Ada). Ada_Version_Pragma_Config : Node_Id; - -- This will be set non empty if it is set by a configuration pragma + -- This will be set nonempty if it is set by a configuration pragma Ada_Version_Explicit_Config : Ada_Version_Type; -- GNAT diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a82385e45fc..31f6bd2a1f7 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3270,6 +3270,8 @@ package body Sem_Ch3 is Rewrite (E, Make_Integer_Literal (Sloc (N), 1)); Set_Etype (E, Any_Type); end if; + + Analyze_Dimension (N); end Analyze_Number_Declaration; -------------------------------- diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 1706f5e96cc..7a544b645ed 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -253,6 +253,11 @@ package body Sem_Dim is -- N_Type_Conversion -- N_Unchecked_Type_Conversion + procedure Analyze_Dimension_Number_Declaration (N : Node_Id); + -- Procedure to analyze dimension of expression in a number declaration. + -- This allows a named number to have non-trivial dimensions, while by + -- default a named number is dimensionless. + procedure Analyze_Dimension_Object_Declaration (N : Node_Id); -- Subroutine of Analyze_Dimension for object declaration. Check that -- the dimensions of the object type and the dimensions of the expression @@ -1147,6 +1152,9 @@ package body Sem_Dim is N_Unchecked_Type_Conversion => Analyze_Dimension_Has_Etype (N); + when N_Number_Declaration => + Analyze_Dimension_Number_Declaration (N); + when N_Object_Declaration => Analyze_Dimension_Object_Declaration (N); @@ -1308,10 +1316,30 @@ package body Sem_Dim is procedure Analyze_Dimension_Binary_Op (N : Node_Id) is N_Kind : constant Node_Kind := Nkind (N); + function Dimensions_Of_Operand (N : Node_Id) return Dimension_Type; + -- If the operand is a numeric literal that comes from a declared + -- constant, use the dimensions of the constant which were computed + -- from the expression of the constant declaration. + procedure Error_Dim_Msg_For_Binary_Op (N, L, R : Node_Id); -- Error using Error_Msg_NE and Error_Msg_N at node N. Output the -- dimensions of both operands. + --------------------------- + -- Dimensions_Of_Operand -- + --------------------------- + + function Dimensions_Of_Operand (N : Node_Id) return Dimension_Type is + begin + if Nkind (N) = N_Real_Literal + and then Present (Original_Entity (N)) + then + return Dimensions_Of (Original_Entity (N)); + else + return Dimensions_Of (N); + end if; + end Dimensions_Of_Operand; + --------------------------------- -- Error_Dim_Msg_For_Binary_Op -- --------------------------------- @@ -1334,10 +1362,12 @@ package body Sem_Dim is then declare L : constant Node_Id := Left_Opnd (N); - Dims_Of_L : constant Dimension_Type := Dimensions_Of (L); + Dims_Of_L : constant Dimension_Type := + Dimensions_Of_Operand (L); L_Has_Dimensions : constant Boolean := Exists (Dims_Of_L); R : constant Node_Id := Right_Opnd (N); - Dims_Of_R : constant Dimension_Type := Dimensions_Of (R); + Dims_Of_R : constant Dimension_Type := + Dimensions_Of_Operand (R); R_Has_Dimensions : constant Boolean := Exists (Dims_Of_R); Dims_Of_N : Dimension_Type := Null_Dimension; @@ -1453,20 +1483,40 @@ package body Sem_Dim is -- Comparison cases -- For relational operations, only dimension checking is - -- performed (no propagation). + -- performed (no propagation). If one operand is the result + -- of constant folding the dimensions may have been lost + -- in a tree copy, so assume that pre-analysis has verified + -- that dimensions are correct. elsif N_Kind in N_Op_Compare then if (L_Has_Dimensions or R_Has_Dimensions) and then Dims_Of_L /= Dims_Of_R then - Error_Dim_Msg_For_Binary_Op (N, L, R); + if Nkind (L) = N_Real_Literal + and then not (Comes_From_Source (L)) + and then Expander_Active + then + null; + + elsif Nkind (R) = N_Real_Literal + and then not (Comes_From_Source (R)) + and then Expander_Active + then + null; + + else + Error_Dim_Msg_For_Binary_Op (N, L, R); + end if; end if; end if; - -- Removal of dimensions for each operands + -- If expander is active, remove dimension information from each + -- operand, as only dimensions of result are relevant. - Remove_Dimensions (L); - Remove_Dimensions (R); + if Expander_Active then + Remove_Dimensions (L); + Remove_Dimensions (R); + end if; end; end if; end Analyze_Dimension_Binary_Op; @@ -1929,7 +1979,7 @@ package body Sem_Dim is Check_Error_Detected; return; - elsif Ekind (Id) = E_Constant + elsif Ekind_In (Id, E_Constant, E_Named_Real) and then Exists (Dimensions_Of (Id)) then Set_Dimensions (N, Dimensions_Of (Id)); @@ -1980,6 +2030,22 @@ package body Sem_Dim is end case; end Analyze_Dimension_Has_Etype; + ------------------------------------------ + -- Analyze_Dimension_Number_Declaration -- + ------------------------------------------ + + procedure Analyze_Dimension_Number_Declaration (N : Node_Id) is + Expr : constant Node_Id := Expression (N); + Id : constant Entity_Id := Defining_Identifier (N); + Dim_Of_Expr : constant Dimension_Type := Dimensions_Of (Expr); + + begin + if Exists (Dim_Of_Expr) then + Set_Dimensions (Id, Dim_Of_Expr); + Set_Etype (Id, Etype (Expr)); + end if; + end Analyze_Dimension_Number_Declaration; + ------------------------------------------ -- Analyze_Dimension_Object_Declaration -- ------------------------------------------ diff --git a/gcc/ada/sem_dim.ads b/gcc/ada/sem_dim.ads index 7393bf6cadd..d1521e90826 100644 --- a/gcc/ada/sem_dim.ads +++ b/gcc/ada/sem_dim.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2011-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2011-2015, 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- -- @@ -116,8 +116,10 @@ package Sem_Dim is -- * compontent declaration -- * extended return statement -- * expanded name + -- * explicit dereference -- * identifier -- * indexed component + -- * number declaration -- * object declaration -- * object renaming declaration -- * procedure call statement