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

[multiple changes] 

2015-10-20  Yannick Moy  <moy@adacore.com>

	* sem_warn.adb (Is_OK_Fully_Initialized): Consider types with DIC as
	fully default initialized.
	* sem_ch6.adb: minor style fix in comment

2015-10-20  Ed Schonberg  <schonberg@adacore.com>

	* s-diflio.ads, s-diflio.adb (Image): New function for dimensioned
	quantities, to produce a string that includes the dimension
	synbol for the quantity, or the vector of dimensions in standard
	notation.
	* sem_dim.adb (Expand_Put_Call_With_Symbol): Process new function
	Image, to include dimension information in the generated string,
	identical to the string produced by the Put procedure on a string
	for a dimensioned quantity.

From-SVN: r229053
This commit is contained in:
Arnaud Charlet 2015-10-20 13:59:22 +02:00
parent d29f68cf55
commit 319c61611e
6 changed files with 91 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/ada/ChangeLog
View File

@ -1,3 +1,20 @@
2015-10-20 Yannick Moy <moy@adacore.com>
* sem_warn.adb (Is_OK_Fully_Initialized): Consider types with DIC as
fully default initialized.
* sem_ch6.adb: minor style fix in comment
2015-10-20 Ed Schonberg <schonberg@adacore.com>
* s-diflio.ads, s-diflio.adb (Image): New function for dimensioned
quantities, to produce a string that includes the dimension
synbol for the quantity, or the vector of dimensions in standard
notation.
* sem_dim.adb (Expand_Put_Call_With_Symbol): Process new function
Image, to include dimension information in the generated string,
identical to the string produced by the Put procedure on a string
for a dimensioned quantity.
2015-10-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Process_Declarations): A loop

31
gcc/ada/s-diflio.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011-2012, 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- --
@ -69,9 +69,11 @@ package body System.Dim.Float_IO is
Exp : Field := Default_Exp;
Symbol : String := "")
is
Ptr : constant Natural := Symbol'Length;
begin
Num_Dim_Float_IO.Put (To, Item, Aft, Exp);
To := To & Symbol;
Num_Dim_Float_IO.Put (To (To'First .. To'Last - Ptr), Item, Aft, Exp);
To (To'Last - Ptr + 1 .. To'Last) := Symbol;
end Put;
----------------
@ -104,6 +106,27 @@ package body System.Dim.Float_IO is
Symbol : String := "")
is
begin
To := Symbol;
To (1 .. Symbol'Length) := Symbol;
end Put_Dim_Of;
-----------
-- Image --
-----------
function Image
(Item : Num_Dim_Float;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbol : String := "") return String
is
Buffer : String (1 .. 50);
begin
Put (Buffer, Item, Aft, Exp);
for I in Buffer'Range loop
if Buffer (I) /= ' ' then
return Buffer (I .. Buffer'Last) & Symbol;
end if;
end loop;
end Image;
end System.Dim.Float_IO;

8
gcc/ada/s-diflio.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- --
@ -175,4 +175,10 @@ package System.Dim.Float_IO is
pragma Inline (Put);
pragma Inline (Put_Dim_Of);
function Image
(Item : Num_Dim_Float;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbol : String := "") return String;
end System.Dim.Float_IO;

2
gcc/ada/sem_ch6.adb
View File

@ -4388,7 +4388,7 @@ package body Sem_Ch6 is
-- Flag Is_Inlined_Always is True by default, and reversed to False for
-- those subprograms which could be inlined in GNATprove mode (because
-- Body_To_Inline is non-Empty) but cannot be inlined.
-- Body_To_Inline is non-Empty) but should not be inlined.
if GNATprove_Mode then
Set_Is_Inlined_Always (Designator);

50
gcc/ada/sem_dim.adb
View File

@ -2658,11 +2658,12 @@ package body Sem_Dim is
-- Expand_Put_Call_With_Symbol --
---------------------------------
-- For procedure Put (resp. Put_Dim_Of) defined in System.Dim.Float_IO
-- (System.Dim.Integer_IO), the default string parameter must be rewritten
-- to include the unit symbols (resp. dimension symbols) in the output
-- of a dimensioned object. Note that if a value is already supplied for
-- parameter Symbol, this routine doesn't do anything.
-- For procedure Put (resp. Put_Dim_Of) and function Image, defined in
-- System.Dim.Float_IO or System.Dim.Integer_IO, the default string
-- parameter is rewritten to include the unit symbol (or the dimension
-- symbols if not a defined quantity) in the output of a dimensioned
-- object. If a value is already supplied by the user for the parameter
-- Symbol, it is used as is.
-- Case 1. Item is dimensionless
@ -2708,6 +2709,9 @@ package body Sem_Dim is
-- $5.0 m**3.cd**(-1)
-- $[l**3.J**(-1)]
-- The function Image returns the string identical to that produced by
-- a call to Put whose first parameter is a string.
procedure Expand_Put_Call_With_Symbol (N : Node_Id) is
Actuals : constant List_Id := Parameter_Associations (N);
Loc : constant Source_Ptr := Sloc (N);
@ -2773,22 +2777,12 @@ package body Sem_Dim is
if Present (Actual_Str) then
-- Return True if the actual comes from source or if the string
-- of symbols doesn't have the default value (i.e. it is "").
-- of symbols doesn't have the default value (i.e. it is ""),
-- in which case it is used as suffix of the generated string.
if Comes_From_Source (Actual)
or else String_Length (Strval (Actual_Str)) /= 0
then
-- Complain only if the actual comes from source or if it
-- hasn't been fully analyzed yet.
if Comes_From_Source (Actual)
or else not Analyzed (Actual)
then
Error_Msg_N ("Symbol parameter should not be provided",
Actual);
Error_Msg_N ("\reserved for compiler use only", Actual);
end if;
return True;
else
@ -2841,7 +2835,9 @@ package body Sem_Dim is
Is_Put_Dim_Of := True;
return True;
elsif Chars (Ent) = Name_Put then
elsif Chars (Ent) = Name_Put
or else Chars (Ent) = Name_Image
then
return True;
end if;
end if;
@ -2976,12 +2972,20 @@ package body Sem_Dim is
-- Rewrite and analyze the procedure call
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Copy (Name_Call),
Parameter_Associations => New_Actuals));
if Chars (Name_Call) = Name_Image then
Rewrite (N,
Make_Function_Call (Loc,
Name => New_Copy (Name_Call),
Parameter_Associations => New_Actuals));
Analyze_And_Resolve (N);
else
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Copy (Name_Call),
Parameter_Associations => New_Actuals));
Analyze (N);
end if;
Analyze (N);
end if;
end if;
end Expand_Put_Call_With_Symbol;

12
gcc/ada/sem_warn.adb
View File

@ -1697,6 +1697,18 @@ package body Sem_Warn is
begin
if Is_Access_Type (Typ) and then Is_Dereferenced (N) then
return False;
-- If a type has Default_Initial_Condition set, or it inherits it,
-- DIC might be specified with a boolean value, meaning that the type
-- is considered to be fully default initialized (SPARK RM 3.1 and
-- SPARK RM 7.3.3). To avoid generating spurious warnings in this
-- case, consider all types with DIC as fully initialized.
elsif Has_Default_Init_Cond (Typ)
or else Has_Inherited_Default_Init_Cond (Typ)
then
return True;
else
return Is_Fully_Initialized_Type (Typ);
end if;