Skip to content

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

[multiple changes] 

2014-07-30  Arnaud Charlet  <charlet@adacore.com>

	* set_targ.adb (Read_Target_Dependent_Values): New subprogram.
	(elab body): Add provision for default target config file.
	* get_targ.ads, get_targ.adb (Get_Back_End_Config_File): New subprogram.

2014-07-30  Ed Schonberg  <schonberg@adacore.com>

	* a-cbhase.adb (Delete): Raise Constraint_Error, not Program_Error,
	when attempting to remove an element not in the set. This is
	the given semantics for all set containers.
	* a-cborse.adb (Delete): Attempt removal first, to check for
	tampering, before checking whether this is an attempt to
	delete a  non-existing element, and in fthe latter case raise
	Constraint_Error.

2014-07-30  Vincent Celier  <celier@adacore.com>

	* prj-proc.adb (Recursive_Process): Do not create a new
	Project_Id if the project is already in the list of projects of
	the tree.

2014-07-30  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Function_Return): Reject a return expression
	whose type is an incomplete formal type.
	(Analyze_Return_Type): Reject a return type that is an untagged
	imcomplete formal type.
	(Process_Formals): Reject a formal parameter whose type is an
	untagged formal incomplete type.
	* sem_res.adb (Resolve_Actuals): Reject an actual whose type is
	an untagged formal incomplete type.

