OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2009-11-30  Emmanuel Briot  <briot@adacore.com>

	* clean.adb ("-eL"): Also set Follow_Links_For_Dirs, to match what is
	done in other project-aware tools like gnatmake and gprbuild.

2009-11-30  Jerome Lambourg  <lambourg@adacore.com>

	* exp_ch3.adb (Make_Predefined_Primitive_Specs): Take care of CIL
	ValueTypes.
	* exp_ch7.adb (Needs_Finalization): Do not finalize CIL valuetypes.
	* sem_util.adb (Is_Value_Type): Protect against invalid calls to Chars
	(Is_Delegate): New method used for CIL.
	* sem_util.ads (Is_Delegate): New method for CIL handling.
	(Is_Value_Type): Improve documentation.

2009-11-30  Ed Schonberg  <schonberg@adacore.com>

	* errout.adb (Unwind_Internal_Type): Improve error reporting if the
	type is an anonymous access to subprogram that is the type of a formal
	in a subprogram spec.

2009-11-30  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Check_Interfaces): In a Stand-Alone Library project, if
	attribute Interfaces is not declared, then Library_Interface should
	define the interfaces.

2009-11-30  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb: New semantics for Annotate.

From-SVN: r154800
This commit is contained in:
Arnaud Charlet 2009-11-30 14:45:45 +01:00
parent 207b17442a
commit 226e989e7e
9 changed files with 223 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
gcc/ada/ChangeLog
View File

@ -1,3 +1,34 @@
2009-11-30 Emmanuel Briot <briot@adacore.com>
* clean.adb ("-eL"): Also set Follow_Links_For_Dirs, to match what is
done in other project-aware tools like gnatmake and gprbuild.
2009-11-30 Jerome Lambourg <lambourg@adacore.com>
* exp_ch3.adb (Make_Predefined_Primitive_Specs): Take care of CIL
ValueTypes.
* exp_ch7.adb (Needs_Finalization): Do not finalize CIL valuetypes.
* sem_util.adb (Is_Value_Type): Protect against invalid calls to Chars
(Is_Delegate): New method used for CIL.
* sem_util.ads (Is_Delegate): New method for CIL handling.
(Is_Value_Type): Improve documentation.
2009-11-30 Ed Schonberg <schonberg@adacore.com>
* errout.adb (Unwind_Internal_Type): Improve error reporting if the
type is an anonymous access to subprogram that is the type of a formal
in a subprogram spec.
2009-11-30 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Check_Interfaces): In a Stand-Alone Library project, if
attribute Interfaces is not declared, then Library_Interface should
define the interfaces.
2009-11-30 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb: New semantics for Annotate.
2009-11-30 Tristan Gingold <gingold@adacore.com>
* gcc-interface/Makefile.in: Do not link with -static-libgcc on Darwin.

1
gcc/ada/clean.adb
View File

@ -1740,6 +1740,7 @@ package body Clean is
when 'e' =>
if Arg = "-eL" then
Follow_Links_For_Files := True;
Follow_Links_For_Dirs := True;
else
Bad_Argument;

25
gcc/ada/errout.adb
View File

@ -2848,7 +2848,30 @@ package body Errout is
Buffer_Remove ("type ");
end if;
Set_Msg_Str ("access to subprogram with profile ");
if Is_Itype (Ent) then
declare
Assoc : constant Node_Id :=
Associated_Node_For_Itype (Ent);
begin
if Nkind (Assoc) = N_Procedure_Specification
or else Nkind (Assoc) = N_Function_Specification
then
-- Anonymous access to subprogram in a signature
-- Indicate the enclosing subprogram.
Ent :=
Defining_Unit_Name
(Associated_Node_For_Itype (Ent));
Set_Msg_Str
("access to subprogram declared in profile of ");
else
Set_Msg_Str ("access to subprogram with profile ");
end if;
end;
end if;
elsif Ekind (Ent) = E_Function then
Set_Msg_Str ("access to function ");

