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

[multiple changes]

Browse Source 
2011-12-22  Vincent Pucci  <pucci@adacore.com>

	* sem_dim.adb: Addressed all ??? comments. Replacement of warnings by
	errors using continuation marks.
	(Error_Dim_Msg_For_?): Renaming of Error_Dim_For_?.

2011-12-22  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, sem_ch3.ads, sem_prag.adb: Minor code clean up.

From-SVN: r182616
This commit is contained in:
Arnaud Charlet 2011-12-22 09:49:14 +01:00
parent 868df137e6
commit 9a7e930fb2
5 changed files with 165 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
View File

@ -1,3 +1,13 @@
2011-12-22 Vincent Pucci <pucci@adacore.com>
* sem_dim.adb: Addressed all ??? comments. Replacement of warnings by
errors using continuation marks.
(Error_Dim_Msg_For_?): Renaming of Error_Dim_For_?.
2011-12-22 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch3.ads, sem_prag.adb: Minor code clean up.
2011-12-21 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
* s-oscons-tmplt.c [__alpha__ && __osf__] (_XOPEN_SOURCE): Define.

24
gcc/ada/sem_ch3.adb
View File

@ -9640,37 +9640,39 @@ package body Sem_Ch3 is
end loop;
end Check_Completion;
--------------------
-- Check_CPP_Type --
--------------------
------------------------------------
-- Check_CPP_Type_Has_No_Defaults --
------------------------------------
procedure Check_CPP_Type (T : Entity_Id) is
procedure Check_CPP_Type_Has_No_Defaults (T : Entity_Id) is
Tdef : constant Node_Id := Type_Definition (Declaration_Node (T));
Clist : Node_Id;
Comp : Node_Id;
begin
-- Obtain the component list
if Nkind (Tdef) = N_Record_Definition then
Clist := Component_List (Tdef);
else
pragma Assert (Nkind (Tdef) = N_Derived_Type_Definition);
else pragma Assert (Nkind (Tdef) = N_Derived_Type_Definition);
Clist := Component_List (Record_Extension_Part (Tdef));
end if;
-- Check all components to ensure no default expressions
if Present (Clist) then
Comp := First (Component_Items (Clist));
while Present (Comp) loop
if Present (Expression (Comp)) then
Error_Msg_N
("component of imported 'C'P'P type cannot have" &
" default expression", Expression (Comp));
("component of imported 'C'P'P type cannot have "
& "default expression", Expression (Comp));
end if;
Next (Comp);
end loop;
end if;
end Check_CPP_Type;
end Check_CPP_Type_Has_No_Defaults;
----------------------------
-- Check_Delta_Expression --
@ -18130,7 +18132,7 @@ package body Sem_Ch3 is
-- Check that components of imported CPP types do not have default
-- expressions.
Check_CPP_Type (Full_T);
Check_CPP_Type_Has_No_Defaults (Full_T);
end if;
-- If the private view has user specified stream attributes, then so has

2
gcc/ada/sem_ch3.ads
View File

@ -115,7 +115,7 @@ package Sem_Ch3 is
-- and errors are posted on that node, rather than on the declarations that
-- require completion in the package declaration.
procedure Check_CPP_Type (T : Entity_Id);
procedure Check_CPP_Type_Has_No_Defaults (T : Entity_Id);
-- Check that components of imported CPP type T do not have default
-- expressions because the constructor (if any) is on the C++ side.

267
gcc/ada/sem_dim.adb
View File

