Skip to content

R
riscv-gcc-1
Commit 82923c66 by Arnaud Charlet
Options

[multiple changes] 

2010-06-17  Thomas Quinot  <quinot@adacore.com>

	* put_scos.adb: Do not generate a blank line in SCOs when omitting the
	CP line for a disabled pragma.

2010-06-17  Emmanuel Briot  <briot@adacore.com>

	* prj-proc.adb, prj.adb, prj.ads (Check_Or_Set_Typed_Variable): New
	subprogram.
	(Process_Declarative_Item): An invalid value in an typed variable
	declaration is no longer always fatal.

From-SVN: r160875
parent cfc3e933
Showing with 129 additions and 62 deletions
gcc/ada/ChangeLog
2010-06-17 Thomas Quinot <quinot@adacore.com>
* put_scos.adb: Do not generate a blank line in SCOs when omitting the
CP line for a disabled pragma.
2010-06-17 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj.adb, prj.ads (Check_Or_Set_Typed_Variable): New
subprogram.
(Process_Declarative_Item): An invalid value in an typed variable
declaration is no longer always fatal.
2010-06-16 Arnaud Charlet <charlet@adacore.com>
* get_scos.adb, par_sco.adb, par_sco.ads, put_scos.adb, scos.adb,
......
gcc/ada/prj-proc.adb
......@@ -1255,9 +1255,101 @@ package body Prj.Proc is
Pkg : Package_Id;
Item : Project_Node_Id)
is
procedure Check_Or_Set_Typed_Variable
(Value : in out Variable_Value;
Declaration : Project_Node_Id);
-- Check whether Value is valid for this typed variable declaration. If
-- it is an error, the behavior depends on the flags: either an error is
-- reported, or a warning, or nothing. In the last two cases, the value
-- of the variable is set to a valid value, replacing Value.
---------------------------------
-- Check_Or_Set_Typed_Variable --
---------------------------------
procedure Check_Or_Set_Typed_Variable
(Value : in out Variable_Value;
Declaration : Project_Node_Id)
is
Loc : constant Source_Ptr :=
Location_Of (Declaration, From_Project_Node_Tree);
Reset_Value : Boolean := False;
Current_String : Project_Node_Id;
begin
-- Report an error for an empty string
if Value.Value = Empty_String then
Error_Msg_Name_1 := Name_Of (Declaration, From_Project_Node_Tree);
case Flags.Allow_Invalid_External is
when Error =>
Error_Msg (Flags, "no value defined for %%", Loc, Project);
when Warning =>
Reset_Value := True;
Error_Msg (Flags, "?no value defined for %%", Loc, Project);
when Silent =>
Reset_Value := True;
end case;
else
-- Loop through all the valid strings for the
-- string type and compare to the string value.
Current_String :=
First_Literal_String
(String_Type_Of (Declaration, From_Project_Node_Tree),
From_Project_Node_Tree);
while Present (Current_String)
and then String_Value_Of
(Current_String, From_Project_Node_Tree) /= Value.Value
loop
Current_String :=
Next_Literal_String (Current_String, From_Project_Node_Tree);
end loop;
-- Report error if string value is not one for the string type
if No (Current_String) then
Error_Msg_Name_1 := Value.Value;
Error_Msg_Name_2 :=
Name_Of (Declaration, From_Project_Node_Tree);
case Flags.Allow_Invalid_External is
when Error =>
Error_Msg
(Flags, "value %% is illegal for typed string %%",
Loc, Project);
when Warning =>
Error_Msg
(Flags, "?value %% is illegal for typed string %%",
Loc, Project);
Reset_Value := True;
when Silent =>
Reset_Value := True;
end case;
end if;
end if;
if Reset_Value then
Current_String :=
First_Literal_String
(String_Type_Of (Declaration, From_Project_Node_Tree),
From_Project_Node_Tree);
Value.Value := String_Value_Of
(Current_String, From_Project_Node_Tree);
end if;
end Check_Or_Set_Typed_Variable;
-- Local variables
Current_Declarative_Item : Project_Node_Id;
Current_Item : Project_Node_Id;
-- Start of processing for Process_Declarative_Items
begin
-- Loop through declarative items
......@@ -1677,7 +1769,7 @@ package body Prj.Proc is
else
declare
New_Value : constant Variable_Value :=
New_Value : Variable_Value :=
Expression
(Project => Project,
In_Tree => In_Tree,
......@@ -1713,59 +1805,9 @@ package body Prj.Proc is
if Kind_Of (Current_Item, From_Project_Node_Tree) =
N_Typed_Variable_Declaration
then
-- Report an error for an empty string
if New_Value.Value = Empty_String then
Error_Msg_Name_1 :=
Name_Of (Current_Item, From_Project_Node_Tree);
Error_Msg
(Flags,
"no value defined for %%",
Location_Of
(Current_Item, From_Project_Node_Tree),
Project);
else
declare
Current_String : Project_Node_Id;
begin
-- Loop through all the valid strings for the
-- string type and compare to the string value.
Current_String :=
First_Literal_String
(String_Type_Of (Current_Item,
From_Project_Node_Tree),
From_Project_Node_Tree);
while Present (Current_String)
and then
String_Value_Of
(Current_String, From_Project_Node_Tree) /=
New_Value.Value
loop
Current_String :=
Next_Literal_String
(Current_String, From_Project_Node_Tree);
end loop;
-- Report an error if the string value is not
-- one for the string type.
if No (Current_String) then
Error_Msg_Name_1 := New_Value.Value;
Error_Msg_Name_2 :=
Name_Of
(Current_Item, From_Project_Node_Tree);
Error_Msg
(Flags,
"value %% is illegal for typed string %%",
Location_Of
(Current_Item, From_Project_Node_Tree),
Project);
end if;
end;
end if;
Check_Or_Set_Typed_Variable
(Value => New_Value,
Declaration => Current_Item);
end if;
-- Comment here ???
......
gcc/ada/prj.adb
......@@ -1230,7 +1230,8 @@ package body Prj is
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True;
Require_Obj_Dirs : Error_Warning := Error)
Require_Obj_Dirs : Error_Warning := Error;
Allow_Invalid_External : Error_Warning := Error)
return Processing_Flags
is
begin
......@@ -1241,7 +1242,8 @@ package body Prj is
Allow_Duplicate_Basenames => Allow_Duplicate_Basenames,
Error_On_Unknown_Language => Error_On_Unknown_Language,
Compiler_Driver_Mandatory => Compiler_Driver_Mandatory,
Require_Obj_Dirs => Require_Obj_Dirs);
Require_Obj_Dirs => Require_Obj_Dirs,
Allow_Invalid_External => Allow_Invalid_External);
end Create_Flags;
------------
......
gcc/ada/prj.ads
......@@ -1452,7 +1452,8 @@ package Prj is
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True;
Require_Obj_Dirs : Error_Warning := Error)
Require_Obj_Dirs : Error_Warning := Error;
Allow_Invalid_External : Error_Warning := Error)
return Processing_Flags;
-- Function used to create Processing_Flags structure
--
......@@ -1481,6 +1482,10 @@ package Prj is
-- If Require_Obj_Dirs is true, then all object directories must exist
-- (possibly after they have been created automatically if the appropriate
-- switches were specified), or an error is raised.
--
-- If Allow_Invalid_External is Silent, then no error is reported when an
-- invalid value is used for an external variable (and it doesn't match its
-- type). Instead, the first possible value is used.
Gprbuild_Flags : constant Processing_Flags;
Gprclean_Flags : constant Processing_Flags;
......@@ -1589,6 +1594,7 @@ private
Compiler_Driver_Mandatory : Boolean;
Error_On_Unknown_Language : Boolean;
Require_Obj_Dirs : Error_Warning;
Allow_Invalid_External : Error_Warning;
end record;
Gprbuild_Flags : constant Processing_Flags :=
......@@ -1598,7 +1604,8 @@ private
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Error);
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error);
Gprclean_Flags : constant Processing_Flags :=
(Report_Error => null,
......@@ -1607,7 +1614,8 @@ private
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Warning);
Require_Obj_Dirs => Warning,
Allow_Invalid_External => Error);
Gnatmake_Flags : constant Processing_Flags :=
(Report_Error => null,
......@@ -1616,6 +1624,7 @@ private
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => False,
Error_On_Unknown_Language => False,
Require_Obj_Dirs => Error);
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error);
end Prj;
gcc/ada/put_scos.adb
......@@ -134,6 +134,8 @@ begin
end if;
end loop;
Write_Info_Terminate;
-- Statement continuations should not occur since they
-- are supposed to have been handled in the loop above.
......@@ -197,13 +199,13 @@ begin
Start := Start + 1;
end;
end loop;
Write_Info_Terminate;
end if;
when others =>
raise Program_Error;
end case;
Write_Info_Terminate;
end Output_SCO_Line;
Start := Start + 1;
......
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