4
gcc/ada/exp_ch3.adb
View File

@ -8121,7 +8121,9 @@ package body Exp_Ch3 is
and then not Is_Limited_Interface (Tag_Typ)
and then Is_Limited_Interface (Etype (Tag_Typ)))
then
if not Is_Limited_Type (Tag_Typ) then
if not Is_Limited_Type (Tag_Typ)
and then not Is_Value_Type (Tag_Typ)
then
Append_To (Res,
Predef_Deep_Spec (Loc, Tag_Typ, TSS_Deep_Adjust));
end if;

3
gcc/ada/exp_ch7.adb
View File

@ -3294,7 +3294,8 @@ package body Exp_Ch7 is
return (Is_Class_Wide_Type (T)
and then not In_Finalization_Root (T)
and then not Restriction_Active (No_Finalization))
and then not Restriction_Active (No_Finalization)
and then not Is_Value_Type (Etype (T)))
or else Is_Controlled (T)
or else Has_Some_Controlled_Component (T)
or else (Is_Concurrent_Type (T)

94
gcc/ada/prj-nmsc.adb
View File

@ -2520,6 +2520,12 @@ package body Prj.Nmsc is
Project.Decl.Attributes,
Data.Tree);
Library_Interface : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Interface,
Project.Decl.Attributes,
Data.Tree);
List : String_List_Id;
Element : String_Element;
Name : File_Name_Type;
@ -2604,22 +2610,90 @@ package body Prj.Nmsc is
Project.Interfaces_Defined := True;
elsif Project.Extends /= No_Project then
Project.Interfaces_Defined := Project.Extends.Interfaces_Defined;
elsif Project.Library and then not Library_Interface.Default then
if Project.Interfaces_Defined then
Iter := For_Each_Source (Data.Tree, Project);
-- Set In_Interfaces to False for all sources. It will be set to True
-- later for the sources in the Library_Interface list.
Project_2 := Project;
while Project_2 /= No_Project loop
Iter := For_Each_Source (Data.Tree, Project_2);
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
if not Source.Declared_In_Interfaces then
Source.In_Interfaces := False;
end if;
Source.In_Interfaces := False;
Next (Iter);
end loop;
end if;
Project_2 := Project_2.Extends;
end loop;
List := Library_Interface.Values;
while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List);
Get_Name_String (Element.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
Name := Name_Find;
Project_2 := Project;
Big_Loop_2 :
while Project_2 /= No_Project loop
Iter := For_Each_Source (Data.Tree, Project_2);
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
if Source.Unit /= No_Unit_Index and then
Source.Unit.Name = Name_Id (Name)
then
if not Source.Locally_Removed then
Source.In_Interfaces := True;
Source.Declared_In_Interfaces := True;
Other := Other_Part (Source);
if Other /= No_Source then
Other.In_Interfaces := True;
Other.Declared_In_Interfaces := True;
end if;
if Current_Verbosity = High then
Write_Str (" interface: ");
Write_Line (Get_Name_String (Source.Path.Name));
end if;
end if;
exit Big_Loop_2;
end if;
Next (Iter);
end loop;
Project_2 := Project_2.Extends;
end loop Big_Loop_2;
List := Element.Next;
end loop;
Project.Interfaces_Defined := True;
elsif Project.Extends /= No_Project and then
Project.Extends.Interfaces_Defined
then
Project.Interfaces_Defined := True;
Iter := For_Each_Source (Data.Tree, Project);
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
if not Source.Declared_In_Interfaces then
Source.In_Interfaces := False;
end if;
Next (Iter);
end loop;
end if;
end Check_Interfaces;

42
gcc/ada/sem_prag.adb
View File

@ -5212,8 +5212,11 @@ package body Sem_Prag is
-- Annotate --
--------------
-- pragma Annotate (IDENTIFIER {, ARG});
-- pragma Annotate (IDENTIFIER, [IDENTIFIER], {, ARG});
-- ARG ::= NAME | EXPRESSION
-- The first two arguments are by convention intended to refer
-- to an external tool and a tool-specific function. These
-- arguments are not analyzed.
when Pragma_Annotate => Annotate : begin
GNAT_Pragma;
@ -5225,26 +5228,33 @@ package body Sem_Prag is
Exp : Node_Id;
begin
Arg := Arg2;
while Present (Arg) loop
Exp := Expression (Arg);
Analyze (Exp);
if No (Arg2) then
Error_Pragma_Arg
("pragma requires at least two arguments", Arg1);
if Is_Entity_Name (Exp) then
null;
else
Arg := Next (Arg2);
while Present (Arg) loop
Exp := Expression (Arg);
Analyze (Exp);
elsif Nkind (Exp) = N_String_Literal then
Resolve (Exp, Standard_String);
if Is_Entity_Name (Exp) then
null;
elsif Is_Overloaded (Exp) then
Error_Pragma_Arg ("ambiguous argument for pragma%", Exp);
elsif Nkind (Exp) = N_String_Literal then
Resolve (Exp, Standard_String);
else
Resolve (Exp);
end if;
elsif Is_Overloaded (Exp) then
Error_Pragma_Arg
("ambiguous argument for pragma%", Exp);
Next (Arg);
end loop;
else
Resolve (Exp);
end if;
Next (Arg);
end loop;
end if;
end;
end Annotate;

44
gcc/ada/sem_util.adb
View File

@ -7040,10 +7040,54 @@ package body Sem_Util is
function Is_Value_Type (T : Entity_Id) return Boolean is
begin
return VM_Target = CLI_Target
and then Nkind (T) in N_Has_Chars
and then Chars (T) /= No_Name
and then Get_Name_String (Chars (T)) = "valuetype";
end Is_Value_Type;
-----------------
-- Is_Delegate --
-----------------
function Is_Delegate (T : Entity_Id) return Boolean is
Desig_Type : Entity_Id;
begin
if VM_Target /= CLI_Target then
return False;
end if;
-- Access-to-subprograms are delegates in CIL
if Ekind (T) = E_Access_Subprogram_Type then
return True;
end if;
if Ekind (T) not in Access_Kind then
-- a delegate is a managed pointer. If no designated type is defined
-- it means that it's not a delegate.
return False;
end if;
Desig_Type := Etype (Directly_Designated_Type (T));
if not Is_Tagged_Type (Desig_Type) then
return False;
end if;
-- Test if the type is inherited from [mscorlib]System.Delegate
while Etype (Desig_Type) /= Desig_Type loop
if Chars (Scope (Desig_Type)) /= No_Name
and then Is_Imported (Scope (Desig_Type))
and then Get_Name_String (Chars (Scope (Desig_Type))) = "delegate"
then
return True;
end if;
Desig_Type := Etype (Desig_Type);
end loop;
return False;
end Is_Delegate;
-----------------
-- Is_Variable --
-----------------

10
gcc/ada/sem_util.ads
View File

@ -800,8 +800,14 @@ package Sem_Util is
function Is_Value_Type (T : Entity_Id) return Boolean;
-- Returns true if type T represents a value type. This is only relevant to
-- CIL, will always return false for other targets.
-- What is a "value type", since this is not an Ada term, it should be
-- defined here ???
-- A value type is a CIL object that is accessed directly, as opposed to
-- the other CIL objects that are accessed through managed pointers.
function Is_Delegate (T : Entity_Id) return Boolean;
-- Returns true if type T represents a delegate. A Delegate is the CIL
-- object used to represent access-to-subprogram types.
-- This is only relevant to CIL, will always return false for other
-- targets.
function Is_Variable (N : Node_Id) return Boolean;
-- Determines if the tree referenced by N represents a variable, i.e.