[multiple changes]

2010-08-05  Thomas Quinot  <quinot@adacore.com>

	* sem_ch6.adb, gnat1drv.adb, exp_ch6.adb, sem_eval.adb: Minor
	reformatting.

2010-08-05  Steve Baird  <baird@adacore.com>

	* exp_util.adb (Remove_Side_Effects): An access value which designates
	a volatile object of a nonvolatile type is prohibited.
	Do not call Make_Reference to construct a reference to such an object.

From-SVN: r162905
This commit is contained in:
Arnaud Charlet 2010-08-05 11:14:19 +02:00
parent c97c0163bc
commit 676e842077
6 changed files with 54 additions and 49 deletions

View File

@ -1,3 +1,14 @@
2010-08-05 Thomas Quinot <quinot@adacore.com>
* sem_ch6.adb, gnat1drv.adb, exp_ch6.adb, sem_eval.adb: Minor
reformatting.
2010-08-05 Steve Baird <baird@adacore.com>
* exp_util.adb (Remove_Side_Effects): An access value which designates
a volatile object of a nonvolatile type is prohibited.
Do not call Make_Reference to construct a reference to such an object.
2010-08-05 Robert Dewar <dewar@adacore.com> 2010-08-05 Robert Dewar <dewar@adacore.com>
* a-suezse.adb, a-suezse.ads, a-suezen.adb, a-suezen.ads: Removed. * a-suezse.adb, a-suezse.ads, a-suezen.adb, a-suezen.ads: Removed.

View File

@ -3713,9 +3713,7 @@ package body Exp_Ch6 is
Set_Name (N, New_Occurrence_Of (Orig_Bod, Loc)); Set_Name (N, New_Occurrence_Of (Orig_Bod, Loc));
if Present (Alias (Orig_Bod)) if Present (Alias (Orig_Bod)) or else Is_Inlined (Orig_Bod) then
or else Is_Inlined (Orig_Bod)
then
Expand_Call (N); Expand_Call (N);
end if; end if;

View File

@ -4799,12 +4799,17 @@ package body Exp_Util is
end if; end if;
-- For expressions that denote objects, we can use a renaming scheme. -- For expressions that denote objects, we can use a renaming scheme.
-- We skip using this if we have a volatile reference and we do not -- This is needed for correctness in the case of a volatile object
-- have Name_Req set true (see comments above for Side_Effect_Free). -- of a non-volatile type because the Make_Reference call of the
-- "default" approach would generate an illegal access value (an access
-- value cannot designate such an object - see Analyze_Reference).
-- We skip using this scheme if we have an object of a volatile type
-- and we do not have Name_Req set true (see comments above for
-- Side_Effect_Free).
elsif Is_Object_Reference (Exp) elsif Is_Object_Reference (Exp)
and then Nkind (Exp) /= N_Function_Call and then Nkind (Exp) /= N_Function_Call
and then (Name_Req or else not Is_Volatile_Reference (Exp)) and then (Name_Req or else not Treat_As_Volatile (Exp_Type))
then then
Def_Id := Make_Temporary (Loc, 'R', Exp); Def_Id := Make_Temporary (Loc, 'R', Exp);

View File

