Skip to content

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

[multiple changes] 

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

	* sem_res.adb (Resolve_Intrinsic_Operator): Add guards to handle
	properly the rare cases where VMS operators are visible through
	Extend_System, but the default System is being used and Address is a
	private type.
	* sem_util.adb: Widen predicate Is_VMS_Operator.

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

	* switch-m.adb (Normalize_Compiler_Switches): Take into account -gnatC
	and -gnateS.

From-SVN: r161263
parent e2cc5258
Showing with 65 additions and 17 deletions
gcc/ada/ChangeLog
2010-06-23 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Intrinsic_Operator): Add guards to handle
properly the rare cases where VMS operators are visible through
Extend_System, but the default System is being used and Address is a
private type.
* sem_util.adb: Widen predicate Is_VMS_Operator.
2010-06-23 Vincent Celier <celier@adacore.com>
* switch-m.adb (Normalize_Compiler_Switches): Take into account -gnatC
and -gnateS.
2010-06-23 Olivier Hainque <hainque@adacore.com>
* einfo.adb (Has_Foreign_Convention): Consider Intrinsic with
......
gcc/ada/sem_res.adb
......@@ -3474,6 +3474,12 @@ package body Sem_Res is
A_Typ := Etype (A);
F_Typ := Etype (F);
-- Save actual for subsequent check on order dependence,
-- and indicate whether actual is modifiable. For AI05-0144
-- Save_Actual (A,
-- Ekind (F) /= E_In_Parameter or else Is_Access_Type (F_Typ));
-- For mode IN, if actual is an entity, and the type of the formal
-- has warnings suppressed, then we reset Never_Set_In_Source for
-- the calling entity. The reason for this is to catch cases like
......@@ -6751,10 +6757,11 @@ package body Sem_Res is
--------------------------------
procedure Resolve_Intrinsic_Operator (N : Node_Id; Typ : Entity_Id) is
Btyp : constant Entity_Id := Base_Type (Underlying_Type (Typ));
Op : Entity_Id;
Arg1 : Node_Id;
Arg2 : Node_Id;
Btyp : constant Entity_Id := Base_Type (Underlying_Type (Typ));
Op : Entity_Id;
Orig_Op : constant Entity_Id := Entity (N);
Arg1 : Node_Id;
Arg2 : Node_Id;
begin
-- We must preserve the original entity in a generic setting, so that
......@@ -6786,8 +6793,13 @@ package body Sem_Res is
Arg2 := Unchecked_Convert_To (Btyp, Right_Opnd (N));
end if;
Save_Interps (Left_Opnd (N), Expression (Arg1));
Save_Interps (Right_Opnd (N), Expression (Arg2));
if Nkind (Arg1) = N_Type_Conversion then
Save_Interps (Left_Opnd (N), Expression (Arg1));
end if;
if Nkind (Arg2) = N_Type_Conversion then
Save_Interps (Right_Opnd (N), Expression (Arg2));
end if;
Set_Left_Opnd (N, Arg1);
Set_Right_Opnd (N, Arg2);
......@@ -6800,19 +6812,31 @@ package body Sem_Res is
or else Typ /= Etype (Right_Opnd (N))
then
-- Add explicit conversion where needed, and save interpretations in
-- case operands are overloaded.
-- case operands are overloaded. If the context is a VMS operation,
-- assert that the conversion is legal (the operands have the proper
-- types to select the VMS intrinsic). Note that in rare cases the
-- VMS operators may be visible, but the default System is being used
-- and Address is a private type.
Arg1 := Convert_To (Typ, Left_Opnd (N));
Arg2 := Convert_To (Typ, Right_Opnd (N));
if Nkind (Arg1) = N_Type_Conversion then
Save_Interps (Left_Opnd (N), Expression (Arg1));
if Is_VMS_Operator (Orig_Op) then
Set_Conversion_OK (Arg1);
end if;
else
Save_Interps (Left_Opnd (N), Arg1);
end if;
if Nkind (Arg2) = N_Type_Conversion then
Save_Interps (Right_Opnd (N), Expression (Arg2));
if Is_VMS_Operator (Orig_Op) then
Set_Conversion_OK (Arg2);
end if;
else
Save_Interps (Right_Opnd (N), Arg2);
end if;
......@@ -7941,7 +7965,9 @@ package body Sem_Res is
begin
Resolve (L, B_Typ);
-- Check_Order_Dependence; -- For AI05-0144
Resolve (R, B_Typ);
-- Check_Order_Dependence; -- For AI05-0144
-- Check for issuing warning for always False assert/check, this happens
-- when assertions are turned off, in which case the pragma Assert/Check
......
gcc/ada/sem_util.adb
......@@ -7220,8 +7220,12 @@ package body Sem_Util is
return Ekind (Op) = E_Function
and then Is_Intrinsic_Subprogram (Op)
and then Present_System_Aux
and then Scope (Op) = System_Aux_Id;
and then
((Present_System_Aux
and then Scope (Op) = System_Aux_Id)
or else
(True_VMS_Target
and then Chars (Scope (Scope (Op))) = Name_System));
end Is_VMS_Operator;
-----------------
......
gcc/ada/switch-m.adb
......@@ -71,7 +71,7 @@ package body Switch.M is
procedure Add_Switch_Component (S : String);
-- Add a new String_Access component in Switches. If a string equal
-- to S is already stored in the table Normalized_Switches, use it.
-- Other wise add a new component to the table.
-- Otherwise add a new component to the table.
--------------------------
-- Add_Switch_Component --
......@@ -215,10 +215,10 @@ package body Switch.M is
-- One-letter switches
when 'a' | 'A' | 'b' | 'c' | 'D' | 'E' | 'f' | 'F' |
'g' | 'h' | 'H' | 'l' | 'L' | 'n' | 'N' | 'o' |
'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' |
'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
when 'a' | 'A' | 'b' | 'c' | 'C' | 'D' | 'E' | 'f' |
'F' | 'g' | 'h' | 'H' | 'l' | 'L' | 'n' | 'N' |
'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' |
't' | 'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
Storing (First_Stored) := C;
Add_Switch_Component
(Storing (Storing'First .. First_Stored));
......@@ -268,8 +268,9 @@ package body Switch.M is
when 'e' =>
-- Store -gnateD, -gnatep= and -gnateG in the ALI file.
-- The other -gnate switches do not need to be stored.
-- Store -gnateD, -gnatep=, -gnateG and -gnateS in the
-- ALI file. The other -gnate switches do not need to be
-- stored.
Storing (First_Stored) := 'e';
Ptr := Ptr + 1;
......@@ -277,7 +278,8 @@ package body Switch.M is
if Ptr > Max
or else (Switch_Chars (Ptr) /= 'D'
and then Switch_Chars (Ptr) /= 'G'
and then Switch_Chars (Ptr) /= 'p')
and then Switch_Chars (Ptr) /= 'p'
and then Switch_Chars (Ptr) /= 'S')
then
Last := 0;
return;
......@@ -322,6 +324,9 @@ package body Switch.M is
elsif Switch_Chars (Ptr) = 'G' then
Add_Switch_Component ("-gnateG");
elsif Switch_Chars (Ptr) = 'S' then
Add_Switch_Component ("-gnateS");
end if;
return;
......
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