@ -258,7 +258,7 @@ package body Sem_Dim is
-- Subroutine of Analyze_Dimension for object declaration. Check that
-- the dimensions of the object type and the dimensions of the expression
-- (if expression is present) match. Note that when the expression is
-- a literal, no warning is returned. This special case allows object
-- a literal, no error is returned. This special case allows object
-- declaration such as: m : constant Length := 1.0;
procedure Analyze_Dimension_Object_Renaming_Declaration (N : Node_Id);
@ -274,7 +274,7 @@ package body Sem_Dim is
-- Subroutine of Analyze_Dimension for subtype declaration. Propagate the
-- dimensions from the parent type to the identifier of N. Note that if
-- both the identifier and the parent type of N are not dimensionless,
-- return an error message.
-- return an error.
procedure Analyze_Dimension_Unary_Op (N : Node_Id);
-- Subroutine of Analyze_Dimension for unary operators. For Plus, Minus and
@ -1035,26 +1035,33 @@ package body Sem_Dim is
Rhs : constant Node_Id := Expression (N);
Dims_Of_Rhs : constant Dimension_Type := Dimensions_Of (Rhs);
procedure Error_Dim_For_Assignment_Statement (N, Lhs, Rhs : Node_Id);
-- Error using Error_Msg_N at node N. Output in the error message the
-- dimensions of left and right hand sides.
procedure Error_Dim_Msg_For_Assignment_Statement
(N : Node_Id;
Lhs : Node_Id;
Rhs : Node_Id);
-- Error using Error_Msg_N at node N. Output the dimensions of left
-- and right hand sides.
----------------------------------------
-- Error_Dim_For_Assignment_Statement --
----------------------------------------
--------------------------------------------
-- Error_Dim_Msg_For_Assignment_Statement --
--------------------------------------------
procedure Error_Dim_For_Assignment_Statement (N, Lhs, Rhs : Node_Id) is
procedure Error_Dim_Msg_For_Assignment_Statement
(N : Node_Id;
Lhs : Node_Id;
Rhs : Node_Id)
is
begin
Error_Msg_N ("?dimensions mismatch in assignment", N);
Error_Msg_N ("?left-hand side " & Dimensions_Msg_Of (Lhs), N);
Error_Msg_N ("?right-hand side " & Dimensions_Msg_Of (Rhs), N);
end Error_Dim_For_Assignment_Statement;
Error_Msg_N ("dimensions mismatch in assignment", N);
Error_Msg_N ("\left-hand side " & Dimensions_Msg_Of (Lhs), N);
Error_Msg_N ("\right-hand side " & Dimensions_Msg_Of (Rhs), N);
end Error_Dim_Msg_For_Assignment_Statement;
-- Start of processing for Analyze_Dimension_Assignment
begin
if Dims_Of_Lhs /= Dims_Of_Rhs then
Error_Dim_For_Assignment_Statement (N, Lhs, Rhs);
Error_Dim_Msg_For_Assignment_Statement (N, Lhs, Rhs);
end if;
end Analyze_Dimension_Assignment_Statement;
@ -1068,23 +1075,23 @@ package body Sem_Dim is
procedure Analyze_Dimension_Binary_Op (N : Node_Id) is
N_Kind : constant Node_Kind := Nkind (N);
procedure Error_Dim_For_Binary_Op (N, L, R : Node_Id);
-- Error using Error_Msg_N at node N
-- Output in the error message the dimensions of both operands.
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.
-----------------------------
-- Error_Dim_For_Binary_Op --
-----------------------------
---------------------------------
-- Error_Dim_Msg_For_Binary_Op --
---------------------------------
procedure Error_Dim_For_Binary_Op (N, L, R : Node_Id) is
procedure Error_Dim_Msg_For_Binary_Op (N, L, R : Node_Id) is
begin
Error_Msg_NE ("?both operands for operation& must have same " &
Error_Msg_NE ("both operands for operation& must have same " &
"dimensions",
N,
Entity (N));
Error_Msg_N ("?left operand " & Dimensions_Msg_Of (L), N);
Error_Msg_N ("?right operand " & Dimensions_Msg_Of (R), N);
end Error_Dim_For_Binary_Op;
Error_Msg_N ("\left operand " & Dimensions_Msg_Of (L), N);
Error_Msg_N ("\right operand " & Dimensions_Msg_Of (R), N);
end Error_Dim_Msg_For_Binary_Op;
-- Start of processing for Analyze_Dimension_Binary_Op
@ -1110,7 +1117,7 @@ package body Sem_Dim is
-- Check both operands have same dimension
if Dims_Of_L /= Dims_Of_R then
Error_Dim_For_Binary_Op (N, L, R);
Error_Dim_Msg_For_Binary_Op (N, L, R);
else
-- Check both operands are not dimensionless
@ -1216,7 +1223,7 @@ package body Sem_Dim is
if (L_Has_Dimensions or R_Has_Dimensions)
and then Dims_Of_L /= Dims_Of_R
then
Error_Dim_For_Binary_Op (N, L, R);
Error_Dim_Msg_For_Binary_Op (N, L, R);
end if;
end if;
@ -1239,26 +1246,26 @@ package body Sem_Dim is
Dims_Of_Etyp : constant Dimension_Type := Dimensions_Of (Etyp);
Dims_Of_Expr : Dimension_Type;
procedure Error_Dim_For_Component_Declaration
procedure Error_Dim_Msg_For_Component_Declaration
(N : Node_Id;
Etyp : Entity_Id;
Expr : Node_Id);
-- Error using Error_Msg_N at node N. Output in the error message the
-- dimensions of the type Etyp and the expression Expr of N.
-- Error using Error_Msg_N at node N. Output the dimensions of the
-- type Etyp and the expression Expr of N.
-----------------------------------------
-- Error_Dim_For_Component_Declaration --
-----------------------------------------
---------------------------------------------
-- Error_Dim_Msg_For_Component_Declaration --
---------------------------------------------
procedure Error_Dim_For_Component_Declaration
procedure Error_Dim_Msg_For_Component_Declaration
(N : Node_Id;
Etyp : Entity_Id;
Expr : Node_Id) is
begin
Error_Msg_N ("?dimensions mismatch in component declaration", N);
Error_Msg_N ("\?component type " & Dimensions_Msg_Of (Etyp), N);
Error_Msg_N ("\?component expression " & Dimensions_Msg_Of (Expr), N);
end Error_Dim_For_Component_Declaration;
Error_Msg_N ("dimensions mismatch in component declaration", N);
Error_Msg_N ("\component type " & Dimensions_Msg_Of (Etyp), N);
Error_Msg_N ("\component expression " & Dimensions_Msg_Of (Expr), N);
end Error_Dim_Msg_For_Component_Declaration;
-- Start of processing for Analyze_Dimension_Component_Declaration
@ -1270,7 +1277,7 @@ package body Sem_Dim is
-- dimension of the type mismatch.
if Dims_Of_Etyp /= Dims_Of_Expr then
Error_Dim_For_Component_Declaration (N, Etyp, Expr);
Error_Dim_Msg_For_Component_Declaration (N, Etyp, Expr);
end if;
-- Removal of dimensions in expression
@ -1296,31 +1303,31 @@ package body Sem_Dim is
Return_Obj_Decl : Node_Id;
Return_Obj_Id : Entity_Id;
procedure Error_Dim_For_Extended_Return_Statement
procedure Error_Dim_Msg_For_Extended_Return_Statement
(N : Node_Id;
Return_Etyp : Entity_Id;
Return_Obj_Id : Entity_Id);
-- Warning using Error_Msg_N at node N. Output in the error message the
-- dimensions of the returned type Return_Etyp and the returned object
-- Return_Obj_Id of N.
-- Error using Error_Msg_N at node N. Output the dimensions of the
-- returned type Return_Etyp and the returned object Return_Obj_Id of N.
---------------------------------------------
-- Error_Dim_For_Extended_Return_Statement --
---------------------------------------------
-------------------------------------------------
-- Error_Dim_Msg_For_Extended_Return_Statement --
-------------------------------------------------
procedure Error_Dim_For_Extended_Return_Statement
procedure Error_Dim_Msg_For_Extended_Return_Statement
(N : Node_Id;
Return_Etyp : Entity_Id;
Return_Obj_Id : Entity_Id)
is
begin
Error_Msg_N ("?dimensions mismatch in extended return statement", N);
Error_Msg_N ("?returned type " & Dimensions_Msg_Of (Return_Etyp), N);
Error_Msg_N ("?returned object " & Dimensions_Msg_Of (Return_Obj_Id),
Error_Msg_N ("dimensions mismatch in extended return statement", N);
Error_Msg_N ("\returned type " & Dimensions_Msg_Of (Return_Etyp), N);
Error_Msg_N ("\returned object " & Dimensions_Msg_Of (Return_Obj_Id),
N);
end Error_Dim_For_Extended_Return_Statement;
end Error_Dim_Msg_For_Extended_Return_Statement;
-- Start of processing for Analyze_Dimension_Extended_Return_Statement
begin
if Present (Return_Obj_Decls) then
Return_Obj_Decl := First (Return_Obj_Decls);
@ -1332,7 +1339,7 @@ package body Sem_Dim is
Dims_Of_Return_Obj_Id := Dimensions_Of (Return_Obj_Id);
if Dims_Of_Return_Etyp /= Dims_Of_Return_Obj_Id then
Error_Dim_For_Extended_Return_Statement
Error_Dim_Msg_For_Extended_Return_Statement
(N, Return_Etyp, Return_Obj_Id);
return;
end if;
@ -1355,7 +1362,7 @@ package body Sem_Dim is
Dims_Of_Actual : Dimension_Type;
Dims_Of_Call : Dimension_Type;
function Is_Elementary_Function_Call (N : Node_Id) return Boolean;
function Is_Elementary_Function_Call return Boolean;
-- Return True if the call is a call of an elementary function (see
-- Ada.Numerics.Generic_Elementary_Functions).
@ -1363,13 +1370,11 @@ package body Sem_Dim is
-- Is_Elementary_Function_Call --
---------------------------------
function Is_Elementary_Function_Call (N : Node_Id) return Boolean is
function Is_Elementary_Function_Call return Boolean is
Ent : Entity_Id;
begin
-- Note that the node must come from source (why not???)
if Comes_From_Source (N) and then Is_Entity_Name (Name_Call) then
if Is_Entity_Name (Name_Call) then
Ent := Entity (Name_Call);
-- Check the procedure is defined in an instantiation of a generic
@ -1395,7 +1400,7 @@ package body Sem_Dim is
begin
-- Elementary function case
if Is_Elementary_Function_Call (N) then
if Is_Elementary_Function_Call then
-- Sqrt function call case
@ -1421,11 +1426,12 @@ package body Sem_Dim is
Dims_Of_Actual := Dimensions_Of (Actual);
if Exists (Dims_Of_Actual) then
Error_Msg_NE
("?parameter should be dimensionless for elementary "
& "function&", Actual, Name_Call);
Error_Msg_N
("?parameter " & Dimensions_Msg_Of (Actual), Actual);
Error_Msg_NE ("parameter should be dimensionless for " &
"elementary function&",
Actual,
Name_Call);
Error_Msg_N ("\parameter " & Dimensions_Msg_Of (Actual),
Actual);
end if;
Next (Actual);
@ -1446,7 +1452,6 @@ package body Sem_Dim is
procedure Analyze_Dimension_Has_Etype (N : Node_Id) is
Etyp : constant Entity_Id := Etype (N);
Dims_Of_Etyp : constant Dimension_Type := Dimensions_Of (Etyp);
N_Kind : constant Node_Kind := Nkind (N);
begin
-- Propagation of the dimensions from the type
@ -1457,31 +1462,35 @@ package body Sem_Dim is
-- Removal of dimensions in expression
-- Wouldn't a case statement be clearer here???
case Nkind (N) is
if Nkind_In (N_Kind, N_Attribute_Reference, N_Indexed_Component) then
declare
Expr : Node_Id;
Exprs : constant List_Id := Expressions (N);
begin
if Present (Exprs) then
Expr := First (Exprs);
while Present (Expr) loop
Remove_Dimensions (Expr);
Next (Expr);
end loop;
end if;
end;
when N_Attribute_Reference |
N_Indexed_Component =>
declare
Expr : Node_Id;
Exprs : constant List_Id := Expressions (N);
elsif Nkind_In (N_Kind, N_Qualified_Expression,
N_Type_Conversion,
N_Unchecked_Type_Conversion)
then
Remove_Dimensions (Expression (N));
begin
if Present (Exprs) then
Expr := First (Exprs);
while Present (Expr) loop
Remove_Dimensions (Expr);
Next (Expr);
end loop;
end if;
end;
elsif N_Kind = N_Selected_Component then
Remove_Dimensions (Selector_Name (N));
end if;
when N_Qualified_Expression |
N_Type_Conversion |
N_Unchecked_Type_Conversion =>
Remove_Dimensions (Expression (N));
when N_Selected_Component =>
Remove_Dimensions (Selector_Name (N));
when others => null;
end case;
end Analyze_Dimension_Has_Etype;
------------------------------------------
@ -1495,26 +1504,26 @@ package body Sem_Dim is
Dim_Of_Etyp : constant Dimension_Type := Dimensions_Of (Etyp);
Dim_Of_Expr : Dimension_Type;
procedure Error_Dim_For_Object_Declaration
procedure Error_Dim_Msg_For_Object_Declaration
(N : Node_Id;
Etyp : Entity_Id;
Expr : Node_Id);
-- Warnings using Error_Msg_N at node N. Output in the error message the
-- dimensions of the type Etyp and the ???
-- Error using Error_Msg_N at node N. Output the dimensions of the
-- type Etyp and of the expression Expr.
--------------------------------------
-- Error_Dim_For_Object_Declaration --
--------------------------------------
------------------------------------------
-- Error_Dim_Msg_For_Object_Declaration --
------------------------------------------
procedure Error_Dim_For_Object_Declaration
procedure Error_Dim_Msg_For_Object_Declaration
(N : Node_Id;
Etyp : Entity_Id;
Expr : Node_Id) is
begin
Error_Msg_N ("?dimensions mismatch in object declaration", N);
Error_Msg_N ("\?object type " & Dimensions_Msg_Of (Etyp), N);
Error_Msg_N ("\?object expression " & Dimensions_Msg_Of (Expr), N);
end Error_Dim_For_Object_Declaration;
Error_Msg_N ("dimensions mismatch in object declaration", N);
Error_Msg_N ("\object type " & Dimensions_Msg_Of (Etyp), N);
Error_Msg_N ("\object expression " & Dimensions_Msg_Of (Expr), N);
end Error_Dim_Msg_For_Object_Declaration;
-- Start of processing for Analyze_Dimension_Object_Declaration
@ -1532,7 +1541,7 @@ package body Sem_Dim is
N_Integer_Literal)
and then Dim_Of_Expr /= Dim_Of_Etyp
then
Error_Dim_For_Object_Declaration (N, Etyp, Expr);
Error_Dim_Msg_For_Object_Declaration (N, Etyp, Expr);
end if;
-- Removal of dimensions in expression
@ -1549,34 +1558,34 @@ package body Sem_Dim is
Renamed_Name : constant Node_Id := Name (N);
Sub_Mark : constant Node_Id := Subtype_Mark (N);
procedure Error_Dim_For_Object_Renaming_Declaration
procedure Error_Dim_Msg_For_Object_Renaming_Declaration
(N : Node_Id;
Sub_Mark : Node_Id;
Renamed_Name : Node_Id);
-- Error using Error_Msg_N at node N. Output in the error message the
-- dimensions of Sub_Mark and of Renamed_Name.
-- Error using Error_Msg_N at node N. Output the dimensions of
-- Sub_Mark and of Renamed_Name.
-----------------------------------------------
-- Error_Dim_For_Object_Renaming_Declaration --
-----------------------------------------------
---------------------------------------------------
-- Error_Dim_Msg_For_Object_Renaming_Declaration --
---------------------------------------------------
procedure Error_Dim_For_Object_Renaming_Declaration
procedure Error_Dim_Msg_For_Object_Renaming_Declaration
(N : Node_Id;
Sub_Mark : Node_Id;
Renamed_Name : Node_Id) is
begin
Error_Msg_N ("?dimensions mismatch in object renaming declaration",
Error_Msg_N ("dimensions mismatch in object renaming declaration",
N);
Error_Msg_N ("?type " & Dimensions_Msg_Of (Sub_Mark), N);
Error_Msg_N ("?renamed object " & Dimensions_Msg_Of (Renamed_Name),
Error_Msg_N ("\type " & Dimensions_Msg_Of (Sub_Mark), N);
Error_Msg_N ("\renamed object " & Dimensions_Msg_Of (Renamed_Name),
N);
end Error_Dim_For_Object_Renaming_Declaration;
end Error_Dim_Msg_For_Object_Renaming_Declaration;
-- Start of processing for Analyze_Dimension_Object_Renaming_Declaration
begin
if Dimensions_Of (Renamed_Name) /= Dimensions_Of (Sub_Mark) then
Error_Dim_For_Object_Renaming_Declaration
Error_Dim_Msg_For_Object_Renaming_Declaration
(N, Sub_Mark, Renamed_Name);
end if;
end Analyze_Dimension_Object_Renaming_Declaration;
@ -1594,34 +1603,33 @@ package body Sem_Dim is
Dims_Of_Return_Etyp : constant Dimension_Type :=
Dimensions_Of (Return_Etyp);
procedure Error_Dim_For_Simple_Return_Statement
procedure Error_Dim_Msg_For_Simple_Return_Statement
(N : Node_Id;
Return_Etyp : Entity_Id;
Expr : Node_Id);
-- Error using Error_Msg_N at node N. Output in the error message
-- the dimensions of the returned type Return_Etyp and the returned
-- expression Expr of N.
-- Error using Error_Msg_N at node N. Output the dimensions of the
-- returned type Return_Etyp and the returned expression Expr of N.
-------------------------------------------
-- Error_Dim_For_Simple_Return_Statement --
-------------------------------------------
-----------------------------------------------
-- Error_Dim_Msg_For_Simple_Return_Statement --
-----------------------------------------------
procedure Error_Dim_For_Simple_Return_Statement
procedure Error_Dim_Msg_For_Simple_Return_Statement
(N : Node_Id;
Return_Etyp : Entity_Id;
Expr : Node_Id)
is
begin
Error_Msg_N ("?dimensions mismatch in return statement", N);
Error_Msg_N ("\?returned type " & Dimensions_Msg_Of (Return_Etyp), N);
Error_Msg_N ("\?returned expression " & Dimensions_Msg_Of (Expr), N);
end Error_Dim_For_Simple_Return_Statement;
Error_Msg_N ("dimensions mismatch in return statement", N);
Error_Msg_N ("\returned type " & Dimensions_Msg_Of (Return_Etyp), N);
Error_Msg_N ("\returned expression " & Dimensions_Msg_Of (Expr), N);
end Error_Dim_Msg_For_Simple_Return_Statement;
-- Start of processing for Analyze_Dimension_Simple_Return_Statement
begin
if Dims_Of_Return_Etyp /= Dims_Of_Expr then
Error_Dim_For_Simple_Return_Statement (N, Return_Etyp, Expr);
Error_Dim_Msg_For_Simple_Return_Statement (N, Return_Etyp, Expr);
Remove_Dimensions (Expr);
end if;
end Analyze_Dimension_Simple_Return_Statement;
@ -1649,7 +1657,7 @@ package body Sem_Dim is
-- it cannot inherit a dimension from its subtype.
if Exists (Dims_Of_Id) then
Error_Msg_N ("?subtype& already" & Dimensions_Msg_Of (Id), N);
Error_Msg_N ("subtype& already" & Dimensions_Msg_Of (Id), N);
else
Set_Dimensions (Id, Dims_Of_Etyp);
Set_Symbol (Id, Symbol_Of (Etyp));
@ -1698,7 +1706,7 @@ package body Sem_Dim is
-- RATIONAL ::= [-] NUMERAL [/ NUMERAL]
-- A rational number is a number that can be expressed as the quotient or
-- fraction a/b of two integers, where b is non-zero.
-- fraction a/b of two integers, where b is non-zero positive.
function Create_Rational_From
(Expr : Node_Id;
@ -1889,7 +1897,7 @@ package body Sem_Dim is
if Exists (Dims_Of_N) then
System := System_Of (Base_Type (Etype (N)));
Add_Str_To_Name_Buffer ("has dimensions: ");
Add_Str_To_Name_Buffer ("has dimensions ");
Add_Dimension_Vector_To_Buffer (Dims_Of_N, System);
else
Add_Str_To_Name_Buffer ("is dimensionless");
@ -1914,8 +1922,7 @@ package body Sem_Dim is
-- Eval_Op_Expon_For_Dimensioned_Type --
----------------------------------------
-- Evaluate the expon operator for real dimensioned type. Note that the
-- node must come from source. Why???
-- Evaluate the expon operator for real dimensioned type.
-- Note that if the exponent is an integer (denominator = 1) the node is
-- evaluated by the regular Eval_Op_Expon routine (see Sem_Eval).
@ -1928,9 +1935,7 @@ package body Sem_Dim is
R_Value : Rational := No_Rational;
begin
if Comes_From_Source (N)
and then Is_Real_Type (Btyp)
then
if Is_Real_Type (Btyp) then
R_Value := Create_Rational_From (R, False);
end if;

9
gcc/ada/sem_prag.adb
View File

@ -4604,11 +4604,12 @@ package body Sem_Prag is
elsif C = Convention_CPP
and then (Is_Record_Type (Def_Id)
or else Ekind (Def_Id) = E_Incomplete_Type)
or else Ekind (Def_Id) = E_Incomplete_Type)
then
if Ekind (Def_Id) = E_Incomplete_Type then
if Present (Full_View (Def_Id)) then
Def_Id := Full_View (Def_Id);
else
Error_Msg_N
("cannot import 'C'P'P type before full declaration seen",
@ -4650,7 +4651,7 @@ package body Sem_Prag is
-- full view is analyzed (see Process_Full_View).
if not Is_Private_Type (Def_Id) then
Check_CPP_Type (Def_Id);
Check_CPP_Type_Has_No_Defaults (Def_Id);
end if;
elsif Nkind (Parent (Def_Id)) = N_Incomplete_Type_Declaration then
@ -4662,8 +4663,8 @@ package body Sem_Prag is
else
Error_Pragma_Arg
("second argument of pragma% must be object, subprogram" &
" or incomplete type",
("second argument of pragma% must be object, subprogram "
& "or incomplete type",
Arg2);
end if;