Skip to content

R
riscv-gcc-1
Commit 88ff8916 by Arnaud Charlet
Options

[multiple changes] 

2013-04-11  Ben Brosgol  <brosgol@adacore.com>

	* gnat_ugn.texi: Minor clean ups.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* nlists.ads, nlists.adb, treepr.adb, treepr.ads: Move debugging
	function p from Nlists to Treepr.

2013-04-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_disp.adb (Check_Dispatching_Context): If the context is
	a contract for a null procedure defer error reporting until
	postcondition body is created.
	* exp_ch13.adb (Expand_N_Freeze_Entity): If the entity is a
	null procedure, complete the analysis of its contracts so that
	calls within classwide conditions are properly rewritten as
	dispatching calls.

From-SVN: r197794
parent 327900c7
Showing with 97 additions and 47 deletions
gcc/ada/ChangeLog
2013-04-11 Ben Brosgol <brosgol@adacore.com>
* gnat_ugn.texi: Minor clean ups.
2013-04-11 Robert Dewar <dewar@adacore.com>
* nlists.ads, nlists.adb, treepr.adb, treepr.ads: Move debugging
function p from Nlists to Treepr.
2013-04-11 Ed Schonberg <schonberg@adacore.com>
* sem_disp.adb (Check_Dispatching_Context): If the context is
a contract for a null procedure defer error reporting until
postcondition body is created.
* exp_ch13.adb (Expand_N_Freeze_Entity): If the entity is a
null procedure, complete the analysis of its contracts so that
calls within classwide conditions are properly rewritten as
dispatching calls.
2013-04-11 Thomas Quinot <quinot@adacore.com>
* sem_ch10.adb, sem_ch12.adb: Minor reformatting.
......
gcc/ada/exp_ch13.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
......@@ -43,6 +43,7 @@ with Sem_Aux; use Sem_Aux;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;
with Sem_Eval; use Sem_Eval;
with Sem_Prag; use Sem_Prag;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
......@@ -553,6 +554,28 @@ package body Exp_Ch13 is
end;
else
-- If the action is the generated body of a null subprogram,
-- analyze the expressions in its delayed aspects, because we
-- may not have reached the end of the declarative list when
-- delayed aspects are normally analyzed. This ensures that
-- dispatching calls are properly rewritten when the inner
-- postcondition procedure is analyzed.
if Is_Subprogram (E)
and then Nkind (Parent (E)) = N_Procedure_Specification
and then Null_Present (Parent (E))
then
declare
Prag : Node_Id;
begin
Prag := Spec_PPC_List (Contract (E));
while Present (Prag) loop
Analyze_PPC_In_Decl_Part (Prag, E);
Prag := Next_Pragma (Prag);
end loop;
end;
end if;
Analyze (Decl, Suppress => All_Checks);
end if;
......
gcc/ada/gnat_ugn.texi
......@@ -454,18 +454,6 @@ Stack Related Facilities
* Static Stack Usage Analysis::
* Dynamic Stack Usage Analysis::
Some Useful Memory Pools
The GNAT Debug Pool Facility
@ifclear vms
The gnatmem Tool
* Running gnatmem::
* Switches for gnatmem::
* Example of gnatmem Usage::
@end ifclear
Verifying Properties Using gnatcheck
Sample Bodies Using gnatstub
gcc/ada/nlists.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
......@@ -987,21 +987,6 @@ package body Nlists is
return Int (Lists.Last) - Int (Lists.First) + 1;
end Num_Lists;
-------
-- p --
-------
function p (U : Union_Id) return Node_Or_Entity_Id is
begin
if U in Node_Range then
return Parent (Node_Or_Entity_Id (U));
elsif U in List_Range then
return Parent (List_Id (U));
else
return 99_999_999;
end if;
end p;
------------
-- Parent --
------------
......
gcc/ada/nlists.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
......@@ -363,12 +363,4 @@ package Nlists is
-- These functions return the addresses of the Next_Node and Prev_Node
-- tables (used in Back_End for Gigi).
function p (U : Union_Id) return Node_Or_Entity_Id;
-- This function is intended for use from the debugger, it determines
-- whether U is a Node_Id or List_Id, and calls the appropriate Parent
-- function and returns the parent Node in either case. This is shorter
-- to type, and avoids the overloading problem of using Parent. It
-- should NEVER be used except from the debugger. If p is called with
-- other than a node or list id value, it returns 99_999_999.
end Nlists;
gcc/ada/sem_disp.adb
......@@ -536,6 +536,21 @@ package body Sem_Disp is
Set_Entity (Name (N), Alias (Subp));
return;
-- An obscure special case: a null procedure may have a class-
-- wide pre/postcondition that includes a call to an abstract
-- subp. Calls within the expression may not have been rewritten
-- as dispatching calls yet, because the null body appears in
-- the current declarative part. The expression will be properly
-- rewritten/reanalyzed when the postcondition procedure is built.
elsif In_Spec_Expression
and then Is_Subprogram (Current_Scope)
and then
Nkind (Parent (Current_Scope)) = N_Procedure_Specification
and then Null_Present (Parent (Current_Scope))
then
null;
else
-- We need to determine whether the context of the call
-- provides a tag to make the call dispatching. This requires
......
gcc/ada/treepr.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
......@@ -215,6 +215,27 @@ package body Treepr is
-- descendents are to be printed. Prefix_Str is to be added to all
-- printed lines.
-------
-- p --
-------
function p (N : Union_Id) return Node_Or_Entity_Id is
begin
case N is
when List_Low_Bound .. List_High_Bound - 1 =>
return Nlists.Parent (List_Id (N));
when Node_Range =>
return Atree.Parent (Node_Or_Entity_Id (N));
when others =>
Write_Int (Int (N));
Write_Str (" is not a Node_Id or List_Id value");
Write_Eol;
return Empty;
end case;
end p;
--------
-- pe --
--------
......
gcc/ada/treepr.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
......@@ -62,16 +62,27 @@ package Treepr is
-- The following debugging procedures are intended to be called from gdb
function p (N : Union_Id) return Node_Or_Entity_Id;
pragma Export (Ada, p);
-- Returns parent of a list or node (depending on the value of N). If N
-- is neither a list nor a node id, then prints a message to that effect
-- and returns Empty.
procedure pn (N : Union_Id);
-- Prints a node, node list, uint, or anything else that falls under
-- the definition of Union_Id. Historically this was only for printing
-- nodes, hence the name.
procedure pp (N : Union_Id);
pragma Export (Ada, pp);
-- Prints a node, node list, uint, or anything else that falls under
-- Union_Id.
-- Identical to pn, present for historical reasons
procedure ppp (N : Node_Id);
pragma Export (Ada, ppp);
-- Same as Print_Node_Subtree
-- The following are no longer needed; you can use pp or ppp instead
-- The following are no longer really needed, now that pn will print
-- anything you throw at it!
procedure pe (E : Elist_Id);
pragma Export (Ada, pe);
......@@ -84,10 +95,6 @@ package Treepr is
-- on the left and add a minus sign. This just saves some typing in the
-- debugger.
procedure pn (N : Union_Id);
pragma Export (Ada, pn);
-- Same as pp
procedure pt (N : Node_Id);
pragma Export (Ada, pt);
-- Same as ppp
......
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