Commit 582dbb53 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r244401
parent e4d04166
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.
......
......@@ -28,9 +28,14 @@ with Einfo; use Einfo;
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
......@@ -39,6 +44,10 @@ 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
......@@ -74,6 +83,12 @@ package body Exp_SPARK is
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
......@@ -101,6 +116,42 @@ package body Exp_SPARK is
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 --
------------------------------------------------
......
......@@ -1455,9 +1455,6 @@ package body Freeze is
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,
......@@ -1468,9 +1465,6 @@ package body Freeze is
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,
......
......@@ -69,10 +69,7 @@ procedure Gnatbind is
-- 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'("");
......@@ -124,6 +121,9 @@ procedure Gnatbind is
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;
......@@ -769,7 +769,7 @@ begin
-- 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.
......
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -347,6 +347,13 @@ package body Osint.C is
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;
......
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -34,8 +34,8 @@ package body Ch11 is
-- 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 --
......
......@@ -3686,12 +3686,6 @@ package body Sem_Ch12 is
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
......@@ -3724,6 +3718,12 @@ package body Sem_Ch12 is
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;
......
......@@ -11603,12 +11603,11 @@ package body Sem_Ch13 is
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
......
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