+2017-01-13 Justin Squirek <squirek@adacore.com>
+
+ * sem_ch12.adb (Analyze_Package_Instantiation): Move disabiling
+ of the style check until after preanalysis of acutals.
+
+2017-01-13 Yannick Moy <moy@adacore.com>
+
+ * sem_ch13.adb: Minor reformatting.
+ * par-ch11.adb: minor style fix in whitespace
+ * gnatbind.adb (Gnatbind): Scope of Std_Lib_File
+ reduced to Add_Artificial_ALI_File; style fix in declaration of
+ Text; grammar fix in comment.
+ * osint-c.adb (Read_Library_Info): strip trailing NUL from result.
+ * freeze.adb: Cleanup to pass pragma instead of
+ expression to call.
+ * exp_spark.adb (Expand_SPARK_Attribute_Reference): New procedure to
+ replace System'To_Address by equivalent call.
+
2017-01-13 Arnaud Charlet <charlet@adacore.com>
* bindusg.adb: Improve usage output for -f switch.
with Exp_Ch5; use Exp_Ch5;
with Exp_Dbug; use Exp_Dbug;
with Exp_Util; use Exp_Util;
+with Namet; use Namet;
+with Nlists; use Nlists;
+with Nmake; use Nmake;
+with Rtsfind;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
+with Snames; use Snames;
with Tbuild; use Tbuild;
package body Exp_SPARK is
-- Local Subprograms --
-----------------------
+ procedure Expand_SPARK_Attribute_Reference (N : Node_Id);
+ -- Replace occurrences of System'To_Address by calls to
+ -- System.Storage_Elements.To_Address
+
procedure Expand_SPARK_N_Object_Renaming_Declaration (N : Node_Id);
-- Perform name evaluation for a renamed object
when N_Object_Renaming_Declaration =>
Expand_SPARK_N_Object_Renaming_Declaration (N);
+ -- Replace occurrences of System'To_Address by calls to
+ -- System.Storage_Elements.To_Address
+
+ when N_Attribute_Reference =>
+ Expand_SPARK_Attribute_Reference (N);
+
-- Loop iterations over arrays need to be expanded, to avoid getting
-- two names referring to the same object in memory (the array and
-- the iterator) in GNATprove, especially since both can be written
end case;
end Expand_SPARK;
+ --------------------------------------
+ -- Expand_SPARK_Attribute_Reference --
+ --------------------------------------
+
+ procedure Expand_SPARK_Attribute_Reference (N : Node_Id) is
+ Aname : constant Name_Id := Attribute_Name (N);
+ Attr_Id : constant Attribute_Id := Get_Attribute_Id (Aname);
+ Expr : Node_Id;
+ Call : Node_Id;
+
+ begin
+ if Attr_Id = Attribute_To_Address then
+ -- Extract argument to later reanalyze it in the new context
+
+ Expr := First (Expressions (N));
+ Nlists.Remove (Expr);
+ Set_Etype (Expr, Empty);
+ Set_Analyzed (Expr, False);
+
+ -- Create the call and insert it in the tree
+
+ Call := Make_Function_Call (Sloc (N),
+ Name => New_Occurrence_Of
+ (Rtsfind.RTE (Rtsfind.RE_To_Address), Sloc (N)),
+ Parameter_Associations =>
+ New_List (Expr));
+ Set_Etype (Call, Etype (N));
+ Rewrite (Old_Node => N, New_Node => Call);
+
+ -- Reanalyze argument and call in the new context
+
+ Analyze_And_Resolve (Expr, Rtsfind.RTE (Rtsfind.RE_Integer_Address));
+ Analyze_And_Resolve (N, Etype (N));
+ end if;
+ end Expand_SPARK_Attribute_Reference;
+
------------------------------------------------
-- Expand_SPARK_N_Object_Renaming_Declaration --
------------------------------------------------
A_Pre := Get_Pragma (Par_Prim, Pragma_Precondition);
if Present (A_Pre) and then Class_Present (A_Pre) then
- A_Pre :=
- Expression (First (Pragma_Argument_Associations (A_Pre)));
-
Build_Class_Wide_Expression
(Prag => New_Copy_Tree (A_Pre),
Subp => Prim,
A_Post := Get_Pragma (Par_Prim, Pragma_Postcondition);
if Present (A_Post) and then Class_Present (A_Post) then
- A_Post :=
- Expression (First (Pragma_Argument_Associations (A_Post)));
-
Build_Class_Wide_Expression
(Prag => New_Copy_Tree (A_Post),
Subp => Prim,
-- The first library file, that should be a main subprogram if neither -n
-- nor -z are used.
- Std_Lib_File : File_Name_Type;
- -- Standard library
-
- Text : Text_Buffer_Ptr;
+ Text : Text_Buffer_Ptr;
Output_File_Name_Seen : Boolean := False;
Output_File_Name : String_Ptr := new String'("");
Id : ALI_Id;
pragma Warnings (Off, Id);
+ Std_Lib_File : File_Name_Type;
+ -- Standard library
+
begin
Name_Len := Name'Length;
Name_Buffer (1 .. Name_Len) := Name;
-- Add System.Standard_Library to list to ensure that these files are
-- included in the bind, even if not directly referenced from Ada code
-- This is suppressed if the appropriate targparm switch is set. Be sure
- -- in any case that System is in the closure, as it may contains linker
+ -- in any case that System is in the closure, as it may contain linker
-- options. Note that it will be automatically added if s-stalib is
-- added.
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2016, 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- --
is
begin
Set_File_Name (ALI_Suffix.all);
+
+ -- Remove trailing NUL that comes from Set_File_Name above. This is
+ -- needed for consistency with names that come from Scan_ALI and thus
+ -- preventing repeated scanning of the same file.
+ pragma Assert (Name_Len > 1 and then Name_Buffer (Name_Len) = ASCII.NUL);
+ Name_Len := Name_Len - 1;
+
Name := Name_Find;
Text := Read_Library_Info (Name, Fatal_Err => False);
end Read_Library_Info;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
-- Local functions, used only in this chapter
- function P_Exception_Handler return Node_Id;
- function P_Exception_Choice return Node_Id;
+ function P_Exception_Handler return Node_Id;
+ function P_Exception_Choice return Node_Id;
---------------------------------
-- 11.1 Exception Declaration --
Instantiation_Node := N;
- -- Turn off style checking in instances. If the check is enabled on the
- -- generic unit, a warning in an instance would just be noise. If not
- -- enabled on the generic, then a warning in an instance is just wrong.
-
- Style_Check := False;
-
-- Case of instantiation of a generic package
if Nkind (N) = N_Package_Instantiation then
Preanalyze_Actuals (N, Act_Decl_Id);
+ -- Turn off style checking in instances. If the check is enabled on the
+ -- generic unit, a warning in an instance would just be noise. If not
+ -- enabled on the generic, then a warning in an instance is just wrong.
+
+ Style_Check := False;
+
Init_Env;
Env_Installed := True;
function Is_Type_Ref (N : Node_Id) return Boolean;
pragma Inline (Is_Type_Ref);
-
-- Returns True if N is a reference to the type for the predicate in the
-- expression (i.e. if it is an identifier whose Chars field matches the
-- Nam given in the call). N must not be parenthesized, if the type name
-- appears in parens, this routine will return False.
-
+ --
-- The routine also returns True for function calls generated during the
-- expansion of comparison operators on strings, which are intended to
-- be legal in static predicates, and are converted into calls to array
projects / gcc.git / commitdiff