From-SVN: r213299
parent 45ec05e1
Showing with 136 additions and 20 deletions
gcc/ada/ChangeLog
2014-07-30 Arnaud Charlet <charlet@adacore.com>
* set_targ.adb (Read_Target_Dependent_Values): New subprogram.
(elab body): Add provision for default target config file.
* get_targ.ads, get_targ.adb (Get_Back_End_Config_File): New subprogram.
2014-07-30 Ed Schonberg <schonberg@adacore.com>
* a-cbhase.adb (Delete): Raise Constraint_Error, not Program_Error,
when attempting to remove an element not in the set. This is
the given semantics for all set containers.
* a-cborse.adb (Delete): Attempt removal first, to check for
tampering, before checking whether this is an attempt to
delete a non-existing element, and in fthe latter case raise
Constraint_Error.
2014-07-30 Vincent Celier <celier@adacore.com>
* prj-proc.adb (Recursive_Process): Do not create a new
Project_Id if the project is already in the list of projects of
the tree.
2014-07-30 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Function_Return): Reject a return expression
whose type is an incomplete formal type.
(Analyze_Return_Type): Reject a return type that is an untagged
imcomplete formal type.
(Process_Formals): Reject a formal parameter whose type is an
untagged formal incomplete type.
* sem_res.adb (Resolve_Actuals): Reject an actual whose type is
an untagged formal incomplete type.
2014-07-30 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Minor spelling correction.
......
gcc/ada/a-cbhase.adb
......@@ -313,7 +313,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
if X = 0 then
raise Program_Error with "attempt to delete element not in set";
raise Constraint_Error with "attempt to delete element not in set";
end if;
HT_Ops.Free (Container, X);
......
gcc/ada/a-cborse.adb
......@@ -500,11 +500,12 @@ package body Ada.Containers.Bounded_Ordered_Sets is
X : constant Count_Type := Element_Keys.Find (Container, Item);
begin
Tree_Operations.Delete_Node_Sans_Free (Container, X);
if X = 0 then
raise Program_Error with "attempt to delete element not in set";
raise Constraint_Error with "attempt to delete element not in set";
end if;
Tree_Operations.Delete_Node_Sans_Free (Container, X);
Tree_Operations.Free (Container, X);
end Delete;
......
gcc/ada/get_targ.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -293,6 +293,15 @@ package body Get_Targ is
return C_Get_Double_Scalar_Alignment;
end Get_Double_Scalar_Alignment;
------------------------------
-- Get_Back_End_Config_File --
------------------------------
function Get_Back_End_Config_File return String_Ptr is
begin
return null;
end Get_Back_End_Config_File;
----------------------
-- Digits_From_Size --
----------------------
......
gcc/ada/get_targ.ads
......@@ -145,4 +145,9 @@ package Get_Targ is
procedure Register_Back_End_Types (Call_Back : Register_Type_Proc);
-- Calls the Call_Back function with information for each supported type
function Get_Back_End_Config_File return String_Ptr;
-- Return the back end configuration file, or null if none.
-- If non null, this file should be used instead of calling the various
-- Get_xxx functions in this package.
end Get_Targ;
gcc/ada/prj-proc.adb
......@@ -2845,20 +2845,42 @@ package body Prj.Proc is
return;
end if;
Project :=
new Project_Data'
(Empty_Project
(Project_Qualifier_Of
(From_Project_Node, From_Project_Node_Tree)));
-- Note that at this point we do not know yet if the project has
-- been withed from an encapsulated library or not.
In_Tree.Projects :=
new Project_List_Element'
(Project => Project,
From_Encapsulated_Lib => False,
Next => In_Tree.Projects);
-- Check if the project is already in the tree
Project := No_Project;
declare
List : Project_List := In_Tree.Projects;
Path : constant Path_Name_Type :=
Path_Name_Of (From_Project_Node,
From_Project_Node_Tree);
begin
while List /= null loop
if List.Project.Path.Display_Name = Path then
Project := List.Project;
exit;
end if;
List := List.Next;
end loop;
end;
if Project = No_Project then
Project :=
new Project_Data'
(Empty_Project
(Project_Qualifier_Of
(From_Project_Node, From_Project_Node_Tree)));
-- Note that at this point we do not know yet if the project
-- has been withed from an encapsulated library or not.
In_Tree.Projects :=
new Project_List_Element'
(Project => Project,
From_Encapsulated_Lib => False,
Next => In_Tree.Projects);
end if;
-- Keep track of this point
......
gcc/ada/sem_ch6.adb
......@@ -981,6 +981,14 @@ package body Sem_Ch6 is
then
Error_Msg_N ("cannot return local access to subprogram", N);
end if;
-- The expression cannot be of a formal incomplete type
elsif Ekind (Etype (Expr)) = E_Incomplete_Type
and then Is_Generic_Type (Etype (Expr))
then
Error_Msg_N
("cannot return expression of a formal incomplete type", N);
end if;
-- If the result type is class-wide, then check that the return
......@@ -1953,6 +1961,24 @@ package body Sem_Ch6 is
("invalid use of incomplete type&",
Result_Definition (N), Typ);
-- The return type of a subprogram body cannot be of a
-- formal incomplete type.
elsif Is_Generic_Type (Typ)
and then Nkind (Parent (N)) = N_Subprogram_Body
then
Error_Msg_N
("return type cannot be a formal incomplete type",
Result_Definition (N));
elsif Is_Class_Wide_Type (Typ)
and then Is_Generic_Type (Root_Type (Typ))
and then Nkind (Parent (N)) = N_Subprogram_Body
then
Error_Msg_N
("return type cannot be a formal incomplete type",
Result_Definition (N));
elsif Is_Tagged_Type (Typ) then
null;
......@@ -9827,7 +9853,8 @@ package body Sem_Ch6 is
if Is_Tagged_Type (Formal_Type)
or else (Ada_Version >= Ada_2012
and then not From_Limited_With (Formal_Type))
and then not From_Limited_With (Formal_Type)
and then not Is_Generic_Type (Formal_Type))
then
if Ekind (Scope (Current_Scope)) = E_Package
and then not Is_Generic_Type (Formal_Type)
......@@ -9864,8 +9891,17 @@ package body Sem_Ch6 is
-- in bodies. Limited views of either kind are not allowed
-- if there is no place at which the non-limited view can
-- become available.
-- Incomplete formal untagged types are not allowed in
-- subprogram bodies (but are legal in their declarations).
if Is_Generic_Type (Formal_Type)
and then not Is_Tagged_Type (Formal_Type)
and then Nkind (Parent (Related_Nod)) = N_Subprogram_Body
then
Error_Msg_N
("invalid use of formal incomplete type", Param_Spec);
if Ada_Version >= Ada_2012 then
elsif Ada_Version >= Ada_2012 then
if Is_Tagged_Type (Formal_Type)
and then (not From_Limited_With (Formal_Type)
or else not In_Package_Body)
......
gcc/ada/sem_res.adb
......@@ -3864,6 +3864,16 @@ package body Sem_Res is
A_Typ := Etype (A);
F_Typ := Etype (F);
-- An actual cannot be an untagged formal incomplete type
if Ekind (A_Typ) = E_Incomplete_Type
and then not Is_Tagged_Type (A_Typ)
and then Is_Generic_Type (A_Typ)
then
Error_Msg_N
("invalid use of untagged formal incomplete type", A);
end if;
if Comes_From_Source (Original_Node (N))
and then Nkind_In (Original_Node (N), N_Function_Call,
N_Procedure_Call_Statement)
......
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