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