+2014-10-23 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_eval.adb (Check_Non_Static_Context): Do not set
+ Is_Machine_Number on a literal of a fixed-point type.
+
+2014-10-23 Robert Dewar <dewar@adacore.com>
+
+ * mlib-prj.adb, sem_ch4.adb, exp_ch3.adb: Minor reformatting.
+
+2014-10-23 Pierre-Marie Derodat <derodat@adacore.com>
+
+ * exp_dbug.ads: Update ___XA parallel type specification.
+
+2014-10-23 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch3.adb (Copy_Array_Subtype_Attributes): Inherit the rep
+ chain of the source type.
+ * sem_ch13.adb (Analyze_Aspect_Specifications): Minor
+ reformatting of an error message.
+ * sem_util.adb (Inherit_Rep_Item_Chain): Do not inherit a rep
+ chain that has been inherited already.
+
2014-10-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): Simplify analysis
and then Static_Dispatch_Tables
and then Is_Library_Level_Entity (Def_Id)
and then Is_Library_Level_Tagged_Type (Base_Typ)
- and then (Ekind (Base_Typ) = E_Record_Type
- or else Ekind (Base_Typ) = E_Protected_Type
- or else Ekind (Base_Typ) = E_Task_Type)
+ and then Ekind_In (Base_Typ, E_Record_Type,
+ E_Protected_Type,
+ E_Task_Type)
and then not Has_Dispatch_Table (Base_Typ)
then
declare
-- names of these types).
-- To conserve space, we do not produce this type unless one of the
- -- index types is either an enumeration type, has a variable upper
- -- bound, has a lower bound different from the constant 1, is a biased
- -- type, or is wider than "sizetype".
+ -- index types is either an enumeration type, has a variable lower or
+ -- upper bound or is a biased type.
-- Given the full encoding of these types (see above description for
-- the encoding of discrete types), this means that all necessary
-- because they are also needed for non Stand-Alone shared
-- libraries.
- -- Also ignore the shared libraries which are :
+ -- Also ignore the shared libraries which are:
-- -lgnat-<version> (7 + version'length chars)
-- -lgnarl-<version> (8 + version'length chars)
if Next_Line (1 .. Nlast) /= "-static" and then
Next_Line (1 .. Nlast) /= "-shared" and then
Next_Line (1 .. Nlast) /= "-lgnarl" and then
- Next_Line (1 .. Nlast) /= "-lgnat" and then
- Next_Line
- (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
- Shared_Lib ("gnarl") and then
- Next_Line
- (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /=
- Shared_Lib ("gnat")
+ Next_Line (1 .. Nlast) /= "-lgnat"
+ and then
+ Next_Line
+ (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
+ Shared_Lib ("gnarl")
+ and then
+ Next_Line
+ (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /=
+ Shared_Lib ("gnat")
then
if Next_Line (1) /= '-' then
when Aspect_Default_Value =>
if not Is_Scalar_Type (E) then
Error_Msg_N
- ("aspect Default_Value must apply to a scalar_Type", N);
+ ("aspect Default_Value must apply to a scalar type", N);
end if;
Aitem := Empty;
Set_Has_Predicates (Derived_Type);
end if;
- -- The derived type inherits the representation clauses of the parent.
- -- However, for a private type that is completed by a derivation, there
- -- may be operation attributes that have been specified already (stream
- -- attributes and External_Tag) and those must be provided. Finally, if
- -- the partial view is a private extension, the representation items of
- -- the parent have been inherited already, and should not be chained
- -- twice to the derived type.
-
- -- Historic note: The guard below used to check whether the parent type
- -- is tagged. This is no longer needed because an untagged derived type
- -- may carry rep items of its own as a result of certain SPARK pragmas.
- -- With the old guard in place, the rep items of the derived type were
- -- clobbered.
-
- if Present (First_Rep_Item (Derived_Type)) then
- declare
- Par_Item : constant Node_Id := First_Rep_Item (Parent_Type);
- Inherited : Boolean := False;
- Item : Node_Id;
- Last_Item : Node_Id;
-
- begin
- -- Inspect the rep item chain of the derived type and perform the
- -- following two functions:
- -- 1) Determine whether the derived type already inherited the
- -- rep items of the parent type.
- -- 2) Find the last rep item of the derived type
-
- Item := First_Rep_Item (Derived_Type);
- Last_Item := Item;
- while Present (Item) loop
- if Item = Par_Item then
- Inherited := True;
- exit;
- end if;
-
- Last_Item := Item;
- Item := Next_Rep_Item (Item);
- end loop;
+ -- The derived type inherits the representation clauses of the parent
- -- Nothing to do if the derived type already inherited the rep
- -- items from the parent type, otherwise append the parent rep
- -- item chain to that of the derived type.
-
- if not Inherited then
- Set_Next_Rep_Item (Last_Item, Par_Item);
- end if;
- end;
-
- -- Otherwise the derived type lacks rep items and directly inherits the
- -- rep items of the parent type.
-
- else
- Set_First_Rep_Item (Derived_Type, First_Rep_Item (Parent_Type));
- end if;
+ Inherit_Rep_Item_Chain (Derived_Type, Parent_Type);
-- Propagate the attributes related to pragma Default_Initial_Condition
-- from the parent type to the private extension. A derived type always
begin
Set_Size_Info (T1, T2);
- Set_First_Index (T1, First_Index (T2));
- Set_Is_Aliased (T1, Is_Aliased (T2));
- Set_Is_Volatile (T1, Is_Volatile (T2));
- Set_Treat_As_Volatile (T1, Treat_As_Volatile (T2));
- Set_Is_Constrained (T1, Is_Constrained (T2));
- Set_Depends_On_Private (T1, Has_Private_Component (T2));
- Set_First_Rep_Item (T1, First_Rep_Item (T2));
- Set_Convention (T1, Convention (T2));
- Set_Is_Limited_Composite (T1, Is_Limited_Composite (T2));
- Set_Is_Private_Composite (T1, Is_Private_Composite (T2));
- Set_Packed_Array_Impl_Type (T1, Packed_Array_Impl_Type (T2));
+ Set_First_Index (T1, First_Index (T2));
+ Set_Is_Aliased (T1, Is_Aliased (T2));
+ Set_Is_Volatile (T1, Is_Volatile (T2));
+ Set_Treat_As_Volatile (T1, Treat_As_Volatile (T2));
+ Set_Is_Constrained (T1, Is_Constrained (T2));
+ Set_Depends_On_Private (T1, Has_Private_Component (T2));
+ Inherit_Rep_Item_Chain (T1, T2);
+ Set_Convention (T1, Convention (T2));
+ Set_Is_Limited_Composite (T1, Is_Limited_Composite (T2));
+ Set_Is_Private_Composite (T1, Is_Private_Composite (T2));
+ Set_Packed_Array_Impl_Type (T1, Packed_Array_Impl_Type (T2));
end Copy_Array_Subtype_Attributes;
-----------------------------------
or else not Is_Variable (Obj)
then
Error_Msg_NE
- ("actual for& must be a variable", Obj, Control);
+ ("actual for & must be a variable", Obj, Control);
end if;
end if;
if not Is_Aliased_View (Obj) then
Error_Msg_NE
- ("object in prefixed call to& must be aliased"
- & " (RM-2005 4.3.1 (13))",
- Prefix (First_Actual), Subprog);
+ ("object in prefixed call to & must be aliased "
+ & " (RM-2005 4.3.1 (13))", Prefix (First_Actual), Subprog);
end if;
Analyze (First_Actual);
-- differences in rounding between static and non-static
-- expressions. AI-100 specifies that the effect of such rounding
-- is implementation dependent, and in GNAT we round to nearest
- -- even to match the run-time behavior.
+ -- even to match the run-time behavior. Note that this applies
+ -- to floating point literals, not fixed points ones, even though
+ -- their compiler representation is also as a universal real.
Set_Realval
(N, Machine (Base_Type (T), Realval (N), Round_Even, N));
+ Set_Is_Machine_Number (N);
end if;
- Set_Is_Machine_Number (N);
end if;
-- Check for out of range universal integer. This is a non-static
procedure Inherit_Rep_Item_Chain (Typ : Entity_Id; From_Typ : Entity_Id) is
From_Item : constant Node_Id := First_Rep_Item (From_Typ);
- Item : Node_Id;
+ Item : Node_Id := Empty;
+ Last_Item : Node_Id := Empty;
begin
- -- Reach the end of the destination type's chain (if any). The traversal
- -- ensures that we do not go past the last item.
+ -- Reach the end of the destination type's chain (if any) and capture
+ -- the last item.
Item := First_Rep_Item (Typ);
- while Present (Item) and then Present (Next_Rep_Item (Item)) loop
+ while Present (Item) loop
+
+ -- Do not inherit a chain that has been inherited already
+
+ if Item = From_Item then
+ return;
+ end if;
+
+ Last_Item := Item;
Item := Next_Rep_Item (Item);
end loop;
-- When the destination type has a rep item chain, the chain of the
-- source type is appended to it.
- if Present (Item) then
- Set_Next_Rep_Item (Item, From_Item);
+ if Present (Last_Item) then
+ Set_Next_Rep_Item (Last_Item, From_Item);
-- Otherwise the destination type directly inherits the rep item chain
- -- of the source type.
+ -- of the source type (if any).
else
Set_First_Rep_Item (Typ, From_Item);
projects / gcc.git / commitdiff