Debug_Pragmas_Enabled :=
Chars (Get_Pragma_Arg (Arg1)) = Name_Check;
- -----------------------------
- -- Default_Component_Value --
- -----------------------------
-
- when Pragma_Default_Component_Value => declare
- Arg : Node_Id;
- E : Entity_Id;
-
- begin
- GNAT_Pragma;
- Check_Arg_Count (2);
- Check_Arg_Is_Local_Name (Arg1);
-
- Arg := Get_Pragma_Arg (Arg1);
- Analyze (Arg);
-
- if Etype (Arg) = Any_Type then
- return;
- end if;
-
- if not Is_Entity_Name (Arg)
- or else not Is_Array_Type (Entity (Arg))
- then
- Error_Pragma_Arg ("pragma% requires an array type", Arg1);
- end if;
-
- Check_First_Subtype (Arg1);
-
- E := Entity (Arg);
- Check_Duplicate_Pragma (E);
-
- -- Check for rep item too early or too late, but skip this if
- -- the pragma comes from the corresponding aspect, since we do
- -- not need the checks, and more importantly, the pragma is on
- -- the rep item chain alreay, and must not be put there twice!
-
- if not From_Aspect_Specification (N) then
- if Rep_Item_Too_Early (E, N)
- or else
- Rep_Item_Too_Late (E, N)
- then
- return;
- end if;
- end if;
-
- -- Analyze the default value
-
- Arg := Get_Pragma_Arg (Arg2);
- Analyze_And_Resolve (Arg, Component_Type (E));
-
- if not Is_OK_Static_Expression (Arg) then
- Flag_Non_Static_Expr
- ("non-static expression not allowed for " &
- "Default_Component_Value",
- Arg2);
- raise Pragma_Exit;
- end if;
-
- -- Set the flag on the root type and then check for Rep_Item too
- -- early or too late, the latter call chains the pragma onto the
- -- Rep_Item chain.
-
- Set_Has_Default_Component_Value (Base_Type (E));
- end;
-
- -------------------
- -- Default_Value --
- -------------------
-
- when Pragma_Default_Value => declare
- Arg : Node_Id;
- E : Entity_Id;
-
- begin
- -- Error checks
-
- GNAT_Pragma;
- Check_Arg_Count (2);
- Check_Arg_Is_Local_Name (Arg1);
-
- Arg := Get_Pragma_Arg (Arg1);
- Analyze (Arg);
-
- if Etype (Arg) = Any_Type then
- return;
- end if;
-
- if not Is_Entity_Name (Arg)
- or else not Is_Scalar_Type (Entity (Arg))
- then
- Error_Pragma_Arg ("pragma% requires a scalar type", Arg1);
- end if;
-
- Check_First_Subtype (Arg1);
-
- E := Entity (Arg);
- Check_Duplicate_Pragma (E);
-
- -- Check for rep item too early or too late, but skip this if
- -- the pragma comes from the corresponding aspect, since we do
- -- not need the checks, and more importantly, the pragma is on
- -- the rep item chain alreay, and must not be put there twice!
-
- if not From_Aspect_Specification (N) then
- if Rep_Item_Too_Early (E, N)
- or else
- Rep_Item_Too_Late (E, N)
- then
- return;
- end if;
- end if;
-
- -- Analyze the default value. Note that we must do that after
- -- checking for Rep_Item_Too_Late since this resolution will
- -- freeze the type involved.
-
- Arg := Get_Pragma_Arg (Arg2);
- Analyze_And_Resolve (Arg, E);
-
- if not Is_OK_Static_Expression (Arg) then
- Flag_Non_Static_Expr
- ("non-static expression not allowed for Default_Value",
- Arg2);
- raise Pragma_Exit;
- end if;
-
- -- Set the flag on the root type and then check for Rep_Item too
- -- early or too late, the latter call chains the pragma onto the
- -- Rep_Item chain.
-
- Set_Has_Default_Value (Base_Type (E));
- end;
-
---------------------
-- Detect_Blocking --
---------------------
Pragma_Convention_Identifier => 0,
Pragma_Debug => -1,
Pragma_Debug_Policy => 0,
- Pragma_Default_Value => -1,
- Pragma_Default_Component_Value => -1,
Pragma_Detect_Blocking => -1,
Pragma_Default_Storage_Pool => -1,
Pragma_Dimension => -1,
projects / gcc.git / blobdiff