mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-13 08:00:40 +08:00
[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
This commit is contained in:
parent
e2cc5258ca
commit
bb481772fe
@ -1,3 +1,16 @@
|
||||
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
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
||||
-----------------
|
||||
|
@ -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;
|
||||
|
Loading…
x
Reference in New Issue
Block a user