Skip to content

R
riscv-gcc-1
Commit f9adb9d4 by Arnaud Charlet
Options

[multiple changes] 

2011-08-02  Vincent Celier  <celier@adacore.com>

	* link.c: Only import "auto-host.h" when building the gnattools.

2011-08-02  Yannick Moy  <moy@adacore.com>

	* sem_util.adb: Inter-unit inlining does not work for a subprogram
	which calls a local subprogram, so extract subprogram
	from Mark_Non_ALFA_Subprogram_Body.

2011-08-02  Javier Miranda  <miranda@adacore.com>

	* exp_ch9.adb
	(Extract_Dispatching_Call): If the type of the dispatching object is an
	access type then return an explicit dereference in the Object out-mode
	parameter.

2011-08-02  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch3.adb (Analyze_Subtype_Declaration): Generate range
	compatibility checks for all indexes of an array subtype, not just the
	first. Reset Has_Dynamic_Range_Check on the subtype before each
	potential check to ensure that Insert_Range_Checks will not elide any
	of the dynamic checks.

2011-08-02  Yannick Moy  <moy@adacore.com>

	* par-prag.ad (Process_Restrictions_Or_Restriction_Warnings): recognize
	SPARK restriction at parsing time.
	* scng.adb (Scan): Generate a token Tok_SPARK_Hide for a SPARK HIDE
	directive only if the SPARK restriction is set for this unit.

