Skip to content

R
riscv-gcc-1
Commit 533369aa by Arnaud Charlet
Options

[multiple changes] 

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* sem_ch6.adb: Minor reformatting.

2013-04-11  Yannick Moy  <moy@adacore.com>

	* ali-util.adb (Read_Withed_ALIs): Do not consider it an error to
	read ALI files with No_Object=True in Alfa mode.
	* gnat1drv.adb: Set appropriately Back_End_Mode in Alfa mode, whether
	this is during frame condition generation of translation to Why.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb: Minor code reorganization
	* types.ads: Minor reformatting.

From-SVN: r197759
parent 3a8e3f63
Showing with 100 additions and 100 deletions
gcc/ada/ChangeLog
2013-04-11 Robert Dewar <dewar@adacore.com>
* sem_ch6.adb: Minor reformatting.
2013-04-11 Yannick Moy <moy@adacore.com>
* ali-util.adb (Read_Withed_ALIs): Do not consider it an error to
read ALI files with No_Object=True in Alfa mode.
* gnat1drv.adb: Set appropriately Back_End_Mode in Alfa mode, whether
this is during frame condition generation of translation to Why.
2013-04-11 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb: Minor code reorganization
* types.ads: Minor reformatting.
2013-04-11 Johannes Kanig <kanig@adacore.com> 2013-04-11 Johannes Kanig <kanig@adacore.com>
* opt.ads New global boolean Frame_Condition_Mode to avoid * opt.ads New global boolean Frame_Condition_Mode to avoid
......
gcc/ada/ali-util.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -272,7 +272,11 @@ package body ALI.Util is ...@@ -272,7 +272,11 @@ package body ALI.Util is
Error_Msg ("{ had errors, must be fixed, and recompiled"); Error_Msg ("{ had errors, must be fixed, and recompiled");
Set_Name_Table_Info (Afile, Int (No_Unit_Id)); Set_Name_Table_Info (Afile, Int (No_Unit_Id));
-- In formal verification mode, object files are never
-- generated, so No_Object=True is not considered an error.
elsif ALIs.Table (Idread).No_Object elsif ALIs.Table (Idread).No_Object
and then not Alfa_Mode
and then not Ignore_Errors and then not Ignore_Errors
then then
Error_Msg_File_1 := Withs.Table (W).Sfile; Error_Msg_File_1 := Withs.Table (W).Sfile;
......
gcc/ada/exp_ch4.adb
...@@ -355,6 +355,7 @@ package body Exp_Ch4 is ...@@ -355,6 +355,7 @@ package body Exp_Ch4 is
if Nkind (Op1) = N_Op_Not then if Nkind (Op1) = N_Op_Not then
Arg1 := Right_Opnd (Op1); Arg1 := Right_Opnd (Op1);
Arg2 := Right_Opnd (Op2); Arg2 := Right_Opnd (Op2);
if Kind = N_Op_And then if Kind = N_Op_And then
Proc_Name := RTE (RE_Vector_Nor); Proc_Name := RTE (RE_Vector_Nor);
elsif Kind = N_Op_Or then elsif Kind = N_Op_Or then
...@@ -601,9 +602,8 @@ package body Exp_Ch4 is ...@@ -601,9 +602,8 @@ package body Exp_Ch4 is
Dtyp := Available_View (Designated_Type (PtrT)); Dtyp := Available_View (Designated_Type (PtrT));
Etyp := Etype (Expression (Orig_Node)); Etyp := Etype (Expression (Orig_Node));
if Is_Class_Wide_Type (Dtyp) if Is_Class_Wide_Type (Dtyp) and then Is_Interface (Dtyp) then
and then Is_Interface (Dtyp)
then
-- If the type of the allocator expression is not an interface type -- If the type of the allocator expression is not an interface type
-- we can generate code to reference the record component containing -- we can generate code to reference the record component containing
-- the pointer to the secondary dispatch table. -- the pointer to the secondary dispatch table.
...@@ -641,7 +641,7 @@ package body Exp_Ch4 is ...@@ -641,7 +641,7 @@ package body Exp_Ch4 is
-- generate a run-time call to displace "this" to reference the -- generate a run-time call to displace "this" to reference the
-- component containing the pointer to the secondary dispatch table -- component containing the pointer to the secondary dispatch table
-- or else raise Constraint_Error if the actual object does not -- or else raise Constraint_Error if the actual object does not
-- implement the target interface. This case corresponds with the -- implement the target interface. This case corresponds to the
-- following example: -- following example:
-- function Op (Obj : Iface_1'Class) return access Iface_2'Class is -- function Op (Obj : Iface_1'Class) return access Iface_2'Class is
...@@ -1204,9 +1204,8 @@ package body Exp_Ch4 is ...@@ -1204,9 +1204,8 @@ package body Exp_Ch4 is
Insert_Action (N, Tag_Assign); Insert_Action (N, Tag_Assign);
end if; end if;
if Needs_Finalization (DesigT) if Needs_Finalization (DesigT) and then Needs_Finalization (T) then
and then Needs_Finalization (T)
then
-- Generate an Adjust call if the object will be moved. In Ada -- Generate an Adjust call if the object will be moved. In Ada
-- 2005, the object may be inherently limited, in which case -- 2005, the object may be inherently limited, in which case
-- there is no Adjust procedure, and the object is built in -- there is no Adjust procedure, and the object is built in
...@@ -1220,17 +1219,17 @@ package body Exp_Ch4 is ...@@ -1220,17 +1219,17 @@ package body Exp_Ch4 is
and then not Is_Immutably_Limited_Type (T) and then not Is_Immutably_Limited_Type (T)
then then
Insert_Action (N, Insert_Action (N,
Make_Adjust_Call (
Obj_Ref =>
-- An unchecked conversion is needed in the classwide -- An unchecked conversion is needed in the classwide case
-- case because the designated type can be an ancestor -- because the designated type can be an ancestor of the
-- of the subtype mark of the allocator. -- subtype mark of the allocator.
Unchecked_Convert_To (T, Make_Adjust_Call
Make_Explicit_Dereference (Loc, (Obj_Ref =>
Prefix => New_Reference_To (Temp, Loc))), Unchecked_Convert_To (T,
Typ => T)); Make_Explicit_Dereference (Loc,
Prefix => New_Reference_To (Temp, Loc))),
Typ => T));
end if; end if;
-- Generate: -- Generate:
...@@ -1315,9 +1314,7 @@ package body Exp_Ch4 is ...@@ -1315,9 +1314,7 @@ package body Exp_Ch4 is
Rewrite (N, New_Reference_To (Temp, Loc)); Rewrite (N, New_Reference_To (Temp, Loc));
Analyze_And_Resolve (N, PtrT); Analyze_And_Resolve (N, PtrT);
elsif Is_Access_Type (T) elsif Is_Access_Type (T) and then Can_Never_Be_Null (T) then
and then Can_Never_Be_Null (T)
then
Install_Null_Excluding_Check (Exp); Install_Null_Excluding_Check (Exp);
elsif Is_Access_Type (DesigT) elsif Is_Access_Type (DesigT)
...@@ -2701,8 +2698,8 @@ package body Exp_Ch4 is ...@@ -2701,8 +2698,8 @@ package body Exp_Ch4 is
-- discriminant(s). -- discriminant(s).
if Nkind (Lhs) = N_Selected_Component if Nkind (Lhs) = N_Selected_Component
and then Has_Per_Object_Constraint ( and then Has_Per_Object_Constraint
Entity (Selector_Name (Lhs))) (Entity (Selector_Name (Lhs)))
then then
Lhs_Discr_Val := Lhs_Discr_Val :=
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
...@@ -3336,9 +3333,7 @@ package body Exp_Ch4 is ...@@ -3336,9 +3333,7 @@ package body Exp_Ch4 is
-- converted to an array, and the easiest way of doing that is to go -- converted to an array, and the easiest way of doing that is to go
-- through the normal general circuit. -- through the normal general circuit.
if NN = 1 if NN = 1 and then Base_Type (Etype (Operands (1))) /= Ctyp then
and then Base_Type (Etype (Operands (1))) /= Ctyp
then
Result := Operands (1); Result := Operands (1);
goto Done; goto Done;
end if; end if;
...@@ -4214,8 +4209,7 @@ package body Exp_Ch4 is ...@@ -4214,8 +4209,7 @@ package body Exp_Ch4 is
-- Expand_Allocator_Expression inherit the proper type attributes. -- Expand_Allocator_Expression inherit the proper type attributes.
if (Ekind (PtrT) = E_Anonymous_Access_Type if (Ekind (PtrT) = E_Anonymous_Access_Type
or else or else (Is_Itype (PtrT) and then No (Finalization_Master (PtrT))))
(Is_Itype (PtrT) and then No (Finalization_Master (PtrT))))
and then Needs_Finalization (Dtyp) and then Needs_Finalization (Dtyp)
then then
-- Detect the allocation of an anonymous controlled object where the -- Detect the allocation of an anonymous controlled object where the
...@@ -4797,9 +4791,7 @@ package body Exp_Ch4 is ...@@ -4797,9 +4791,7 @@ package body Exp_Ch4 is
-- * CodePeer mode - TSS primitive Finalize_Address is -- * CodePeer mode - TSS primitive Finalize_Address is
-- not created in this mode. -- not created in this mode.
elsif not Alfa_Mode elsif not (Alfa_Mode or CodePeer_Mode) then
and then not CodePeer_Mode
then
Insert_Action (N, Insert_Action (N,
Make_Set_Finalize_Address_Call Make_Set_Finalize_Address_Call
(Loc => Loc, (Loc => Loc,
...@@ -4819,9 +4811,7 @@ package body Exp_Ch4 is ...@@ -4819,9 +4811,7 @@ package body Exp_Ch4 is
-- object that has been rewritten as a reference, we displace "this" -- object that has been rewritten as a reference, we displace "this"
-- to reference properly its secondary dispatch table. -- to reference properly its secondary dispatch table.
if Nkind (N) = N_Identifier if Nkind (N) = N_Identifier and then Is_Interface (Dtyp) then
and then Is_Interface (Dtyp)
then
Displace_Allocator_Pointer (N); Displace_Allocator_Pointer (N);
end if; end if;
...@@ -5101,10 +5091,10 @@ package body Exp_Ch4 is ...@@ -5101,10 +5091,10 @@ package body Exp_Ch4 is
while Present (Par) loop while Present (Par) loop
if Is_List_Member (Par) if Is_List_Member (Par)
and then and then
not Nkind_In (Par, N_Component_Association, not Nkind_In (Par, N_Component_Association,
N_Discriminant_Association, N_Discriminant_Association,
N_Parameter_Association, N_Parameter_Association,
N_Pragma_Argument_Association) N_Pragma_Argument_Association)
then then
return Par; return Par;
...@@ -5667,9 +5657,7 @@ package body Exp_Ch4 is ...@@ -5667,9 +5657,7 @@ package body Exp_Ch4 is
-- change it to the SLOC of the expression which, after expansion, will -- change it to the SLOC of the expression which, after expansion, will
-- correspond to what is being evaluated. -- correspond to what is being evaluated.
if Present (Parent (N)) if Present (Parent (N)) and then Nkind (Parent (N)) = N_If_Statement then
and then Nkind (Parent (N)) = N_If_Statement
then
Set_Sloc (New_If, Sloc (Parent (N))); Set_Sloc (New_If, Sloc (Parent (N)));
Set_Sloc (Parent (N), Loc); Set_Sloc (Parent (N), Loc);
end if; end if;
...@@ -6531,7 +6519,7 @@ package body Exp_Ch4 is ...@@ -6531,7 +6519,7 @@ package body Exp_Ch4 is
return; return;
elsif Nkind_In (Parnt, N_Indexed_Component, N_Selected_Component) elsif Nkind_In (Parnt, N_Indexed_Component, N_Selected_Component)
and then Prefix (Parnt) = Child and then Prefix (Parnt) = Child
then then
null; null;
...@@ -6643,8 +6631,8 @@ package body Exp_Ch4 is ...@@ -6643,8 +6631,8 @@ package body Exp_Ch4 is
-- Deal with software overflow checking -- Deal with software overflow checking
if not Backend_Overflow_Checks_On_Target if not Backend_Overflow_Checks_On_Target
and then Is_Signed_Integer_Type (Etype (N)) and then Is_Signed_Integer_Type (Etype (N))
and then Do_Overflow_Check (N) and then Do_Overflow_Check (N)
then then
-- The only case to worry about is when the argument is equal to the -- The only case to worry about is when the argument is equal to the
-- largest negative number, so what we do is to insert the check: -- largest negative number, so what we do is to insert the check:
...@@ -6881,9 +6869,8 @@ package body Exp_Ch4 is ...@@ -6881,9 +6869,8 @@ package body Exp_Ch4 is
-- We cannot do this transformation in configurable run time mode if we -- We cannot do this transformation in configurable run time mode if we
-- have 64-bit integers and long shifts are not available. -- have 64-bit integers and long shifts are not available.
and then and then (Esize (Ltyp) <= 32
(Esize (Ltyp) <= 32 or else Support_Long_Shifts_On_Target)
or else Support_Long_Shifts_On_Target)
then then
Rewrite (N, Rewrite (N,
Make_Op_Shift_Right (Loc, Make_Op_Shift_Right (Loc,
...@@ -6934,17 +6921,13 @@ package body Exp_Ch4 is ...@@ -6934,17 +6921,13 @@ package body Exp_Ch4 is
-- Mixed-mode operations can appear in a non-static universal context, -- Mixed-mode operations can appear in a non-static universal context,
-- in which case the integer argument must be converted explicitly. -- in which case the integer argument must be converted explicitly.
elsif Typ = Universal_Real elsif Typ = Universal_Real and then Is_Integer_Type (Rtyp) then
and then Is_Integer_Type (Rtyp)
then
Rewrite (Ropnd, Rewrite (Ropnd,
Convert_To (Universal_Real, Relocate_Node (Ropnd))); Convert_To (Universal_Real, Relocate_Node (Ropnd)));
Analyze_And_Resolve (Ropnd, Universal_Real); Analyze_And_Resolve (Ropnd, Universal_Real);
elsif Typ = Universal_Real elsif Typ = Universal_Real and then Is_Integer_Type (Ltyp) then
and then Is_Integer_Type (Ltyp)
then
Rewrite (Lopnd, Rewrite (Lopnd,
Convert_To (Universal_Real, Relocate_Node (Lopnd))); Convert_To (Universal_Real, Relocate_Node (Lopnd)));
...@@ -7077,8 +7060,8 @@ package body Exp_Ch4 is ...@@ -7077,8 +7060,8 @@ package body Exp_Ch4 is
-- Lhs of equality -- Lhs of equality
if Nkind (Lhs) = N_Selected_Component if Nkind (Lhs) = N_Selected_Component
and then Has_Per_Object_Constraint and then
(Entity (Selector_Name (Lhs))) Has_Per_Object_Constraint (Entity (Selector_Name (Lhs)))
then then
-- Enclosing record is an Unchecked_Union, use formal A -- Enclosing record is an Unchecked_Union, use formal A
...@@ -7118,8 +7101,8 @@ package body Exp_Ch4 is ...@@ -7118,8 +7101,8 @@ package body Exp_Ch4 is
-- Rhs of equality -- Rhs of equality
if Nkind (Rhs) = N_Selected_Component if Nkind (Rhs) = N_Selected_Component
and then Has_Per_Object_Constraint and then
(Entity (Selector_Name (Rhs))) Has_Per_Object_Constraint (Entity (Selector_Name (Rhs)))
then then
if Is_Unchecked_Union if Is_Unchecked_Union
(Scope (Entity (Selector_Name (Rhs)))) (Scope (Entity (Selector_Name (Rhs))))
...@@ -7764,10 +7747,10 @@ package body Exp_Ch4 is ...@@ -7764,10 +7747,10 @@ package body Exp_Ch4 is
and then not Do_Overflow_Check (P)) and then not Do_Overflow_Check (P))
or else or else
(Nkind (P) = N_Op_Divide (Nkind (P) = N_Op_Divide
and then Is_Integer_Type (Etype (L)) and then Is_Integer_Type (Etype (L))
and then Is_Unsigned_Type (Etype (L)) and then Is_Unsigned_Type (Etype (L))
and then R = N and then R = N
and then not Do_Overflow_Check (P)) and then not Do_Overflow_Check (P))
then then
Set_Is_Power_Of_2_For_Shift (N); Set_Is_Power_Of_2_For_Shift (N);
return; return;
...@@ -8209,10 +8192,7 @@ package body Exp_Ch4 is ...@@ -8209,10 +8192,7 @@ package body Exp_Ch4 is
-- (the operation now corresponds to the hardware remainder), and it -- (the operation now corresponds to the hardware remainder), and it
-- does not seem likely that it could be harmful. -- does not seem likely that it could be harmful.
if LOK and then Llo >= 0 if LOK and then Llo >= 0 and then ROK and then Rlo >= 0 then
and then
ROK and then Rlo >= 0
then
Rewrite (N, Rewrite (N,
Make_Op_Rem (Sloc (N), Make_Op_Rem (Sloc (N),
Left_Opnd => Left_Opnd (N), Left_Opnd => Left_Opnd (N),
...@@ -8312,12 +8292,9 @@ package body Exp_Ch4 is ...@@ -8312,12 +8292,9 @@ package body Exp_Ch4 is
Rop : constant Node_Id := Right_Opnd (N); Rop : constant Node_Id := Right_Opnd (N);
Lp2 : constant Boolean := Lp2 : constant Boolean :=
Nkind (Lop) = N_Op_Expon Nkind (Lop) = N_Op_Expon and then Is_Power_Of_2_For_Shift (Lop);
and then Is_Power_Of_2_For_Shift (Lop);
Rp2 : constant Boolean := Rp2 : constant Boolean :=
Nkind (Rop) = N_Op_Expon Nkind (Rop) = N_Op_Expon and then Is_Power_Of_2_For_Shift (Rop);
and then Is_Power_Of_2_For_Shift (Rop);
Ltyp : constant Entity_Id := Etype (Lop); Ltyp : constant Entity_Id := Etype (Lop);
Rtyp : constant Entity_Id := Etype (Rop); Rtyp : constant Entity_Id := Etype (Rop);
...@@ -8476,18 +8453,12 @@ package body Exp_Ch4 is ...@@ -8476,18 +8453,12 @@ package body Exp_Ch4 is
-- Mixed-mode operations can appear in a non-static universal context, -- Mixed-mode operations can appear in a non-static universal context,
-- in which case the integer argument must be converted explicitly. -- in which case the integer argument must be converted explicitly.
elsif Typ = Universal_Real elsif Typ = Universal_Real and then Is_Integer_Type (Rtyp) then
and then Is_Integer_Type (Rtyp)
then
Rewrite (Rop, Convert_To (Universal_Real, Relocate_Node (Rop))); Rewrite (Rop, Convert_To (Universal_Real, Relocate_Node (Rop)));
Analyze_And_Resolve (Rop, Universal_Real); Analyze_And_Resolve (Rop, Universal_Real);
elsif Typ = Universal_Real elsif Typ = Universal_Real and then Is_Integer_Type (Ltyp) then
and then Is_Integer_Type (Ltyp)
then
Rewrite (Lop, Convert_To (Universal_Real, Relocate_Node (Lop))); Rewrite (Lop, Convert_To (Universal_Real, Relocate_Node (Lop)));
Analyze_And_Resolve (Lop, Universal_Real); Analyze_And_Resolve (Lop, Universal_Real);
-- Non-fixed point cases, check software overflow checking required -- Non-fixed point cases, check software overflow checking required
...@@ -9105,7 +9076,7 @@ package body Exp_Ch4 is ...@@ -9105,7 +9076,7 @@ package body Exp_Ch4 is
begin begin
-- Do validity check if validity checking operands -- Do validity check if validity checking operands
if Validity_Checks_On and then Validity_Check_Operands then if Validity_Checks_On and Validity_Check_Operands then
Ensure_Valid (Operand); Ensure_Valid (Operand);
end if; end if;
...@@ -9383,7 +9354,7 @@ package body Exp_Ch4 is ...@@ -9383,7 +9354,7 @@ package body Exp_Ch4 is
-- contexts where we do not want the value anyway. -- contexts where we do not want the value anyway.
elsif (Nkind (Par) = N_Attribute_Reference elsif (Nkind (Par) = N_Attribute_Reference
and then Prefix (Par) = N) and then Prefix (Par) = N)
or else Is_Renamed_Object (N) or else Is_Renamed_Object (N)
then then
null; null;
...@@ -9452,11 +9423,11 @@ package body Exp_Ch4 is ...@@ -9452,11 +9423,11 @@ package body Exp_Ch4 is
-- fact incorrect. -- fact incorrect.
elsif Is_Entity_Name (Dval) elsif Is_Entity_Name (Dval)
and then Nkind (Parent (Entity (Dval))) =
N_Object_Declaration
and then Present (Expression (Parent (Entity (Dval))))
and then and then
not Is_Static_Expression Nkind (Parent (Entity (Dval))) = N_Object_Declaration
and then Present (Expression (Parent (Entity (Dval))))
and then not
Is_Static_Expression
(Expression (Parent (Entity (Dval)))) (Expression (Parent (Entity (Dval))))
then then
exit Discr_Loop; exit Discr_Loop;
...@@ -9725,7 +9696,7 @@ package body Exp_Ch4 is ...@@ -9725,7 +9696,7 @@ package body Exp_Ch4 is
elsif Nkind (Parent (N)) = N_Assignment_Statement elsif Nkind (Parent (N)) = N_Assignment_Statement
or else (Nkind (Parent (Parent (N))) = N_Assignment_Statement or else (Nkind (Parent (Parent (N))) = N_Assignment_Statement
and then Parent (N) = Name (Parent (Parent (N)))) and then Parent (N) = Name (Parent (Parent (N))))
then then
return; return;
...@@ -9958,7 +9929,7 @@ package body Exp_Ch4 is ...@@ -9958,7 +9929,7 @@ package body Exp_Ch4 is
-- range as the base type (or is the base type). -- range as the base type (or is the base type).
if Range_Checks_Suppressed (Target_Type) if Range_Checks_Suppressed (Target_Type)
or else (Lo = Type_Low_Bound (Btyp) or else (Lo = Type_Low_Bound (Btyp)
and then and then
Hi = Type_High_Bound (Btyp)) Hi = Type_High_Bound (Btyp))
then then
...@@ -10222,9 +10193,7 @@ package body Exp_Ch4 is ...@@ -10222,9 +10193,7 @@ package body Exp_Ch4 is
-- Do validity check if validity checking operands -- Do validity check if validity checking operands
if Validity_Checks_On if Validity_Checks_On and Validity_Check_Operands then
and then Validity_Check_Operands
then
Ensure_Valid (Operand); Ensure_Valid (Operand);
end if; end if;
...@@ -12775,10 +12744,10 @@ package body Exp_Ch4 is ...@@ -12775,10 +12744,10 @@ package body Exp_Ch4 is
if not Is_Class_Wide_Type (Left_Type) if not Is_Class_Wide_Type (Left_Type)
and then (Is_Ancestor (Etype (Right_Type), Left_Type, and then (Is_Ancestor (Etype (Right_Type), Left_Type,
Use_Full_View => True) Use_Full_View => True)
or else (Is_Interface (Etype (Right_Type)) or else (Is_Interface (Etype (Right_Type))
and then Interface_Present_In_Ancestor and then Interface_Present_In_Ancestor
(Typ => Left_Type, (Typ => Left_Type,
Iface => Etype (Right_Type)))) Iface => Etype (Right_Type))))
then then
Result := New_Reference_To (Standard_True, Loc); Result := New_Reference_To (Standard_True, Loc);
return; return;
......
gcc/ada/gnat1drv.adb
...@@ -1043,13 +1043,24 @@ begin ...@@ -1043,13 +1043,24 @@ begin
elsif Main_Kind in N_Generic_Renaming_Declaration then elsif Main_Kind in N_Generic_Renaming_Declaration then
Back_End_Mode := Generate_Object; Back_End_Mode := Generate_Object;
-- It is not an error to analyze (in CodePeer mode or Alfa mode with -- It is not an error to analyze in CodePeer mode a spec which requires
-- generation of Why) a spec which requires a body, when the body is -- a body, in order to generate SCIL for this spec.
-- not available.
elsif CodePeer_Mode or (Alfa_Mode and not Frame_Condition_Mode) then elsif CodePeer_Mode then
Back_End_Mode := Generate_Object; Back_End_Mode := Generate_Object;
-- It is not an error to analyze in Alfa mode a spec which requires a
-- body, when the body is not available. During frame condition
-- generation, the corresponding ALI file is generated. During
-- translation to Why, Why code is generated for the spec.
elsif Alfa_Mode then
if Frame_Condition_Mode then
Back_End_Mode := Declarations_Only;
else
Back_End_Mode := Generate_Object;
end if;
-- In all other cases (specs which have bodies, generics, and bodies -- In all other cases (specs which have bodies, generics, and bodies
-- where subunits are missing), we cannot generate code and we generate -- where subunits are missing), we cannot generate code and we generate
-- a warning message. Note that generic instantiations are gone at this -- a warning message. Note that generic instantiations are gone at this
......
gcc/ada/sem_ch6.adb
...@@ -449,7 +449,7 @@ package body Sem_Ch6 is ...@@ -449,7 +449,7 @@ package body Sem_Ch6 is
-- prevent visibility issues later with operators in instances. -- prevent visibility issues later with operators in instances.
Preanalyze_Spec_Expression Preanalyze_Spec_Expression
(New_Copy_Tree (Expression (Ret)), Etype (Id)); (New_Copy_Tree (Expression (Ret)), Etype (Id));
End_Scope; End_Scope;
end; end;
end if; end if;
......
gcc/ada/types.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -102,8 +102,8 @@ package Types is ...@@ -102,8 +102,8 @@ package Types is
-- Graphic characters, as defined in ARM -- Graphic characters, as defined in ARM
subtype Line_Terminator is Character range ASCII.LF .. ASCII.CR; subtype Line_Terminator is Character range ASCII.LF .. ASCII.CR;
-- Line terminator characters (LF, VT, FF, CR). For further details, -- Line terminator characters (LF, VT, FF, CR). For further details, see
-- see the extensive discussion of line termination in the Sinput spec. -- the extensive discussion of line termination in the Sinput spec.
subtype Upper_Half_Character is subtype Upper_Half_Character is
Character range Character'Val (16#80#) .. Character'Val (16#FF#); Character range Character'Val (16#80#) .. Character'Val (16#FF#);
......
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