+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
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;
-- 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
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
-- 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
-- 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
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);
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 --
---------------------------------
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;
-- 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;
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));
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 --
------------------------------------------
projects / gcc.git / commitdiff