Skip to content

R
riscv-gcc-1
Commit 0688dac8 by Robert Dewar Committed by Arnaud Charlet
Options

layout.adb: Minor reformatting. 

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* layout.adb: Minor reformatting.
	* sem_prag.adb (Analyze_Pragma, case Inspection_Point): Call
	dummy procedure ip.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* restrict.ads (Implementation_Restriction): Add entry for
	No_Fixed_IO.
	* rtsfind.ads: Add entries for Fixed_IO and Decimal_IO in
	Ada.[Wide_[Wide_]Text_IO.
	* s-rident.ads (Restriction_Id): Add entry for No_Fixed_IO.
	* sem_attr.adb (Analyze_Attribute): Disallow fixed point types
	for Img, Image, Value, Wide_Image, Wide_Value, Wide_Wide_Image,
	Wide_Wide_Value if restriction No_Fixed_IO is set.
	* sem_util.adb (Set_Entity_Checks): Check restriction No_Fixed_IO.

From-SVN: r210710
parent ee6208f2
Showing with 189 additions and 50 deletions
gcc/ada/ChangeLog
2014-05-21 Robert Dewar <dewar@adacore.com>
* layout.adb: Minor reformatting.
* sem_prag.adb (Analyze_Pragma, case Inspection_Point): Call
dummy procedure ip.
2014-05-21 Robert Dewar <dewar@adacore.com>
* restrict.ads (Implementation_Restriction): Add entry for
No_Fixed_IO.
* rtsfind.ads: Add entries for Fixed_IO and Decimal_IO in
Ada.[Wide_[Wide_]Text_IO.
* s-rident.ads (Restriction_Id): Add entry for No_Fixed_IO.
* sem_attr.adb (Analyze_Attribute): Disallow fixed point types
for Img, Image, Value, Wide_Image, Wide_Value, Wide_Wide_Image,
Wide_Wide_Value if restriction No_Fixed_IO is set.
* sem_util.adb (Set_Entity_Checks): Check restriction No_Fixed_IO.
2014-05-21 Robert Dewar <dewar@adacore.com>
* gnatcmd.adb: Minor error msg changes (no upper case letter
at start).
* sem_ch12.adb, sem_ch5.adb, sem_res.adb, sem_util.adb: Minor
......
gcc/ada/layout.adb
......@@ -270,8 +270,7 @@ package body Layout is
-- the Integer base type, but it is safe to reduce it to 1 at this
-- stage, since we will only be loading a single storage unit.
if Is_Discrete_Type (Etype (E))
and then not Has_Alignment_Clause (E)
if Is_Discrete_Type (Etype (E)) and then not Has_Alignment_Clause (E)
then
loop
Abits := Abits / 2;
......@@ -363,13 +362,13 @@ package body Layout is
-- (E - C1) + C2 = E - (C1 - C2)
-- If the type is unsigned, then only do the optimization if
-- C1 >= C2, to avoid creating a negative literal that can't be
-- used with the unsigned type.
-- If the type is unsigned then only do the optimization if C1 >= C2,
-- to avoid creating a negative literal that can't be used with the
-- unsigned type.
elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L))
and then (not Is_Unsigned_Type (Etype (Sinfo.Right_Opnd (L)))
or else Expr_Value (Sinfo.Right_Opnd (L)) >= R)
or else Expr_Value (Sinfo.Right_Opnd (L)) >= R)
then
Rewrite_Integer
(Sinfo.Right_Opnd (L),
......@@ -626,8 +625,8 @@ package body Layout is
-- parameter rather than passing "V" directly.
if Present (Comp)
and then Base_Type (Etype (Comp))
= Base_Type (Etype (First_Formal (Ent)))
and then Base_Type (Etype (Comp)) =
Base_Type (Etype (First_Formal (Ent)))
then
return
Make_Function_Call (Loc,
......@@ -755,7 +754,8 @@ package body Layout is
-- Value of the current subscript range is statically known
if Compile_Time_Known_Value (Lo)
and then Compile_Time_Known_Value (Hi)
and then
Compile_Time_Known_Value (Hi)
then
S := Expr_Value (Hi) - Expr_Value (Lo) + 1;
......@@ -1092,7 +1092,8 @@ package body Layout is
-- Value of the current subscript range is statically known
if Compile_Time_Known_Value (Lo)
and then Compile_Time_Known_Value (Hi)
and then
Compile_Time_Known_Value (Hi)
then
S := Expr_Value (Hi) - Expr_Value (Lo) + 1;
......@@ -1388,9 +1389,7 @@ package body Layout is
-- not set by an explicit Object_Size attribute clause, then we reset
-- the Esize to unknown, since we really don't know it.
if Unknown_Alignment (E)
and then not Has_Size_Clause (E)
then
if Unknown_Alignment (E) and then not Has_Size_Clause (E) then
Set_Esize (E, Uint_0);
end if;
end Layout_Object;
......@@ -2512,12 +2511,12 @@ package body Layout is
elsif AAMP_On_Target
and then
((Ekind (E) = E_Access_Subprogram_Type
and then Present (Enclosing_Subprogram (E)))
or else
(Ekind (E) = E_Anonymous_Access_Subprogram_Type
and then
(not Is_Local_Anonymous_Access (E)
or else Present (Enclosing_Subprogram (E)))))
and then Present (Enclosing_Subprogram (E)))
or else
(Ekind (E) = E_Anonymous_Access_Subprogram_Type
and then
(not Is_Local_Anonymous_Access (E)
or else Present (Enclosing_Subprogram (E)))))
then
Init_Size (E, 2 * System_Address_Size);
else
......@@ -2541,7 +2540,7 @@ package body Layout is
if Opt.True_VMS_Target
and then (Convention (E) = Convention_C
or else
or else
Convention (E) = Convention_CPP)
and then No (Get_Attribute_Definition_Clause (E, Attribute_Size))
and then Esize (E) = 64
......@@ -2653,14 +2652,12 @@ package body Layout is
-- component type is known and is a small power of 2 (8, 16, 32, 64),
-- since this is what will always be used.
if Ekind (E) = E_Array_Type
and then Unknown_Component_Size (E)
then
if Ekind (E) = E_Array_Type and then Unknown_Component_Size (E) then
declare
CT : constant Entity_Id := Component_Type (E);
begin
-- For some reasons, access types can cause trouble, So let's
-- For some reason, access types can cause trouble, So let's
-- just do this for scalar types ???
if Present (CT)
......@@ -2700,9 +2697,7 @@ package body Layout is
-- For these types, we set a corresponding alignment matching
-- the size if possible, or as large as possible if not.
if Convention (E) = Convention_Ada
and then not Debug_Flag_Q
then
if Convention (E) = Convention_Ada and then not Debug_Flag_Q then
Set_Composite_Alignment (E);
end if;
......@@ -2724,9 +2719,7 @@ package body Layout is
-- arrays when passed to subprogram parameters (see special test
-- in Exp_Ch6.Expand_Actuals).
if not Is_Packed (E)
and then Unknown_Alignment (E)
then
if not Is_Packed (E) and then Unknown_Alignment (E) then
if Known_Static_Component_Size (E)
and then Component_Size (E) = 1
then
......@@ -2989,12 +2982,8 @@ package body Layout is
if Known_Static_Esize (E) then
Siz := Esize (E);
elsif Unknown_Esize (E)
and then Known_Static_RM_Size (E)
then
elsif Unknown_Esize (E) and then Known_Static_RM_Size (E) then
Siz := RM_Size (E);
else
return;
end if;
......@@ -3102,7 +3091,7 @@ package body Layout is
(Unknown_Esize (Comp)
or else (Known_Static_Esize (Comp)
and then
Esize (Comp) =
Esize (Comp) =
Calign * System_Storage_Unit))
then
Align := UI_To_Int (Calign);
......@@ -3194,9 +3183,7 @@ package body Layout is
-- For access types, do not set the alignment if the size is less than
-- the allowed minimum size. This avoids cascaded error messages.
elsif Is_Access_Type (E)
and then Esize (E) < System_Address_Size
then
elsif Is_Access_Type (E) and then Esize (E) < System_Address_Size then
return;
end if;
......
gcc/ada/restrict.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -120,6 +120,7 @@ package Restrict is
No_Exception_Propagation => True,
No_Exception_Registration => True,
No_Finalization => True,
No_Fixed_IO => True,
No_Implementation_Attributes => True,
No_Implementation_Pragmas => True,
No_Implicit_Conditionals => True,
......
gcc/ada/rtsfind.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -108,8 +108,9 @@ package Rtsfind is
-- ambiguities).
type RTU_Id is (
-- Runtime packages, for list of accessible entities in each
-- package see declarations in the runtime entity table below.
-- Runtime packages, for list of accessible entities in each package,
-- see declarations in the runtime entity table below.
RTU_Null,
-- Used as a null entry (will cause an error if referenced)
......@@ -132,6 +133,9 @@ package Rtsfind is
Ada_Tags,
Ada_Task_Identification,
Ada_Task_Termination,
Ada_Text_IO,
Ada_Wide_Text_IO,
Ada_Wide_Wide_Text_IO,
-- Children of Ada.Calendar
......@@ -701,6 +705,15 @@ package Rtsfind is
RE_Current_Task, -- Ada.Task_Identification
RO_AT_Task_Id, -- Ada.Task_Identification
RE_Decimal_IO, -- Ada.Text_IO
RE_Fixed_IO, -- Ada.Text_IO
RO_WT_Decimal_IO, -- Ada.Wide_Text_IO
RO_WT_Fixed_IO, -- Ada.Wide_Text_IO
RO_WW_Decimal_IO, -- Ada.Wide_Wide_Text_IO
RO_WW_Fixed_IO, -- Ada.Wide_Wide_Text_IO
RE_Integer_8, -- Interfaces
RE_Integer_16, -- Interfaces
RE_Integer_32, -- Interfaces
......@@ -1973,6 +1986,15 @@ package Rtsfind is
RE_Current_Task => Ada_Task_Identification,
RO_AT_Task_Id => Ada_Task_Identification,
RE_Decimal_IO => Ada_Text_IO,
RE_Fixed_IO => Ada_Text_IO,
RO_WT_Decimal_IO => Ada_Wide_Text_IO,
RO_WT_Fixed_IO => Ada_Wide_Text_IO,
RO_WW_Decimal_IO => Ada_Wide_Wide_Text_IO,
RO_WW_Fixed_IO => Ada_Wide_Wide_Text_IO,
RE_Integer_8 => Interfaces,
RE_Integer_16 => Interfaces,
RE_Integer_32 => Interfaces,
......
gcc/ada/s-rident.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -112,6 +112,7 @@ package System.Rident is
No_Exception_Registration, -- GNAT
No_Exceptions, -- (RM H.4(12))
No_Finalization, -- GNAT
No_Fixed_IO, -- GNAT
No_Fixed_Point, -- (RM H.4(15))
No_Floating_Point, -- (RM H.4(14))
No_IO, -- (RM H.4(20))
......
gcc/ada/sem_attr.adb
......@@ -3627,6 +3627,16 @@ package body Sem_Attr is
Resolve (E1, P_Base_Type);
Check_Enum_Image;
Validate_Non_Static_Attribute_Function_Call;
-- Check restriction No_Fixed_IO. Note the check of Comes_From_Source
-- to avoid giving a duplicate message for Img expanded into Image.
if Restriction_Check_Required (No_Fixed_IO)
and then Comes_From_Source (N)
and then Is_Fixed_Point_Type (P_Type)
then
Check_Restriction (No_Fixed_IO, P);
end if;
end Image;
---------
......@@ -3646,6 +3656,14 @@ package body Sem_Attr is
end if;
Check_Enum_Image;
-- Check restriction No_Fixed_IO
if Restriction_Check_Required (No_Fixed_IO)
and then Is_Fixed_Point_Type (P_Type)
then
Check_Restriction (No_Fixed_IO, P);
end if;
end Img;
-----------
......@@ -6458,6 +6476,14 @@ package body Sem_Attr is
Set_Etype (N, P_Base_Type);
Validate_Non_Static_Attribute_Function_Call;
-- Check restriction No_Fixed_IO
if Restriction_Check_Required (No_Fixed_IO)
and then Is_Fixed_Point_Type (P_Type)
then
Check_Restriction (No_Fixed_IO, P);
end if;
end Value;
----------------
......@@ -6498,6 +6524,14 @@ package body Sem_Attr is
Check_E1;
Resolve (E1, P_Base_Type);
Validate_Non_Static_Attribute_Function_Call;
-- Check restriction No_Fixed_IO
if Restriction_Check_Required (No_Fixed_IO)
and then Is_Fixed_Point_Type (P_Type)
then
Check_Restriction (No_Fixed_IO, P);
end if;
end Wide_Image;
---------------------
......@@ -6511,6 +6545,14 @@ package body Sem_Attr is
Check_E1;
Resolve (E1, P_Base_Type);
Validate_Non_Static_Attribute_Function_Call;
-- Check restriction No_Fixed_IO
if Restriction_Check_Required (No_Fixed_IO)
and then Is_Fixed_Point_Type (P_Type)
then
Check_Restriction (No_Fixed_IO, P);
end if;
end Wide_Wide_Image;
----------------
......@@ -6528,6 +6570,14 @@ package body Sem_Attr is
Set_Etype (N, P_Type);
Validate_Non_Static_Attribute_Function_Call;
-- Check restriction No_Fixed_IO
if Restriction_Check_Required (No_Fixed_IO)
and then Is_Fixed_Point_Type (P_Type)
then
Check_Restriction (No_Fixed_IO, P);
end if;
end Wide_Value;
---------------------
......@@ -6544,6 +6594,14 @@ package body Sem_Attr is
Set_Etype (N, P_Type);
Validate_Non_Static_Attribute_Function_Call;
-- Check restriction No_Fixed_IO
if Restriction_Check_Required (No_Fixed_IO)
and then Is_Fixed_Point_Type (P_Type)
then
Check_Restriction (No_Fixed_IO, P);
end if;
end Wide_Wide_Value;
---------------------
......
gcc/ada/sem_prag.adb
......@@ -15327,7 +15327,26 @@ package body Sem_Prag is
Arg : Node_Id;
Exp : Node_Id;
procedure ip;
-- A dummy procedure called when pragma Inspection_Point is
-- analyzed. This is just to help debugging the front end. If
-- a pragma Inspection_Point is added to a source program, then
-- breaking on ip will get you to that point in the program.
--------
-- ip --
--------
procedure ip is
begin
null;
end ip;
-- Start of processing for Inspection_Point
begin
ip;
if Arg_Count > 0 then
Arg := Arg1;
loop
......
gcc/ada/sem_util.adb
......@@ -15867,12 +15867,6 @@ package body Sem_Util is
Set_Entity (N, Val);
-- Remaining checks are only done on source nodes
if not Comes_From_Source (N) then
return;
end if;
-- The node to post on is the selector in the case of an expanded name,
-- and otherwise the node itself.
......@@ -15882,6 +15876,44 @@ package body Sem_Util is
Post_Node := N;
end if;
-- Check for violation of No_Fixed_IO
if Restriction_Check_Required (No_Fixed_IO)
and then
((RTU_Loaded (Ada_Text_IO)
and then (Is_RTE (Val, RE_Decimal_IO)
or else
Is_RTE (Val, RE_Fixed_IO)))
or else
(RTU_Loaded (Ada_Wide_Text_IO)
and then (Is_RTE (Val, RO_WT_Decimal_IO)
or else
Is_RTE (Val, RO_WT_Fixed_IO)))
or else
(RTU_Loaded (Ada_Wide_Wide_Text_IO)
and then (Is_RTE (Val, RO_WW_Decimal_IO)
or else
Is_RTE (Val, RO_WW_Fixed_IO))))
-- A special extra check, don't complain about a reference from within
-- the Ada.Interrupts package itself!
and then not In_Same_Extended_Unit (N, Val)
then
Check_Restriction (No_Fixed_IO, Post_Node);
end if;
-- Remaining checks are only done on source nodes. Note that we test
-- for violation of No_Fixed_IO even on non-source nodes, because the
-- cases for checking violations of this restriction are instantiations
-- where the refernece in the instance has Comes_From_Source False.
if not Comes_From_Source (N) then
return;
end if;
-- Check for violation of No_Abort_Statements, which is triggered by
-- call to Ada.Task_Identification.Abort_Task.
......@@ -15907,6 +15939,7 @@ package body Sem_Util is
Is_RTE (Val, RE_Exchange_Handler) or else
Is_RTE (Val, RE_Detach_Handler) or else
Is_RTE (Val, RE_Reference))
-- A special extra check, don't complain about a reference from within
-- the Ada.Interrupts package itself!
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment