OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2015-11-12  Gary Dismukes  <dismukes@adacore.com>

	* gnat1drv.adb, opt.ads: Minor reformatting.

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* 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
This commit is contained in:
Arnaud Charlet 2015-11-12 12:54:53 +01:00
parent 549cc9c2bc
commit df9ad6bc49
6 changed files with 109 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gcc/ada/ChangeLog
View File

@ -1,3 +1,27 @@
2015-11-12 Gary Dismukes <dismukes@adacore.com>
* gnat1drv.adb, opt.ads: Minor reformatting.
2015-11-12 Ed Schonberg <schonberg@adacore.com>
* 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 <schonberg@adacore.com>
* sem_ch8.adb (Find_Selected_Component): In a synchronized

2
gcc/ada/gnat1drv.adb
View File

@ -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;

10
gcc/ada/opt.ads
View File

@ -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

2
gcc/ada/sem_ch3.adb
View File

@ -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;
--------------------------------

82
gcc/ada/sem_dim.adb
View File

@ -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 --
------------------------------------------

4
gcc/ada/sem_dim.ads
View File

@ -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