Commit e86a3a7e by Arnaud Charlet

[multiple changes]

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* errout.adb (Unwind_Internal_Type): Improve handling of First_Subtype
	test to catch more cases where first subtype is the results we want.
	* sem_res.adb (Make_Call_Into_Operator): Don't go to First_Subtype in
	error case, since Errout will now handle this correctly.
	* gcc-interface/Make-lang.in: Add Sem_Aux to list of GNATBIND objects.
	Update dependencies.

2010-06-22  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch4.adb (Expand_Allocator_Expression): Set Related_Node properly
	when calling Make_Temporary.

2010-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Access_Subprogram_Declaration): An anonymous access to
	subprogram can be associated with an entry body.

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* scos.ads: Add note on membership test handling.

2010-06-22  Vincent Celier  <celier@adacore.com>

	* projects.texi: Minor spelling fixes.
	Minor reformatting.

2010-06-22  Paul Hilfinger  <hilfinger@adacore.com>

	* s-rannum.adb: Correct off-by-one error in Extract_Value.

From-SVN: r161171
parent b086849e
2010-06-22 Robert Dewar <dewar@adacore.com>
* errout.adb (Unwind_Internal_Type): Improve handling of First_Subtype
test to catch more cases where first subtype is the results we want.
* sem_res.adb (Make_Call_Into_Operator): Don't go to First_Subtype in
error case, since Errout will now handle this correctly.
* gcc-interface/Make-lang.in: Add Sem_Aux to list of GNATBIND objects.
Update dependencies.
2010-06-22 Arnaud Charlet <charlet@adacore.com>
* exp_ch4.adb (Expand_Allocator_Expression): Set Related_Node properly
when calling Make_Temporary.
2010-06-22 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Access_Subprogram_Declaration): An anonymous access to
subprogram can be associated with an entry body.
2010-06-22 Robert Dewar <dewar@adacore.com>
* scos.ads: Add note on membership test handling.
2010-06-22 Vincent Celier <celier@adacore.com>
* projects.texi: Minor spelling fixes.
Minor reformatting.
2010-06-22 Paul Hilfinger <hilfinger@adacore.com>
* s-rannum.adb: Correct off-by-one error in Extract_Value.
2010-06-22 Vincent Celier <celier@adacore.com>
* mlib-prj.adb (Display): In non verbose mode, truncate after fourth
......
......@@ -43,6 +43,7 @@ with Opt; use Opt;
with Nlists; use Nlists;
with Output; use Output;
with Scans; use Scans;
with Sem_Aux; use Sem_Aux;
with Sinput; use Sinput;
with Sinfo; use Sinfo;
with Snames; use Snames;
......@@ -2824,7 +2825,7 @@ package body Errout is
-- "type derived from" message more than once in the case where we climb
-- up multiple levels.
loop
Find : loop
Old_Ent := Ent;
-- Implicit access type, use directly designated type In Ada 2005,
......@@ -2872,7 +2873,7 @@ package body Errout is
Set_Msg_Str ("access to procedure ");
end if;
exit;
exit Find;
-- Type is access to object, named or anonymous
......@@ -2910,51 +2911,54 @@ package body Errout is
-- itself an internal name. This avoids the obvious loop (subtype ->
-- basetype -> subtype) which would otherwise occur!)
elsif Present (Freeze_Node (Ent))
and then Present (First_Subtype_Link (Freeze_Node (Ent)))
and then
not Is_Internal_Name
(Chars (First_Subtype_Link (Freeze_Node (Ent))))
then
Ent := First_Subtype_Link (Freeze_Node (Ent));
else
declare
FST : constant Entity_Id := First_Subtype (Ent);
-- Otherwise use root type
begin
if not Is_Internal_Name (Chars (FST)) then
Ent := FST;
exit Find;
else
if not Derived then
Buffer_Remove ("type ");
-- Otherwise use root type
-- Test for "subtype of type derived from" which seems
-- excessive and is replaced by simply "type derived from"
else
if not Derived then
Buffer_Remove ("type ");
Buffer_Remove ("subtype of");
-- Test for "subtype of type derived from" which seems
-- excessive and is replaced by "type derived from".
-- Avoid duplication "type derived from type derived from"
Buffer_Remove ("subtype of");
if not Buffer_Ends_With ("type derived from ") then
Set_Msg_Str ("type derived from ");
end if;
-- Avoid duplicated "type derived from type derived from"
Derived := True;
end if;
if not Buffer_Ends_With ("type derived from ") then
Set_Msg_Str ("type derived from ");
end if;
Derived := True;
end if;
end if;
end;
Ent := Etype (Ent);
end if;
-- If we are stuck in a loop, get out and settle for the internal
-- name after all. In this case we set to kill the message if it
-- is not the first error message (we really try hard not to show
-- the dirty laundry of the implementation to the poor user!)
-- name after all. In this case we set to kill the message if it is
-- not the first error message (we really try hard not to show the
-- dirty laundry of the implementation to the poor user!)
if Ent = Old_Ent then
Kill_Message := True;
exit;
exit Find;
end if;
-- Get out if we finally found a non-internal name to use
exit when not Is_Internal_Name (Chars (Ent));
end loop;
exit Find when not Is_Internal_Name (Chars (Ent));
end loop Find;
if Mchar = '"' then
Set_Msg_Char ('"');
......
......@@ -590,7 +590,7 @@ package body Exp_Ch4 is
Set_Analyzed (Node);
Temp := Make_Temporary (Loc, 'P', Node);
Temp := Make_Temporary (Loc, 'P', N);
Insert_Action (N,
Make_Object_Declaration (Loc,
......@@ -659,7 +659,7 @@ package body Exp_Ch4 is
Remove_Side_Effects (Exp);
end if;
Temp := Make_Temporary (Loc, 'P');
Temp := Make_Temporary (Loc, 'P', N);
-- For a class wide allocation generate the following code:
......@@ -979,7 +979,7 @@ package body Exp_Ch4 is
end if;
elsif Aggr_In_Place then
Temp := Make_Temporary (Loc, 'P');
Temp := Make_Temporary (Loc, 'P', N);
Tmp_Node :=
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
......
......@@ -443,6 +443,7 @@ GNATBIND_OBJS = \
ada/scng.o \
ada/scans.o \
ada/sdefault.o \
ada/sem_aux.o \
ada/sinfo.o \
ada/sinput.o \
ada/sinput-c.o \
......@@ -1600,16 +1601,16 @@ ada/errout.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/fname.ads ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads \
ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads ada/lib.adb \
ada/lib-list.adb ada/lib-sort.adb ada/namet.ads ada/nlists.ads \
ada/nlists.adb ada/opt.ads ada/output.ads ada/scans.ads ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
ada/stand.ads ada/stringt.ads ada/stylesw.ads ada/system.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
ada/urealp.ads ada/widechar.ads
ada/nlists.adb ada/opt.ads ada/output.ads ada/scans.ads ada/sem_aux.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
ada/snames.ads ada/stand.ads ada/stringt.ads ada/stylesw.ads \
ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/erroutc.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
......@@ -2570,10 +2571,10 @@ ada/gnatvsn.o : ada/ada.ads ada/a-unccon.ads ada/gnatvsn.ads \
ada/gnatvsn.adb ada/system.ads ada/s-secsta.ads ada/s-stoele.ads \
ada/s-stoele.adb
ada/hlo.o : ada/ada.ads ada/a-unccon.ads ada/hlo.ads ada/hlo.adb \
ada/hostparm.ads ada/output.ads ada/system.ads ada/s-exctab.ads \
ada/s-stalib.ads ada/s-unstyp.ads ada/types.ads ada/unchconv.ads \
ada/unchdeal.ads
ada/hlo.o : ada/ada.ads ada/a-unccon.ads ada/a-uncdea.ads ada/hlo.ads \
ada/hlo.adb ada/hostparm.ads ada/output.ads ada/system.ads \
ada/s-exctab.ads ada/s-os_lib.ads ada/s-stalib.ads ada/s-string.ads \
ada/s-unstyp.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads
ada/hostparm.o : ada/ada.ads ada/a-unccon.ads ada/hostparm.ads \
ada/system.ads ada/s-exctab.ads ada/s-stalib.ads ada/s-unstyp.ads \
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007,2009 Free Software Foundation, Inc. --
-- Copyright (C) 2007-2010, 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- --
......@@ -528,7 +528,7 @@ package body System.Random_Numbers is
function Extract_Value (S : String; Index : Integer) return State_Val is
begin
return State_Val'Value (S (S'First + Index * 11 ..
S'First + Index * 11 + 11));
S'First + Index * 11 + 10));
end Extract_Value;
end System.Random_Numbers;
......@@ -272,6 +272,10 @@ package SCOs is
-- enclosing statement. The SCO line for a nested decision always occurs
-- after the line for the enclosing decision.
-- Note that membership tests are considered to be a single simple
-- condition, and that is true even if the Ada 2005 set membership
-- form is used, e.g. A in (2,7,11.15).
-- Case Expressions
-- For case statements, we rely on statement coverage to make sure that
......
......@@ -1037,8 +1037,8 @@ package body Sem_Ch3 is
begin
-- Associate the Itype node with the inner full-type declaration or
-- subprogram spec. This is required to handle nested anonymous
-- declarations. For example:
-- subprogram spec or entry body. This is required to handle nested
-- anonymous declarations. For example:
-- procedure P
-- (X : access procedure
......@@ -1050,7 +1050,9 @@ package body Sem_Ch3 is
N_Private_Type_Declaration,
N_Private_Extension_Declaration,
N_Procedure_Specification,
N_Function_Specification)
N_Function_Specification,
N_Entry_Body)
or else
Nkind_In (D_Ityp, N_Object_Declaration,
N_Object_Renaming_Declaration,
......
......@@ -1444,7 +1444,7 @@ package body Sem_Res is
null;
-- Operator may be defined in an extension of system
-- Operator may be defined in an extension of System
elsif Present (System_Aux_Id)
and then Scope (Opnd_Type) = System_Aux_Id
......@@ -1452,13 +1452,10 @@ package body Sem_Res is
null;
else
-- Note: go to First_Subtype here to ensure the message has the
-- proper source type name (Typ may be an anonymous base type).
-- Could we use Wrong_Type here??? (this would require setting
-- Etype (N) to the actual type found where Typ was expected).
Error_Msg_NE ("expect type&", N, First_Subtype (Typ));
Error_Msg_NE ("expect }", N, Typ);
end if;
end if;
end if;
......
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