From-SVN: r177183
parent 83f33150
Showing with 147 additions and 56 deletions
gcc/ada/ChangeLog
2011-08-02 Vincent Celier <celier@adacore.com>
* link.c: Only import "auto-host.h" when building the gnattools.
2011-08-02 Yannick Moy <moy@adacore.com>
* sem_util.adb: Inter-unit inlining does not work for a subprogram
which calls a local subprogram, so extract subprogram
from Mark_Non_ALFA_Subprogram_Body.
2011-08-02 Javier Miranda <miranda@adacore.com>
* exp_ch9.adb
(Extract_Dispatching_Call): If the type of the dispatching object is an
access type then return an explicit dereference in the Object out-mode
parameter.
2011-08-02 Gary Dismukes <dismukes@adacore.com>
* sem_ch3.adb (Analyze_Subtype_Declaration): Generate range
compatibility checks for all indexes of an array subtype, not just the
first. Reset Has_Dynamic_Range_Check on the subtype before each
potential check to ensure that Insert_Range_Checks will not elide any
of the dynamic checks.
2011-08-02 Yannick Moy <moy@adacore.com>
* par-prag.ad (Process_Restrictions_Or_Restriction_Warnings): recognize
SPARK restriction at parsing time.
* scng.adb (Scan): Generate a token Tok_SPARK_Hide for a SPARK HIDE
directive only if the SPARK restriction is set for this unit.
2011-08-02 Yannick Moy <moy@adacore.com>
* sem_ch3.adb, sem_ch5.adb, sem_ch9.adb, sem_util.adb, sem_util.ads,
......
gcc/ada/exp_ch9.adb
......@@ -341,8 +341,10 @@ package body Exp_Ch9 is
Actuals : out List_Id;
Formals : out List_Id);
-- Given a dispatching call, extract the entity of the name of the call,
-- its object parameter, its actual parameters and the formal parameters
-- of the overridden interface-level version.
-- its actual dispatching object, its actual parameters and the formal
-- parameters of the overridden interface-level version. If the type of
-- the dispatching object is an access type then an explicit dereference
-- is returned in Object.
procedure Extract_Entry
(N : Node_Id;
......@@ -11512,6 +11514,14 @@ package body Exp_Ch9 is
if Present (Original_Node (Object)) then
Object := Original_Node (Object);
end if;
-- If the type of the dispatching object is an access type then return
-- an explicit dereference
if Is_Access_Type (Etype (Object)) then
Object := Make_Explicit_Dereference (Sloc (N), Object);
Analyze (Object);
end if;
end Extract_Dispatching_Call;
-------------------
......
gcc/ada/link.c
......@@ -37,7 +37,10 @@ extern "C" {
#endif
#include <string.h>
#ifdef IN_GCC
#include "auto-host.h"
#endif
/* objlist_file_supported is set to 1 when the system linker allows */
/* response file, that is a file that contains the list of object files. */
......
gcc/ada/par-prag.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
......@@ -89,11 +89,13 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
procedure Process_Restrictions_Or_Restriction_Warnings;
-- Common processing for Restrictions and Restriction_Warnings pragmas.
-- This routine only processes the case of No_Obsolescent_Features, which
-- is the only restriction that has syntactic effects. No general error
-- checking is done, since this will be done in Sem_Prag. The other case
-- processed is pragma Restrictions No_Dependence, since otherwise this is
-- done too late.
-- This routine processes the cases of No_Obsolescent_Features and SPARK,
-- which are the only restriction that have syntactic effects. In the case
-- of SPARK, it controls whether the scanner generates a token
-- Tok_SPARK_Hide for HIDE directives formatted as Ada comments. No general
-- error checking is done, since this will be done in Sem_Prag. The other
-- case processed is pragma Restrictions No_Dependence, since otherwise
-- this is done too late.
----------
-- Arg1 --
......@@ -230,6 +232,10 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
Set_Restriction (No_Obsolescent_Features, Pragma_Node);
Restriction_Warnings (No_Obsolescent_Features) :=
Prag_Id = Pragma_Restriction_Warnings;
when SPARK =>
Set_Restriction (SPARK, Pragma_Node);
Restriction_Warnings (SPARK) :=
Prag_Id = Pragma_Restriction_Warnings;
when others =>
null;
end case;
......
gcc/ada/scng.adb
......@@ -28,6 +28,8 @@ with Err_Vars; use Err_Vars;
with Hostparm; use Hostparm;
with Namet; use Namet;
with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Scans; use Scans;
with Sinput; use Sinput;
with Snames; use Snames;
......@@ -1762,7 +1764,12 @@ package body Scng is
return;
end if;
if Source (Start_Of_Comment) = '#' then
-- Generate a token Tok_SPARK_Hide for a SPARK HIDE directive
-- only if the SPARK restriction is set for this unit.
if Restriction_Check_Required (SPARK)
and then Source (Start_Of_Comment) = '#'
then
declare
Scan_SPARK_Ptr : Source_Ptr;
......
gcc/ada/sem_ch3.adb
......@@ -4396,9 +4396,9 @@ package body Sem_Ch3 is
Conditional_Delay (Id, T);
end if;
-- Check that constraint_error is raised for a scalar subtype
-- indication when the lower or upper bound of a non-null range
-- lies outside the range of the type mark.
-- Check that Constraint_Error is raised for a scalar subtype indication
-- when the lower or upper bound of a non-null range lies outside the
-- range of the type mark.
if Nkind (Subtype_Indication (N)) = N_Subtype_Indication then
if Is_Scalar_Type (Etype (Id))
......@@ -4410,38 +4410,69 @@ package body Sem_Ch3 is
(Scalar_Range (Id),
Etype (Subtype_Mark (Subtype_Indication (N))));
-- In the array case, check compatibility for each index
elsif Is_Array_Type (Etype (Id))
and then Present (First_Index (Id))
then
-- This really should be a subprogram that finds the indications
-- to check???
if ((Nkind (First_Index (Id)) = N_Identifier
and then Ekind (Entity (First_Index (Id))) in Scalar_Kind)
or else Nkind (First_Index (Id)) = N_Subtype_Indication)
and then
Nkind (Scalar_Range (Etype (First_Index (Id)))) = N_Range
then
declare
Target_Typ : constant Entity_Id :=
Etype
(First_Index (Etype
(Subtype_Mark (Subtype_Indication (N)))));
begin
R_Checks :=
Get_Range_Checks
(Scalar_Range (Etype (First_Index (Id))),
Target_Typ,
Etype (First_Index (Id)),
Defining_Identifier (N));
Insert_Range_Checks
(R_Checks,
N,
Target_Typ,
Sloc (Defining_Identifier (N)));
end;
end if;
declare
Subt_Index : Node_Id := First_Index (Id);
Target_Index : Node_Id :=
First_Index (Etype
(Subtype_Mark (Subtype_Indication (N))));
Has_Dyn_Chk : Boolean := Has_Dynamic_Range_Check (N);
begin
while Present (Subt_Index) loop
if ((Nkind (Subt_Index) = N_Identifier
and then Ekind (Entity (Subt_Index)) in Scalar_Kind)
or else Nkind (Subt_Index) = N_Subtype_Indication)
and then
Nkind (Scalar_Range (Etype (Subt_Index))) = N_Range
then
declare
Target_Typ : constant Entity_Id :=
Etype (Target_Index);
begin
R_Checks :=
Get_Range_Checks
(Scalar_Range (Etype (Subt_Index)),
Target_Typ,
Etype (Subt_Index),
Defining_Identifier (N));
-- Reset Has_Dynamic_Range_Check on the subtype to
-- prevent elision of the index check due to a dynamic
-- check generated for a preceding index (needed since
-- Insert_Range_Checks tries to avoid generating
-- redundant checks on a given declaration).
Set_Has_Dynamic_Range_Check (N, False);
Insert_Range_Checks
(R_Checks,
N,
Target_Typ,
Sloc (Defining_Identifier (N)));
-- Record whether this index involved a dynamic check
Has_Dyn_Chk :=
Has_Dyn_Chk or else Has_Dynamic_Range_Check (N);
end;
end if;
Next_Index (Subt_Index);
Next_Index (Target_Index);
end loop;
-- Finally, mark whether the subtype involves dynamic checks
Set_Has_Dynamic_Range_Check (N, Has_Dyn_Chk);
end;
end if;
end if;
......
gcc/ada/sem_util.adb
......@@ -141,6 +141,10 @@ package body Sem_Util is
-- T is a derived tagged type. Check whether the type extension is null.
-- If the parent type is fully initialized, T can be treated as such.
procedure Mark_Non_ALFA_Subprogram_Body_Unconditional;
-- Perform the action for Mark_Non_ALFA_Subprogram_Body, which allows the
-- latter to be small and inlined.
------------------------------
-- Abstract_Interface_List --
------------------------------
......@@ -2316,31 +2320,29 @@ package body Sem_Util is
-----------------------------------
procedure Mark_Non_ALFA_Subprogram_Body is
procedure Unconditional_Mark;
begin
-- Isolate marking of the current subprogram body so that the body of
-- Mark_Non_ALFA_Subprogram_Body is small and inlined.
------------------------
-- Unconditional_Mark --
------------------------
if ALFA_Mode then
Mark_Non_ALFA_Subprogram_Body_Unconditional;
end if;
end Mark_Non_ALFA_Subprogram_Body;
procedure Unconditional_Mark is
Cur_Subp : constant Entity_Id := Current_Subprogram;
begin
if Present (Cur_Subp)
and then (Is_Subprogram (Cur_Subp)
or else Is_Generic_Subprogram (Cur_Subp))
then
Set_Body_Is_In_ALFA (Cur_Subp, False);
end if;
end Unconditional_Mark;
-------------------------------------------------
-- Mark_Non_ALFA_Subprogram_Body_Unconditional --
-------------------------------------------------
procedure Mark_Non_ALFA_Subprogram_Body_Unconditional is
Cur_Subp : constant Entity_Id := Current_Subprogram;
begin
if ALFA_Mode then
Unconditional_Mark;
if Present (Cur_Subp)
and then (Is_Subprogram (Cur_Subp)
or else Is_Generic_Subprogram (Cur_Subp))
then
Set_Body_Is_In_ALFA (Cur_Subp, False);
end if;
end Mark_Non_ALFA_Subprogram_Body;
end Mark_Non_ALFA_Subprogram_Body_Unconditional;
---------------------
-- Defining_Entity --
......
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