@ -441,20 +441,19 @@ procedure Gnat1drv is
Fname := Get_File_Name (Sname, Subunit => False); Fname := Get_File_Name (Sname, Subunit => False);
Src_Ind := Load_Source_File (Fname); Src_Ind := Load_Source_File (Fname);
-- Case where body is present and it is not a subunit. Exclude -- Case where body is present and it is not a subunit. Exclude the
-- the subunit case, because it has nothing to do with the -- subunit case, because it has nothing to do with the package we are
-- package we are compiling. It is illegal for a child unit and a -- compiling. It is illegal for a child unit and a subunit with the
-- subunit with the same expanded name (RM 10.2(9)) to appear -- same expanded name (RM 10.2(9)) to appear together in a partition,
-- together in a partition, but there is nothing to stop a -- but there is nothing to stop a compilation environment from having
-- compilation environment from having both, and the test here -- both, and the test here simply allows that. If there is an attempt
-- simply allows that. If there is an attempt to include both in -- to include both in a partition, this is diagnosed at bind time. In
-- a partition, this is diagnosed at bind time. In Ada 83 mode -- Ada 83 mode this is not a warning case.
-- this is not a warning case.
-- Note: if weird file names are being used, we can have -- Note: if weird file names are being used, we can have a situation
-- situation where the file name that supposedly contains body, -- where the file name that supposedly contains body in fact contains
-- in fact contains a spec, or we can't tell what it contains. -- a spec, or we can't tell what it contains. Skip the error message
-- Skip the error message in these cases. -- in these cases.
-- Also ignore body that is nothing but pragma No_Body; (that's the -- Also ignore body that is nothing but pragma No_Body; (that's the
-- whole point of this pragma, to be used this way and to cause the -- whole point of this pragma, to be used this way and to cause the
@ -635,8 +634,7 @@ begin
if S = No_Source_File then if S = No_Source_File then
Write_Line Write_Line
("fatal error, run-time library not installed correctly"); ("fatal error, run-time library not installed correctly");
Write_Line Write_Line ("cannot locate file system.ads");
("cannot locate file system.ads");
raise Unrecoverable_Error; raise Unrecoverable_Error;
-- Remember source index of system.ads (which was read successfully) -- Remember source index of system.ads (which was read successfully)
@ -778,18 +776,14 @@ begin
-- subunits. Note that we always generate code for all generic units (a -- subunits. Note that we always generate code for all generic units (a
-- change from some previous versions of GNAT). -- change from some previous versions of GNAT).
elsif Main_Kind = N_Subprogram_Body elsif Main_Kind = N_Subprogram_Body and then not Subunits_Missing then
and then not Subunits_Missing
then
Back_End_Mode := Generate_Object; Back_End_Mode := Generate_Object;
-- We can generate code for a package body unless there are subunits -- We can generate code for a package body unless there are subunits
-- missing (note that we always generate code for generic units, which -- missing (note that we always generate code for generic units, which
-- is a change from some earlier versions of GNAT). -- is a change from some earlier versions of GNAT).
elsif Main_Kind = N_Package_Body elsif Main_Kind = N_Package_Body and then not Subunits_Missing then
and then not Subunits_Missing
then
Back_End_Mode := Generate_Object; Back_End_Mode := Generate_Object;
-- We can generate code for a package declaration or a subprogram -- We can generate code for a package declaration or a subprogram
@ -903,8 +897,8 @@ begin
Exit_Program (E_No_Code); Exit_Program (E_No_Code);
end if; end if;
-- In -gnatc mode, we only do annotation if -gnatt or -gnatR is also -- In -gnatc mode, we only do annotation if -gnatt or -gnatR is also set
-- set as indicated by Back_Annotate_Rep_Info being set to True. -- as indicated by Back_Annotate_Rep_Info being set to True.
-- We don't call for annotations on a subunit, because to process those -- We don't call for annotations on a subunit, because to process those
-- the back-end requires that the parent(s) be properly compiled. -- the back-end requires that the parent(s) be properly compiled.
@ -912,8 +906,8 @@ begin
-- Annotation is suppressed for targets where front-end layout is -- Annotation is suppressed for targets where front-end layout is
-- enabled, because the front end determines representations. -- enabled, because the front end determines representations.
-- Annotation is also suppressed in the case of compiling for -- Annotation is also suppressed in the case of compiling for a VM,
-- a VM, since representations are largely symbolic there. -- since representations are largely symbolic there.
if Back_End_Mode = Declarations_Only if Back_End_Mode = Declarations_Only
and then (not (Back_Annotate_Rep_Info or Generate_SCIL) and then (not (Back_Annotate_Rep_Info or Generate_SCIL)
@ -1011,11 +1005,10 @@ begin
Write_ALI (Object => (Back_End_Mode = Generate_Object)); Write_ALI (Object => (Back_End_Mode = Generate_Object));
-- Generate the ASIS tree after writing the ALI file, since in ASIS -- Generate ASIS tree after writing the ALI file, since in ASIS mode,
-- mode, Write_ALI may in fact result in further tree decoration from -- Write_ALI may in fact result in further tree decoration from the
-- the original tree file. Note that we dump the tree just before -- original tree file. Note that we dump the tree just before generating
-- generating it, so that the dump will exactly reflect what is written -- it, so that the dump will exactly reflect what is written out.
-- out.
Treepr.Tree_Dump; Treepr.Tree_Dump;
Tree_Gen; Tree_Gen;

View File

@ -3472,10 +3472,9 @@ package body Sem_Ch6 is
procedure Cannot_Inline (Msg : String; N : Node_Id; Subp : Entity_Id) is procedure Cannot_Inline (Msg : String; N : Node_Id; Subp : Entity_Id) is
begin begin
-- Do not emit warning if this is a predefined unit which is not -- Do not emit warning if this is a predefined unit which is not the
-- the main unit. With validity checks enabled, some predefined -- main unit. With validity checks enabled, some predefined subprograms
-- subprograms may contain nested subprograms and become ineligible -- may contain nested subprograms and become ineligible for inlining.
-- for inlining.
if Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (Subp))) if Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (Subp)))
and then not In_Extended_Main_Source_Unit (Subp) and then not In_Extended_Main_Source_Unit (Subp)
@ -4490,8 +4489,8 @@ package body Sem_Ch6 is
end; end;
end if; end if;
-- If there is an overridden subprogram, then check that there is not -- If there is an overridden subprogram, then check that there is no
-- a "not overriding" indicator, and mark the subprogram as overriding. -- "not overriding" indicator, and mark the subprogram as overriding.
-- This is not done if the overridden subprogram is marked as hidden, -- This is not done if the overridden subprogram is marked as hidden,
-- which can occur for the case of inherited controlled operations -- which can occur for the case of inherited controlled operations
-- (see Derive_Subprogram), unless the inherited subprogram's parent -- (see Derive_Subprogram), unless the inherited subprogram's parent
@ -4539,7 +4538,7 @@ package body Sem_Ch6 is
-- If Subp is an operator, it may override a predefined operation, if -- If Subp is an operator, it may override a predefined operation, if
-- it is defined in the same scope as the type to which it applies. -- it is defined in the same scope as the type to which it applies.
-- In that case overridden_subp is empty because of our implicit -- In that case Overridden_Subp is empty because of our implicit
-- representation for predefined operators. We have to check whether the -- representation for predefined operators. We have to check whether the
-- signature of Subp matches that of a predefined operator. Note that -- signature of Subp matches that of a predefined operator. Note that
-- first argument provides the name of the operator, and the second -- first argument provides the name of the operator, and the second
@ -4551,7 +4550,7 @@ package body Sem_Ch6 is
elsif Nkind (Subp) = N_Defining_Operator_Symbol then elsif Nkind (Subp) = N_Defining_Operator_Symbol then
declare declare
Typ : constant Entity_Id := Typ : constant Entity_Id :=
Base_Type (Etype (First_Formal (Subp))); Base_Type (Etype (First_Formal (Subp)));
Can_Override : constant Boolean := Can_Override : constant Boolean :=
Operator_Matches_Spec (Subp, Subp) Operator_Matches_Spec (Subp, Subp)
@ -4573,8 +4572,7 @@ package body Sem_Ch6 is
elsif Can_Override then elsif Can_Override then
Error_Msg_NE Error_Msg_NE
("subprogram & overrides predefined operator ", ("subprogram& overrides predefined operator ", Spec, Subp);
Spec, Subp);
end if; end if;
elsif Must_Override (Spec) then elsif Must_Override (Spec) then

View File

@ -3865,13 +3865,13 @@ package body Sem_Eval is
if No (Typ1) then if No (Typ1) then
Typ1 := E; Typ1 := E;
-- Before emitting an error, check for the presence of a -- Before emitting an error, check for the presence of a
-- mixed-mode operation that specifies a fixed point type. -- mixed-mode operation that specifies a fixed point type.
elsif Is_Relational elsif Is_Relational
and then and then
(Is_Mixed_Mode_Operand (Left_Opnd (N)) (Is_Mixed_Mode_Operand (Left_Opnd (N))
or else Is_Mixed_Mode_Operand (Right_Opnd (N))) or else Is_Mixed_Mode_Operand (Right_Opnd (N)))
and then Is_Fixed_Point_Type (E) /= Is_Fixed_Point_Type (Typ1) and then Is_Fixed_Point_Type (E) /= Is_Fixed_Point_Type (Typ1)
then then